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 Vauto_file_coding_system_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 (Vauto_file_coding_system_function
)
3153 && Fboundp (Vauto_file_coding_system_function
))
3155 /* Find a coding system specified in a few lines at the
3156 head of the file. We assume that the fist 1K bytes is
3157 sufficient fot this purpose. */
3158 int nread
= read (fd
, read_buf
, 1024);
3161 error ("IO error reading %s: %s",
3162 XSTRING (filename
)->data
, strerror (errno
));
3165 val
= call1 (Vauto_file_coding_system_function
,
3166 make_string (read_buf
, nread
));
3167 /* Rewind the file for the actual read done later. */
3168 if (lseek (fd
, 0, 0) < 0)
3169 report_file_error ("Setting file position",
3170 Fcons (filename
, Qnil
));
3175 Lisp_Object args
[6], coding_systems
;
3177 args
[0] = Qinsert_file_contents
, args
[1] = filename
,
3178 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3179 coding_systems
= Ffind_operation_coding_system (6, args
);
3180 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3183 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3186 /* If requested, replace the accessible part of the buffer
3187 with the file contents. Avoid replacing text at the
3188 beginning or end of the buffer that matches the file contents;
3189 that preserves markers pointing to the unchanged parts.
3191 Here we implement this feature in an optimized way
3192 for the case where code conversion is NOT needed.
3193 The following if-statement handles the case of conversion
3194 in a less optimal way.
3196 If the code conversion is "automatic" then we try using this
3197 method and hope for the best.
3198 But if we discover the need for conversion, we give up on this method
3199 and let the following if-statement handle the replace job. */
3201 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3203 int same_at_start
= BEGV
;
3204 int same_at_end
= ZV
;
3206 /* There is still a possibility we will find the need to do code
3207 conversion. If that happens, we set this variable to 1 to
3208 give up on handling REPLACE in the optimized way. */
3209 int giveup_match_end
= 0;
3211 if (XINT (beg
) != 0)
3213 if (lseek (fd
, XINT (beg
), 0) < 0)
3214 report_file_error ("Setting file position",
3215 Fcons (filename
, Qnil
));
3220 /* Count how many chars at the start of the file
3221 match the text at the beginning of the buffer. */
3226 nread
= read (fd
, buffer
, sizeof buffer
);
3228 error ("IO error reading %s: %s",
3229 XSTRING (filename
)->data
, strerror (errno
));
3230 else if (nread
== 0)
3233 if (coding
.type
== coding_type_undecided
)
3234 detect_coding (&coding
, buffer
, nread
);
3235 if (coding
.type
!= coding_type_undecided
3236 && coding
.type
!= coding_type_no_conversion
3237 && coding
.type
!= coding_type_emacs_mule
)
3238 /* We found that the file should be decoded somehow.
3239 Let's give up here. */
3241 giveup_match_end
= 1;
3245 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3246 detect_eol (&coding
, buffer
, nread
);
3247 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3248 && coding
.eol_type
!= CODING_EOL_LF
)
3249 /* We found that the format of eol should be decoded.
3250 Let's give up here. */
3252 giveup_match_end
= 1;
3257 while (bufpos
< nread
&& same_at_start
< ZV
3258 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3259 same_at_start
++, bufpos
++;
3260 /* If we found a discrepancy, stop the scan.
3261 Otherwise loop around and scan the next bufferful. */
3262 if (bufpos
!= nread
)
3266 /* If the file matches the buffer completely,
3267 there's no need to replace anything. */
3268 if (same_at_start
- BEGV
== XINT (end
))
3272 /* Truncate the buffer to the size of the file. */
3273 del_range_1 (same_at_start
, same_at_end
, 0);
3278 /* Count how many chars at the end of the file
3279 match the text at the end of the buffer. But, if we have
3280 already found that decoding is necessary, don't waste time. */
3281 while (!giveup_match_end
)
3283 int total_read
, nread
, bufpos
, curpos
, trial
;
3285 /* At what file position are we now scanning? */
3286 curpos
= XINT (end
) - (ZV
- same_at_end
);
3287 /* If the entire file matches the buffer tail, stop the scan. */
3290 /* How much can we scan in the next step? */
3291 trial
= min (curpos
, sizeof buffer
);
3292 if (lseek (fd
, curpos
- trial
, 0) < 0)
3293 report_file_error ("Setting file position",
3294 Fcons (filename
, Qnil
));
3297 while (total_read
< trial
)
3299 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3301 error ("IO error reading %s: %s",
3302 XSTRING (filename
)->data
, strerror (errno
));
3303 total_read
+= nread
;
3305 /* Scan this bufferful from the end, comparing with
3306 the Emacs buffer. */
3307 bufpos
= total_read
;
3308 /* Compare with same_at_start to avoid counting some buffer text
3309 as matching both at the file's beginning and at the end. */
3310 while (bufpos
> 0 && same_at_end
> same_at_start
3311 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3312 same_at_end
--, bufpos
--;
3314 /* If we found a discrepancy, stop the scan.
3315 Otherwise loop around and scan the preceding bufferful. */
3318 /* If this discrepancy is because of code conversion,
3319 we cannot use this method; giveup and try the other. */
3320 if (same_at_end
> same_at_start
3321 && FETCH_BYTE (same_at_end
- 1) >= 0200
3322 && ! NILP (current_buffer
->enable_multibyte_characters
)
3323 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3324 giveup_match_end
= 1;
3330 if (! giveup_match_end
)
3332 /* We win! We can handle REPLACE the optimized way. */
3334 /* Extends the end of non-matching text area to multibyte
3335 character boundary. */
3336 if (! NILP (current_buffer
->enable_multibyte_characters
))
3337 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3340 /* Don't try to reuse the same piece of text twice. */
3341 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3343 same_at_end
+= overlap
;
3345 /* Arrange to read only the nonmatching middle part of the file. */
3346 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3347 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3349 del_range_1 (same_at_start
, same_at_end
, 0);
3350 /* Insert from the file at the proper position. */
3351 SET_PT (same_at_start
);
3353 /* If display currently starts at beginning of line,
3354 keep it that way. */
3355 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3356 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3358 replace_handled
= 1;
3362 /* If requested, replace the accessible part of the buffer
3363 with the file contents. Avoid replacing text at the
3364 beginning or end of the buffer that matches the file contents;
3365 that preserves markers pointing to the unchanged parts.
3367 Here we implement this feature for the case where code conversion
3368 is needed, in a simple way that needs a lot of memory.
3369 The preceding if-statement handles the case of no conversion
3370 in a more optimized way. */
3371 if (!NILP (replace
) && ! replace_handled
)
3373 int same_at_start
= BEGV
;
3374 int same_at_end
= ZV
;
3377 /* Make sure that the gap is large enough. */
3378 int bufsize
= 2 * st
.st_size
;
3379 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3381 /* First read the whole file, performing code conversion into
3382 CONVERSION_BUFFER. */
3384 if (lseek (fd
, XINT (beg
), 0) < 0)
3386 free (conversion_buffer
);
3387 report_file_error ("Setting file position",
3388 Fcons (filename
, Qnil
));
3391 total
= st
.st_size
; /* Total bytes in the file. */
3392 how_much
= 0; /* Bytes read from file so far. */
3393 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3394 unprocessed
= 0; /* Bytes not processed in previous loop. */
3396 while (how_much
< total
)
3398 /* try is reserved in some compilers (Microsoft C) */
3399 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3400 char *destination
= read_buf
+ unprocessed
;
3403 /* Allow quitting out of the actual I/O. */
3406 this = read (fd
, destination
, trytry
);
3409 if (this < 0 || this + unprocessed
== 0)
3417 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3419 int require
, produced
, consumed
;
3421 this += unprocessed
;
3423 /* If we are using more space than estimated,
3424 make CONVERSION_BUFFER bigger. */
3425 require
= decoding_buffer_size (&coding
, this);
3426 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3428 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3429 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3432 /* Convert this batch with results in CONVERSION_BUFFER. */
3433 if (how_much
>= total
) /* This is the last block. */
3434 coding
.last_block
= 1;
3435 produced
= decode_coding (&coding
, read_buf
,
3436 conversion_buffer
+ inserted
,
3437 this, bufsize
- inserted
,
3440 /* Save for next iteration whatever we didn't convert. */
3441 unprocessed
= this - consumed
;
3442 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3449 /* At this point, INSERTED is how many characters
3450 are present in CONVERSION_BUFFER.
3451 HOW_MUCH should equal TOTAL,
3452 or should be <= 0 if we couldn't read the file. */
3456 free (conversion_buffer
);
3459 error ("IO error reading %s: %s",
3460 XSTRING (filename
)->data
, strerror (errno
));
3461 else if (how_much
== -2)
3462 error ("maximum buffer size exceeded");
3465 /* Compare the beginning of the converted file
3466 with the buffer text. */
3469 while (bufpos
< inserted
&& same_at_start
< same_at_end
3470 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3471 same_at_start
++, bufpos
++;
3473 /* If the file matches the buffer completely,
3474 there's no need to replace anything. */
3476 if (bufpos
== inserted
)
3478 free (conversion_buffer
);
3481 /* Truncate the buffer to the size of the file. */
3482 del_range_1 (same_at_start
, same_at_end
, 0);
3486 /* Scan this bufferful from the end, comparing with
3487 the Emacs buffer. */
3490 /* Compare with same_at_start to avoid counting some buffer text
3491 as matching both at the file's beginning and at the end. */
3492 while (bufpos
> 0 && same_at_end
> same_at_start
3493 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3494 same_at_end
--, bufpos
--;
3496 /* Don't try to reuse the same piece of text twice. */
3497 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3499 same_at_end
+= overlap
;
3501 /* If display currently starts at beginning of line,
3502 keep it that way. */
3503 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3504 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3506 /* Replace the chars that we need to replace,
3507 and update INSERTED to equal the number of bytes
3508 we are taking from the file. */
3509 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3510 move_gap (same_at_start
);
3511 del_range_1 (same_at_start
, same_at_end
, 0);
3512 SET_PT (same_at_start
);
3513 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3515 free (conversion_buffer
);
3524 register Lisp_Object temp
;
3526 total
= XINT (end
) - XINT (beg
);
3528 /* Make sure point-max won't overflow after this insertion. */
3529 XSETINT (temp
, total
);
3530 if (total
!= XINT (temp
))
3531 error ("Maximum buffer size exceeded");
3534 /* For a special file, all we can do is guess. */
3535 total
= READ_BUF_SIZE
;
3537 if (NILP (visit
) && total
> 0)
3538 prepare_to_modify_buffer (PT
, PT
, NULL
);
3541 if (GAP_SIZE
< total
)
3542 make_gap (total
- GAP_SIZE
);
3544 if (XINT (beg
) != 0 || !NILP (replace
))
3546 if (lseek (fd
, XINT (beg
), 0) < 0)
3547 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3550 /* In the following loop, HOW_MUCH contains the total bytes read so
3551 far. Before exiting the loop, it is set to -1 if I/O error
3552 occurs, set to -2 if the maximum buffer size is exceeded. */
3554 /* Total bytes inserted. */
3556 /* Bytes not processed in the previous loop because short gap size. */
3558 while (how_much
< total
)
3560 /* try is reserved in some compilers (Microsoft C) */
3561 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3562 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3563 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3564 : read_buf
+ unprocessed
);
3567 /* Allow quitting out of the actual I/O. */
3570 this = read (fd
, destination
, trytry
);
3573 if (this < 0 || this + unprocessed
== 0)
3579 /* For a regular file, where TOTAL is the real size,
3580 count HOW_MUCH to compare with it.
3581 For a special file, where TOTAL is just a buffer size,
3582 so don't bother counting in HOW_MUCH.
3583 (INSERTED is where we count the number of characters inserted.) */
3587 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3589 int require
, produced
, consumed
;
3591 this += unprocessed
;
3592 /* Make sure that the gap is large enough. */
3593 require
= decoding_buffer_size (&coding
, this);
3594 if (GAP_SIZE
< require
)
3595 make_gap (require
- GAP_SIZE
);
3599 if (how_much
>= total
) /* This is the last block. */
3600 coding
.last_block
= 1;
3604 /* If we encounter EOF, say it is the last block. (The
3605 data this will apply to is the UNPROCESSED characters
3606 carried over from the last batch.) */
3608 coding
.last_block
= 1;
3611 produced
= decode_coding (&coding
, read_buf
,
3612 POS_ADDR (PT
+ inserted
- 1) + 1,
3613 this, GAP_SIZE
, &consumed
);
3618 XSET (temp
, Lisp_Int
, Z
+ produced
);
3619 if (Z
+ produced
!= XINT (temp
))
3625 unprocessed
= this - consumed
;
3626 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3635 /* Put an anchor to ensure multi-byte form ends at gap. */
3642 /* Use the conversion type to determine buffer-file-type
3643 (find-buffer-file-type is now used to help determine the
3645 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3646 && coding
.eol_type
!= CODING_EOL_LF
)
3647 current_buffer
->buffer_file_type
= Qnil
;
3649 current_buffer
->buffer_file_type
= Qt
;
3652 /* We don't have to consider file type of MSDOS because all files
3653 are read as binary and end-of-line format has already been
3654 decoded appropriately. */
3657 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3658 /* Determine file type from name and remove LFs from CR-LFs if the file
3659 is deemed to be a text file. */
3661 current_buffer
->buffer_file_type
3662 = call1 (Qfind_buffer_file_type
, filename
);
3663 if (NILP (current_buffer
->buffer_file_type
))
3666 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3669 GPT
-= reduced_size
;
3670 GAP_SIZE
+= reduced_size
;
3671 inserted
-= reduced_size
;
3679 record_insert (PT
, inserted
);
3681 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3682 offset_intervals (current_buffer
, PT
, inserted
);
3688 /* Discard the unwind protect for closing the file. */
3692 error ("IO error reading %s: %s",
3693 XSTRING (filename
)->data
, strerror (errno
));
3694 else if (how_much
== -2)
3695 error ("maximum buffer size exceeded");
3702 if (!EQ (current_buffer
->undo_list
, Qt
))
3703 current_buffer
->undo_list
= Qnil
;
3705 stat (XSTRING (filename
)->data
, &st
);
3710 current_buffer
->modtime
= st
.st_mtime
;
3711 current_buffer
->filename
= filename
;
3714 SAVE_MODIFF
= MODIFF
;
3715 current_buffer
->auto_save_modified
= MODIFF
;
3716 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3717 #ifdef CLASH_DETECTION
3720 if (!NILP (current_buffer
->file_truename
))
3721 unlock_file (current_buffer
->file_truename
);
3722 unlock_file (filename
);
3724 #endif /* CLASH_DETECTION */
3726 Fsignal (Qfile_error
,
3727 Fcons (build_string ("not a regular file"),
3728 Fcons (filename
, Qnil
)));
3730 /* If visiting nonexistent file, return nil. */
3731 if (current_buffer
->modtime
== -1)
3732 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3735 /* Decode file format */
3738 insval
= call3 (Qformat_decode
,
3739 Qnil
, make_number (inserted
), visit
);
3740 CHECK_NUMBER (insval
, 0);
3741 inserted
= XFASTINT (insval
);
3744 /* Call after-change hooks for the inserted text, aside from the case
3745 of normal visiting (not with REPLACE), which is done in a new buffer
3746 "before" the buffer is changed. */
3747 if (inserted
> 0 && total
> 0
3748 && (NILP (visit
) || !NILP (replace
)))
3749 signal_after_change (PT
, 0, inserted
);
3753 p
= Vafter_insert_file_functions
;
3754 if (!NILP (coding
.post_read_conversion
))
3755 p
= Fcons (coding
.post_read_conversion
, p
);
3759 insval
= call1 (Fcar (p
), make_number (inserted
));
3762 CHECK_NUMBER (insval
, 0);
3763 inserted
= XFASTINT (insval
);
3771 val
= Fcons (filename
,
3772 Fcons (make_number (inserted
),
3775 RETURN_UNGCPRO (unbind_to (count
, val
));
3778 static Lisp_Object
build_annotations ();
3779 extern Lisp_Object
Ffile_locked_p ();
3781 /* If build_annotations switched buffers, switch back to BUF.
3782 Kill the temporary buffer that was selected in the meantime.
3784 Since this kill only the last temporary buffer, some buffers remain
3785 not killed if build_annotations switched buffers more than once.
3789 build_annotations_unwind (buf
)
3794 if (XBUFFER (buf
) == current_buffer
)
3796 tembuf
= Fcurrent_buffer ();
3798 Fkill_buffer (tembuf
);
3802 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3803 "r\nFWrite region to file: ",
3804 "Write current region into specified file.\n\
3805 When called from a program, takes three arguments:\n\
3806 START, END and FILENAME. START and END are buffer positions.\n\
3807 Optional fourth argument APPEND if non-nil means\n\
3808 append to existing file contents (if any).\n\
3809 Optional fifth argument VISIT if t means\n\
3810 set the last-save-file-modtime of buffer to this file's modtime\n\
3811 and mark buffer not modified.\n\
3812 If VISIT is a string, it is a second file name;\n\
3813 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3814 VISIT is also the file name to lock and unlock for clash detection.\n\
3815 If VISIT is neither t nor nil nor a string,\n\
3816 that means do not print the \"Wrote file\" message.\n\
3817 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3818 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3819 Kludgy feature: if START is a string, then that string is written\n\
3820 to the file, instead of any buffer contents, and END is ignored.")
3821 (start
, end
, filename
, append
, visit
, lockname
)
3822 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3830 int count
= specpdl_ptr
- specpdl
;
3833 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3835 Lisp_Object handler
;
3836 Lisp_Object visit_file
;
3837 Lisp_Object annotations
;
3838 int visiting
, quietly
;
3839 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3840 struct buffer
*given_buffer
;
3842 int buffer_file_type
= O_BINARY
;
3844 struct coding_system coding
;
3846 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3847 error ("Cannot do file visiting in an indirect buffer");
3849 if (!NILP (start
) && !STRINGP (start
))
3850 validate_region (&start
, &end
);
3852 GCPRO4 (start
, filename
, visit
, lockname
);
3854 /* Decide the coding-system to be encoded to. */
3860 else if (!NILP (Vcoding_system_for_write
))
3861 val
= Vcoding_system_for_write
;
3862 else if (NILP (current_buffer
->enable_multibyte_characters
))
3863 val
= (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
))
3865 : Fsymbol_value (Qbuffer_file_coding_system
));
3868 Lisp_Object args
[7], coding_systems
;
3870 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3871 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3873 coding_systems
= Ffind_operation_coding_system (7, args
);
3874 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3875 ? XCONS (coding_systems
)->cdr
3876 : current_buffer
->buffer_file_coding_system
);
3878 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3879 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3880 coding
.selective
= 1;
3883 filename
= Fexpand_file_name (filename
, Qnil
);
3884 if (STRINGP (visit
))
3885 visit_file
= Fexpand_file_name (visit
, Qnil
);
3887 visit_file
= filename
;
3890 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3891 quietly
= !NILP (visit
);
3895 if (NILP (lockname
))
3896 lockname
= visit_file
;
3898 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3900 /* If the file name has special constructs in it,
3901 call the corresponding file handler. */
3902 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3903 /* If FILENAME has no handler, see if VISIT has one. */
3904 if (NILP (handler
) && STRINGP (visit
))
3905 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3907 if (!NILP (handler
))
3910 val
= call6 (handler
, Qwrite_region
, start
, end
,
3911 filename
, append
, visit
);
3915 SAVE_MODIFF
= MODIFF
;
3916 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3917 current_buffer
->filename
= visit_file
;
3923 /* Special kludge to simplify auto-saving. */
3926 XSETFASTINT (start
, BEG
);
3927 XSETFASTINT (end
, Z
);
3930 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3931 count1
= specpdl_ptr
- specpdl
;
3933 given_buffer
= current_buffer
;
3934 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3935 if (current_buffer
!= given_buffer
)
3937 XSETFASTINT (start
, BEGV
);
3938 XSETFASTINT (end
, ZV
);
3941 #ifdef CLASH_DETECTION
3944 #if 0 /* This causes trouble for GNUS. */
3945 /* If we've locked this file for some other buffer,
3946 query before proceeding. */
3947 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3948 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
3951 lock_file (lockname
);
3953 #endif /* CLASH_DETECTION */
3955 fn
= XSTRING (filename
)->data
;
3959 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3960 #else /* not DOS_NT */
3961 desc
= open (fn
, O_WRONLY
);
3962 #endif /* not DOS_NT */
3964 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
3966 if (auto_saving
) /* Overwrite any previous version of autosave file */
3968 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3969 desc
= open (fn
, O_RDWR
);
3971 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3972 ? XSTRING (current_buffer
->filename
)->data
: 0,
3975 else /* Write to temporary name and rename if no errors */
3977 Lisp_Object temp_name
;
3978 temp_name
= Ffile_name_directory (filename
);
3980 if (!NILP (temp_name
))
3982 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3983 build_string ("$$SAVE$$")));
3984 fname
= XSTRING (filename
)->data
;
3985 fn
= XSTRING (temp_name
)->data
;
3986 desc
= creat_copy_attrs (fname
, fn
);
3989 /* If we can't open the temporary file, try creating a new
3990 version of the original file. VMS "creat" creates a
3991 new version rather than truncating an existing file. */
3994 desc
= creat (fn
, 0666);
3995 #if 0 /* This can clobber an existing file and fail to replace it,
3996 if the user runs out of space. */
3999 /* We can't make a new version;
4000 try to truncate and rewrite existing version if any. */
4002 desc
= open (fn
, O_RDWR
);
4008 desc
= creat (fn
, 0666);
4013 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4014 S_IREAD
| S_IWRITE
);
4015 #else /* not DOS_NT */
4016 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4017 #endif /* not DOS_NT */
4018 #endif /* not VMS */
4024 #ifdef CLASH_DETECTION
4026 if (!auto_saving
) unlock_file (lockname
);
4028 #endif /* CLASH_DETECTION */
4029 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4032 record_unwind_protect (close_file_unwind
, make_number (desc
));
4035 if (lseek (desc
, 0, 2) < 0)
4037 #ifdef CLASH_DETECTION
4038 if (!auto_saving
) unlock_file (lockname
);
4039 #endif /* CLASH_DETECTION */
4040 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4045 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4046 * if we do writes that don't end with a carriage return. Furthermore
4047 * it cannot handle writes of more then 16K. The modified
4048 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4049 * this EXCEPT for the last record (iff it doesn't end with a carriage
4050 * return). This implies that if your buffer doesn't end with a carriage
4051 * return, you get one free... tough. However it also means that if
4052 * we make two calls to sys_write (a la the following code) you can
4053 * get one at the gap as well. The easiest way to fix this (honest)
4054 * is to move the gap to the next newline (or the end of the buffer).
4059 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4060 move_gap (find_next_newline (GPT
, 1));
4062 /* Whether VMS or not, we must move the gap to the next of newline
4063 when we must put designation sequences at beginning of line. */
4064 if (INTEGERP (start
)
4065 && coding
.type
== coding_type_iso2022
4066 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4067 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4068 move_gap (find_next_newline (GPT
, 1));
4074 if (STRINGP (start
))
4076 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4077 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4080 else if (XINT (start
) != XINT (end
))
4083 if (XINT (start
) < GPT
)
4085 register int end1
= XINT (end
);
4087 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4088 min (GPT
, end1
) - tem
, tem
, &annotations
,
4090 nwritten
+= min (GPT
, end1
) - tem
;
4094 if (XINT (end
) > GPT
&& !failure
)
4097 tem
= max (tem
, GPT
);
4098 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4099 tem
, &annotations
, &coding
);
4100 nwritten
+= XINT (end
) - tem
;
4106 /* If file was empty, still need to write the annotations */
4107 coding
.last_block
= 1;
4108 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4112 if (coding
.require_flushing
&& !coding
.last_block
)
4114 /* We have to flush out a data. */
4115 coding
.last_block
= 1;
4116 failure
= 0 > e_write (desc
, "", 0, &coding
);
4123 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4124 Disk full in NFS may be reported here. */
4125 /* mib says that closing the file will try to write as fast as NFS can do
4126 it, and that means the fsync here is not crucial for autosave files. */
4127 if (!auto_saving
&& fsync (desc
) < 0)
4129 /* If fsync fails with EINTR, don't treat that as serious. */
4131 failure
= 1, save_errno
= errno
;
4135 /* Spurious "file has changed on disk" warnings have been
4136 observed on Suns as well.
4137 It seems that `close' can change the modtime, under nfs.
4139 (This has supposedly been fixed in Sunos 4,
4140 but who knows about all the other machines with NFS?) */
4143 /* On VMS and APOLLO, must do the stat after the close
4144 since closing changes the modtime. */
4147 /* Recall that #if defined does not work on VMS. */
4154 /* NFS can report a write failure now. */
4155 if (close (desc
) < 0)
4156 failure
= 1, save_errno
= errno
;
4159 /* If we wrote to a temporary name and had no errors, rename to real name. */
4163 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4171 /* Discard the unwind protect for close_file_unwind. */
4172 specpdl_ptr
= specpdl
+ count1
;
4173 /* Restore the original current buffer. */
4174 visit_file
= unbind_to (count
, visit_file
);
4176 #ifdef CLASH_DETECTION
4178 unlock_file (lockname
);
4179 #endif /* CLASH_DETECTION */
4181 /* Do this before reporting IO error
4182 to avoid a "file has changed on disk" warning on
4183 next attempt to save. */
4185 current_buffer
->modtime
= st
.st_mtime
;
4188 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4192 SAVE_MODIFF
= MODIFF
;
4193 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4194 current_buffer
->filename
= visit_file
;
4195 update_mode_lines
++;
4201 message ("Wrote %s", XSTRING (visit_file
)->data
);
4206 Lisp_Object
merge ();
4208 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4209 "Return t if (car A) is numerically less than (car B).")
4213 return Flss (Fcar (a
), Fcar (b
));
4216 /* Build the complete list of annotations appropriate for writing out
4217 the text between START and END, by calling all the functions in
4218 write-region-annotate-functions and merging the lists they return.
4219 If one of these functions switches to a different buffer, we assume
4220 that buffer contains altered text. Therefore, the caller must
4221 make sure to restore the current buffer in all cases,
4222 as save-excursion would do. */
4225 build_annotations (start
, end
, pre_write_conversion
)
4226 Lisp_Object start
, end
, pre_write_conversion
;
4228 Lisp_Object annotations
;
4230 struct gcpro gcpro1
, gcpro2
;
4231 Lisp_Object original_buffer
;
4233 XSETBUFFER (original_buffer
, current_buffer
);
4236 p
= Vwrite_region_annotate_functions
;
4237 GCPRO2 (annotations
, p
);
4240 struct buffer
*given_buffer
= current_buffer
;
4241 Vwrite_region_annotations_so_far
= annotations
;
4242 res
= call2 (Fcar (p
), start
, end
);
4243 /* If the function makes a different buffer current,
4244 assume that means this buffer contains altered text to be output.
4245 Reset START and END from the buffer bounds
4246 and discard all previous annotations because they should have
4247 been dealt with by this function. */
4248 if (current_buffer
!= given_buffer
)
4250 XSETFASTINT (start
, BEGV
);
4251 XSETFASTINT (end
, ZV
);
4254 Flength (res
); /* Check basic validity of return value */
4255 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4259 /* Now do the same for annotation functions implied by the file-format */
4260 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4261 p
= Vauto_save_file_format
;
4263 p
= current_buffer
->file_format
;
4266 struct buffer
*given_buffer
= current_buffer
;
4267 Vwrite_region_annotations_so_far
= annotations
;
4268 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4270 if (current_buffer
!= given_buffer
)
4272 XSETFASTINT (start
, BEGV
);
4273 XSETFASTINT (end
, ZV
);
4277 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4281 /* At last, do the same for the function PRE_WRITE_CONVERSION
4282 implied by the current coding-system. */
4283 if (!NILP (pre_write_conversion
))
4285 struct buffer
*given_buffer
= current_buffer
;
4286 Vwrite_region_annotations_so_far
= annotations
;
4287 res
= call2 (pre_write_conversion
, start
, end
);
4289 annotations
= (current_buffer
!= given_buffer
4291 : merge (annotations
, res
, Qcar_less_than_car
));
4298 /* Write to descriptor DESC the LEN characters starting at ADDR,
4299 assuming they start at position POS in the buffer.
4300 Intersperse with them the annotations from *ANNOT
4301 (those which fall within the range of positions POS to POS + LEN),
4302 each at its appropriate position.
4304 Modify *ANNOT by discarding elements as we output them.
4305 The return value is negative in case of system call failure. */
4308 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4310 register char *addr
;
4314 struct coding_system
*coding
;
4318 int lastpos
= pos
+ len
;
4320 while (NILP (*annot
) || CONSP (*annot
))
4322 tem
= Fcar_safe (Fcar (*annot
));
4323 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4324 nextpos
= XFASTINT (tem
);
4326 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4329 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4331 addr
+= nextpos
- pos
;
4334 tem
= Fcdr (Fcar (*annot
));
4337 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4341 *annot
= Fcdr (*annot
);
4345 #ifndef WRITE_BUF_SIZE
4346 #define WRITE_BUF_SIZE (16 * 1024)
4350 e_write (desc
, addr
, len
, coding
)
4352 register char *addr
;
4354 struct coding_system
*coding
;
4356 char buf
[WRITE_BUF_SIZE
];
4357 int produced
, consumed
;
4359 /* We used to have a code for handling selective display here. But,
4360 now it is handled within encode_coding. */
4363 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4365 len
-= consumed
, addr
+= consumed
;
4368 produced
-= write (desc
, buf
, produced
);
4369 if (produced
) return -1;
4377 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4378 Sverify_visited_file_modtime
, 1, 1, 0,
4379 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4380 This means that the file has not been changed since it was visited or saved.")
4386 Lisp_Object handler
;
4388 CHECK_BUFFER (buf
, 0);
4391 if (!STRINGP (b
->filename
)) return Qt
;
4392 if (b
->modtime
== 0) return Qt
;
4394 /* If the file name has special constructs in it,
4395 call the corresponding file handler. */
4396 handler
= Ffind_file_name_handler (b
->filename
,
4397 Qverify_visited_file_modtime
);
4398 if (!NILP (handler
))
4399 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4401 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4403 /* If the file doesn't exist now and didn't exist before,
4404 we say that it isn't modified, provided the error is a tame one. */
4405 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4410 if (st
.st_mtime
== b
->modtime
4411 /* If both are positive, accept them if they are off by one second. */
4412 || (st
.st_mtime
> 0 && b
->modtime
> 0
4413 && (st
.st_mtime
== b
->modtime
+ 1
4414 || st
.st_mtime
== b
->modtime
- 1)))
4419 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4420 Sclear_visited_file_modtime
, 0, 0, 0,
4421 "Clear out records of last mod time of visited file.\n\
4422 Next attempt to save will certainly not complain of a discrepancy.")
4425 current_buffer
->modtime
= 0;
4429 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4430 Svisited_file_modtime
, 0, 0, 0,
4431 "Return the current buffer's recorded visited file modification time.\n\
4432 The value is a list of the form (HIGH . LOW), like the time values\n\
4433 that `file-attributes' returns.")
4436 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4439 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4440 Sset_visited_file_modtime
, 0, 1, 0,
4441 "Update buffer's recorded modification time from the visited file's time.\n\
4442 Useful if the buffer was not read from the file normally\n\
4443 or if the file itself has been changed for some known benign reason.\n\
4444 An argument specifies the modification time value to use\n\
4445 \(instead of that of the visited file), in the form of a list\n\
4446 \(HIGH . LOW) or (HIGH LOW).")
4448 Lisp_Object time_list
;
4450 if (!NILP (time_list
))
4451 current_buffer
->modtime
= cons_to_long (time_list
);
4454 register Lisp_Object filename
;
4456 Lisp_Object handler
;
4458 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4460 /* If the file name has special constructs in it,
4461 call the corresponding file handler. */
4462 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4463 if (!NILP (handler
))
4464 /* The handler can find the file name the same way we did. */
4465 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4466 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4467 current_buffer
->modtime
= st
.st_mtime
;
4477 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4478 Fsleep_for (make_number (1), Qnil
);
4479 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4480 Fsleep_for (make_number (1), Qnil
);
4481 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4482 Fsleep_for (make_number (1), Qnil
);
4492 /* Get visited file's mode to become the auto save file's mode. */
4493 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4494 /* But make sure we can overwrite it later! */
4495 auto_save_mode_bits
= st
.st_mode
| 0600;
4497 auto_save_mode_bits
= 0666;
4500 Fwrite_region (Qnil
, Qnil
,
4501 current_buffer
->auto_save_file_name
,
4502 Qnil
, Qlambda
, Qnil
);
4506 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4511 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4512 | XFASTINT (XCONS (stream
)->cdr
)));
4517 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4520 minibuffer_auto_raise
= XINT (value
);
4524 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4525 "Auto-save all buffers that need it.\n\
4526 This is all buffers that have auto-saving enabled\n\
4527 and are changed since last auto-saved.\n\
4528 Auto-saving writes the buffer into a file\n\
4529 so that your editing is not lost if the system crashes.\n\
4530 This file is not the file you visited; that changes only when you save.\n\
4531 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4532 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4533 A non-nil CURRENT-ONLY argument means save only current buffer.")
4534 (no_message
, current_only
)
4535 Lisp_Object no_message
, current_only
;
4537 struct buffer
*old
= current_buffer
, *b
;
4538 Lisp_Object tail
, buf
;
4540 char *omessage
= echo_area_glyphs
;
4541 int omessage_length
= echo_area_glyphs_length
;
4542 int do_handled_files
;
4545 Lisp_Object lispstream
;
4546 int count
= specpdl_ptr
- specpdl
;
4548 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4550 /* Ordinarily don't quit within this function,
4551 but don't make it impossible to quit (in case we get hung in I/O). */
4555 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4556 point to non-strings reached from Vbuffer_alist. */
4561 if (!NILP (Vrun_hooks
))
4562 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4564 if (STRINGP (Vauto_save_list_file_name
))
4566 Lisp_Object listfile
;
4567 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4568 stream
= fopen (XSTRING (listfile
)->data
, "w");
4571 /* Arrange to close that file whether or not we get an error.
4572 Also reset auto_saving to 0. */
4573 lispstream
= Fcons (Qnil
, Qnil
);
4574 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4575 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4586 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4587 record_unwind_protect (do_auto_save_unwind_1
,
4588 make_number (minibuffer_auto_raise
));
4589 minibuffer_auto_raise
= 0;
4592 /* First, save all files which don't have handlers. If Emacs is
4593 crashing, the handlers may tweak what is causing Emacs to crash
4594 in the first place, and it would be a shame if Emacs failed to
4595 autosave perfectly ordinary files because it couldn't handle some
4597 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4598 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4600 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4603 /* Record all the buffers that have auto save mode
4604 in the special file that lists them. For each of these buffers,
4605 Record visited name (if any) and auto save name. */
4606 if (STRINGP (b
->auto_save_file_name
)
4607 && stream
!= NULL
&& do_handled_files
== 0)
4609 if (!NILP (b
->filename
))
4611 fwrite (XSTRING (b
->filename
)->data
, 1,
4612 XSTRING (b
->filename
)->size
, stream
);
4614 putc ('\n', stream
);
4615 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4616 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4617 putc ('\n', stream
);
4620 if (!NILP (current_only
)
4621 && b
!= current_buffer
)
4624 /* Don't auto-save indirect buffers.
4625 The base buffer takes care of it. */
4629 /* Check for auto save enabled
4630 and file changed since last auto save
4631 and file changed since last real save. */
4632 if (STRINGP (b
->auto_save_file_name
)
4633 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4634 && b
->auto_save_modified
< BUF_MODIFF (b
)
4635 /* -1 means we've turned off autosaving for a while--see below. */
4636 && XINT (b
->save_length
) >= 0
4637 && (do_handled_files
4638 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4641 EMACS_TIME before_time
, after_time
;
4643 EMACS_GET_TIME (before_time
);
4645 /* If we had a failure, don't try again for 20 minutes. */
4646 if (b
->auto_save_failure_time
>= 0
4647 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4650 if ((XFASTINT (b
->save_length
) * 10
4651 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4652 /* A short file is likely to change a large fraction;
4653 spare the user annoying messages. */
4654 && XFASTINT (b
->save_length
) > 5000
4655 /* These messages are frequent and annoying for `*mail*'. */
4656 && !EQ (b
->filename
, Qnil
)
4657 && NILP (no_message
))
4659 /* It has shrunk too much; turn off auto-saving here. */
4660 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4661 message ("Buffer %s has shrunk a lot; auto save turned off there",
4662 XSTRING (b
->name
)->data
);
4663 minibuffer_auto_raise
= 0;
4664 /* Turn off auto-saving until there's a real save,
4665 and prevent any more warnings. */
4666 XSETINT (b
->save_length
, -1);
4667 Fsleep_for (make_number (1), Qnil
);
4670 set_buffer_internal (b
);
4671 if (!auto_saved
&& NILP (no_message
))
4672 message1 ("Auto-saving...");
4673 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4675 b
->auto_save_modified
= BUF_MODIFF (b
);
4676 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4677 set_buffer_internal (old
);
4679 EMACS_GET_TIME (after_time
);
4681 /* If auto-save took more than 60 seconds,
4682 assume it was an NFS failure that got a timeout. */
4683 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4684 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4688 /* Prevent another auto save till enough input events come in. */
4689 record_auto_save ();
4691 if (auto_saved
&& NILP (no_message
))
4695 sit_for (1, 0, 0, 0, 0);
4696 message2 (omessage
, omessage_length
);
4699 message1 ("Auto-saving...done");
4704 unbind_to (count
, Qnil
);
4708 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4709 Sset_buffer_auto_saved
, 0, 0, 0,
4710 "Mark current buffer as auto-saved with its current text.\n\
4711 No auto-save file will be written until the buffer changes again.")
4714 current_buffer
->auto_save_modified
= MODIFF
;
4715 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4716 current_buffer
->auto_save_failure_time
= -1;
4720 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4721 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4722 "Clear any record of a recent auto-save failure in the current buffer.")
4725 current_buffer
->auto_save_failure_time
= -1;
4729 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4731 "Return t if buffer has been auto-saved since last read in or saved.")
4734 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4737 /* Reading and completing file names */
4738 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4740 /* In the string VAL, change each $ to $$ and return the result. */
4743 double_dollars (val
)
4746 register unsigned char *old
, *new;
4750 osize
= XSTRING (val
)->size
;
4751 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4752 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4753 if (*old
++ == '$') count
++;
4756 old
= XSTRING (val
)->data
;
4757 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4758 new = XSTRING (val
)->data
;
4759 for (n
= osize
; n
> 0; n
--)
4772 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4774 "Internal subroutine for read-file-name. Do not call this.")
4775 (string
, dir
, action
)
4776 Lisp_Object string
, dir
, action
;
4777 /* action is nil for complete, t for return list of completions,
4778 lambda for verify final value */
4780 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4782 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4784 CHECK_STRING (string
, 0);
4791 /* No need to protect ACTION--we only compare it with t and nil. */
4792 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4794 if (XSTRING (string
)->size
== 0)
4796 if (EQ (action
, Qlambda
))
4804 orig_string
= string
;
4805 string
= Fsubstitute_in_file_name (string
);
4806 changed
= NILP (Fstring_equal (string
, orig_string
));
4807 name
= Ffile_name_nondirectory (string
);
4808 val
= Ffile_name_directory (string
);
4810 realdir
= Fexpand_file_name (val
, realdir
);
4815 specdir
= Ffile_name_directory (string
);
4816 val
= Ffile_name_completion (name
, realdir
);
4821 return double_dollars (string
);
4825 if (!NILP (specdir
))
4826 val
= concat2 (specdir
, val
);
4828 return double_dollars (val
);
4831 #endif /* not VMS */
4835 if (EQ (action
, Qt
))
4836 return Ffile_name_all_completions (name
, realdir
);
4837 /* Only other case actually used is ACTION = lambda */
4839 /* Supposedly this helps commands such as `cd' that read directory names,
4840 but can someone explain how it helps them? -- RMS */
4841 if (XSTRING (name
)->size
== 0)
4844 return Ffile_exists_p (string
);
4847 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4848 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4849 Value is not expanded---you must call `expand-file-name' yourself.\n\
4850 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4851 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4852 except that if INITIAL is specified, that combined with DIR is used.)\n\
4853 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4854 Non-nil and non-t means also require confirmation after completion.\n\
4855 Fifth arg INITIAL specifies text to start with.\n\
4856 DIR defaults to current buffer's directory default.")
4857 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4858 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4860 Lisp_Object val
, insdef
, insdef1
, tem
;
4861 struct gcpro gcpro1
, gcpro2
;
4862 register char *homedir
;
4866 dir
= current_buffer
->directory
;
4867 if (NILP (default_filename
))
4869 if (! NILP (initial
))
4870 default_filename
= Fexpand_file_name (initial
, dir
);
4872 default_filename
= current_buffer
->filename
;
4875 /* If dir starts with user's homedir, change that to ~. */
4876 homedir
= (char *) egetenv ("HOME");
4878 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4879 CORRECT_DIR_SEPS (homedir
);
4883 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4884 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4886 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4887 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4888 XSTRING (dir
)->data
[0] = '~';
4891 if (insert_default_directory
&& STRINGP (dir
))
4894 if (!NILP (initial
))
4896 Lisp_Object args
[2], pos
;
4900 insdef
= Fconcat (2, args
);
4901 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4902 insdef1
= Fcons (double_dollars (insdef
), pos
);
4905 insdef1
= double_dollars (insdef
);
4907 else if (STRINGP (initial
))
4910 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
4913 insdef
= Qnil
, insdef1
= Qnil
;
4916 count
= specpdl_ptr
- specpdl
;
4917 specbind (intern ("completion-ignore-case"), Qt
);
4920 GCPRO2 (insdef
, default_filename
);
4921 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4922 dir
, mustmatch
, insdef1
,
4923 Qfile_name_history
, default_filename
);
4924 /* If Fcompleting_read returned the default string itself
4925 (rather than a new string with the same contents),
4926 it has to mean that the user typed RET with the minibuffer empty.
4927 In that case, we really want to return ""
4928 so that commands such as set-visited-file-name can distinguish. */
4929 if (EQ (val
, default_filename
))
4930 val
= build_string ("");
4933 unbind_to (count
, Qnil
);
4938 error ("No file name specified");
4939 tem
= Fstring_equal (val
, insdef
);
4940 if (!NILP (tem
) && !NILP (default_filename
))
4941 return default_filename
;
4942 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4944 if (!NILP (default_filename
))
4945 return default_filename
;
4947 error ("No default file name");
4949 return Fsubstitute_in_file_name (val
);
4952 #if 0 /* Old version */
4953 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4954 /* Don't confuse make-docfile by having two doc strings for this function.
4955 make-docfile does not pay attention to #if, for good reason! */
4957 (prompt
, dir
, defalt
, mustmatch
, initial
)
4958 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4960 Lisp_Object val
, insdef
, tem
;
4961 struct gcpro gcpro1
, gcpro2
;
4962 register char *homedir
;
4966 dir
= current_buffer
->directory
;
4968 defalt
= current_buffer
->filename
;
4970 /* If dir starts with user's homedir, change that to ~. */
4971 homedir
= (char *) egetenv ("HOME");
4974 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4975 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4977 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4978 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4979 XSTRING (dir
)->data
[0] = '~';
4982 if (!NILP (initial
))
4984 else if (insert_default_directory
)
4987 insdef
= build_string ("");
4990 count
= specpdl_ptr
- specpdl
;
4991 specbind (intern ("completion-ignore-case"), Qt
);
4994 GCPRO2 (insdef
, defalt
);
4995 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4997 insert_default_directory
? insdef
: Qnil
,
4998 Qfile_name_history
, Qnil
);
5001 unbind_to (count
, Qnil
);
5006 error ("No file name specified");
5007 tem
= Fstring_equal (val
, insdef
);
5008 if (!NILP (tem
) && !NILP (defalt
))
5010 return Fsubstitute_in_file_name (val
);
5012 #endif /* Old version */
5016 Qexpand_file_name
= intern ("expand-file-name");
5017 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5018 Qdirectory_file_name
= intern ("directory-file-name");
5019 Qfile_name_directory
= intern ("file-name-directory");
5020 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5021 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5022 Qfile_name_as_directory
= intern ("file-name-as-directory");
5023 Qcopy_file
= intern ("copy-file");
5024 Qmake_directory_internal
= intern ("make-directory-internal");
5025 Qdelete_directory
= intern ("delete-directory");
5026 Qdelete_file
= intern ("delete-file");
5027 Qrename_file
= intern ("rename-file");
5028 Qadd_name_to_file
= intern ("add-name-to-file");
5029 Qmake_symbolic_link
= intern ("make-symbolic-link");
5030 Qfile_exists_p
= intern ("file-exists-p");
5031 Qfile_executable_p
= intern ("file-executable-p");
5032 Qfile_readable_p
= intern ("file-readable-p");
5033 Qfile_writable_p
= intern ("file-writable-p");
5034 Qfile_symlink_p
= intern ("file-symlink-p");
5035 Qaccess_file
= intern ("access-file");
5036 Qfile_directory_p
= intern ("file-directory-p");
5037 Qfile_regular_p
= intern ("file-regular-p");
5038 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5039 Qfile_modes
= intern ("file-modes");
5040 Qset_file_modes
= intern ("set-file-modes");
5041 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5042 Qinsert_file_contents
= intern ("insert-file-contents");
5043 Qwrite_region
= intern ("write-region");
5044 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5045 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5047 staticpro (&Qexpand_file_name
);
5048 staticpro (&Qsubstitute_in_file_name
);
5049 staticpro (&Qdirectory_file_name
);
5050 staticpro (&Qfile_name_directory
);
5051 staticpro (&Qfile_name_nondirectory
);
5052 staticpro (&Qunhandled_file_name_directory
);
5053 staticpro (&Qfile_name_as_directory
);
5054 staticpro (&Qcopy_file
);
5055 staticpro (&Qmake_directory_internal
);
5056 staticpro (&Qdelete_directory
);
5057 staticpro (&Qdelete_file
);
5058 staticpro (&Qrename_file
);
5059 staticpro (&Qadd_name_to_file
);
5060 staticpro (&Qmake_symbolic_link
);
5061 staticpro (&Qfile_exists_p
);
5062 staticpro (&Qfile_executable_p
);
5063 staticpro (&Qfile_readable_p
);
5064 staticpro (&Qfile_writable_p
);
5065 staticpro (&Qaccess_file
);
5066 staticpro (&Qfile_symlink_p
);
5067 staticpro (&Qfile_directory_p
);
5068 staticpro (&Qfile_regular_p
);
5069 staticpro (&Qfile_accessible_directory_p
);
5070 staticpro (&Qfile_modes
);
5071 staticpro (&Qset_file_modes
);
5072 staticpro (&Qfile_newer_than_file_p
);
5073 staticpro (&Qinsert_file_contents
);
5074 staticpro (&Qwrite_region
);
5075 staticpro (&Qverify_visited_file_modtime
);
5076 staticpro (&Qset_visited_file_modtime
);
5078 Qfile_name_history
= intern ("file-name-history");
5079 Fset (Qfile_name_history
, Qnil
);
5080 staticpro (&Qfile_name_history
);
5082 Qfile_error
= intern ("file-error");
5083 staticpro (&Qfile_error
);
5084 Qfile_already_exists
= intern ("file-already-exists");
5085 staticpro (&Qfile_already_exists
);
5086 Qfile_date_error
= intern ("file-date-error");
5087 staticpro (&Qfile_date_error
);
5090 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5091 staticpro (&Qfind_buffer_file_type
);
5094 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5095 "*Format in which to write auto-save files.\n\
5096 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5097 If it is t, which is the default, auto-save files are written in the\n\
5098 same format as a regular save would use.");
5099 Vauto_save_file_format
= Qt
;
5101 Qformat_decode
= intern ("format-decode");
5102 staticpro (&Qformat_decode
);
5103 Qformat_annotate_function
= intern ("format-annotate-function");
5104 staticpro (&Qformat_annotate_function
);
5106 Qcar_less_than_car
= intern ("car-less-than-car");
5107 staticpro (&Qcar_less_than_car
);
5109 Fput (Qfile_error
, Qerror_conditions
,
5110 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5111 Fput (Qfile_error
, Qerror_message
,
5112 build_string ("File error"));
5114 Fput (Qfile_already_exists
, Qerror_conditions
,
5115 Fcons (Qfile_already_exists
,
5116 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5117 Fput (Qfile_already_exists
, Qerror_message
,
5118 build_string ("File already exists"));
5120 Fput (Qfile_date_error
, Qerror_conditions
,
5121 Fcons (Qfile_date_error
,
5122 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5123 Fput (Qfile_date_error
, Qerror_message
,
5124 build_string ("Cannot set file date"));
5126 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5127 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5128 insert_default_directory
= 1;
5130 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5131 "*Non-nil means write new files with record format `stmlf'.\n\
5132 nil means use format `var'. This variable is meaningful only on VMS.");
5133 vms_stmlf_recfm
= 0;
5135 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5136 "Directory separator character for built-in functions that return file names.\n\
5137 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5138 This variable affects the built-in functions only on Windows,\n\
5139 on other platforms, it is initialized so that Lisp code can find out\n\
5140 what the normal separator is.");
5141 XSETFASTINT (Vdirectory_sep_char
, '/');
5143 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5144 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5145 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5148 The first argument given to HANDLER is the name of the I/O primitive\n\
5149 to be handled; the remaining arguments are the arguments that were\n\
5150 passed to that primitive. For example, if you do\n\
5151 (file-exists-p FILENAME)\n\
5152 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5153 (funcall HANDLER 'file-exists-p FILENAME)\n\
5154 The function `find-file-name-handler' checks this list for a handler\n\
5155 for its argument.");
5156 Vfile_name_handler_alist
= Qnil
;
5158 DEFVAR_LISP ("auto-file-coding-system-function",
5159 &Vauto_file_coding_system_function
,
5160 "If non-nil, a function to call to decide a coding system of file.\n\
5161 One argument is passed to this function: the string of the first\n\
5162 few lines of a file to be read.\n\
5163 This function should return a coding system to decode the file contents\n\
5164 specified in the heading lines with the format:\n\
5165 -*- ... coding: CODING-SYSTEM; ... -*-");
5166 Vauto_file_coding_system_function
= Qnil
;
5168 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5169 "A list of functions to be called at the end of `insert-file-contents'.\n\
5170 Each is passed one argument, the number of bytes inserted. It should return\n\
5171 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5172 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5173 responsible for calling the after-insert-file-functions if appropriate.");
5174 Vafter_insert_file_functions
= Qnil
;
5176 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5177 "A list of functions to be called at the start of `write-region'.\n\
5178 Each is passed two arguments, START and END as for `write-region'.\n\
5179 These are usually two numbers but not always; see the documentation\n\
5180 for `write-region'. The function should return a list of pairs\n\
5181 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5182 inserted at the specified positions of the file being written (1 means to\n\
5183 insert before the first byte written). The POSITIONs must be sorted into\n\
5184 increasing order. If there are several functions in the list, the several\n\
5185 lists are merged destructively.");
5186 Vwrite_region_annotate_functions
= Qnil
;
5188 DEFVAR_LISP ("write-region-annotations-so-far",
5189 &Vwrite_region_annotations_so_far
,
5190 "When an annotation function is called, this holds the previous annotations.\n\
5191 These are the annotations made by other annotation functions\n\
5192 that were already called. See also `write-region-annotate-functions'.");
5193 Vwrite_region_annotations_so_far
= Qnil
;
5195 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5196 "A list of file name handlers that temporarily should not be used.\n\
5197 This applies only to the operation `inhibit-file-name-operation'.");
5198 Vinhibit_file_name_handlers
= Qnil
;
5200 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5201 "The operation for which `inhibit-file-name-handlers' is applicable.");
5202 Vinhibit_file_name_operation
= Qnil
;
5204 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5205 "File name in which we write a list of all auto save file names.\n\
5206 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5207 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5209 Vauto_save_list_file_name
= Qnil
;
5211 defsubr (&Sfind_file_name_handler
);
5212 defsubr (&Sfile_name_directory
);
5213 defsubr (&Sfile_name_nondirectory
);
5214 defsubr (&Sunhandled_file_name_directory
);
5215 defsubr (&Sfile_name_as_directory
);
5216 defsubr (&Sdirectory_file_name
);
5217 defsubr (&Smake_temp_name
);
5218 defsubr (&Sexpand_file_name
);
5219 defsubr (&Ssubstitute_in_file_name
);
5220 defsubr (&Scopy_file
);
5221 defsubr (&Smake_directory_internal
);
5222 defsubr (&Sdelete_directory
);
5223 defsubr (&Sdelete_file
);
5224 defsubr (&Srename_file
);
5225 defsubr (&Sadd_name_to_file
);
5227 defsubr (&Smake_symbolic_link
);
5228 #endif /* S_IFLNK */
5230 defsubr (&Sdefine_logical_name
);
5233 defsubr (&Ssysnetunam
);
5234 #endif /* HPUX_NET */
5235 defsubr (&Sfile_name_absolute_p
);
5236 defsubr (&Sfile_exists_p
);
5237 defsubr (&Sfile_executable_p
);
5238 defsubr (&Sfile_readable_p
);
5239 defsubr (&Sfile_writable_p
);
5240 defsubr (&Saccess_file
);
5241 defsubr (&Sfile_symlink_p
);
5242 defsubr (&Sfile_directory_p
);
5243 defsubr (&Sfile_accessible_directory_p
);
5244 defsubr (&Sfile_regular_p
);
5245 defsubr (&Sfile_modes
);
5246 defsubr (&Sset_file_modes
);
5247 defsubr (&Sset_default_file_modes
);
5248 defsubr (&Sdefault_file_modes
);
5249 defsubr (&Sfile_newer_than_file_p
);
5250 defsubr (&Sinsert_file_contents
);
5251 defsubr (&Swrite_region
);
5252 defsubr (&Scar_less_than_car
);
5253 defsubr (&Sverify_visited_file_modtime
);
5254 defsubr (&Sclear_visited_file_modtime
);
5255 defsubr (&Svisited_file_modtime
);
5256 defsubr (&Sset_visited_file_modtime
);
5257 defsubr (&Sdo_auto_save
);
5258 defsubr (&Sset_buffer_auto_saved
);
5259 defsubr (&Sclear_buffer_auto_save_failure
);
5260 defsubr (&Srecent_auto_save_p
);
5262 defsubr (&Sread_file_name_internal
);
5263 defsubr (&Sread_file_name
);
5266 defsubr (&Sunix_sync
);