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 (SYMBOLP (Vset_auto_coding_function
)
3153 && !NILP (Fboundp (Vset_auto_coding_function
)))
3155 /* Find a coding system specified in the heading two lines
3156 or in the tailing several lines of the file. We assume
3157 that the 1K-byte and 3K-byte for heading and tailing
3158 respectively are sufficient fot this purpose. */
3159 int how_many
, nread
;
3161 if (st
.st_size
<= (1024 * 4))
3162 nread
= read (fd
, read_buf
, 1024 * 4);
3165 nread
= read (fd
, read_buf
, 1024);
3168 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3169 report_file_error ("Setting file position",
3170 Fcons (filename
, Qnil
));
3171 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3176 error ("IO error reading %s: %s",
3177 XSTRING (filename
)->data
, strerror (errno
));
3180 val
= call1 (Vset_auto_coding_function
,
3181 make_string (read_buf
, nread
));
3182 /* Rewind the file for the actual read done later. */
3183 if (lseek (fd
, 0, 0) < 0)
3184 report_file_error ("Setting file position",
3185 Fcons (filename
, Qnil
));
3190 Lisp_Object args
[6], coding_systems
;
3192 args
[0] = Qinsert_file_contents
, args
[1] = filename
,
3193 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3194 coding_systems
= Ffind_operation_coding_system (6, args
);
3195 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3198 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3201 /* If requested, replace the accessible part of the buffer
3202 with the file contents. Avoid replacing text at the
3203 beginning or end of the buffer that matches the file contents;
3204 that preserves markers pointing to the unchanged parts.
3206 Here we implement this feature in an optimized way
3207 for the case where code conversion is NOT needed.
3208 The following if-statement handles the case of conversion
3209 in a less optimal way.
3211 If the code conversion is "automatic" then we try using this
3212 method and hope for the best.
3213 But if we discover the need for conversion, we give up on this method
3214 and let the following if-statement handle the replace job. */
3216 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3218 int same_at_start
= BEGV
;
3219 int same_at_end
= ZV
;
3221 /* There is still a possibility we will find the need to do code
3222 conversion. If that happens, we set this variable to 1 to
3223 give up on handling REPLACE in the optimized way. */
3224 int giveup_match_end
= 0;
3226 if (XINT (beg
) != 0)
3228 if (lseek (fd
, XINT (beg
), 0) < 0)
3229 report_file_error ("Setting file position",
3230 Fcons (filename
, Qnil
));
3235 /* Count how many chars at the start of the file
3236 match the text at the beginning of the buffer. */
3241 nread
= read (fd
, buffer
, sizeof buffer
);
3243 error ("IO error reading %s: %s",
3244 XSTRING (filename
)->data
, strerror (errno
));
3245 else if (nread
== 0)
3248 if (coding
.type
== coding_type_undecided
)
3249 detect_coding (&coding
, buffer
, nread
);
3250 if (coding
.type
!= coding_type_undecided
3251 && coding
.type
!= coding_type_no_conversion
3252 && coding
.type
!= coding_type_emacs_mule
)
3253 /* We found that the file should be decoded somehow.
3254 Let's give up here. */
3256 giveup_match_end
= 1;
3260 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3261 detect_eol (&coding
, buffer
, nread
);
3262 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3263 && coding
.eol_type
!= CODING_EOL_LF
)
3264 /* We found that the format of eol should be decoded.
3265 Let's give up here. */
3267 giveup_match_end
= 1;
3272 while (bufpos
< nread
&& same_at_start
< ZV
3273 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3274 same_at_start
++, bufpos
++;
3275 /* If we found a discrepancy, stop the scan.
3276 Otherwise loop around and scan the next bufferful. */
3277 if (bufpos
!= nread
)
3281 /* If the file matches the buffer completely,
3282 there's no need to replace anything. */
3283 if (same_at_start
- BEGV
== XINT (end
))
3287 /* Truncate the buffer to the size of the file. */
3288 del_range_1 (same_at_start
, same_at_end
, 0);
3293 /* Count how many chars at the end of the file
3294 match the text at the end of the buffer. But, if we have
3295 already found that decoding is necessary, don't waste time. */
3296 while (!giveup_match_end
)
3298 int total_read
, nread
, bufpos
, curpos
, trial
;
3300 /* At what file position are we now scanning? */
3301 curpos
= XINT (end
) - (ZV
- same_at_end
);
3302 /* If the entire file matches the buffer tail, stop the scan. */
3305 /* How much can we scan in the next step? */
3306 trial
= min (curpos
, sizeof buffer
);
3307 if (lseek (fd
, curpos
- trial
, 0) < 0)
3308 report_file_error ("Setting file position",
3309 Fcons (filename
, Qnil
));
3312 while (total_read
< trial
)
3314 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3316 error ("IO error reading %s: %s",
3317 XSTRING (filename
)->data
, strerror (errno
));
3318 total_read
+= nread
;
3320 /* Scan this bufferful from the end, comparing with
3321 the Emacs buffer. */
3322 bufpos
= total_read
;
3323 /* Compare with same_at_start to avoid counting some buffer text
3324 as matching both at the file's beginning and at the end. */
3325 while (bufpos
> 0 && same_at_end
> same_at_start
3326 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3327 same_at_end
--, bufpos
--;
3329 /* If we found a discrepancy, stop the scan.
3330 Otherwise loop around and scan the preceding bufferful. */
3333 /* If this discrepancy is because of code conversion,
3334 we cannot use this method; giveup and try the other. */
3335 if (same_at_end
> same_at_start
3336 && FETCH_BYTE (same_at_end
- 1) >= 0200
3337 && ! NILP (current_buffer
->enable_multibyte_characters
)
3338 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3339 giveup_match_end
= 1;
3345 if (! giveup_match_end
)
3347 /* We win! We can handle REPLACE the optimized way. */
3349 /* Extends the end of non-matching text area to multibyte
3350 character boundary. */
3351 if (! NILP (current_buffer
->enable_multibyte_characters
))
3352 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3355 /* Don't try to reuse the same piece of text twice. */
3356 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3358 same_at_end
+= overlap
;
3360 /* Arrange to read only the nonmatching middle part of the file. */
3361 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3362 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3364 del_range_1 (same_at_start
, same_at_end
, 0);
3365 /* Insert from the file at the proper position. */
3366 SET_PT (same_at_start
);
3368 /* If display currently starts at beginning of line,
3369 keep it that way. */
3370 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3371 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3373 replace_handled
= 1;
3377 /* If requested, replace the accessible part of the buffer
3378 with the file contents. Avoid replacing text at the
3379 beginning or end of the buffer that matches the file contents;
3380 that preserves markers pointing to the unchanged parts.
3382 Here we implement this feature for the case where code conversion
3383 is needed, in a simple way that needs a lot of memory.
3384 The preceding if-statement handles the case of no conversion
3385 in a more optimized way. */
3386 if (!NILP (replace
) && ! replace_handled
)
3388 int same_at_start
= BEGV
;
3389 int same_at_end
= ZV
;
3392 /* Make sure that the gap is large enough. */
3393 int bufsize
= 2 * st
.st_size
;
3394 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3396 /* First read the whole file, performing code conversion into
3397 CONVERSION_BUFFER. */
3399 if (lseek (fd
, XINT (beg
), 0) < 0)
3401 free (conversion_buffer
);
3402 report_file_error ("Setting file position",
3403 Fcons (filename
, Qnil
));
3406 total
= st
.st_size
; /* Total bytes in the file. */
3407 how_much
= 0; /* Bytes read from file so far. */
3408 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3409 unprocessed
= 0; /* Bytes not processed in previous loop. */
3411 while (how_much
< total
)
3413 /* try is reserved in some compilers (Microsoft C) */
3414 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3415 char *destination
= read_buf
+ unprocessed
;
3418 /* Allow quitting out of the actual I/O. */
3421 this = read (fd
, destination
, trytry
);
3424 if (this < 0 || this + unprocessed
== 0)
3432 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3434 int require
, produced
, consumed
;
3436 this += unprocessed
;
3438 /* If we are using more space than estimated,
3439 make CONVERSION_BUFFER bigger. */
3440 require
= decoding_buffer_size (&coding
, this);
3441 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3443 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3444 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3447 /* Convert this batch with results in CONVERSION_BUFFER. */
3448 if (how_much
>= total
) /* This is the last block. */
3449 coding
.last_block
= 1;
3450 produced
= decode_coding (&coding
, read_buf
,
3451 conversion_buffer
+ inserted
,
3452 this, bufsize
- inserted
,
3455 /* Save for next iteration whatever we didn't convert. */
3456 unprocessed
= this - consumed
;
3457 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3464 /* At this point, INSERTED is how many characters
3465 are present in CONVERSION_BUFFER.
3466 HOW_MUCH should equal TOTAL,
3467 or should be <= 0 if we couldn't read the file. */
3471 free (conversion_buffer
);
3474 error ("IO error reading %s: %s",
3475 XSTRING (filename
)->data
, strerror (errno
));
3476 else if (how_much
== -2)
3477 error ("maximum buffer size exceeded");
3480 /* Compare the beginning of the converted file
3481 with the buffer text. */
3484 while (bufpos
< inserted
&& same_at_start
< same_at_end
3485 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3486 same_at_start
++, bufpos
++;
3488 /* If the file matches the buffer completely,
3489 there's no need to replace anything. */
3491 if (bufpos
== inserted
)
3493 free (conversion_buffer
);
3496 /* Truncate the buffer to the size of the file. */
3497 del_range_1 (same_at_start
, same_at_end
, 0);
3501 /* Scan this bufferful from the end, comparing with
3502 the Emacs buffer. */
3505 /* Compare with same_at_start to avoid counting some buffer text
3506 as matching both at the file's beginning and at the end. */
3507 while (bufpos
> 0 && same_at_end
> same_at_start
3508 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3509 same_at_end
--, bufpos
--;
3511 /* Don't try to reuse the same piece of text twice. */
3512 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3514 same_at_end
+= overlap
;
3516 /* If display currently starts at beginning of line,
3517 keep it that way. */
3518 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3519 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3521 /* Replace the chars that we need to replace,
3522 and update INSERTED to equal the number of bytes
3523 we are taking from the file. */
3524 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3525 move_gap (same_at_start
);
3526 del_range_1 (same_at_start
, same_at_end
, 0);
3527 SET_PT (same_at_start
);
3528 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3530 free (conversion_buffer
);
3539 register Lisp_Object temp
;
3541 total
= XINT (end
) - XINT (beg
);
3543 /* Make sure point-max won't overflow after this insertion. */
3544 XSETINT (temp
, total
);
3545 if (total
!= XINT (temp
))
3546 error ("Maximum buffer size exceeded");
3549 /* For a special file, all we can do is guess. */
3550 total
= READ_BUF_SIZE
;
3552 if (NILP (visit
) && total
> 0)
3553 prepare_to_modify_buffer (PT
, PT
, NULL
);
3556 if (GAP_SIZE
< total
)
3557 make_gap (total
- GAP_SIZE
);
3559 if (XINT (beg
) != 0 || !NILP (replace
))
3561 if (lseek (fd
, XINT (beg
), 0) < 0)
3562 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3565 /* In the following loop, HOW_MUCH contains the total bytes read so
3566 far. Before exiting the loop, it is set to -1 if I/O error
3567 occurs, set to -2 if the maximum buffer size is exceeded. */
3569 /* Total bytes inserted. */
3571 /* Bytes not processed in the previous loop because short gap size. */
3573 while (how_much
< total
)
3575 /* try is reserved in some compilers (Microsoft C) */
3576 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3577 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3578 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3579 : read_buf
+ unprocessed
);
3582 /* Allow quitting out of the actual I/O. */
3585 this = read (fd
, destination
, trytry
);
3588 if (this < 0 || this + unprocessed
== 0)
3594 /* For a regular file, where TOTAL is the real size,
3595 count HOW_MUCH to compare with it.
3596 For a special file, where TOTAL is just a buffer size,
3597 so don't bother counting in HOW_MUCH.
3598 (INSERTED is where we count the number of characters inserted.) */
3602 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3604 int require
, produced
, consumed
;
3606 this += unprocessed
;
3607 /* Make sure that the gap is large enough. */
3608 require
= decoding_buffer_size (&coding
, this);
3609 if (GAP_SIZE
< require
)
3610 make_gap (require
- GAP_SIZE
);
3614 if (how_much
>= total
) /* This is the last block. */
3615 coding
.last_block
= 1;
3619 /* If we encounter EOF, say it is the last block. (The
3620 data this will apply to is the UNPROCESSED characters
3621 carried over from the last batch.) */
3623 coding
.last_block
= 1;
3626 produced
= decode_coding (&coding
, read_buf
,
3627 POS_ADDR (PT
+ inserted
- 1) + 1,
3628 this, GAP_SIZE
, &consumed
);
3633 XSET (temp
, Lisp_Int
, Z
+ produced
);
3634 if (Z
+ produced
!= XINT (temp
))
3640 unprocessed
= this - consumed
;
3641 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3650 /* Put an anchor to ensure multi-byte form ends at gap. */
3657 /* Use the conversion type to determine buffer-file-type
3658 (find-buffer-file-type is now used to help determine the
3660 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3661 && coding
.eol_type
!= CODING_EOL_LF
)
3662 current_buffer
->buffer_file_type
= Qnil
;
3664 current_buffer
->buffer_file_type
= Qt
;
3667 /* We don't have to consider file type of MSDOS because all files
3668 are read as binary and end-of-line format has already been
3669 decoded appropriately. */
3672 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3673 /* Determine file type from name and remove LFs from CR-LFs if the file
3674 is deemed to be a text file. */
3676 current_buffer
->buffer_file_type
3677 = call1 (Qfind_buffer_file_type
, filename
);
3678 if (NILP (current_buffer
->buffer_file_type
))
3681 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3684 GPT
-= reduced_size
;
3685 GAP_SIZE
+= reduced_size
;
3686 inserted
-= reduced_size
;
3694 record_insert (PT
, inserted
);
3696 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3697 offset_intervals (current_buffer
, PT
, inserted
);
3703 /* Discard the unwind protect for closing the file. */
3707 error ("IO error reading %s: %s",
3708 XSTRING (filename
)->data
, strerror (errno
));
3709 else if (how_much
== -2)
3710 error ("maximum buffer size exceeded");
3717 if (!EQ (current_buffer
->undo_list
, Qt
))
3718 current_buffer
->undo_list
= Qnil
;
3720 stat (XSTRING (filename
)->data
, &st
);
3725 current_buffer
->modtime
= st
.st_mtime
;
3726 current_buffer
->filename
= filename
;
3729 SAVE_MODIFF
= MODIFF
;
3730 current_buffer
->auto_save_modified
= MODIFF
;
3731 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3732 #ifdef CLASH_DETECTION
3735 if (!NILP (current_buffer
->file_truename
))
3736 unlock_file (current_buffer
->file_truename
);
3737 unlock_file (filename
);
3739 #endif /* CLASH_DETECTION */
3741 Fsignal (Qfile_error
,
3742 Fcons (build_string ("not a regular file"),
3743 Fcons (filename
, Qnil
)));
3745 /* If visiting nonexistent file, return nil. */
3746 if (current_buffer
->modtime
== -1)
3747 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3750 /* Decode file format */
3753 insval
= call3 (Qformat_decode
,
3754 Qnil
, make_number (inserted
), visit
);
3755 CHECK_NUMBER (insval
, 0);
3756 inserted
= XFASTINT (insval
);
3759 /* Call after-change hooks for the inserted text, aside from the case
3760 of normal visiting (not with REPLACE), which is done in a new buffer
3761 "before" the buffer is changed. */
3762 if (inserted
> 0 && total
> 0
3763 && (NILP (visit
) || !NILP (replace
)))
3764 signal_after_change (PT
, 0, inserted
);
3768 p
= Vafter_insert_file_functions
;
3769 if (!NILP (coding
.post_read_conversion
))
3770 p
= Fcons (coding
.post_read_conversion
, p
);
3774 insval
= call1 (Fcar (p
), make_number (inserted
));
3777 CHECK_NUMBER (insval
, 0);
3778 inserted
= XFASTINT (insval
);
3786 val
= Fcons (filename
,
3787 Fcons (make_number (inserted
),
3790 RETURN_UNGCPRO (unbind_to (count
, val
));
3793 static Lisp_Object
build_annotations ();
3794 extern Lisp_Object
Ffile_locked_p ();
3796 /* If build_annotations switched buffers, switch back to BUF.
3797 Kill the temporary buffer that was selected in the meantime.
3799 Since this kill only the last temporary buffer, some buffers remain
3800 not killed if build_annotations switched buffers more than once.
3804 build_annotations_unwind (buf
)
3809 if (XBUFFER (buf
) == current_buffer
)
3811 tembuf
= Fcurrent_buffer ();
3813 Fkill_buffer (tembuf
);
3817 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3818 "r\nFWrite region to file: ",
3819 "Write current region into specified file.\n\
3820 When called from a program, takes three arguments:\n\
3821 START, END and FILENAME. START and END are buffer positions.\n\
3822 Optional fourth argument APPEND if non-nil means\n\
3823 append to existing file contents (if any).\n\
3824 Optional fifth argument VISIT if t means\n\
3825 set the last-save-file-modtime of buffer to this file's modtime\n\
3826 and mark buffer not modified.\n\
3827 If VISIT is a string, it is a second file name;\n\
3828 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3829 VISIT is also the file name to lock and unlock for clash detection.\n\
3830 If VISIT is neither t nor nil nor a string,\n\
3831 that means do not print the \"Wrote file\" message.\n\
3832 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3833 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3834 Kludgy feature: if START is a string, then that string is written\n\
3835 to the file, instead of any buffer contents, and END is ignored.")
3836 (start
, end
, filename
, append
, visit
, lockname
)
3837 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3845 int count
= specpdl_ptr
- specpdl
;
3848 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3850 Lisp_Object handler
;
3851 Lisp_Object visit_file
;
3852 Lisp_Object annotations
;
3853 int visiting
, quietly
;
3854 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3855 struct buffer
*given_buffer
;
3857 int buffer_file_type
= O_BINARY
;
3859 struct coding_system coding
;
3861 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3862 error ("Cannot do file visiting in an indirect buffer");
3864 if (!NILP (start
) && !STRINGP (start
))
3865 validate_region (&start
, &end
);
3867 GCPRO4 (start
, filename
, visit
, lockname
);
3869 /* Decide the coding-system to be encoded to. */
3875 else if (!NILP (Vcoding_system_for_write
))
3876 val
= Vcoding_system_for_write
;
3877 else if (NILP (current_buffer
->enable_multibyte_characters
))
3879 /* If the variable `buffer-file-coding-system' is set locally,
3880 it means that the file was read with some kind of code
3881 conversion or the varialbe is explicitely set by users. We
3882 had better write it out with the same coding system even if
3883 `enable-multibyte-characters' is nil.
3885 If is is not set locally, we anyway have to convert EOL
3886 format if the default value of `buffer-file-coding-system'
3887 tells that it is not Unix-like (LF only) format. */
3888 val
= current_buffer
->buffer_file_coding_system
;
3889 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3891 struct coding_system coding_temp
;
3893 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3894 if (coding_temp
.eol_type
== CODING_EOL_CRLF
3895 || coding_temp
.eol_type
== CODING_EOL_CR
)
3897 setup_coding_system (Qemacs_mule
, &coding
);
3898 coding
.eol_type
= coding_temp
.eol_type
;
3899 goto done_setup_coding
;
3906 Lisp_Object args
[7], coding_systems
;
3908 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3909 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3911 coding_systems
= Ffind_operation_coding_system (7, args
);
3912 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3913 ? XCONS (coding_systems
)->cdr
3914 : current_buffer
->buffer_file_coding_system
);
3916 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3919 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3920 coding
.selective
= 1;
3923 filename
= Fexpand_file_name (filename
, Qnil
);
3924 if (STRINGP (visit
))
3925 visit_file
= Fexpand_file_name (visit
, Qnil
);
3927 visit_file
= filename
;
3930 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3931 quietly
= !NILP (visit
);
3935 if (NILP (lockname
))
3936 lockname
= visit_file
;
3938 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3940 /* If the file name has special constructs in it,
3941 call the corresponding file handler. */
3942 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3943 /* If FILENAME has no handler, see if VISIT has one. */
3944 if (NILP (handler
) && STRINGP (visit
))
3945 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3947 if (!NILP (handler
))
3950 val
= call6 (handler
, Qwrite_region
, start
, end
,
3951 filename
, append
, visit
);
3955 SAVE_MODIFF
= MODIFF
;
3956 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3957 current_buffer
->filename
= visit_file
;
3963 /* Special kludge to simplify auto-saving. */
3966 XSETFASTINT (start
, BEG
);
3967 XSETFASTINT (end
, Z
);
3970 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3971 count1
= specpdl_ptr
- specpdl
;
3973 given_buffer
= current_buffer
;
3974 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3975 if (current_buffer
!= given_buffer
)
3977 XSETFASTINT (start
, BEGV
);
3978 XSETFASTINT (end
, ZV
);
3981 #ifdef CLASH_DETECTION
3984 #if 0 /* This causes trouble for GNUS. */
3985 /* If we've locked this file for some other buffer,
3986 query before proceeding. */
3987 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3988 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
3991 lock_file (lockname
);
3993 #endif /* CLASH_DETECTION */
3995 fn
= XSTRING (filename
)->data
;
3999 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4000 #else /* not DOS_NT */
4001 desc
= open (fn
, O_WRONLY
);
4002 #endif /* not DOS_NT */
4004 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
4006 if (auto_saving
) /* Overwrite any previous version of autosave file */
4008 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4009 desc
= open (fn
, O_RDWR
);
4011 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4012 ? XSTRING (current_buffer
->filename
)->data
: 0,
4015 else /* Write to temporary name and rename if no errors */
4017 Lisp_Object temp_name
;
4018 temp_name
= Ffile_name_directory (filename
);
4020 if (!NILP (temp_name
))
4022 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4023 build_string ("$$SAVE$$")));
4024 fname
= XSTRING (filename
)->data
;
4025 fn
= XSTRING (temp_name
)->data
;
4026 desc
= creat_copy_attrs (fname
, fn
);
4029 /* If we can't open the temporary file, try creating a new
4030 version of the original file. VMS "creat" creates a
4031 new version rather than truncating an existing file. */
4034 desc
= creat (fn
, 0666);
4035 #if 0 /* This can clobber an existing file and fail to replace it,
4036 if the user runs out of space. */
4039 /* We can't make a new version;
4040 try to truncate and rewrite existing version if any. */
4042 desc
= open (fn
, O_RDWR
);
4048 desc
= creat (fn
, 0666);
4053 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4054 S_IREAD
| S_IWRITE
);
4055 #else /* not DOS_NT */
4056 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4057 #endif /* not DOS_NT */
4058 #endif /* not VMS */
4064 #ifdef CLASH_DETECTION
4066 if (!auto_saving
) unlock_file (lockname
);
4068 #endif /* CLASH_DETECTION */
4069 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4072 record_unwind_protect (close_file_unwind
, make_number (desc
));
4075 if (lseek (desc
, 0, 2) < 0)
4077 #ifdef CLASH_DETECTION
4078 if (!auto_saving
) unlock_file (lockname
);
4079 #endif /* CLASH_DETECTION */
4080 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4085 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4086 * if we do writes that don't end with a carriage return. Furthermore
4087 * it cannot handle writes of more then 16K. The modified
4088 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4089 * this EXCEPT for the last record (iff it doesn't end with a carriage
4090 * return). This implies that if your buffer doesn't end with a carriage
4091 * return, you get one free... tough. However it also means that if
4092 * we make two calls to sys_write (a la the following code) you can
4093 * get one at the gap as well. The easiest way to fix this (honest)
4094 * is to move the gap to the next newline (or the end of the buffer).
4099 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4100 move_gap (find_next_newline (GPT
, 1));
4102 /* Whether VMS or not, we must move the gap to the next of newline
4103 when we must put designation sequences at beginning of line. */
4104 if (INTEGERP (start
)
4105 && coding
.type
== coding_type_iso2022
4106 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4107 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4108 move_gap (find_next_newline (GPT
, 1));
4114 if (STRINGP (start
))
4116 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4117 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4120 else if (XINT (start
) != XINT (end
))
4123 if (XINT (start
) < GPT
)
4125 register int end1
= XINT (end
);
4127 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4128 min (GPT
, end1
) - tem
, tem
, &annotations
,
4130 nwritten
+= min (GPT
, end1
) - tem
;
4134 if (XINT (end
) > GPT
&& !failure
)
4137 tem
= max (tem
, GPT
);
4138 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4139 tem
, &annotations
, &coding
);
4140 nwritten
+= XINT (end
) - tem
;
4146 /* If file was empty, still need to write the annotations */
4147 coding
.last_block
= 1;
4148 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4152 if (coding
.require_flushing
&& !coding
.last_block
)
4154 /* We have to flush out a data. */
4155 coding
.last_block
= 1;
4156 failure
= 0 > e_write (desc
, "", 0, &coding
);
4163 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4164 Disk full in NFS may be reported here. */
4165 /* mib says that closing the file will try to write as fast as NFS can do
4166 it, and that means the fsync here is not crucial for autosave files. */
4167 if (!auto_saving
&& fsync (desc
) < 0)
4169 /* If fsync fails with EINTR, don't treat that as serious. */
4171 failure
= 1, save_errno
= errno
;
4175 /* Spurious "file has changed on disk" warnings have been
4176 observed on Suns as well.
4177 It seems that `close' can change the modtime, under nfs.
4179 (This has supposedly been fixed in Sunos 4,
4180 but who knows about all the other machines with NFS?) */
4183 /* On VMS and APOLLO, must do the stat after the close
4184 since closing changes the modtime. */
4187 /* Recall that #if defined does not work on VMS. */
4194 /* NFS can report a write failure now. */
4195 if (close (desc
) < 0)
4196 failure
= 1, save_errno
= errno
;
4199 /* If we wrote to a temporary name and had no errors, rename to real name. */
4203 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4211 /* Discard the unwind protect for close_file_unwind. */
4212 specpdl_ptr
= specpdl
+ count1
;
4213 /* Restore the original current buffer. */
4214 visit_file
= unbind_to (count
, visit_file
);
4216 #ifdef CLASH_DETECTION
4218 unlock_file (lockname
);
4219 #endif /* CLASH_DETECTION */
4221 /* Do this before reporting IO error
4222 to avoid a "file has changed on disk" warning on
4223 next attempt to save. */
4225 current_buffer
->modtime
= st
.st_mtime
;
4228 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4232 SAVE_MODIFF
= MODIFF
;
4233 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4234 current_buffer
->filename
= visit_file
;
4235 update_mode_lines
++;
4241 message ("Wrote %s", XSTRING (visit_file
)->data
);
4246 Lisp_Object
merge ();
4248 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4249 "Return t if (car A) is numerically less than (car B).")
4253 return Flss (Fcar (a
), Fcar (b
));
4256 /* Build the complete list of annotations appropriate for writing out
4257 the text between START and END, by calling all the functions in
4258 write-region-annotate-functions and merging the lists they return.
4259 If one of these functions switches to a different buffer, we assume
4260 that buffer contains altered text. Therefore, the caller must
4261 make sure to restore the current buffer in all cases,
4262 as save-excursion would do. */
4265 build_annotations (start
, end
, pre_write_conversion
)
4266 Lisp_Object start
, end
, pre_write_conversion
;
4268 Lisp_Object annotations
;
4270 struct gcpro gcpro1
, gcpro2
;
4271 Lisp_Object original_buffer
;
4273 XSETBUFFER (original_buffer
, current_buffer
);
4276 p
= Vwrite_region_annotate_functions
;
4277 GCPRO2 (annotations
, p
);
4280 struct buffer
*given_buffer
= current_buffer
;
4281 Vwrite_region_annotations_so_far
= annotations
;
4282 res
= call2 (Fcar (p
), start
, end
);
4283 /* If the function makes a different buffer current,
4284 assume that means this buffer contains altered text to be output.
4285 Reset START and END from the buffer bounds
4286 and discard all previous annotations because they should have
4287 been dealt with by this function. */
4288 if (current_buffer
!= given_buffer
)
4290 XSETFASTINT (start
, BEGV
);
4291 XSETFASTINT (end
, ZV
);
4294 Flength (res
); /* Check basic validity of return value */
4295 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4299 /* Now do the same for annotation functions implied by the file-format */
4300 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4301 p
= Vauto_save_file_format
;
4303 p
= current_buffer
->file_format
;
4306 struct buffer
*given_buffer
= current_buffer
;
4307 Vwrite_region_annotations_so_far
= annotations
;
4308 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4310 if (current_buffer
!= given_buffer
)
4312 XSETFASTINT (start
, BEGV
);
4313 XSETFASTINT (end
, ZV
);
4317 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4321 /* At last, do the same for the function PRE_WRITE_CONVERSION
4322 implied by the current coding-system. */
4323 if (!NILP (pre_write_conversion
))
4325 struct buffer
*given_buffer
= current_buffer
;
4326 Vwrite_region_annotations_so_far
= annotations
;
4327 res
= call2 (pre_write_conversion
, start
, end
);
4329 annotations
= (current_buffer
!= given_buffer
4331 : merge (annotations
, res
, Qcar_less_than_car
));
4338 /* Write to descriptor DESC the LEN characters starting at ADDR,
4339 assuming they start at position POS in the buffer.
4340 Intersperse with them the annotations from *ANNOT
4341 (those which fall within the range of positions POS to POS + LEN),
4342 each at its appropriate position.
4344 Modify *ANNOT by discarding elements as we output them.
4345 The return value is negative in case of system call failure. */
4348 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4350 register char *addr
;
4354 struct coding_system
*coding
;
4358 int lastpos
= pos
+ len
;
4360 while (NILP (*annot
) || CONSP (*annot
))
4362 tem
= Fcar_safe (Fcar (*annot
));
4363 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4364 nextpos
= XFASTINT (tem
);
4366 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4369 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4371 addr
+= nextpos
- pos
;
4374 tem
= Fcdr (Fcar (*annot
));
4377 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4381 *annot
= Fcdr (*annot
);
4385 #ifndef WRITE_BUF_SIZE
4386 #define WRITE_BUF_SIZE (16 * 1024)
4390 e_write (desc
, addr
, len
, coding
)
4392 register char *addr
;
4394 struct coding_system
*coding
;
4396 char buf
[WRITE_BUF_SIZE
];
4397 int produced
, consumed
;
4399 /* We used to have a code for handling selective display here. But,
4400 now it is handled within encode_coding. */
4403 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4405 len
-= consumed
, addr
+= consumed
;
4408 produced
-= write (desc
, buf
, produced
);
4409 if (produced
) return -1;
4417 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4418 Sverify_visited_file_modtime
, 1, 1, 0,
4419 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4420 This means that the file has not been changed since it was visited or saved.")
4426 Lisp_Object handler
;
4428 CHECK_BUFFER (buf
, 0);
4431 if (!STRINGP (b
->filename
)) return Qt
;
4432 if (b
->modtime
== 0) return Qt
;
4434 /* If the file name has special constructs in it,
4435 call the corresponding file handler. */
4436 handler
= Ffind_file_name_handler (b
->filename
,
4437 Qverify_visited_file_modtime
);
4438 if (!NILP (handler
))
4439 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4441 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4443 /* If the file doesn't exist now and didn't exist before,
4444 we say that it isn't modified, provided the error is a tame one. */
4445 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4450 if (st
.st_mtime
== b
->modtime
4451 /* If both are positive, accept them if they are off by one second. */
4452 || (st
.st_mtime
> 0 && b
->modtime
> 0
4453 && (st
.st_mtime
== b
->modtime
+ 1
4454 || st
.st_mtime
== b
->modtime
- 1)))
4459 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4460 Sclear_visited_file_modtime
, 0, 0, 0,
4461 "Clear out records of last mod time of visited file.\n\
4462 Next attempt to save will certainly not complain of a discrepancy.")
4465 current_buffer
->modtime
= 0;
4469 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4470 Svisited_file_modtime
, 0, 0, 0,
4471 "Return the current buffer's recorded visited file modification time.\n\
4472 The value is a list of the form (HIGH . LOW), like the time values\n\
4473 that `file-attributes' returns.")
4476 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4479 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4480 Sset_visited_file_modtime
, 0, 1, 0,
4481 "Update buffer's recorded modification time from the visited file's time.\n\
4482 Useful if the buffer was not read from the file normally\n\
4483 or if the file itself has been changed for some known benign reason.\n\
4484 An argument specifies the modification time value to use\n\
4485 \(instead of that of the visited file), in the form of a list\n\
4486 \(HIGH . LOW) or (HIGH LOW).")
4488 Lisp_Object time_list
;
4490 if (!NILP (time_list
))
4491 current_buffer
->modtime
= cons_to_long (time_list
);
4494 register Lisp_Object filename
;
4496 Lisp_Object handler
;
4498 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4500 /* If the file name has special constructs in it,
4501 call the corresponding file handler. */
4502 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4503 if (!NILP (handler
))
4504 /* The handler can find the file name the same way we did. */
4505 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4506 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4507 current_buffer
->modtime
= st
.st_mtime
;
4517 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4518 Fsleep_for (make_number (1), Qnil
);
4519 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4520 Fsleep_for (make_number (1), Qnil
);
4521 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4522 Fsleep_for (make_number (1), Qnil
);
4532 /* Get visited file's mode to become the auto save file's mode. */
4533 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4534 /* But make sure we can overwrite it later! */
4535 auto_save_mode_bits
= st
.st_mode
| 0600;
4537 auto_save_mode_bits
= 0666;
4540 Fwrite_region (Qnil
, Qnil
,
4541 current_buffer
->auto_save_file_name
,
4542 Qnil
, Qlambda
, Qnil
);
4546 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4551 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4552 | XFASTINT (XCONS (stream
)->cdr
)));
4557 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4560 minibuffer_auto_raise
= XINT (value
);
4564 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4565 "Auto-save all buffers that need it.\n\
4566 This is all buffers that have auto-saving enabled\n\
4567 and are changed since last auto-saved.\n\
4568 Auto-saving writes the buffer into a file\n\
4569 so that your editing is not lost if the system crashes.\n\
4570 This file is not the file you visited; that changes only when you save.\n\
4571 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4572 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4573 A non-nil CURRENT-ONLY argument means save only current buffer.")
4574 (no_message
, current_only
)
4575 Lisp_Object no_message
, current_only
;
4577 struct buffer
*old
= current_buffer
, *b
;
4578 Lisp_Object tail
, buf
;
4580 char *omessage
= echo_area_glyphs
;
4581 int omessage_length
= echo_area_glyphs_length
;
4582 int do_handled_files
;
4585 Lisp_Object lispstream
;
4586 int count
= specpdl_ptr
- specpdl
;
4588 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4590 /* Ordinarily don't quit within this function,
4591 but don't make it impossible to quit (in case we get hung in I/O). */
4595 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4596 point to non-strings reached from Vbuffer_alist. */
4601 if (!NILP (Vrun_hooks
))
4602 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4604 if (STRINGP (Vauto_save_list_file_name
))
4606 Lisp_Object listfile
;
4607 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4608 stream
= fopen (XSTRING (listfile
)->data
, "w");
4611 /* Arrange to close that file whether or not we get an error.
4612 Also reset auto_saving to 0. */
4613 lispstream
= Fcons (Qnil
, Qnil
);
4614 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4615 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4626 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4627 record_unwind_protect (do_auto_save_unwind_1
,
4628 make_number (minibuffer_auto_raise
));
4629 minibuffer_auto_raise
= 0;
4632 /* First, save all files which don't have handlers. If Emacs is
4633 crashing, the handlers may tweak what is causing Emacs to crash
4634 in the first place, and it would be a shame if Emacs failed to
4635 autosave perfectly ordinary files because it couldn't handle some
4637 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4638 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4640 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4643 /* Record all the buffers that have auto save mode
4644 in the special file that lists them. For each of these buffers,
4645 Record visited name (if any) and auto save name. */
4646 if (STRINGP (b
->auto_save_file_name
)
4647 && stream
!= NULL
&& do_handled_files
== 0)
4649 if (!NILP (b
->filename
))
4651 fwrite (XSTRING (b
->filename
)->data
, 1,
4652 XSTRING (b
->filename
)->size
, stream
);
4654 putc ('\n', stream
);
4655 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4656 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4657 putc ('\n', stream
);
4660 if (!NILP (current_only
)
4661 && b
!= current_buffer
)
4664 /* Don't auto-save indirect buffers.
4665 The base buffer takes care of it. */
4669 /* Check for auto save enabled
4670 and file changed since last auto save
4671 and file changed since last real save. */
4672 if (STRINGP (b
->auto_save_file_name
)
4673 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4674 && b
->auto_save_modified
< BUF_MODIFF (b
)
4675 /* -1 means we've turned off autosaving for a while--see below. */
4676 && XINT (b
->save_length
) >= 0
4677 && (do_handled_files
4678 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4681 EMACS_TIME before_time
, after_time
;
4683 EMACS_GET_TIME (before_time
);
4685 /* If we had a failure, don't try again for 20 minutes. */
4686 if (b
->auto_save_failure_time
>= 0
4687 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4690 if ((XFASTINT (b
->save_length
) * 10
4691 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4692 /* A short file is likely to change a large fraction;
4693 spare the user annoying messages. */
4694 && XFASTINT (b
->save_length
) > 5000
4695 /* These messages are frequent and annoying for `*mail*'. */
4696 && !EQ (b
->filename
, Qnil
)
4697 && NILP (no_message
))
4699 /* It has shrunk too much; turn off auto-saving here. */
4700 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4701 message ("Buffer %s has shrunk a lot; auto save turned off there",
4702 XSTRING (b
->name
)->data
);
4703 minibuffer_auto_raise
= 0;
4704 /* Turn off auto-saving until there's a real save,
4705 and prevent any more warnings. */
4706 XSETINT (b
->save_length
, -1);
4707 Fsleep_for (make_number (1), Qnil
);
4710 set_buffer_internal (b
);
4711 if (!auto_saved
&& NILP (no_message
))
4712 message1 ("Auto-saving...");
4713 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4715 b
->auto_save_modified
= BUF_MODIFF (b
);
4716 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4717 set_buffer_internal (old
);
4719 EMACS_GET_TIME (after_time
);
4721 /* If auto-save took more than 60 seconds,
4722 assume it was an NFS failure that got a timeout. */
4723 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4724 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4728 /* Prevent another auto save till enough input events come in. */
4729 record_auto_save ();
4731 if (auto_saved
&& NILP (no_message
))
4735 sit_for (1, 0, 0, 0, 0);
4736 message2 (omessage
, omessage_length
);
4739 message1 ("Auto-saving...done");
4744 unbind_to (count
, Qnil
);
4748 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4749 Sset_buffer_auto_saved
, 0, 0, 0,
4750 "Mark current buffer as auto-saved with its current text.\n\
4751 No auto-save file will be written until the buffer changes again.")
4754 current_buffer
->auto_save_modified
= MODIFF
;
4755 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4756 current_buffer
->auto_save_failure_time
= -1;
4760 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4761 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4762 "Clear any record of a recent auto-save failure in the current buffer.")
4765 current_buffer
->auto_save_failure_time
= -1;
4769 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4771 "Return t if buffer has been auto-saved since last read in or saved.")
4774 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4777 /* Reading and completing file names */
4778 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4780 /* In the string VAL, change each $ to $$ and return the result. */
4783 double_dollars (val
)
4786 register unsigned char *old
, *new;
4790 osize
= XSTRING (val
)->size
;
4791 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4792 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4793 if (*old
++ == '$') count
++;
4796 old
= XSTRING (val
)->data
;
4797 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4798 new = XSTRING (val
)->data
;
4799 for (n
= osize
; n
> 0; n
--)
4812 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4814 "Internal subroutine for read-file-name. Do not call this.")
4815 (string
, dir
, action
)
4816 Lisp_Object string
, dir
, action
;
4817 /* action is nil for complete, t for return list of completions,
4818 lambda for verify final value */
4820 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4822 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4824 CHECK_STRING (string
, 0);
4831 /* No need to protect ACTION--we only compare it with t and nil. */
4832 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4834 if (XSTRING (string
)->size
== 0)
4836 if (EQ (action
, Qlambda
))
4844 orig_string
= string
;
4845 string
= Fsubstitute_in_file_name (string
);
4846 changed
= NILP (Fstring_equal (string
, orig_string
));
4847 name
= Ffile_name_nondirectory (string
);
4848 val
= Ffile_name_directory (string
);
4850 realdir
= Fexpand_file_name (val
, realdir
);
4855 specdir
= Ffile_name_directory (string
);
4856 val
= Ffile_name_completion (name
, realdir
);
4861 return double_dollars (string
);
4865 if (!NILP (specdir
))
4866 val
= concat2 (specdir
, val
);
4868 return double_dollars (val
);
4871 #endif /* not VMS */
4875 if (EQ (action
, Qt
))
4876 return Ffile_name_all_completions (name
, realdir
);
4877 /* Only other case actually used is ACTION = lambda */
4879 /* Supposedly this helps commands such as `cd' that read directory names,
4880 but can someone explain how it helps them? -- RMS */
4881 if (XSTRING (name
)->size
== 0)
4884 return Ffile_exists_p (string
);
4887 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4888 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4889 Value is not expanded---you must call `expand-file-name' yourself.\n\
4890 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4891 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4892 except that if INITIAL is specified, that combined with DIR is used.)\n\
4893 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4894 Non-nil and non-t means also require confirmation after completion.\n\
4895 Fifth arg INITIAL specifies text to start with.\n\
4896 DIR defaults to current buffer's directory default.")
4897 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4898 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4900 Lisp_Object val
, insdef
, insdef1
, tem
;
4901 struct gcpro gcpro1
, gcpro2
;
4902 register char *homedir
;
4906 dir
= current_buffer
->directory
;
4907 if (NILP (default_filename
))
4909 if (! NILP (initial
))
4910 default_filename
= Fexpand_file_name (initial
, dir
);
4912 default_filename
= current_buffer
->filename
;
4915 /* If dir starts with user's homedir, change that to ~. */
4916 homedir
= (char *) egetenv ("HOME");
4918 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4919 CORRECT_DIR_SEPS (homedir
);
4923 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4924 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4926 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4927 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4928 XSTRING (dir
)->data
[0] = '~';
4931 if (insert_default_directory
&& STRINGP (dir
))
4934 if (!NILP (initial
))
4936 Lisp_Object args
[2], pos
;
4940 insdef
= Fconcat (2, args
);
4941 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4942 insdef1
= Fcons (double_dollars (insdef
), pos
);
4945 insdef1
= double_dollars (insdef
);
4947 else if (STRINGP (initial
))
4950 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
4953 insdef
= Qnil
, insdef1
= Qnil
;
4956 count
= specpdl_ptr
- specpdl
;
4957 specbind (intern ("completion-ignore-case"), Qt
);
4960 GCPRO2 (insdef
, default_filename
);
4961 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4962 dir
, mustmatch
, insdef1
,
4963 Qfile_name_history
, default_filename
, Qnil
);
4964 /* If Fcompleting_read returned the default string itself
4965 (rather than a new string with the same contents),
4966 it has to mean that the user typed RET with the minibuffer empty.
4967 In that case, we really want to return ""
4968 so that commands such as set-visited-file-name can distinguish. */
4969 if (EQ (val
, default_filename
))
4970 val
= build_string ("");
4973 unbind_to (count
, Qnil
);
4978 error ("No file name specified");
4979 tem
= Fstring_equal (val
, insdef
);
4980 if (!NILP (tem
) && !NILP (default_filename
))
4981 return default_filename
;
4982 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4984 if (!NILP (default_filename
))
4985 return default_filename
;
4987 error ("No default file name");
4989 return Fsubstitute_in_file_name (val
);
4992 #if 0 /* Old version */
4993 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4994 /* Don't confuse make-docfile by having two doc strings for this function.
4995 make-docfile does not pay attention to #if, for good reason! */
4997 (prompt
, dir
, defalt
, mustmatch
, initial
)
4998 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
5000 Lisp_Object val
, insdef
, tem
;
5001 struct gcpro gcpro1
, gcpro2
;
5002 register char *homedir
;
5006 dir
= current_buffer
->directory
;
5008 defalt
= current_buffer
->filename
;
5010 /* If dir starts with user's homedir, change that to ~. */
5011 homedir
= (char *) egetenv ("HOME");
5014 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5015 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
5017 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5018 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5019 XSTRING (dir
)->data
[0] = '~';
5022 if (!NILP (initial
))
5024 else if (insert_default_directory
)
5027 insdef
= build_string ("");
5030 count
= specpdl_ptr
- specpdl
;
5031 specbind (intern ("completion-ignore-case"), Qt
);
5034 GCPRO2 (insdef
, defalt
);
5035 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5037 insert_default_directory
? insdef
: Qnil
,
5038 Qfile_name_history
, Qnil
, Qnil
);
5041 unbind_to (count
, Qnil
);
5046 error ("No file name specified");
5047 tem
= Fstring_equal (val
, insdef
);
5048 if (!NILP (tem
) && !NILP (defalt
))
5050 return Fsubstitute_in_file_name (val
);
5052 #endif /* Old version */
5056 Qexpand_file_name
= intern ("expand-file-name");
5057 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5058 Qdirectory_file_name
= intern ("directory-file-name");
5059 Qfile_name_directory
= intern ("file-name-directory");
5060 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5061 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5062 Qfile_name_as_directory
= intern ("file-name-as-directory");
5063 Qcopy_file
= intern ("copy-file");
5064 Qmake_directory_internal
= intern ("make-directory-internal");
5065 Qdelete_directory
= intern ("delete-directory");
5066 Qdelete_file
= intern ("delete-file");
5067 Qrename_file
= intern ("rename-file");
5068 Qadd_name_to_file
= intern ("add-name-to-file");
5069 Qmake_symbolic_link
= intern ("make-symbolic-link");
5070 Qfile_exists_p
= intern ("file-exists-p");
5071 Qfile_executable_p
= intern ("file-executable-p");
5072 Qfile_readable_p
= intern ("file-readable-p");
5073 Qfile_writable_p
= intern ("file-writable-p");
5074 Qfile_symlink_p
= intern ("file-symlink-p");
5075 Qaccess_file
= intern ("access-file");
5076 Qfile_directory_p
= intern ("file-directory-p");
5077 Qfile_regular_p
= intern ("file-regular-p");
5078 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5079 Qfile_modes
= intern ("file-modes");
5080 Qset_file_modes
= intern ("set-file-modes");
5081 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5082 Qinsert_file_contents
= intern ("insert-file-contents");
5083 Qwrite_region
= intern ("write-region");
5084 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5085 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5087 staticpro (&Qexpand_file_name
);
5088 staticpro (&Qsubstitute_in_file_name
);
5089 staticpro (&Qdirectory_file_name
);
5090 staticpro (&Qfile_name_directory
);
5091 staticpro (&Qfile_name_nondirectory
);
5092 staticpro (&Qunhandled_file_name_directory
);
5093 staticpro (&Qfile_name_as_directory
);
5094 staticpro (&Qcopy_file
);
5095 staticpro (&Qmake_directory_internal
);
5096 staticpro (&Qdelete_directory
);
5097 staticpro (&Qdelete_file
);
5098 staticpro (&Qrename_file
);
5099 staticpro (&Qadd_name_to_file
);
5100 staticpro (&Qmake_symbolic_link
);
5101 staticpro (&Qfile_exists_p
);
5102 staticpro (&Qfile_executable_p
);
5103 staticpro (&Qfile_readable_p
);
5104 staticpro (&Qfile_writable_p
);
5105 staticpro (&Qaccess_file
);
5106 staticpro (&Qfile_symlink_p
);
5107 staticpro (&Qfile_directory_p
);
5108 staticpro (&Qfile_regular_p
);
5109 staticpro (&Qfile_accessible_directory_p
);
5110 staticpro (&Qfile_modes
);
5111 staticpro (&Qset_file_modes
);
5112 staticpro (&Qfile_newer_than_file_p
);
5113 staticpro (&Qinsert_file_contents
);
5114 staticpro (&Qwrite_region
);
5115 staticpro (&Qverify_visited_file_modtime
);
5116 staticpro (&Qset_visited_file_modtime
);
5118 Qfile_name_history
= intern ("file-name-history");
5119 Fset (Qfile_name_history
, Qnil
);
5120 staticpro (&Qfile_name_history
);
5122 Qfile_error
= intern ("file-error");
5123 staticpro (&Qfile_error
);
5124 Qfile_already_exists
= intern ("file-already-exists");
5125 staticpro (&Qfile_already_exists
);
5126 Qfile_date_error
= intern ("file-date-error");
5127 staticpro (&Qfile_date_error
);
5130 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5131 staticpro (&Qfind_buffer_file_type
);
5134 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5135 "*Format in which to write auto-save files.\n\
5136 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5137 If it is t, which is the default, auto-save files are written in the\n\
5138 same format as a regular save would use.");
5139 Vauto_save_file_format
= Qt
;
5141 Qformat_decode
= intern ("format-decode");
5142 staticpro (&Qformat_decode
);
5143 Qformat_annotate_function
= intern ("format-annotate-function");
5144 staticpro (&Qformat_annotate_function
);
5146 Qcar_less_than_car
= intern ("car-less-than-car");
5147 staticpro (&Qcar_less_than_car
);
5149 Fput (Qfile_error
, Qerror_conditions
,
5150 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5151 Fput (Qfile_error
, Qerror_message
,
5152 build_string ("File error"));
5154 Fput (Qfile_already_exists
, Qerror_conditions
,
5155 Fcons (Qfile_already_exists
,
5156 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5157 Fput (Qfile_already_exists
, Qerror_message
,
5158 build_string ("File already exists"));
5160 Fput (Qfile_date_error
, Qerror_conditions
,
5161 Fcons (Qfile_date_error
,
5162 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5163 Fput (Qfile_date_error
, Qerror_message
,
5164 build_string ("Cannot set file date"));
5166 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5167 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5168 insert_default_directory
= 1;
5170 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5171 "*Non-nil means write new files with record format `stmlf'.\n\
5172 nil means use format `var'. This variable is meaningful only on VMS.");
5173 vms_stmlf_recfm
= 0;
5175 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5176 "Directory separator character for built-in functions that return file names.\n\
5177 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5178 This variable affects the built-in functions only on Windows,\n\
5179 on other platforms, it is initialized so that Lisp code can find out\n\
5180 what the normal separator is.");
5181 XSETFASTINT (Vdirectory_sep_char
, '/');
5183 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5184 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5185 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5188 The first argument given to HANDLER is the name of the I/O primitive\n\
5189 to be handled; the remaining arguments are the arguments that were\n\
5190 passed to that primitive. For example, if you do\n\
5191 (file-exists-p FILENAME)\n\
5192 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5193 (funcall HANDLER 'file-exists-p FILENAME)\n\
5194 The function `find-file-name-handler' checks this list for a handler\n\
5195 for its argument.");
5196 Vfile_name_handler_alist
= Qnil
;
5198 DEFVAR_LISP ("set-auto-coding-function",
5199 &Vset_auto_coding_function
,
5200 "If non-nil, a function to call to decide a coding system of file.\n\
5201 One argument is passed to this function: the string of concatination\n\
5202 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5203 This function should return a coding system to decode the file contents\n\
5204 specified in the heading lines with the format:\n\
5205 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5206 or local variable spec of the tailing lines with `coding:' tag.");
5207 Vset_auto_coding_function
= Qnil
;
5209 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5210 "A list of functions to be called at the end of `insert-file-contents'.\n\
5211 Each is passed one argument, the number of bytes inserted. It should return\n\
5212 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5213 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5214 responsible for calling the after-insert-file-functions if appropriate.");
5215 Vafter_insert_file_functions
= Qnil
;
5217 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5218 "A list of functions to be called at the start of `write-region'.\n\
5219 Each is passed two arguments, START and END as for `write-region'.\n\
5220 These are usually two numbers but not always; see the documentation\n\
5221 for `write-region'. The function should return a list of pairs\n\
5222 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5223 inserted at the specified positions of the file being written (1 means to\n\
5224 insert before the first byte written). The POSITIONs must be sorted into\n\
5225 increasing order. If there are several functions in the list, the several\n\
5226 lists are merged destructively.");
5227 Vwrite_region_annotate_functions
= Qnil
;
5229 DEFVAR_LISP ("write-region-annotations-so-far",
5230 &Vwrite_region_annotations_so_far
,
5231 "When an annotation function is called, this holds the previous annotations.\n\
5232 These are the annotations made by other annotation functions\n\
5233 that were already called. See also `write-region-annotate-functions'.");
5234 Vwrite_region_annotations_so_far
= Qnil
;
5236 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5237 "A list of file name handlers that temporarily should not be used.\n\
5238 This applies only to the operation `inhibit-file-name-operation'.");
5239 Vinhibit_file_name_handlers
= Qnil
;
5241 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5242 "The operation for which `inhibit-file-name-handlers' is applicable.");
5243 Vinhibit_file_name_operation
= Qnil
;
5245 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5246 "File name in which we write a list of all auto save file names.\n\
5247 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5248 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5250 Vauto_save_list_file_name
= Qnil
;
5252 defsubr (&Sfind_file_name_handler
);
5253 defsubr (&Sfile_name_directory
);
5254 defsubr (&Sfile_name_nondirectory
);
5255 defsubr (&Sunhandled_file_name_directory
);
5256 defsubr (&Sfile_name_as_directory
);
5257 defsubr (&Sdirectory_file_name
);
5258 defsubr (&Smake_temp_name
);
5259 defsubr (&Sexpand_file_name
);
5260 defsubr (&Ssubstitute_in_file_name
);
5261 defsubr (&Scopy_file
);
5262 defsubr (&Smake_directory_internal
);
5263 defsubr (&Sdelete_directory
);
5264 defsubr (&Sdelete_file
);
5265 defsubr (&Srename_file
);
5266 defsubr (&Sadd_name_to_file
);
5268 defsubr (&Smake_symbolic_link
);
5269 #endif /* S_IFLNK */
5271 defsubr (&Sdefine_logical_name
);
5274 defsubr (&Ssysnetunam
);
5275 #endif /* HPUX_NET */
5276 defsubr (&Sfile_name_absolute_p
);
5277 defsubr (&Sfile_exists_p
);
5278 defsubr (&Sfile_executable_p
);
5279 defsubr (&Sfile_readable_p
);
5280 defsubr (&Sfile_writable_p
);
5281 defsubr (&Saccess_file
);
5282 defsubr (&Sfile_symlink_p
);
5283 defsubr (&Sfile_directory_p
);
5284 defsubr (&Sfile_accessible_directory_p
);
5285 defsubr (&Sfile_regular_p
);
5286 defsubr (&Sfile_modes
);
5287 defsubr (&Sset_file_modes
);
5288 defsubr (&Sset_default_file_modes
);
5289 defsubr (&Sdefault_file_modes
);
5290 defsubr (&Sfile_newer_than_file_p
);
5291 defsubr (&Sinsert_file_contents
);
5292 defsubr (&Swrite_region
);
5293 defsubr (&Scar_less_than_car
);
5294 defsubr (&Sverify_visited_file_modtime
);
5295 defsubr (&Sclear_visited_file_modtime
);
5296 defsubr (&Svisited_file_modtime
);
5297 defsubr (&Sset_visited_file_modtime
);
5298 defsubr (&Sdo_auto_save
);
5299 defsubr (&Sset_buffer_auto_saved
);
5300 defsubr (&Sclear_buffer_auto_save_failure
);
5301 defsubr (&Srecent_auto_save_p
);
5303 defsubr (&Sread_file_name_internal
);
5304 defsubr (&Sread_file_name
);
5307 defsubr (&Sunix_sync
);