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
)
923 /* Discard any previous drive specifier if nm is now in UNC format. */
924 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
930 /* If nm is absolute, look for /./ or /../ sequences; if none are
931 found, we can probably return right away. We will avoid allocating
932 a new string if name is already fully expanded. */
934 IS_DIRECTORY_SEP (nm
[0])
939 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
946 /* If it turns out that the filename we want to return is just a
947 suffix of FILENAME, we don't need to go through and edit
948 things; we just need to construct a new string using data
949 starting at the middle of FILENAME. If we set lose to a
950 non-zero value, that means we've discovered that we can't do
957 /* Since we know the name is absolute, we can assume that each
958 element starts with a "/". */
960 /* "." and ".." are hairy. */
961 if (IS_DIRECTORY_SEP (p
[0])
963 && (IS_DIRECTORY_SEP (p
[2])
965 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
972 /* if dev:[dir]/, move nm to / */
973 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
974 nm
= (brack
? brack
+ 1 : colon
+ 1);
983 /* VMS pre V4.4,convert '-'s in filenames. */
984 if (lbrack
== rbrack
)
986 if (dots
< 2) /* this is to allow negative version numbers */
991 if (lbrack
> rbrack
&&
992 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
993 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
999 /* count open brackets, reset close bracket pointer */
1000 if (p
[0] == '[' || p
[0] == '<')
1001 lbrack
++, brack
= 0;
1002 /* count close brackets, set close bracket pointer */
1003 if (p
[0] == ']' || p
[0] == '>')
1004 rbrack
++, brack
= p
;
1005 /* detect ][ or >< */
1006 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1008 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1009 nm
= p
+ 1, lose
= 1;
1010 if (p
[0] == ':' && (colon
|| slash
))
1011 /* if dev1:[dir]dev2:, move nm to dev2: */
1017 /* if /name/dev:, move nm to dev: */
1020 /* if node::dev:, move colon following dev */
1021 else if (colon
&& colon
[-1] == ':')
1023 /* if dev1:dev2:, move nm to dev2: */
1024 else if (colon
&& colon
[-1] != ':')
1029 if (p
[0] == ':' && !colon
)
1035 if (lbrack
== rbrack
)
1038 else if (p
[0] == '.')
1046 if (index (nm
, '/'))
1047 return build_string (sys_translate_unix (nm
));
1050 /* Make sure directories are all separated with / or \ as
1051 desired, but avoid allocation of a new string when not
1053 CORRECT_DIR_SEPS (nm
);
1055 if (IS_DIRECTORY_SEP (nm
[1]))
1057 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1058 name
= build_string (nm
);
1062 /* drive must be set, so this is okay */
1063 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1065 name
= make_string (nm
- 2, p
- nm
+ 2);
1066 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1067 XSTRING (name
)->data
[1] = ':';
1070 #else /* not DOS_NT */
1071 if (nm
== XSTRING (name
)->data
)
1073 return build_string (nm
);
1074 #endif /* not DOS_NT */
1078 /* At this point, nm might or might not be an absolute file name. We
1079 need to expand ~ or ~user if present, otherwise prefix nm with
1080 default_directory if nm is not absolute, and finally collapse /./
1081 and /foo/../ sequences.
1083 We set newdir to be the appropriate prefix if one is needed:
1084 - the relevant user directory if nm starts with ~ or ~user
1085 - the specified drive's working dir (DOS/NT only) if nm does not
1087 - the value of default_directory.
1089 Note that these prefixes are not guaranteed to be absolute (except
1090 for the working dir of a drive). Therefore, to ensure we always
1091 return an absolute name, if the final prefix is not absolute we
1092 append it to the current working directory. */
1096 if (nm
[0] == '~') /* prefix ~ */
1098 if (IS_DIRECTORY_SEP (nm
[1])
1102 || nm
[1] == 0) /* ~ by itself */
1104 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1105 newdir
= (unsigned char *) "";
1108 collapse_newdir
= 0;
1111 nm
++; /* Don't leave the slash in nm. */
1114 else /* ~user/filename */
1116 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1121 o
= (unsigned char *) alloca (p
- nm
+ 1);
1122 bcopy ((char *) nm
, o
, p
- nm
);
1125 pw
= (struct passwd
*) getpwnam (o
+ 1);
1128 newdir
= (unsigned char *) pw
-> pw_dir
;
1130 nm
= p
+ 1; /* skip the terminator */
1134 collapse_newdir
= 0;
1139 /* If we don't find a user of that name, leave the name
1140 unchanged; don't move nm forward to p. */
1145 /* On DOS and Windows, nm is absolute if a drive name was specified;
1146 use the drive's current directory as the prefix if needed. */
1147 if (!newdir
&& drive
)
1149 /* Get default directory if needed to make nm absolute. */
1150 if (!IS_DIRECTORY_SEP (nm
[0]))
1152 newdir
= alloca (MAXPATHLEN
+ 1);
1153 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1158 /* Either nm starts with /, or drive isn't mounted. */
1159 newdir
= alloca (4);
1160 newdir
[0] = DRIVE_LETTER (drive
);
1168 /* Finally, if no prefix has been specified and nm is not absolute,
1169 then it must be expanded relative to default_directory. */
1173 /* /... alone is not absolute on DOS and Windows. */
1174 && !IS_DIRECTORY_SEP (nm
[0])
1177 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1184 newdir
= XSTRING (default_directory
)->data
;
1190 /* First ensure newdir is an absolute name. */
1192 /* Detect MSDOS file names with drive specifiers. */
1193 ! (IS_DRIVE (newdir
[0])
1194 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1196 /* Detect Windows file names in UNC format. */
1197 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1201 /* Effectively, let newdir be (expand-file-name newdir cwd).
1202 Because of the admonition against calling expand-file-name
1203 when we have pointers into lisp strings, we accomplish this
1204 indirectly by prepending newdir to nm if necessary, and using
1205 cwd (or the wd of newdir's drive) as the new newdir. */
1207 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1212 if (!IS_DIRECTORY_SEP (nm
[0]))
1214 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1215 file_name_as_directory (tmp
, newdir
);
1219 newdir
= alloca (MAXPATHLEN
+ 1);
1222 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1229 /* Strip off drive name from prefix, if present. */
1230 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1236 /* Keep only a prefix from newdir if nm starts with slash
1237 (//server/share for UNC, nothing otherwise). */
1238 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1241 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1243 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1245 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1247 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1259 /* Get rid of any slash at the end of newdir, unless newdir is
1260 just // (an incomplete UNC name). */
1261 length
= strlen (newdir
);
1262 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1264 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1268 unsigned char *temp
= (unsigned char *) alloca (length
);
1269 bcopy (newdir
, temp
, length
- 1);
1270 temp
[length
- 1] = 0;
1278 /* Now concatenate the directory and name to new space in the stack frame */
1279 tlen
+= strlen (nm
) + 1;
1281 /* Add reserved space for drive name. (The Microsoft x86 compiler
1282 produces incorrect code if the following two lines are combined.) */
1283 target
= (unsigned char *) alloca (tlen
+ 2);
1285 #else /* not DOS_NT */
1286 target
= (unsigned char *) alloca (tlen
);
1287 #endif /* not DOS_NT */
1293 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1294 strcpy (target
, newdir
);
1297 file_name_as_directory (target
, newdir
);
1300 strcat (target
, nm
);
1302 if (index (target
, '/'))
1303 strcpy (target
, sys_translate_unix (target
));
1306 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1308 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1316 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1322 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1323 /* brackets are offset from each other by 2 */
1326 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1327 /* convert [foo][bar] to [bar] */
1328 while (o
[-1] != '[' && o
[-1] != '<')
1330 else if (*p
== '-' && *o
!= '.')
1333 else if (p
[0] == '-' && o
[-1] == '.' &&
1334 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1335 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1339 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1340 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1342 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1344 /* else [foo.-] ==> [-] */
1350 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1351 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1357 if (!IS_DIRECTORY_SEP (*p
))
1361 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1362 #if defined (APOLLO) || defined (WINDOWSNT)
1363 /* // at start of filename is meaningful in Apollo
1364 and WindowsNT systems */
1366 #endif /* APOLLO || WINDOWSNT */
1372 else if (IS_DIRECTORY_SEP (p
[0])
1374 && (IS_DIRECTORY_SEP (p
[2])
1377 /* If "/." is the entire filename, keep the "/". Otherwise,
1378 just delete the whole "/.". */
1379 if (o
== target
&& p
[2] == '\0')
1383 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1384 /* `/../' is the "superroot" on certain file systems. */
1386 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1388 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1390 /* Keep initial / only if this is the whole name. */
1391 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1399 #endif /* not VMS */
1403 /* At last, set drive name. */
1405 /* Except for network file name. */
1406 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1407 #endif /* WINDOWSNT */
1409 if (!drive
) abort ();
1411 target
[0] = DRIVE_LETTER (drive
);
1414 CORRECT_DIR_SEPS (target
);
1417 return make_string (target
, o
- target
);
1421 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1422 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1423 "Convert FILENAME to absolute, and canonicalize it.\n\
1424 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1425 (does not start with slash); if DEFAULT is nil or missing,\n\
1426 the current buffer's value of default-directory is used.\n\
1427 Filenames containing `.' or `..' as components are simplified;\n\
1428 initial `~/' expands to your home directory.\n\
1429 See also the function `substitute-in-file-name'.")
1431 Lisp_Object name
, defalt
;
1435 register unsigned char *newdir
, *p
, *o
;
1437 unsigned char *target
;
1441 unsigned char * colon
= 0;
1442 unsigned char * close
= 0;
1443 unsigned char * slash
= 0;
1444 unsigned char * brack
= 0;
1445 int lbrack
= 0, rbrack
= 0;
1449 CHECK_STRING (name
, 0);
1452 /* Filenames on VMS are always upper case. */
1453 name
= Fupcase (name
);
1456 nm
= XSTRING (name
)->data
;
1458 /* If nm is absolute, flush ...// and detect /./ and /../.
1459 If no /./ or /../ we can return right away. */
1471 if (p
[0] == '/' && p
[1] == '/'
1473 /* // at start of filename is meaningful on Apollo system */
1478 if (p
[0] == '/' && p
[1] == '~')
1479 nm
= p
+ 1, lose
= 1;
1480 if (p
[0] == '/' && p
[1] == '.'
1481 && (p
[2] == '/' || p
[2] == 0
1482 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1488 /* if dev:[dir]/, move nm to / */
1489 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1490 nm
= (brack
? brack
+ 1 : colon
+ 1);
1491 lbrack
= rbrack
= 0;
1499 /* VMS pre V4.4,convert '-'s in filenames. */
1500 if (lbrack
== rbrack
)
1502 if (dots
< 2) /* this is to allow negative version numbers */
1507 if (lbrack
> rbrack
&&
1508 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1509 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1515 /* count open brackets, reset close bracket pointer */
1516 if (p
[0] == '[' || p
[0] == '<')
1517 lbrack
++, brack
= 0;
1518 /* count close brackets, set close bracket pointer */
1519 if (p
[0] == ']' || p
[0] == '>')
1520 rbrack
++, brack
= p
;
1521 /* detect ][ or >< */
1522 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1524 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1525 nm
= p
+ 1, lose
= 1;
1526 if (p
[0] == ':' && (colon
|| slash
))
1527 /* if dev1:[dir]dev2:, move nm to dev2: */
1533 /* If /name/dev:, move nm to dev: */
1536 /* If node::dev:, move colon following dev */
1537 else if (colon
&& colon
[-1] == ':')
1539 /* If dev1:dev2:, move nm to dev2: */
1540 else if (colon
&& colon
[-1] != ':')
1545 if (p
[0] == ':' && !colon
)
1551 if (lbrack
== rbrack
)
1554 else if (p
[0] == '.')
1562 if (index (nm
, '/'))
1563 return build_string (sys_translate_unix (nm
));
1565 if (nm
== XSTRING (name
)->data
)
1567 return build_string (nm
);
1571 /* Now determine directory to start with and put it in NEWDIR */
1575 if (nm
[0] == '~') /* prefix ~ */
1580 || nm
[1] == 0)/* ~/filename */
1582 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1583 newdir
= (unsigned char *) "";
1586 nm
++; /* Don't leave the slash in nm. */
1589 else /* ~user/filename */
1591 /* Get past ~ to user */
1592 unsigned char *user
= nm
+ 1;
1593 /* Find end of name. */
1594 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1595 int len
= ptr
? ptr
- user
: strlen (user
);
1597 unsigned char *ptr1
= index (user
, ':');
1598 if (ptr1
!= 0 && ptr1
- user
< len
)
1601 /* Copy the user name into temp storage. */
1602 o
= (unsigned char *) alloca (len
+ 1);
1603 bcopy ((char *) user
, o
, len
);
1606 /* Look up the user name. */
1607 pw
= (struct passwd
*) getpwnam (o
+ 1);
1609 error ("\"%s\" isn't a registered user", o
+ 1);
1611 newdir
= (unsigned char *) pw
->pw_dir
;
1613 /* Discard the user name from NM. */
1620 #endif /* not VMS */
1624 defalt
= current_buffer
->directory
;
1625 CHECK_STRING (defalt
, 1);
1626 newdir
= XSTRING (defalt
)->data
;
1629 /* Now concatenate the directory and name to new space in the stack frame */
1631 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1632 target
= (unsigned char *) alloca (tlen
);
1638 if (nm
[0] == 0 || nm
[0] == '/')
1639 strcpy (target
, newdir
);
1642 file_name_as_directory (target
, newdir
);
1645 strcat (target
, nm
);
1647 if (index (target
, '/'))
1648 strcpy (target
, sys_translate_unix (target
));
1651 /* Now canonicalize by removing /. and /foo/.. if they appear */
1659 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1665 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1666 /* brackets are offset from each other by 2 */
1669 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1670 /* convert [foo][bar] to [bar] */
1671 while (o
[-1] != '[' && o
[-1] != '<')
1673 else if (*p
== '-' && *o
!= '.')
1676 else if (p
[0] == '-' && o
[-1] == '.' &&
1677 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1678 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1682 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1683 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1685 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1687 /* else [foo.-] ==> [-] */
1693 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1694 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1704 else if (!strncmp (p
, "//", 2)
1706 /* // at start of filename is meaningful in Apollo system */
1714 else if (p
[0] == '/' && p
[1] == '.' &&
1715 (p
[2] == '/' || p
[2] == 0))
1717 else if (!strncmp (p
, "/..", 3)
1718 /* `/../' is the "superroot" on certain file systems. */
1720 && (p
[3] == '/' || p
[3] == 0))
1722 while (o
!= target
&& *--o
!= '/')
1725 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1729 if (o
== target
&& *o
== '/')
1737 #endif /* not VMS */
1740 return make_string (target
, o
- target
);
1744 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1745 Ssubstitute_in_file_name
, 1, 1, 0,
1746 "Substitute environment variables referred to in FILENAME.\n\
1747 `$FOO' where FOO is an environment variable name means to substitute\n\
1748 the value of that variable. The variable name should be terminated\n\
1749 with a character not a letter, digit or underscore; otherwise, enclose\n\
1750 the entire variable name in braces.\n\
1751 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1752 On VMS, `$' substitution is not done; this function does little and only\n\
1753 duplicates what `expand-file-name' does.")
1755 Lisp_Object filename
;
1759 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1760 unsigned char *target
;
1762 int substituted
= 0;
1764 Lisp_Object handler
;
1766 CHECK_STRING (filename
, 0);
1768 /* If the file name has special constructs in it,
1769 call the corresponding file handler. */
1770 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1771 if (!NILP (handler
))
1772 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1774 nm
= XSTRING (filename
)->data
;
1776 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1777 CORRECT_DIR_SEPS (nm
);
1778 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1780 endp
= nm
+ XSTRING (filename
)->size
;
1782 /* If /~ or // appears, discard everything through first slash. */
1784 for (p
= nm
; p
!= endp
; p
++)
1787 #if defined (APOLLO) || defined (WINDOWSNT)
1788 /* // at start of file name is meaningful in Apollo and
1789 WindowsNT systems */
1790 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1791 #else /* not (APOLLO || WINDOWSNT) */
1792 || IS_DIRECTORY_SEP (p
[0])
1793 #endif /* not (APOLLO || WINDOWSNT) */
1798 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1800 || IS_DIRECTORY_SEP (p
[-1])))
1806 /* see comment in expand-file-name about drive specifiers */
1807 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1808 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1817 return build_string (nm
);
1820 /* See if any variables are substituted into the string
1821 and find the total length of their values in `total' */
1823 for (p
= nm
; p
!= endp
;)
1833 /* "$$" means a single "$" */
1842 while (p
!= endp
&& *p
!= '}') p
++;
1843 if (*p
!= '}') goto missingclose
;
1849 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1853 /* Copy out the variable name */
1854 target
= (unsigned char *) alloca (s
- o
+ 1);
1855 strncpy (target
, o
, s
- o
);
1858 strupr (target
); /* $home == $HOME etc. */
1861 /* Get variable value */
1862 o
= (unsigned char *) egetenv (target
);
1863 if (!o
) goto badvar
;
1864 total
+= strlen (o
);
1871 /* If substitution required, recopy the string and do it */
1872 /* Make space in stack frame for the new copy */
1873 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1876 /* Copy the rest of the name through, replacing $ constructs with values */
1893 while (p
!= endp
&& *p
!= '}') p
++;
1894 if (*p
!= '}') goto missingclose
;
1900 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1904 /* Copy out the variable name */
1905 target
= (unsigned char *) alloca (s
- o
+ 1);
1906 strncpy (target
, o
, s
- o
);
1909 strupr (target
); /* $home == $HOME etc. */
1912 /* Get variable value */
1913 o
= (unsigned char *) egetenv (target
);
1923 /* If /~ or // appears, discard everything through first slash. */
1925 for (p
= xnm
; p
!= x
; p
++)
1927 #if defined (APOLLO) || defined (WINDOWSNT)
1928 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1929 #else /* not (APOLLO || WINDOWSNT) */
1930 || IS_DIRECTORY_SEP (p
[0])
1931 #endif /* not (APOLLO || WINDOWSNT) */
1933 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1936 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1937 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1941 return make_string (xnm
, x
- xnm
);
1944 error ("Bad format environment-variable substitution");
1946 error ("Missing \"}\" in environment-variable substitution");
1948 error ("Substituting nonexistent environment variable \"%s\"", target
);
1951 #endif /* not VMS */
1954 /* A slightly faster and more convenient way to get
1955 (directory-file-name (expand-file-name FOO)). */
1958 expand_and_dir_to_file (filename
, defdir
)
1959 Lisp_Object filename
, defdir
;
1961 register Lisp_Object absname
;
1963 absname
= Fexpand_file_name (filename
, defdir
);
1966 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1967 if (c
== ':' || c
== ']' || c
== '>')
1968 absname
= Fdirectory_file_name (absname
);
1971 /* Remove final slash, if any (unless this is the root dir).
1972 stat behaves differently depending! */
1973 if (XSTRING (absname
)->size
> 1
1974 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1975 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1976 /* We cannot take shortcuts; they might be wrong for magic file names. */
1977 absname
= Fdirectory_file_name (absname
);
1982 /* Signal an error if the file ABSNAME already exists.
1983 If INTERACTIVE is nonzero, ask the user whether to proceed,
1984 and bypass the error if the user says to go ahead.
1985 QUERYSTRING is a name for the action that is being considered
1987 *STATPTR is used to store the stat information if the file exists.
1988 If the file does not exist, STATPTR->st_mode is set to 0. */
1991 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1992 Lisp_Object absname
;
1993 unsigned char *querystring
;
1995 struct stat
*statptr
;
1997 register Lisp_Object tem
;
1998 struct stat statbuf
;
1999 struct gcpro gcpro1
;
2001 /* stat is a good way to tell whether the file exists,
2002 regardless of what access permissions it has. */
2003 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2006 Fsignal (Qfile_already_exists
,
2007 Fcons (build_string ("File already exists"),
2008 Fcons (absname
, Qnil
)));
2010 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2011 XSTRING (absname
)->data
, querystring
));
2014 Fsignal (Qfile_already_exists
,
2015 Fcons (build_string ("File already exists"),
2016 Fcons (absname
, Qnil
)));
2023 statptr
->st_mode
= 0;
2028 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2029 "fCopy file: \nFCopy %s to file: \np\nP",
2030 "Copy FILE to NEWNAME. Both args must be strings.\n\
2031 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2032 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2033 A number as third arg means request confirmation if NEWNAME already exists.\n\
2034 This is what happens in interactive use with M-x.\n\
2035 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2036 last-modified time as the old one. (This works on only some systems.)\n\
2037 A prefix arg makes KEEP-TIME non-nil.")
2038 (file
, newname
, ok_if_already_exists
, keep_date
)
2039 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2042 char buf
[16 * 1024];
2043 struct stat st
, out_st
;
2044 Lisp_Object handler
;
2045 struct gcpro gcpro1
, gcpro2
;
2046 int count
= specpdl_ptr
- specpdl
;
2047 int input_file_statable_p
;
2049 GCPRO2 (file
, newname
);
2050 CHECK_STRING (file
, 0);
2051 CHECK_STRING (newname
, 1);
2052 file
= Fexpand_file_name (file
, Qnil
);
2053 newname
= Fexpand_file_name (newname
, Qnil
);
2055 /* If the input file name has special constructs in it,
2056 call the corresponding file handler. */
2057 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2058 /* Likewise for output file name. */
2060 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2061 if (!NILP (handler
))
2062 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2063 ok_if_already_exists
, keep_date
));
2065 if (NILP (ok_if_already_exists
)
2066 || INTEGERP (ok_if_already_exists
))
2067 barf_or_query_if_file_exists (newname
, "copy to it",
2068 INTEGERP (ok_if_already_exists
), &out_st
);
2069 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2072 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2074 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2076 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2078 /* We can only copy regular files and symbolic links. Other files are not
2080 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2082 #if !defined (MSDOS) || __DJGPP__ > 1
2083 if (out_st
.st_mode
!= 0
2084 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2087 report_file_error ("Input and output files are the same",
2088 Fcons (file
, Fcons (newname
, Qnil
)));
2092 #if defined (S_ISREG) && defined (S_ISLNK)
2093 if (input_file_statable_p
)
2095 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2097 #if defined (EISDIR)
2098 /* Get a better looking error message. */
2101 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2104 #endif /* S_ISREG && S_ISLNK */
2107 /* Create the copy file with the same record format as the input file */
2108 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2111 /* System's default file type was set to binary by _fmode in emacs.c. */
2112 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2113 #else /* not MSDOS */
2114 ofd
= creat (XSTRING (newname
)->data
, 0666);
2115 #endif /* not MSDOS */
2118 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2120 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2124 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2125 if (write (ofd
, buf
, n
) != n
)
2126 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2129 /* Closing the output clobbers the file times on some systems. */
2130 if (close (ofd
) < 0)
2131 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2133 if (input_file_statable_p
)
2135 if (!NILP (keep_date
))
2137 EMACS_TIME atime
, mtime
;
2138 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2139 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2140 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2141 Fsignal (Qfile_date_error
,
2142 Fcons (build_string ("Cannot set file date"),
2143 Fcons (newname
, Qnil
)));
2146 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2148 #if defined (__DJGPP__) && __DJGPP__ > 1
2149 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2150 and if it can't, it tells so. Otherwise, under MSDOS we usually
2151 get only the READ bit, which will make the copied file read-only,
2152 so it's better not to chmod at all. */
2153 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2154 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2155 #endif /* DJGPP version 2 or newer */
2161 /* Discard the unwind protects. */
2162 specpdl_ptr
= specpdl
+ count
;
2168 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2169 Smake_directory_internal
, 1, 1, 0,
2170 "Create a new directory named DIRECTORY.")
2172 Lisp_Object directory
;
2175 Lisp_Object handler
;
2177 CHECK_STRING (directory
, 0);
2178 directory
= Fexpand_file_name (directory
, Qnil
);
2180 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2181 if (!NILP (handler
))
2182 return call2 (handler
, Qmake_directory_internal
, directory
);
2184 dir
= XSTRING (directory
)->data
;
2187 if (mkdir (dir
) != 0)
2189 if (mkdir (dir
, 0777) != 0)
2191 report_file_error ("Creating directory", Flist (1, &directory
));
2196 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2197 "Delete the directory named DIRECTORY.")
2199 Lisp_Object directory
;
2202 Lisp_Object handler
;
2204 CHECK_STRING (directory
, 0);
2205 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2206 dir
= XSTRING (directory
)->data
;
2208 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2209 if (!NILP (handler
))
2210 return call2 (handler
, Qdelete_directory
, directory
);
2212 if (rmdir (dir
) != 0)
2213 report_file_error ("Removing directory", Flist (1, &directory
));
2218 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2219 "Delete file named FILENAME.\n\
2220 If file has multiple names, it continues to exist with the other names.")
2222 Lisp_Object filename
;
2224 Lisp_Object handler
;
2225 CHECK_STRING (filename
, 0);
2226 filename
= Fexpand_file_name (filename
, Qnil
);
2228 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2229 if (!NILP (handler
))
2230 return call2 (handler
, Qdelete_file
, filename
);
2232 if (0 > unlink (XSTRING (filename
)->data
))
2233 report_file_error ("Removing old name", Flist (1, &filename
));
2238 internal_delete_file_1 (ignore
)
2244 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2247 internal_delete_file (filename
)
2248 Lisp_Object filename
;
2250 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2251 Qt
, internal_delete_file_1
));
2254 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2255 "fRename file: \nFRename %s to file: \np",
2256 "Rename FILE as NEWNAME. Both args strings.\n\
2257 If file has names other than FILE, it continues to have those names.\n\
2258 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2259 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2260 A number as third arg means request confirmation if NEWNAME already exists.\n\
2261 This is what happens in interactive use with M-x.")
2262 (file
, newname
, ok_if_already_exists
)
2263 Lisp_Object file
, newname
, ok_if_already_exists
;
2266 Lisp_Object args
[2];
2268 Lisp_Object handler
;
2269 struct gcpro gcpro1
, gcpro2
;
2271 GCPRO2 (file
, newname
);
2272 CHECK_STRING (file
, 0);
2273 CHECK_STRING (newname
, 1);
2274 file
= Fexpand_file_name (file
, Qnil
);
2275 newname
= Fexpand_file_name (newname
, Qnil
);
2277 /* If the file name has special constructs in it,
2278 call the corresponding file handler. */
2279 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2281 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2282 if (!NILP (handler
))
2283 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2284 file
, newname
, ok_if_already_exists
));
2286 if (NILP (ok_if_already_exists
)
2287 || INTEGERP (ok_if_already_exists
))
2288 barf_or_query_if_file_exists (newname
, "rename to it",
2289 INTEGERP (ok_if_already_exists
), 0);
2291 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2293 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2294 || 0 > unlink (XSTRING (file
)->data
))
2299 Fcopy_file (file
, newname
,
2300 /* We have already prompted if it was an integer,
2301 so don't have copy-file prompt again. */
2302 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2303 Fdelete_file (file
);
2310 report_file_error ("Renaming", Flist (2, args
));
2313 report_file_error ("Renaming", Flist (2, &file
));
2320 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2321 "fAdd name to file: \nFName to add to %s: \np",
2322 "Give FILE additional name NEWNAME. Both args strings.\n\
2323 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2324 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2325 A number as third arg means request confirmation if NEWNAME already exists.\n\
2326 This is what happens in interactive use with M-x.")
2327 (file
, newname
, ok_if_already_exists
)
2328 Lisp_Object file
, newname
, ok_if_already_exists
;
2331 Lisp_Object args
[2];
2333 Lisp_Object handler
;
2334 struct gcpro gcpro1
, gcpro2
;
2336 GCPRO2 (file
, newname
);
2337 CHECK_STRING (file
, 0);
2338 CHECK_STRING (newname
, 1);
2339 file
= Fexpand_file_name (file
, Qnil
);
2340 newname
= Fexpand_file_name (newname
, Qnil
);
2342 /* If the file name has special constructs in it,
2343 call the corresponding file handler. */
2344 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2345 if (!NILP (handler
))
2346 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2347 newname
, ok_if_already_exists
));
2349 /* If the new name has special constructs in it,
2350 call the corresponding file handler. */
2351 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2352 if (!NILP (handler
))
2353 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2354 newname
, ok_if_already_exists
));
2356 if (NILP (ok_if_already_exists
)
2357 || INTEGERP (ok_if_already_exists
))
2358 barf_or_query_if_file_exists (newname
, "make it a new name",
2359 INTEGERP (ok_if_already_exists
), 0);
2361 /* Windows does not support this operation. */
2362 report_file_error ("Adding new name", Flist (2, &file
));
2363 #else /* not WINDOWSNT */
2365 unlink (XSTRING (newname
)->data
);
2366 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2371 report_file_error ("Adding new name", Flist (2, args
));
2373 report_file_error ("Adding new name", Flist (2, &file
));
2376 #endif /* not WINDOWSNT */
2383 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2384 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2385 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2386 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2387 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2388 A number as third arg means request confirmation if LINKNAME already exists.\n\
2389 This happens for interactive use with M-x.")
2390 (filename
, linkname
, ok_if_already_exists
)
2391 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2394 Lisp_Object args
[2];
2396 Lisp_Object handler
;
2397 struct gcpro gcpro1
, gcpro2
;
2399 GCPRO2 (filename
, linkname
);
2400 CHECK_STRING (filename
, 0);
2401 CHECK_STRING (linkname
, 1);
2402 /* If the link target has a ~, we must expand it to get
2403 a truly valid file name. Otherwise, do not expand;
2404 we want to permit links to relative file names. */
2405 if (XSTRING (filename
)->data
[0] == '~')
2406 filename
= Fexpand_file_name (filename
, Qnil
);
2407 linkname
= Fexpand_file_name (linkname
, Qnil
);
2409 /* If the file name has special constructs in it,
2410 call the corresponding file handler. */
2411 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2412 if (!NILP (handler
))
2413 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2414 linkname
, ok_if_already_exists
));
2416 /* If the new link name has special constructs in it,
2417 call the corresponding file handler. */
2418 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2419 if (!NILP (handler
))
2420 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2421 linkname
, ok_if_already_exists
));
2423 if (NILP (ok_if_already_exists
)
2424 || INTEGERP (ok_if_already_exists
))
2425 barf_or_query_if_file_exists (linkname
, "make it a link",
2426 INTEGERP (ok_if_already_exists
), 0);
2427 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2429 /* If we didn't complain already, silently delete existing file. */
2430 if (errno
== EEXIST
)
2432 unlink (XSTRING (linkname
)->data
);
2433 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2443 report_file_error ("Making symbolic link", Flist (2, args
));
2445 report_file_error ("Making symbolic link", Flist (2, &filename
));
2451 #endif /* S_IFLNK */
2455 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2456 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2457 "Define the job-wide logical name NAME to have the value STRING.\n\
2458 If STRING is nil or a null string, the logical name NAME is deleted.")
2463 CHECK_STRING (name
, 0);
2465 delete_logical_name (XSTRING (name
)->data
);
2468 CHECK_STRING (string
, 1);
2470 if (XSTRING (string
)->size
== 0)
2471 delete_logical_name (XSTRING (name
)->data
);
2473 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2482 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2483 "Open a network connection to PATH using LOGIN as the login string.")
2485 Lisp_Object path
, login
;
2489 CHECK_STRING (path
, 0);
2490 CHECK_STRING (login
, 0);
2492 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2494 if (netresult
== -1)
2499 #endif /* HPUX_NET */
2501 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2503 "Return t if file FILENAME specifies an absolute file name.\n\
2504 On Unix, this is a name starting with a `/' or a `~'.")
2506 Lisp_Object filename
;
2510 CHECK_STRING (filename
, 0);
2511 ptr
= XSTRING (filename
)->data
;
2512 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2514 /* ??? This criterion is probably wrong for '<'. */
2515 || index (ptr
, ':') || index (ptr
, '<')
2516 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2520 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2528 /* Return nonzero if file FILENAME exists and can be executed. */
2531 check_executable (filename
)
2535 int len
= strlen (filename
);
2538 if (stat (filename
, &st
) < 0)
2540 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2541 return ((st
.st_mode
& S_IEXEC
) != 0);
2543 return (S_ISREG (st
.st_mode
)
2545 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2546 || stricmp (suffix
, ".exe") == 0
2547 || stricmp (suffix
, ".bat") == 0)
2548 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2549 #endif /* not WINDOWSNT */
2550 #else /* not DOS_NT */
2551 #ifdef HAVE_EUIDACCESS
2552 return (euidaccess (filename
, 1) >= 0);
2554 /* Access isn't quite right because it uses the real uid
2555 and we really want to test with the effective uid.
2556 But Unix doesn't give us a right way to do it. */
2557 return (access (filename
, 1) >= 0);
2559 #endif /* not DOS_NT */
2562 /* Return nonzero if file FILENAME exists and can be written. */
2565 check_writable (filename
)
2570 if (stat (filename
, &st
) < 0)
2572 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2573 #else /* not MSDOS */
2574 #ifdef HAVE_EUIDACCESS
2575 return (euidaccess (filename
, 2) >= 0);
2577 /* Access isn't quite right because it uses the real uid
2578 and we really want to test with the effective uid.
2579 But Unix doesn't give us a right way to do it.
2580 Opening with O_WRONLY could work for an ordinary file,
2581 but would lose for directories. */
2582 return (access (filename
, 2) >= 0);
2584 #endif /* not MSDOS */
2587 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2588 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2589 See also `file-readable-p' and `file-attributes'.")
2591 Lisp_Object filename
;
2593 Lisp_Object absname
;
2594 Lisp_Object handler
;
2595 struct stat statbuf
;
2597 CHECK_STRING (filename
, 0);
2598 absname
= Fexpand_file_name (filename
, Qnil
);
2600 /* If the file name has special constructs in it,
2601 call the corresponding file handler. */
2602 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2603 if (!NILP (handler
))
2604 return call2 (handler
, Qfile_exists_p
, absname
);
2606 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2609 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2610 "Return t if FILENAME can be executed by you.\n\
2611 For a directory, this means you can access files in that directory.")
2613 Lisp_Object filename
;
2616 Lisp_Object absname
;
2617 Lisp_Object handler
;
2619 CHECK_STRING (filename
, 0);
2620 absname
= Fexpand_file_name (filename
, Qnil
);
2622 /* If the file name has special constructs in it,
2623 call the corresponding file handler. */
2624 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2625 if (!NILP (handler
))
2626 return call2 (handler
, Qfile_executable_p
, absname
);
2628 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2631 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2632 "Return t if file FILENAME exists and you can read it.\n\
2633 See also `file-exists-p' and `file-attributes'.")
2635 Lisp_Object filename
;
2637 Lisp_Object absname
;
2638 Lisp_Object handler
;
2641 struct stat statbuf
;
2643 CHECK_STRING (filename
, 0);
2644 absname
= Fexpand_file_name (filename
, Qnil
);
2646 /* If the file name has special constructs in it,
2647 call the corresponding file handler. */
2648 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2649 if (!NILP (handler
))
2650 return call2 (handler
, Qfile_readable_p
, absname
);
2653 /* Under MS-DOS and Windows, open does not work for directories. */
2654 if (access (XSTRING (absname
)->data
, 0) == 0)
2657 #else /* not DOS_NT */
2659 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2660 /* Opening a fifo without O_NONBLOCK can wait.
2661 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2662 except in the case of a fifo, on a system which handles it. */
2663 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2666 if (S_ISFIFO (statbuf
.st_mode
))
2667 flags
|= O_NONBLOCK
;
2669 desc
= open (XSTRING (absname
)->data
, flags
);
2674 #endif /* not DOS_NT */
2677 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2679 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2680 "Return t if file FILENAME can be written or created by you.")
2682 Lisp_Object filename
;
2684 Lisp_Object absname
, dir
;
2685 Lisp_Object handler
;
2686 struct stat statbuf
;
2688 CHECK_STRING (filename
, 0);
2689 absname
= Fexpand_file_name (filename
, Qnil
);
2691 /* If the file name has special constructs in it,
2692 call the corresponding file handler. */
2693 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2694 if (!NILP (handler
))
2695 return call2 (handler
, Qfile_writable_p
, absname
);
2697 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2698 return (check_writable (XSTRING (absname
)->data
)
2700 dir
= Ffile_name_directory (absname
);
2703 dir
= Fdirectory_file_name (dir
);
2707 dir
= Fdirectory_file_name (dir
);
2709 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2713 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2714 "Access file FILENAME, and get an error if that does not work.\n\
2715 The second argument STRING is used in the error message.\n\
2716 If there is no error, we return nil.")
2718 Lisp_Object filename
, string
;
2720 Lisp_Object handler
;
2723 CHECK_STRING (filename
, 0);
2725 /* If the file name has special constructs in it,
2726 call the corresponding file handler. */
2727 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2728 if (!NILP (handler
))
2729 return call3 (handler
, Qaccess_file
, filename
, string
);
2731 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2733 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2739 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2740 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2741 The value is the name of the file to which it is linked.\n\
2742 Otherwise returns nil.")
2744 Lisp_Object filename
;
2751 Lisp_Object handler
;
2753 CHECK_STRING (filename
, 0);
2754 filename
= Fexpand_file_name (filename
, Qnil
);
2756 /* If the file name has special constructs in it,
2757 call the corresponding file handler. */
2758 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2759 if (!NILP (handler
))
2760 return call2 (handler
, Qfile_symlink_p
, filename
);
2765 buf
= (char *) xmalloc (bufsize
);
2766 bzero (buf
, bufsize
);
2767 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2768 if (valsize
< bufsize
) break;
2769 /* Buffer was not long enough */
2778 val
= make_string (buf
, valsize
);
2781 #else /* not S_IFLNK */
2783 #endif /* not S_IFLNK */
2786 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2787 "Return t if FILENAME names an existing directory.")
2789 Lisp_Object filename
;
2791 register Lisp_Object absname
;
2793 Lisp_Object handler
;
2795 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2797 /* If the file name has special constructs in it,
2798 call the corresponding file handler. */
2799 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2800 if (!NILP (handler
))
2801 return call2 (handler
, Qfile_directory_p
, absname
);
2803 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2805 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2808 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2809 "Return t if file FILENAME is the name of a directory as a file,\n\
2810 and files in that directory can be opened by you. In order to use a\n\
2811 directory as a buffer's current directory, this predicate must return true.\n\
2812 A directory name spec may be given instead; then the value is t\n\
2813 if the directory so specified exists and really is a readable and\n\
2814 searchable directory.")
2816 Lisp_Object filename
;
2818 Lisp_Object handler
;
2820 struct gcpro gcpro1
;
2822 /* If the file name has special constructs in it,
2823 call the corresponding file handler. */
2824 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2825 if (!NILP (handler
))
2826 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2828 /* It's an unlikely combination, but yes we really do need to gcpro:
2829 Suppose that file-accessible-directory-p has no handler, but
2830 file-directory-p does have a handler; this handler causes a GC which
2831 relocates the string in `filename'; and finally file-directory-p
2832 returns non-nil. Then we would end up passing a garbaged string
2833 to file-executable-p. */
2835 tem
= (NILP (Ffile_directory_p (filename
))
2836 || NILP (Ffile_executable_p (filename
)));
2838 return tem
? Qnil
: Qt
;
2841 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2842 "Return t if file FILENAME is the name of a regular file.\n\
2843 This is the sort of file that holds an ordinary stream of data bytes.")
2845 Lisp_Object filename
;
2847 register Lisp_Object absname
;
2849 Lisp_Object handler
;
2851 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2853 /* If the file name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2856 if (!NILP (handler
))
2857 return call2 (handler
, Qfile_regular_p
, absname
);
2859 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2861 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2864 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2865 "Return mode bits of file named FILENAME, as an integer.")
2867 Lisp_Object filename
;
2869 Lisp_Object absname
;
2871 Lisp_Object handler
;
2873 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2875 /* If the file name has special constructs in it,
2876 call the corresponding file handler. */
2877 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2878 if (!NILP (handler
))
2879 return call2 (handler
, Qfile_modes
, absname
);
2881 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2883 #if defined (MSDOS) && __DJGPP__ < 2
2884 if (check_executable (XSTRING (absname
)->data
))
2885 st
.st_mode
|= S_IEXEC
;
2886 #endif /* MSDOS && __DJGPP__ < 2 */
2888 return make_number (st
.st_mode
& 07777);
2891 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2892 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2893 Only the 12 low bits of MODE are used.")
2895 Lisp_Object filename
, mode
;
2897 Lisp_Object absname
;
2898 Lisp_Object handler
;
2900 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2901 CHECK_NUMBER (mode
, 1);
2903 /* If the file name has special constructs in it,
2904 call the corresponding file handler. */
2905 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2906 if (!NILP (handler
))
2907 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2909 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2910 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2915 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2916 "Set the file permission bits for newly created files.\n\
2917 The argument MODE should be an integer; only the low 9 bits are used.\n\
2918 This setting is inherited by subprocesses.")
2922 CHECK_NUMBER (mode
, 0);
2924 umask ((~ XINT (mode
)) & 0777);
2929 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2930 "Return the default file protection for created files.\n\
2931 The value is an integer.")
2937 realmask
= umask (0);
2940 XSETINT (value
, (~ realmask
) & 0777);
2946 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2947 "Tell Unix to finish all pending disk updates.")
2956 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2957 "Return t if file FILE1 is newer than file FILE2.\n\
2958 If FILE1 does not exist, the answer is nil;\n\
2959 otherwise, if FILE2 does not exist, the answer is t.")
2961 Lisp_Object file1
, file2
;
2963 Lisp_Object absname1
, absname2
;
2966 Lisp_Object handler
;
2967 struct gcpro gcpro1
, gcpro2
;
2969 CHECK_STRING (file1
, 0);
2970 CHECK_STRING (file2
, 0);
2973 GCPRO2 (absname1
, file2
);
2974 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2975 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2978 /* If the file name has special constructs in it,
2979 call the corresponding file handler. */
2980 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2982 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2983 if (!NILP (handler
))
2984 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2986 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2989 mtime1
= st
.st_mtime
;
2991 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2994 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2998 Lisp_Object Qfind_buffer_file_type
;
3001 #ifndef READ_BUF_SIZE
3002 #define READ_BUF_SIZE (64 << 10)
3005 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3007 "Insert contents of file FILENAME after point.\n\
3008 Returns list of absolute file name and length of data inserted.\n\
3009 If second argument VISIT is non-nil, the buffer's visited filename\n\
3010 and last save file modtime are set, and it is marked unmodified.\n\
3011 If visiting and the file does not exist, visiting is completed\n\
3012 before the error is signaled.\n\
3013 The optional third and fourth arguments BEG and END\n\
3014 specify what portion of the file to insert.\n\
3015 If VISIT is non-nil, BEG and END must be nil.\n\
3017 If optional fifth argument REPLACE is non-nil,\n\
3018 it means replace the current buffer contents (in the accessible portion)\n\
3019 with the file contents. This is better than simply deleting and inserting\n\
3020 the whole thing because (1) it preserves some marker positions\n\
3021 and (2) it puts less data in the undo list.\n\
3022 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3023 which is often less than the number of characters to be read.\n\
3024 This does code conversion according to the value of\n\
3025 `coding-system-for-read' or `file-coding-system-alist',\n\
3026 and sets the variable `last-coding-system-used' to the coding system\n\
3028 (filename
, visit
, beg
, end
, replace
)
3029 Lisp_Object filename
, visit
, beg
, end
, replace
;
3033 register int inserted
= 0;
3034 register int how_much
;
3035 register int unprocessed
;
3036 int count
= specpdl_ptr
- specpdl
;
3037 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3038 Lisp_Object handler
, val
, insval
;
3041 int not_regular
= 0;
3042 char read_buf
[READ_BUF_SIZE
];
3043 struct coding_system coding
;
3044 unsigned char buffer
[1 << 14];
3045 int replace_handled
= 0;
3047 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3048 error ("Cannot do file visiting in an indirect buffer");
3050 if (!NILP (current_buffer
->read_only
))
3051 Fbarf_if_buffer_read_only ();
3056 GCPRO3 (filename
, val
, p
);
3058 CHECK_STRING (filename
, 0);
3059 filename
= Fexpand_file_name (filename
, Qnil
);
3061 /* If the file name has special constructs in it,
3062 call the corresponding file handler. */
3063 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3064 if (!NILP (handler
))
3066 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3067 visit
, beg
, end
, replace
);
3074 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3076 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3077 || fstat (fd
, &st
) < 0)
3078 #endif /* not APOLLO */
3080 if (fd
>= 0) close (fd
);
3083 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3090 /* This code will need to be changed in order to work on named
3091 pipes, and it's probably just not worth it. So we should at
3092 least signal an error. */
3093 if (!S_ISREG (st
.st_mode
))
3100 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3101 Fsignal (Qfile_error
,
3102 Fcons (build_string ("not a regular file"),
3103 Fcons (filename
, Qnil
)));
3108 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3111 /* Replacement should preserve point as it preserves markers. */
3112 if (!NILP (replace
))
3113 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3115 record_unwind_protect (close_file_unwind
, make_number (fd
));
3117 /* Supposedly happens on VMS. */
3118 if (! not_regular
&& st
.st_size
< 0)
3119 error ("File size is negative");
3121 if (!NILP (beg
) || !NILP (end
))
3123 error ("Attempt to visit less than an entire file");
3126 CHECK_NUMBER (beg
, 0);
3128 XSETFASTINT (beg
, 0);
3131 CHECK_NUMBER (end
, 0);
3136 XSETINT (end
, st
.st_size
);
3137 if (XINT (end
) != st
.st_size
)
3138 error ("Maximum buffer size exceeded");
3142 /* Decide the coding-system of the file. */
3144 Lisp_Object val
= Qnil
;
3146 if (!NILP (Vcoding_system_for_read
))
3147 val
= Vcoding_system_for_read
;
3148 else if (NILP (current_buffer
->enable_multibyte_characters
))
3152 if (! NILP (Vset_auto_coding_function
))
3154 /* Find a coding system specified in the heading two lines
3155 or in the tailing several lines of the file. We assume
3156 that the 1K-byte and 3K-byte for heading and tailing
3157 respectively are sufficient fot this purpose. */
3158 int how_many
, nread
;
3160 if (st
.st_size
<= (1024 * 4))
3161 nread
= read (fd
, read_buf
, 1024 * 4);
3164 nread
= read (fd
, read_buf
, 1024);
3167 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3168 report_file_error ("Setting file position",
3169 Fcons (filename
, Qnil
));
3170 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3175 error ("IO error reading %s: %s",
3176 XSTRING (filename
)->data
, strerror (errno
));
3179 val
= call1 (Vset_auto_coding_function
,
3180 make_string (read_buf
, nread
));
3181 /* Rewind the file for the actual read done later. */
3182 if (lseek (fd
, 0, 0) < 0)
3183 report_file_error ("Setting file position",
3184 Fcons (filename
, Qnil
));
3189 Lisp_Object args
[6], coding_systems
;
3191 args
[0] = Qinsert_file_contents
, args
[1] = filename
,
3192 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3193 coding_systems
= Ffind_operation_coding_system (6, args
);
3194 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3197 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3200 /* If requested, replace the accessible part of the buffer
3201 with the file contents. Avoid replacing text at the
3202 beginning or end of the buffer that matches the file contents;
3203 that preserves markers pointing to the unchanged parts.
3205 Here we implement this feature in an optimized way
3206 for the case where code conversion is NOT needed.
3207 The following if-statement handles the case of conversion
3208 in a less optimal way.
3210 If the code conversion is "automatic" then we try using this
3211 method and hope for the best.
3212 But if we discover the need for conversion, we give up on this method
3213 and let the following if-statement handle the replace job. */
3215 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3217 int same_at_start
= BEGV
;
3218 int same_at_end
= ZV
;
3220 /* There is still a possibility we will find the need to do code
3221 conversion. If that happens, we set this variable to 1 to
3222 give up on handling REPLACE in the optimized way. */
3223 int giveup_match_end
= 0;
3225 if (XINT (beg
) != 0)
3227 if (lseek (fd
, XINT (beg
), 0) < 0)
3228 report_file_error ("Setting file position",
3229 Fcons (filename
, Qnil
));
3234 /* Count how many chars at the start of the file
3235 match the text at the beginning of the buffer. */
3240 nread
= read (fd
, buffer
, sizeof buffer
);
3242 error ("IO error reading %s: %s",
3243 XSTRING (filename
)->data
, strerror (errno
));
3244 else if (nread
== 0)
3247 if (coding
.type
== coding_type_undecided
)
3248 detect_coding (&coding
, buffer
, nread
);
3249 if (coding
.type
!= coding_type_undecided
3250 && coding
.type
!= coding_type_no_conversion
3251 && coding
.type
!= coding_type_emacs_mule
)
3252 /* We found that the file should be decoded somehow.
3253 Let's give up here. */
3255 giveup_match_end
= 1;
3259 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3260 detect_eol (&coding
, buffer
, nread
);
3261 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3262 && coding
.eol_type
!= CODING_EOL_LF
)
3263 /* We found that the format of eol should be decoded.
3264 Let's give up here. */
3266 giveup_match_end
= 1;
3271 while (bufpos
< nread
&& same_at_start
< ZV
3272 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3273 same_at_start
++, bufpos
++;
3274 /* If we found a discrepancy, stop the scan.
3275 Otherwise loop around and scan the next bufferful. */
3276 if (bufpos
!= nread
)
3280 /* If the file matches the buffer completely,
3281 there's no need to replace anything. */
3282 if (same_at_start
- BEGV
== XINT (end
))
3286 /* Truncate the buffer to the size of the file. */
3287 del_range_1 (same_at_start
, same_at_end
, 0);
3292 /* Count how many chars at the end of the file
3293 match the text at the end of the buffer. But, if we have
3294 already found that decoding is necessary, don't waste time. */
3295 while (!giveup_match_end
)
3297 int total_read
, nread
, bufpos
, curpos
, trial
;
3299 /* At what file position are we now scanning? */
3300 curpos
= XINT (end
) - (ZV
- same_at_end
);
3301 /* If the entire file matches the buffer tail, stop the scan. */
3304 /* How much can we scan in the next step? */
3305 trial
= min (curpos
, sizeof buffer
);
3306 if (lseek (fd
, curpos
- trial
, 0) < 0)
3307 report_file_error ("Setting file position",
3308 Fcons (filename
, Qnil
));
3311 while (total_read
< trial
)
3313 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3315 error ("IO error reading %s: %s",
3316 XSTRING (filename
)->data
, strerror (errno
));
3317 total_read
+= nread
;
3319 /* Scan this bufferful from the end, comparing with
3320 the Emacs buffer. */
3321 bufpos
= total_read
;
3322 /* Compare with same_at_start to avoid counting some buffer text
3323 as matching both at the file's beginning and at the end. */
3324 while (bufpos
> 0 && same_at_end
> same_at_start
3325 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3326 same_at_end
--, bufpos
--;
3328 /* If we found a discrepancy, stop the scan.
3329 Otherwise loop around and scan the preceding bufferful. */
3332 /* If this discrepancy is because of code conversion,
3333 we cannot use this method; giveup and try the other. */
3334 if (same_at_end
> same_at_start
3335 && FETCH_BYTE (same_at_end
- 1) >= 0200
3336 && ! NILP (current_buffer
->enable_multibyte_characters
)
3337 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3338 giveup_match_end
= 1;
3344 if (! giveup_match_end
)
3346 /* We win! We can handle REPLACE the optimized way. */
3348 /* Extends the end of non-matching text area to multibyte
3349 character boundary. */
3350 if (! NILP (current_buffer
->enable_multibyte_characters
))
3351 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3354 /* Don't try to reuse the same piece of text twice. */
3355 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3357 same_at_end
+= overlap
;
3359 /* Arrange to read only the nonmatching middle part of the file. */
3360 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3361 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3363 del_range_1 (same_at_start
, same_at_end
, 0);
3364 /* Insert from the file at the proper position. */
3365 SET_PT (same_at_start
);
3367 /* If display currently starts at beginning of line,
3368 keep it that way. */
3369 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3370 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3372 replace_handled
= 1;
3376 /* If requested, replace the accessible part of the buffer
3377 with the file contents. Avoid replacing text at the
3378 beginning or end of the buffer that matches the file contents;
3379 that preserves markers pointing to the unchanged parts.
3381 Here we implement this feature for the case where code conversion
3382 is needed, in a simple way that needs a lot of memory.
3383 The preceding if-statement handles the case of no conversion
3384 in a more optimized way. */
3385 if (!NILP (replace
) && ! replace_handled
)
3387 int same_at_start
= BEGV
;
3388 int same_at_end
= ZV
;
3391 /* Make sure that the gap is large enough. */
3392 int bufsize
= 2 * st
.st_size
;
3393 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3395 /* First read the whole file, performing code conversion into
3396 CONVERSION_BUFFER. */
3398 if (lseek (fd
, XINT (beg
), 0) < 0)
3400 free (conversion_buffer
);
3401 report_file_error ("Setting file position",
3402 Fcons (filename
, Qnil
));
3405 total
= st
.st_size
; /* Total bytes in the file. */
3406 how_much
= 0; /* Bytes read from file so far. */
3407 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3408 unprocessed
= 0; /* Bytes not processed in previous loop. */
3410 while (how_much
< total
)
3412 /* try is reserved in some compilers (Microsoft C) */
3413 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3414 char *destination
= read_buf
+ unprocessed
;
3417 /* Allow quitting out of the actual I/O. */
3420 this = read (fd
, destination
, trytry
);
3423 if (this < 0 || this + unprocessed
== 0)
3431 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3433 int require
, produced
, consumed
;
3435 this += unprocessed
;
3437 /* If we are using more space than estimated,
3438 make CONVERSION_BUFFER bigger. */
3439 require
= decoding_buffer_size (&coding
, this);
3440 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3442 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3443 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3446 /* Convert this batch with results in CONVERSION_BUFFER. */
3447 if (how_much
>= total
) /* This is the last block. */
3448 coding
.last_block
= 1;
3449 produced
= decode_coding (&coding
, read_buf
,
3450 conversion_buffer
+ inserted
,
3451 this, bufsize
- inserted
,
3454 /* Save for next iteration whatever we didn't convert. */
3455 unprocessed
= this - consumed
;
3456 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3463 /* At this point, INSERTED is how many characters
3464 are present in CONVERSION_BUFFER.
3465 HOW_MUCH should equal TOTAL,
3466 or should be <= 0 if we couldn't read the file. */
3470 free (conversion_buffer
);
3473 error ("IO error reading %s: %s",
3474 XSTRING (filename
)->data
, strerror (errno
));
3475 else if (how_much
== -2)
3476 error ("maximum buffer size exceeded");
3479 /* Compare the beginning of the converted file
3480 with the buffer text. */
3483 while (bufpos
< inserted
&& same_at_start
< same_at_end
3484 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3485 same_at_start
++, bufpos
++;
3487 /* If the file matches the buffer completely,
3488 there's no need to replace anything. */
3490 if (bufpos
== inserted
)
3492 free (conversion_buffer
);
3495 /* Truncate the buffer to the size of the file. */
3496 del_range_1 (same_at_start
, same_at_end
, 0);
3500 /* Scan this bufferful from the end, comparing with
3501 the Emacs buffer. */
3504 /* Compare with same_at_start to avoid counting some buffer text
3505 as matching both at the file's beginning and at the end. */
3506 while (bufpos
> 0 && same_at_end
> same_at_start
3507 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3508 same_at_end
--, bufpos
--;
3510 /* Don't try to reuse the same piece of text twice. */
3511 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3513 same_at_end
+= overlap
;
3515 /* If display currently starts at beginning of line,
3516 keep it that way. */
3517 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3518 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3520 /* Replace the chars that we need to replace,
3521 and update INSERTED to equal the number of bytes
3522 we are taking from the file. */
3523 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3524 move_gap (same_at_start
);
3525 del_range_1 (same_at_start
, same_at_end
, 0);
3526 SET_PT (same_at_start
);
3527 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3529 free (conversion_buffer
);
3538 register Lisp_Object temp
;
3540 total
= XINT (end
) - XINT (beg
);
3542 /* Make sure point-max won't overflow after this insertion. */
3543 XSETINT (temp
, total
);
3544 if (total
!= XINT (temp
))
3545 error ("Maximum buffer size exceeded");
3548 /* For a special file, all we can do is guess. */
3549 total
= READ_BUF_SIZE
;
3551 if (NILP (visit
) && total
> 0)
3552 prepare_to_modify_buffer (PT
, PT
, NULL
);
3555 if (GAP_SIZE
< total
)
3556 make_gap (total
- GAP_SIZE
);
3558 if (XINT (beg
) != 0 || !NILP (replace
))
3560 if (lseek (fd
, XINT (beg
), 0) < 0)
3561 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3564 /* In the following loop, HOW_MUCH contains the total bytes read so
3565 far. Before exiting the loop, it is set to -1 if I/O error
3566 occurs, set to -2 if the maximum buffer size is exceeded. */
3568 /* Total bytes inserted. */
3570 /* Bytes not processed in the previous loop because short gap size. */
3572 while (how_much
< total
)
3574 /* try is reserved in some compilers (Microsoft C) */
3575 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3576 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3577 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3578 : read_buf
+ unprocessed
);
3581 /* Allow quitting out of the actual I/O. */
3584 this = read (fd
, destination
, trytry
);
3587 if (this < 0 || this + unprocessed
== 0)
3593 /* For a regular file, where TOTAL is the real size,
3594 count HOW_MUCH to compare with it.
3595 For a special file, where TOTAL is just a buffer size,
3596 so don't bother counting in HOW_MUCH.
3597 (INSERTED is where we count the number of characters inserted.) */
3601 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3603 int require
, produced
, consumed
;
3605 this += unprocessed
;
3606 /* Make sure that the gap is large enough. */
3607 require
= decoding_buffer_size (&coding
, this);
3608 if (GAP_SIZE
< require
)
3609 make_gap (require
- GAP_SIZE
);
3613 if (how_much
>= total
) /* This is the last block. */
3614 coding
.last_block
= 1;
3618 /* If we encounter EOF, say it is the last block. (The
3619 data this will apply to is the UNPROCESSED characters
3620 carried over from the last batch.) */
3622 coding
.last_block
= 1;
3625 produced
= decode_coding (&coding
, read_buf
,
3626 POS_ADDR (PT
+ inserted
- 1) + 1,
3627 this, GAP_SIZE
, &consumed
);
3632 XSET (temp
, Lisp_Int
, Z
+ produced
);
3633 if (Z
+ produced
!= XINT (temp
))
3639 unprocessed
= this - consumed
;
3640 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3649 /* Put an anchor to ensure multi-byte form ends at gap. */
3656 /* Use the conversion type to determine buffer-file-type
3657 (find-buffer-file-type is now used to help determine the
3659 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3660 && coding
.eol_type
!= CODING_EOL_LF
)
3661 current_buffer
->buffer_file_type
= Qnil
;
3663 current_buffer
->buffer_file_type
= Qt
;
3666 /* We don't have to consider file type of MSDOS because all files
3667 are read as binary and end-of-line format has already been
3668 decoded appropriately. */
3671 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3672 /* Determine file type from name and remove LFs from CR-LFs if the file
3673 is deemed to be a text file. */
3675 current_buffer
->buffer_file_type
3676 = call1 (Qfind_buffer_file_type
, filename
);
3677 if (NILP (current_buffer
->buffer_file_type
))
3680 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3683 GPT
-= reduced_size
;
3684 GAP_SIZE
+= reduced_size
;
3685 inserted
-= reduced_size
;
3693 record_insert (PT
, inserted
);
3695 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3696 offset_intervals (current_buffer
, PT
, inserted
);
3702 /* Discard the unwind protect for closing the file. */
3706 error ("IO error reading %s: %s",
3707 XSTRING (filename
)->data
, strerror (errno
));
3708 else if (how_much
== -2)
3709 error ("maximum buffer size exceeded");
3716 if (!EQ (current_buffer
->undo_list
, Qt
))
3717 current_buffer
->undo_list
= Qnil
;
3719 stat (XSTRING (filename
)->data
, &st
);
3724 current_buffer
->modtime
= st
.st_mtime
;
3725 current_buffer
->filename
= filename
;
3728 SAVE_MODIFF
= MODIFF
;
3729 current_buffer
->auto_save_modified
= MODIFF
;
3730 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3731 #ifdef CLASH_DETECTION
3734 if (!NILP (current_buffer
->file_truename
))
3735 unlock_file (current_buffer
->file_truename
);
3736 unlock_file (filename
);
3738 #endif /* CLASH_DETECTION */
3740 Fsignal (Qfile_error
,
3741 Fcons (build_string ("not a regular file"),
3742 Fcons (filename
, Qnil
)));
3744 /* If visiting nonexistent file, return nil. */
3745 if (current_buffer
->modtime
== -1)
3746 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3749 /* Decode file format */
3752 insval
= call3 (Qformat_decode
,
3753 Qnil
, make_number (inserted
), visit
);
3754 CHECK_NUMBER (insval
, 0);
3755 inserted
= XFASTINT (insval
);
3758 /* Call after-change hooks for the inserted text, aside from the case
3759 of normal visiting (not with REPLACE), which is done in a new buffer
3760 "before" the buffer is changed. */
3761 if (inserted
> 0 && total
> 0
3762 && (NILP (visit
) || !NILP (replace
)))
3763 signal_after_change (PT
, 0, inserted
);
3767 p
= Vafter_insert_file_functions
;
3768 if (!NILP (coding
.post_read_conversion
))
3769 p
= Fcons (coding
.post_read_conversion
, p
);
3773 insval
= call1 (Fcar (p
), make_number (inserted
));
3776 CHECK_NUMBER (insval
, 0);
3777 inserted
= XFASTINT (insval
);
3785 val
= Fcons (filename
,
3786 Fcons (make_number (inserted
),
3789 RETURN_UNGCPRO (unbind_to (count
, val
));
3792 static Lisp_Object
build_annotations ();
3793 extern Lisp_Object
Ffile_locked_p ();
3795 /* If build_annotations switched buffers, switch back to BUF.
3796 Kill the temporary buffer that was selected in the meantime.
3798 Since this kill only the last temporary buffer, some buffers remain
3799 not killed if build_annotations switched buffers more than once.
3803 build_annotations_unwind (buf
)
3808 if (XBUFFER (buf
) == current_buffer
)
3810 tembuf
= Fcurrent_buffer ();
3812 Fkill_buffer (tembuf
);
3816 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3817 "r\nFWrite region to file: ",
3818 "Write current region into specified file.\n\
3819 When called from a program, takes three arguments:\n\
3820 START, END and FILENAME. START and END are buffer positions.\n\
3821 Optional fourth argument APPEND if non-nil means\n\
3822 append to existing file contents (if any).\n\
3823 Optional fifth argument VISIT if t means\n\
3824 set the last-save-file-modtime of buffer to this file's modtime\n\
3825 and mark buffer not modified.\n\
3826 If VISIT is a string, it is a second file name;\n\
3827 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3828 VISIT is also the file name to lock and unlock for clash detection.\n\
3829 If VISIT is neither t nor nil nor a string,\n\
3830 that means do not print the \"Wrote file\" message.\n\
3831 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3832 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3833 Kludgy feature: if START is a string, then that string is written\n\
3834 to the file, instead of any buffer contents, and END is ignored.")
3835 (start
, end
, filename
, append
, visit
, lockname
)
3836 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3844 int count
= specpdl_ptr
- specpdl
;
3847 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3849 Lisp_Object handler
;
3850 Lisp_Object visit_file
;
3851 Lisp_Object annotations
;
3852 int visiting
, quietly
;
3853 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3854 struct buffer
*given_buffer
;
3856 int buffer_file_type
= O_BINARY
;
3858 struct coding_system coding
;
3860 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3861 error ("Cannot do file visiting in an indirect buffer");
3863 if (!NILP (start
) && !STRINGP (start
))
3864 validate_region (&start
, &end
);
3866 GCPRO4 (start
, filename
, visit
, lockname
);
3868 /* Decide the coding-system to be encoded to. */
3874 else if (!NILP (Vcoding_system_for_write
))
3875 val
= Vcoding_system_for_write
;
3876 else if (NILP (current_buffer
->enable_multibyte_characters
))
3878 /* If the variable `buffer-file-coding-system' is set locally,
3879 it means that the file was read with some kind of code
3880 conversion or the varialbe is explicitely set by users. We
3881 had better write it out with the same coding system even if
3882 `enable-multibyte-characters' is nil.
3884 If is is not set locally, we anyway have to convert EOL
3885 format if the default value of `buffer-file-coding-system'
3886 tells that it is not Unix-like (LF only) format. */
3887 val
= current_buffer
->buffer_file_coding_system
;
3888 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3890 struct coding_system coding_temp
;
3892 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3893 if (coding_temp
.eol_type
== CODING_EOL_CRLF
3894 || coding_temp
.eol_type
== CODING_EOL_CR
)
3896 setup_coding_system (Qemacs_mule
, &coding
);
3897 coding
.eol_type
= coding_temp
.eol_type
;
3898 goto done_setup_coding
;
3905 Lisp_Object args
[7], coding_systems
;
3907 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3908 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3910 coding_systems
= Ffind_operation_coding_system (7, args
);
3911 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3912 ? XCONS (coding_systems
)->cdr
3913 : current_buffer
->buffer_file_coding_system
);
3915 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3918 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3919 coding
.selective
= 1;
3922 filename
= Fexpand_file_name (filename
, Qnil
);
3923 if (STRINGP (visit
))
3924 visit_file
= Fexpand_file_name (visit
, Qnil
);
3926 visit_file
= filename
;
3929 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3930 quietly
= !NILP (visit
);
3934 if (NILP (lockname
))
3935 lockname
= visit_file
;
3937 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3939 /* If the file name has special constructs in it,
3940 call the corresponding file handler. */
3941 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3942 /* If FILENAME has no handler, see if VISIT has one. */
3943 if (NILP (handler
) && STRINGP (visit
))
3944 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3946 if (!NILP (handler
))
3949 val
= call6 (handler
, Qwrite_region
, start
, end
,
3950 filename
, append
, visit
);
3954 SAVE_MODIFF
= MODIFF
;
3955 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3956 current_buffer
->filename
= visit_file
;
3962 /* Special kludge to simplify auto-saving. */
3965 XSETFASTINT (start
, BEG
);
3966 XSETFASTINT (end
, Z
);
3969 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3970 count1
= specpdl_ptr
- specpdl
;
3972 given_buffer
= current_buffer
;
3973 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3974 if (current_buffer
!= given_buffer
)
3976 XSETFASTINT (start
, BEGV
);
3977 XSETFASTINT (end
, ZV
);
3980 #ifdef CLASH_DETECTION
3983 #if 0 /* This causes trouble for GNUS. */
3984 /* If we've locked this file for some other buffer,
3985 query before proceeding. */
3986 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3987 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
3990 lock_file (lockname
);
3992 #endif /* CLASH_DETECTION */
3994 fn
= XSTRING (filename
)->data
;
3998 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3999 #else /* not DOS_NT */
4000 desc
= open (fn
, O_WRONLY
);
4001 #endif /* not DOS_NT */
4003 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
4005 if (auto_saving
) /* Overwrite any previous version of autosave file */
4007 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4008 desc
= open (fn
, O_RDWR
);
4010 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4011 ? XSTRING (current_buffer
->filename
)->data
: 0,
4014 else /* Write to temporary name and rename if no errors */
4016 Lisp_Object temp_name
;
4017 temp_name
= Ffile_name_directory (filename
);
4019 if (!NILP (temp_name
))
4021 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4022 build_string ("$$SAVE$$")));
4023 fname
= XSTRING (filename
)->data
;
4024 fn
= XSTRING (temp_name
)->data
;
4025 desc
= creat_copy_attrs (fname
, fn
);
4028 /* If we can't open the temporary file, try creating a new
4029 version of the original file. VMS "creat" creates a
4030 new version rather than truncating an existing file. */
4033 desc
= creat (fn
, 0666);
4034 #if 0 /* This can clobber an existing file and fail to replace it,
4035 if the user runs out of space. */
4038 /* We can't make a new version;
4039 try to truncate and rewrite existing version if any. */
4041 desc
= open (fn
, O_RDWR
);
4047 desc
= creat (fn
, 0666);
4052 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4053 S_IREAD
| S_IWRITE
);
4054 #else /* not DOS_NT */
4055 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4056 #endif /* not DOS_NT */
4057 #endif /* not VMS */
4063 #ifdef CLASH_DETECTION
4065 if (!auto_saving
) unlock_file (lockname
);
4067 #endif /* CLASH_DETECTION */
4068 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4071 record_unwind_protect (close_file_unwind
, make_number (desc
));
4074 if (lseek (desc
, 0, 2) < 0)
4076 #ifdef CLASH_DETECTION
4077 if (!auto_saving
) unlock_file (lockname
);
4078 #endif /* CLASH_DETECTION */
4079 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4084 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4085 * if we do writes that don't end with a carriage return. Furthermore
4086 * it cannot handle writes of more then 16K. The modified
4087 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4088 * this EXCEPT for the last record (iff it doesn't end with a carriage
4089 * return). This implies that if your buffer doesn't end with a carriage
4090 * return, you get one free... tough. However it also means that if
4091 * we make two calls to sys_write (a la the following code) you can
4092 * get one at the gap as well. The easiest way to fix this (honest)
4093 * is to move the gap to the next newline (or the end of the buffer).
4098 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4099 move_gap (find_next_newline (GPT
, 1));
4101 /* Whether VMS or not, we must move the gap to the next of newline
4102 when we must put designation sequences at beginning of line. */
4103 if (INTEGERP (start
)
4104 && coding
.type
== coding_type_iso2022
4105 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4106 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4107 move_gap (find_next_newline (GPT
, 1));
4113 if (STRINGP (start
))
4115 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4116 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4119 else if (XINT (start
) != XINT (end
))
4122 if (XINT (start
) < GPT
)
4124 register int end1
= XINT (end
);
4126 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4127 min (GPT
, end1
) - tem
, tem
, &annotations
,
4129 nwritten
+= min (GPT
, end1
) - tem
;
4133 if (XINT (end
) > GPT
&& !failure
)
4136 tem
= max (tem
, GPT
);
4137 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4138 tem
, &annotations
, &coding
);
4139 nwritten
+= XINT (end
) - tem
;
4145 /* If file was empty, still need to write the annotations */
4146 coding
.last_block
= 1;
4147 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4151 if (coding
.require_flushing
&& !coding
.last_block
)
4153 /* We have to flush out a data. */
4154 coding
.last_block
= 1;
4155 failure
= 0 > e_write (desc
, "", 0, &coding
);
4162 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4163 Disk full in NFS may be reported here. */
4164 /* mib says that closing the file will try to write as fast as NFS can do
4165 it, and that means the fsync here is not crucial for autosave files. */
4166 if (!auto_saving
&& fsync (desc
) < 0)
4168 /* If fsync fails with EINTR, don't treat that as serious. */
4170 failure
= 1, save_errno
= errno
;
4174 /* Spurious "file has changed on disk" warnings have been
4175 observed on Suns as well.
4176 It seems that `close' can change the modtime, under nfs.
4178 (This has supposedly been fixed in Sunos 4,
4179 but who knows about all the other machines with NFS?) */
4182 /* On VMS and APOLLO, must do the stat after the close
4183 since closing changes the modtime. */
4186 /* Recall that #if defined does not work on VMS. */
4193 /* NFS can report a write failure now. */
4194 if (close (desc
) < 0)
4195 failure
= 1, save_errno
= errno
;
4198 /* If we wrote to a temporary name and had no errors, rename to real name. */
4202 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4210 /* Discard the unwind protect for close_file_unwind. */
4211 specpdl_ptr
= specpdl
+ count1
;
4212 /* Restore the original current buffer. */
4213 visit_file
= unbind_to (count
, visit_file
);
4215 #ifdef CLASH_DETECTION
4217 unlock_file (lockname
);
4218 #endif /* CLASH_DETECTION */
4220 /* Do this before reporting IO error
4221 to avoid a "file has changed on disk" warning on
4222 next attempt to save. */
4224 current_buffer
->modtime
= st
.st_mtime
;
4227 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4231 SAVE_MODIFF
= MODIFF
;
4232 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4233 current_buffer
->filename
= visit_file
;
4234 update_mode_lines
++;
4240 message ("Wrote %s", XSTRING (visit_file
)->data
);
4245 Lisp_Object
merge ();
4247 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4248 "Return t if (car A) is numerically less than (car B).")
4252 return Flss (Fcar (a
), Fcar (b
));
4255 /* Build the complete list of annotations appropriate for writing out
4256 the text between START and END, by calling all the functions in
4257 write-region-annotate-functions and merging the lists they return.
4258 If one of these functions switches to a different buffer, we assume
4259 that buffer contains altered text. Therefore, the caller must
4260 make sure to restore the current buffer in all cases,
4261 as save-excursion would do. */
4264 build_annotations (start
, end
, pre_write_conversion
)
4265 Lisp_Object start
, end
, pre_write_conversion
;
4267 Lisp_Object annotations
;
4269 struct gcpro gcpro1
, gcpro2
;
4270 Lisp_Object original_buffer
;
4272 XSETBUFFER (original_buffer
, current_buffer
);
4275 p
= Vwrite_region_annotate_functions
;
4276 GCPRO2 (annotations
, p
);
4279 struct buffer
*given_buffer
= current_buffer
;
4280 Vwrite_region_annotations_so_far
= annotations
;
4281 res
= call2 (Fcar (p
), start
, end
);
4282 /* If the function makes a different buffer current,
4283 assume that means this buffer contains altered text to be output.
4284 Reset START and END from the buffer bounds
4285 and discard all previous annotations because they should have
4286 been dealt with by this function. */
4287 if (current_buffer
!= given_buffer
)
4289 XSETFASTINT (start
, BEGV
);
4290 XSETFASTINT (end
, ZV
);
4293 Flength (res
); /* Check basic validity of return value */
4294 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4298 /* Now do the same for annotation functions implied by the file-format */
4299 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4300 p
= Vauto_save_file_format
;
4302 p
= current_buffer
->file_format
;
4305 struct buffer
*given_buffer
= current_buffer
;
4306 Vwrite_region_annotations_so_far
= annotations
;
4307 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4309 if (current_buffer
!= given_buffer
)
4311 XSETFASTINT (start
, BEGV
);
4312 XSETFASTINT (end
, ZV
);
4316 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4320 /* At last, do the same for the function PRE_WRITE_CONVERSION
4321 implied by the current coding-system. */
4322 if (!NILP (pre_write_conversion
))
4324 struct buffer
*given_buffer
= current_buffer
;
4325 Vwrite_region_annotations_so_far
= annotations
;
4326 res
= call2 (pre_write_conversion
, start
, end
);
4328 annotations
= (current_buffer
!= given_buffer
4330 : merge (annotations
, res
, Qcar_less_than_car
));
4337 /* Write to descriptor DESC the LEN characters starting at ADDR,
4338 assuming they start at position POS in the buffer.
4339 Intersperse with them the annotations from *ANNOT
4340 (those which fall within the range of positions POS to POS + LEN),
4341 each at its appropriate position.
4343 Modify *ANNOT by discarding elements as we output them.
4344 The return value is negative in case of system call failure. */
4347 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4349 register char *addr
;
4353 struct coding_system
*coding
;
4357 int lastpos
= pos
+ len
;
4359 while (NILP (*annot
) || CONSP (*annot
))
4361 tem
= Fcar_safe (Fcar (*annot
));
4362 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4363 nextpos
= XFASTINT (tem
);
4365 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4368 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4370 addr
+= nextpos
- pos
;
4373 tem
= Fcdr (Fcar (*annot
));
4376 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4380 *annot
= Fcdr (*annot
);
4384 #ifndef WRITE_BUF_SIZE
4385 #define WRITE_BUF_SIZE (16 * 1024)
4389 e_write (desc
, addr
, len
, coding
)
4391 register char *addr
;
4393 struct coding_system
*coding
;
4395 char buf
[WRITE_BUF_SIZE
];
4396 int produced
, consumed
;
4398 /* We used to have a code for handling selective display here. But,
4399 now it is handled within encode_coding. */
4402 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4404 len
-= consumed
, addr
+= consumed
;
4407 produced
-= write (desc
, buf
, produced
);
4408 if (produced
) return -1;
4416 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4417 Sverify_visited_file_modtime
, 1, 1, 0,
4418 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4419 This means that the file has not been changed since it was visited or saved.")
4425 Lisp_Object handler
;
4427 CHECK_BUFFER (buf
, 0);
4430 if (!STRINGP (b
->filename
)) return Qt
;
4431 if (b
->modtime
== 0) return Qt
;
4433 /* If the file name has special constructs in it,
4434 call the corresponding file handler. */
4435 handler
= Ffind_file_name_handler (b
->filename
,
4436 Qverify_visited_file_modtime
);
4437 if (!NILP (handler
))
4438 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4440 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4442 /* If the file doesn't exist now and didn't exist before,
4443 we say that it isn't modified, provided the error is a tame one. */
4444 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4449 if (st
.st_mtime
== b
->modtime
4450 /* If both are positive, accept them if they are off by one second. */
4451 || (st
.st_mtime
> 0 && b
->modtime
> 0
4452 && (st
.st_mtime
== b
->modtime
+ 1
4453 || st
.st_mtime
== b
->modtime
- 1)))
4458 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4459 Sclear_visited_file_modtime
, 0, 0, 0,
4460 "Clear out records of last mod time of visited file.\n\
4461 Next attempt to save will certainly not complain of a discrepancy.")
4464 current_buffer
->modtime
= 0;
4468 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4469 Svisited_file_modtime
, 0, 0, 0,
4470 "Return the current buffer's recorded visited file modification time.\n\
4471 The value is a list of the form (HIGH . LOW), like the time values\n\
4472 that `file-attributes' returns.")
4475 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4478 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4479 Sset_visited_file_modtime
, 0, 1, 0,
4480 "Update buffer's recorded modification time from the visited file's time.\n\
4481 Useful if the buffer was not read from the file normally\n\
4482 or if the file itself has been changed for some known benign reason.\n\
4483 An argument specifies the modification time value to use\n\
4484 \(instead of that of the visited file), in the form of a list\n\
4485 \(HIGH . LOW) or (HIGH LOW).")
4487 Lisp_Object time_list
;
4489 if (!NILP (time_list
))
4490 current_buffer
->modtime
= cons_to_long (time_list
);
4493 register Lisp_Object filename
;
4495 Lisp_Object handler
;
4497 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4499 /* If the file name has special constructs in it,
4500 call the corresponding file handler. */
4501 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4502 if (!NILP (handler
))
4503 /* The handler can find the file name the same way we did. */
4504 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4505 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4506 current_buffer
->modtime
= st
.st_mtime
;
4516 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4517 Fsleep_for (make_number (1), Qnil
);
4518 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4519 Fsleep_for (make_number (1), Qnil
);
4520 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4521 Fsleep_for (make_number (1), Qnil
);
4531 /* Get visited file's mode to become the auto save file's mode. */
4532 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4533 /* But make sure we can overwrite it later! */
4534 auto_save_mode_bits
= st
.st_mode
| 0600;
4536 auto_save_mode_bits
= 0666;
4539 Fwrite_region (Qnil
, Qnil
,
4540 current_buffer
->auto_save_file_name
,
4541 Qnil
, Qlambda
, Qnil
);
4545 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4550 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4551 | XFASTINT (XCONS (stream
)->cdr
)));
4556 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4559 minibuffer_auto_raise
= XINT (value
);
4563 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4564 "Auto-save all buffers that need it.\n\
4565 This is all buffers that have auto-saving enabled\n\
4566 and are changed since last auto-saved.\n\
4567 Auto-saving writes the buffer into a file\n\
4568 so that your editing is not lost if the system crashes.\n\
4569 This file is not the file you visited; that changes only when you save.\n\
4570 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4571 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4572 A non-nil CURRENT-ONLY argument means save only current buffer.")
4573 (no_message
, current_only
)
4574 Lisp_Object no_message
, current_only
;
4576 struct buffer
*old
= current_buffer
, *b
;
4577 Lisp_Object tail
, buf
;
4579 char *omessage
= echo_area_glyphs
;
4580 int omessage_length
= echo_area_glyphs_length
;
4581 int do_handled_files
;
4584 Lisp_Object lispstream
;
4585 int count
= specpdl_ptr
- specpdl
;
4587 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4589 /* Ordinarily don't quit within this function,
4590 but don't make it impossible to quit (in case we get hung in I/O). */
4594 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4595 point to non-strings reached from Vbuffer_alist. */
4600 if (!NILP (Vrun_hooks
))
4601 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4603 if (STRINGP (Vauto_save_list_file_name
))
4605 Lisp_Object listfile
;
4606 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4607 stream
= fopen (XSTRING (listfile
)->data
, "w");
4610 /* Arrange to close that file whether or not we get an error.
4611 Also reset auto_saving to 0. */
4612 lispstream
= Fcons (Qnil
, Qnil
);
4613 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4614 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4625 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4626 record_unwind_protect (do_auto_save_unwind_1
,
4627 make_number (minibuffer_auto_raise
));
4628 minibuffer_auto_raise
= 0;
4631 /* First, save all files which don't have handlers. If Emacs is
4632 crashing, the handlers may tweak what is causing Emacs to crash
4633 in the first place, and it would be a shame if Emacs failed to
4634 autosave perfectly ordinary files because it couldn't handle some
4636 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4637 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4639 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4642 /* Record all the buffers that have auto save mode
4643 in the special file that lists them. For each of these buffers,
4644 Record visited name (if any) and auto save name. */
4645 if (STRINGP (b
->auto_save_file_name
)
4646 && stream
!= NULL
&& do_handled_files
== 0)
4648 if (!NILP (b
->filename
))
4650 fwrite (XSTRING (b
->filename
)->data
, 1,
4651 XSTRING (b
->filename
)->size
, stream
);
4653 putc ('\n', stream
);
4654 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4655 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4656 putc ('\n', stream
);
4659 if (!NILP (current_only
)
4660 && b
!= current_buffer
)
4663 /* Don't auto-save indirect buffers.
4664 The base buffer takes care of it. */
4668 /* Check for auto save enabled
4669 and file changed since last auto save
4670 and file changed since last real save. */
4671 if (STRINGP (b
->auto_save_file_name
)
4672 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4673 && b
->auto_save_modified
< BUF_MODIFF (b
)
4674 /* -1 means we've turned off autosaving for a while--see below. */
4675 && XINT (b
->save_length
) >= 0
4676 && (do_handled_files
4677 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4680 EMACS_TIME before_time
, after_time
;
4682 EMACS_GET_TIME (before_time
);
4684 /* If we had a failure, don't try again for 20 minutes. */
4685 if (b
->auto_save_failure_time
>= 0
4686 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4689 if ((XFASTINT (b
->save_length
) * 10
4690 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4691 /* A short file is likely to change a large fraction;
4692 spare the user annoying messages. */
4693 && XFASTINT (b
->save_length
) > 5000
4694 /* These messages are frequent and annoying for `*mail*'. */
4695 && !EQ (b
->filename
, Qnil
)
4696 && NILP (no_message
))
4698 /* It has shrunk too much; turn off auto-saving here. */
4699 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4700 message ("Buffer %s has shrunk a lot; auto save turned off there",
4701 XSTRING (b
->name
)->data
);
4702 minibuffer_auto_raise
= 0;
4703 /* Turn off auto-saving until there's a real save,
4704 and prevent any more warnings. */
4705 XSETINT (b
->save_length
, -1);
4706 Fsleep_for (make_number (1), Qnil
);
4709 set_buffer_internal (b
);
4710 if (!auto_saved
&& NILP (no_message
))
4711 message1 ("Auto-saving...");
4712 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4714 b
->auto_save_modified
= BUF_MODIFF (b
);
4715 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4716 set_buffer_internal (old
);
4718 EMACS_GET_TIME (after_time
);
4720 /* If auto-save took more than 60 seconds,
4721 assume it was an NFS failure that got a timeout. */
4722 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4723 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4727 /* Prevent another auto save till enough input events come in. */
4728 record_auto_save ();
4730 if (auto_saved
&& NILP (no_message
))
4734 sit_for (1, 0, 0, 0, 0);
4735 message2 (omessage
, omessage_length
);
4738 message1 ("Auto-saving...done");
4743 unbind_to (count
, Qnil
);
4747 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4748 Sset_buffer_auto_saved
, 0, 0, 0,
4749 "Mark current buffer as auto-saved with its current text.\n\
4750 No auto-save file will be written until the buffer changes again.")
4753 current_buffer
->auto_save_modified
= MODIFF
;
4754 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4755 current_buffer
->auto_save_failure_time
= -1;
4759 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4760 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4761 "Clear any record of a recent auto-save failure in the current buffer.")
4764 current_buffer
->auto_save_failure_time
= -1;
4768 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4770 "Return t if buffer has been auto-saved since last read in or saved.")
4773 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4776 /* Reading and completing file names */
4777 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4779 /* In the string VAL, change each $ to $$ and return the result. */
4782 double_dollars (val
)
4785 register unsigned char *old
, *new;
4789 osize
= XSTRING (val
)->size
;
4790 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4791 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4792 if (*old
++ == '$') count
++;
4795 old
= XSTRING (val
)->data
;
4796 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4797 new = XSTRING (val
)->data
;
4798 for (n
= osize
; n
> 0; n
--)
4811 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4813 "Internal subroutine for read-file-name. Do not call this.")
4814 (string
, dir
, action
)
4815 Lisp_Object string
, dir
, action
;
4816 /* action is nil for complete, t for return list of completions,
4817 lambda for verify final value */
4819 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4821 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4823 CHECK_STRING (string
, 0);
4830 /* No need to protect ACTION--we only compare it with t and nil. */
4831 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4833 if (XSTRING (string
)->size
== 0)
4835 if (EQ (action
, Qlambda
))
4843 orig_string
= string
;
4844 string
= Fsubstitute_in_file_name (string
);
4845 changed
= NILP (Fstring_equal (string
, orig_string
));
4846 name
= Ffile_name_nondirectory (string
);
4847 val
= Ffile_name_directory (string
);
4849 realdir
= Fexpand_file_name (val
, realdir
);
4854 specdir
= Ffile_name_directory (string
);
4855 val
= Ffile_name_completion (name
, realdir
);
4860 return double_dollars (string
);
4864 if (!NILP (specdir
))
4865 val
= concat2 (specdir
, val
);
4867 return double_dollars (val
);
4870 #endif /* not VMS */
4874 if (EQ (action
, Qt
))
4875 return Ffile_name_all_completions (name
, realdir
);
4876 /* Only other case actually used is ACTION = lambda */
4878 /* Supposedly this helps commands such as `cd' that read directory names,
4879 but can someone explain how it helps them? -- RMS */
4880 if (XSTRING (name
)->size
== 0)
4883 return Ffile_exists_p (string
);
4886 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4887 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4888 Value is not expanded---you must call `expand-file-name' yourself.\n\
4889 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4890 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4891 except that if INITIAL is specified, that combined with DIR is used.)\n\
4892 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4893 Non-nil and non-t means also require confirmation after completion.\n\
4894 Fifth arg INITIAL specifies text to start with.\n\
4895 DIR defaults to current buffer's directory default.")
4896 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4897 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4899 Lisp_Object val
, insdef
, insdef1
, tem
;
4900 struct gcpro gcpro1
, gcpro2
;
4901 register char *homedir
;
4905 dir
= current_buffer
->directory
;
4906 if (NILP (default_filename
))
4908 if (! NILP (initial
))
4909 default_filename
= Fexpand_file_name (initial
, dir
);
4911 default_filename
= current_buffer
->filename
;
4914 /* If dir starts with user's homedir, change that to ~. */
4915 homedir
= (char *) egetenv ("HOME");
4917 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4918 CORRECT_DIR_SEPS (homedir
);
4922 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4923 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4925 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4926 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4927 XSTRING (dir
)->data
[0] = '~';
4930 if (insert_default_directory
&& STRINGP (dir
))
4933 if (!NILP (initial
))
4935 Lisp_Object args
[2], pos
;
4939 insdef
= Fconcat (2, args
);
4940 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4941 insdef1
= Fcons (double_dollars (insdef
), pos
);
4944 insdef1
= double_dollars (insdef
);
4946 else if (STRINGP (initial
))
4949 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
4952 insdef
= Qnil
, insdef1
= Qnil
;
4955 count
= specpdl_ptr
- specpdl
;
4956 specbind (intern ("completion-ignore-case"), Qt
);
4959 GCPRO2 (insdef
, default_filename
);
4960 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4961 dir
, mustmatch
, insdef1
,
4962 Qfile_name_history
, default_filename
, Qnil
);
4963 /* If Fcompleting_read returned the default string itself
4964 (rather than a new string with the same contents),
4965 it has to mean that the user typed RET with the minibuffer empty.
4966 In that case, we really want to return ""
4967 so that commands such as set-visited-file-name can distinguish. */
4968 if (EQ (val
, default_filename
))
4969 val
= build_string ("");
4972 unbind_to (count
, Qnil
);
4977 error ("No file name specified");
4978 tem
= Fstring_equal (val
, insdef
);
4979 if (!NILP (tem
) && !NILP (default_filename
))
4980 return default_filename
;
4981 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4983 if (!NILP (default_filename
))
4984 return default_filename
;
4986 error ("No default file name");
4988 return Fsubstitute_in_file_name (val
);
4991 #if 0 /* Old version */
4992 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4993 /* Don't confuse make-docfile by having two doc strings for this function.
4994 make-docfile does not pay attention to #if, for good reason! */
4996 (prompt
, dir
, defalt
, mustmatch
, initial
)
4997 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4999 Lisp_Object val
, insdef
, tem
;
5000 struct gcpro gcpro1
, gcpro2
;
5001 register char *homedir
;
5005 dir
= current_buffer
->directory
;
5007 defalt
= current_buffer
->filename
;
5009 /* If dir starts with user's homedir, change that to ~. */
5010 homedir
= (char *) egetenv ("HOME");
5013 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5014 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
5016 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5017 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5018 XSTRING (dir
)->data
[0] = '~';
5021 if (!NILP (initial
))
5023 else if (insert_default_directory
)
5026 insdef
= build_string ("");
5029 count
= specpdl_ptr
- specpdl
;
5030 specbind (intern ("completion-ignore-case"), Qt
);
5033 GCPRO2 (insdef
, defalt
);
5034 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5036 insert_default_directory
? insdef
: Qnil
,
5037 Qfile_name_history
, Qnil
, Qnil
);
5040 unbind_to (count
, Qnil
);
5045 error ("No file name specified");
5046 tem
= Fstring_equal (val
, insdef
);
5047 if (!NILP (tem
) && !NILP (defalt
))
5049 return Fsubstitute_in_file_name (val
);
5051 #endif /* Old version */
5055 Qexpand_file_name
= intern ("expand-file-name");
5056 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5057 Qdirectory_file_name
= intern ("directory-file-name");
5058 Qfile_name_directory
= intern ("file-name-directory");
5059 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5060 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5061 Qfile_name_as_directory
= intern ("file-name-as-directory");
5062 Qcopy_file
= intern ("copy-file");
5063 Qmake_directory_internal
= intern ("make-directory-internal");
5064 Qdelete_directory
= intern ("delete-directory");
5065 Qdelete_file
= intern ("delete-file");
5066 Qrename_file
= intern ("rename-file");
5067 Qadd_name_to_file
= intern ("add-name-to-file");
5068 Qmake_symbolic_link
= intern ("make-symbolic-link");
5069 Qfile_exists_p
= intern ("file-exists-p");
5070 Qfile_executable_p
= intern ("file-executable-p");
5071 Qfile_readable_p
= intern ("file-readable-p");
5072 Qfile_writable_p
= intern ("file-writable-p");
5073 Qfile_symlink_p
= intern ("file-symlink-p");
5074 Qaccess_file
= intern ("access-file");
5075 Qfile_directory_p
= intern ("file-directory-p");
5076 Qfile_regular_p
= intern ("file-regular-p");
5077 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5078 Qfile_modes
= intern ("file-modes");
5079 Qset_file_modes
= intern ("set-file-modes");
5080 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5081 Qinsert_file_contents
= intern ("insert-file-contents");
5082 Qwrite_region
= intern ("write-region");
5083 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5084 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5086 staticpro (&Qexpand_file_name
);
5087 staticpro (&Qsubstitute_in_file_name
);
5088 staticpro (&Qdirectory_file_name
);
5089 staticpro (&Qfile_name_directory
);
5090 staticpro (&Qfile_name_nondirectory
);
5091 staticpro (&Qunhandled_file_name_directory
);
5092 staticpro (&Qfile_name_as_directory
);
5093 staticpro (&Qcopy_file
);
5094 staticpro (&Qmake_directory_internal
);
5095 staticpro (&Qdelete_directory
);
5096 staticpro (&Qdelete_file
);
5097 staticpro (&Qrename_file
);
5098 staticpro (&Qadd_name_to_file
);
5099 staticpro (&Qmake_symbolic_link
);
5100 staticpro (&Qfile_exists_p
);
5101 staticpro (&Qfile_executable_p
);
5102 staticpro (&Qfile_readable_p
);
5103 staticpro (&Qfile_writable_p
);
5104 staticpro (&Qaccess_file
);
5105 staticpro (&Qfile_symlink_p
);
5106 staticpro (&Qfile_directory_p
);
5107 staticpro (&Qfile_regular_p
);
5108 staticpro (&Qfile_accessible_directory_p
);
5109 staticpro (&Qfile_modes
);
5110 staticpro (&Qset_file_modes
);
5111 staticpro (&Qfile_newer_than_file_p
);
5112 staticpro (&Qinsert_file_contents
);
5113 staticpro (&Qwrite_region
);
5114 staticpro (&Qverify_visited_file_modtime
);
5115 staticpro (&Qset_visited_file_modtime
);
5117 Qfile_name_history
= intern ("file-name-history");
5118 Fset (Qfile_name_history
, Qnil
);
5119 staticpro (&Qfile_name_history
);
5121 Qfile_error
= intern ("file-error");
5122 staticpro (&Qfile_error
);
5123 Qfile_already_exists
= intern ("file-already-exists");
5124 staticpro (&Qfile_already_exists
);
5125 Qfile_date_error
= intern ("file-date-error");
5126 staticpro (&Qfile_date_error
);
5129 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5130 staticpro (&Qfind_buffer_file_type
);
5133 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5134 "*Format in which to write auto-save files.\n\
5135 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5136 If it is t, which is the default, auto-save files are written in the\n\
5137 same format as a regular save would use.");
5138 Vauto_save_file_format
= Qt
;
5140 Qformat_decode
= intern ("format-decode");
5141 staticpro (&Qformat_decode
);
5142 Qformat_annotate_function
= intern ("format-annotate-function");
5143 staticpro (&Qformat_annotate_function
);
5145 Qcar_less_than_car
= intern ("car-less-than-car");
5146 staticpro (&Qcar_less_than_car
);
5148 Fput (Qfile_error
, Qerror_conditions
,
5149 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5150 Fput (Qfile_error
, Qerror_message
,
5151 build_string ("File error"));
5153 Fput (Qfile_already_exists
, Qerror_conditions
,
5154 Fcons (Qfile_already_exists
,
5155 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5156 Fput (Qfile_already_exists
, Qerror_message
,
5157 build_string ("File already exists"));
5159 Fput (Qfile_date_error
, Qerror_conditions
,
5160 Fcons (Qfile_date_error
,
5161 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5162 Fput (Qfile_date_error
, Qerror_message
,
5163 build_string ("Cannot set file date"));
5165 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5166 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5167 insert_default_directory
= 1;
5169 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5170 "*Non-nil means write new files with record format `stmlf'.\n\
5171 nil means use format `var'. This variable is meaningful only on VMS.");
5172 vms_stmlf_recfm
= 0;
5174 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5175 "Directory separator character for built-in functions that return file names.\n\
5176 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5177 This variable affects the built-in functions only on Windows,\n\
5178 on other platforms, it is initialized so that Lisp code can find out\n\
5179 what the normal separator is.");
5180 XSETFASTINT (Vdirectory_sep_char
, '/');
5182 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5183 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5184 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5187 The first argument given to HANDLER is the name of the I/O primitive\n\
5188 to be handled; the remaining arguments are the arguments that were\n\
5189 passed to that primitive. For example, if you do\n\
5190 (file-exists-p FILENAME)\n\
5191 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5192 (funcall HANDLER 'file-exists-p FILENAME)\n\
5193 The function `find-file-name-handler' checks this list for a handler\n\
5194 for its argument.");
5195 Vfile_name_handler_alist
= Qnil
;
5197 DEFVAR_LISP ("set-auto-coding-function",
5198 &Vset_auto_coding_function
,
5199 "If non-nil, a function to call to decide a coding system of file.\n\
5200 One argument is passed to this function: the string of concatination\n\
5201 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5202 This function should return a coding system to decode the file contents\n\
5203 specified in the heading lines with the format:\n\
5204 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5205 or local variable spec of the tailing lines with `coding:' tag.");
5206 Vset_auto_coding_function
= Qnil
;
5208 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5209 "A list of functions to be called at the end of `insert-file-contents'.\n\
5210 Each is passed one argument, the number of bytes inserted. It should return\n\
5211 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5212 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5213 responsible for calling the after-insert-file-functions if appropriate.");
5214 Vafter_insert_file_functions
= Qnil
;
5216 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5217 "A list of functions to be called at the start of `write-region'.\n\
5218 Each is passed two arguments, START and END as for `write-region'.\n\
5219 These are usually two numbers but not always; see the documentation\n\
5220 for `write-region'. The function should return a list of pairs\n\
5221 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5222 inserted at the specified positions of the file being written (1 means to\n\
5223 insert before the first byte written). The POSITIONs must be sorted into\n\
5224 increasing order. If there are several functions in the list, the several\n\
5225 lists are merged destructively.");
5226 Vwrite_region_annotate_functions
= Qnil
;
5228 DEFVAR_LISP ("write-region-annotations-so-far",
5229 &Vwrite_region_annotations_so_far
,
5230 "When an annotation function is called, this holds the previous annotations.\n\
5231 These are the annotations made by other annotation functions\n\
5232 that were already called. See also `write-region-annotate-functions'.");
5233 Vwrite_region_annotations_so_far
= Qnil
;
5235 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5236 "A list of file name handlers that temporarily should not be used.\n\
5237 This applies only to the operation `inhibit-file-name-operation'.");
5238 Vinhibit_file_name_handlers
= Qnil
;
5240 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5241 "The operation for which `inhibit-file-name-handlers' is applicable.");
5242 Vinhibit_file_name_operation
= Qnil
;
5244 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5245 "File name in which we write a list of all auto save file names.\n\
5246 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5247 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5249 Vauto_save_list_file_name
= Qnil
;
5251 defsubr (&Sfind_file_name_handler
);
5252 defsubr (&Sfile_name_directory
);
5253 defsubr (&Sfile_name_nondirectory
);
5254 defsubr (&Sunhandled_file_name_directory
);
5255 defsubr (&Sfile_name_as_directory
);
5256 defsubr (&Sdirectory_file_name
);
5257 defsubr (&Smake_temp_name
);
5258 defsubr (&Sexpand_file_name
);
5259 defsubr (&Ssubstitute_in_file_name
);
5260 defsubr (&Scopy_file
);
5261 defsubr (&Smake_directory_internal
);
5262 defsubr (&Sdelete_directory
);
5263 defsubr (&Sdelete_file
);
5264 defsubr (&Srename_file
);
5265 defsubr (&Sadd_name_to_file
);
5267 defsubr (&Smake_symbolic_link
);
5268 #endif /* S_IFLNK */
5270 defsubr (&Sdefine_logical_name
);
5273 defsubr (&Ssysnetunam
);
5274 #endif /* HPUX_NET */
5275 defsubr (&Sfile_name_absolute_p
);
5276 defsubr (&Sfile_exists_p
);
5277 defsubr (&Sfile_executable_p
);
5278 defsubr (&Sfile_readable_p
);
5279 defsubr (&Sfile_writable_p
);
5280 defsubr (&Saccess_file
);
5281 defsubr (&Sfile_symlink_p
);
5282 defsubr (&Sfile_directory_p
);
5283 defsubr (&Sfile_accessible_directory_p
);
5284 defsubr (&Sfile_regular_p
);
5285 defsubr (&Sfile_modes
);
5286 defsubr (&Sset_file_modes
);
5287 defsubr (&Sset_default_file_modes
);
5288 defsubr (&Sdefault_file_modes
);
5289 defsubr (&Sfile_newer_than_file_p
);
5290 defsubr (&Sinsert_file_contents
);
5291 defsubr (&Swrite_region
);
5292 defsubr (&Scar_less_than_car
);
5293 defsubr (&Sverify_visited_file_modtime
);
5294 defsubr (&Sclear_visited_file_modtime
);
5295 defsubr (&Svisited_file_modtime
);
5296 defsubr (&Sset_visited_file_modtime
);
5297 defsubr (&Sdo_auto_save
);
5298 defsubr (&Sset_buffer_auto_saved
);
5299 defsubr (&Sclear_buffer_auto_save_failure
);
5300 defsubr (&Srecent_auto_save_p
);
5302 defsubr (&Sread_file_name_internal
);
5303 defsubr (&Sread_file_name
);
5306 defsubr (&Sunix_sync
);