1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
55 #include <sys/param.h>
77 extern char *strerror ();
94 #include "intervals.h"
105 #endif /* not WINDOWSNT */
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Encode the file name NAME using the specified coding system
156 for file names, if any. */
157 #define ENCODE_FILE(name) \
158 (! NILP (Vfile_name_coding_system) \
159 && XFASTINT (Vfile_name_coding_system) != 0 \
160 ? Fencode_coding_string (name, Vfile_name_coding_system, Qt) \
163 /* Nonzero during writing of auto-save files */
166 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
167 a new file with the same mode as the original */
168 int auto_save_mode_bits
;
170 /* Coding system for file names, or nil if none. */
171 Lisp_Object Vfile_name_coding_system
;
173 /* Alist of elements (REGEXP . HANDLER) for file names
174 whose I/O is done with a special handler. */
175 Lisp_Object Vfile_name_handler_alist
;
177 /* Format for auto-save files */
178 Lisp_Object Vauto_save_file_format
;
180 /* Lisp functions for translating file formats */
181 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
183 /* Function to be called to decide a coding system of a reading file. */
184 Lisp_Object Vset_auto_coding_function
;
186 /* Functions to be called to process text properties in inserted file. */
187 Lisp_Object Vafter_insert_file_functions
;
189 /* Functions to be called to create text property annotations for file. */
190 Lisp_Object Vwrite_region_annotate_functions
;
192 /* During build_annotations, each time an annotation function is called,
193 this holds the annotations made by the previous functions. */
194 Lisp_Object Vwrite_region_annotations_so_far
;
196 /* File name in which we write a list of all our auto save files. */
197 Lisp_Object Vauto_save_list_file_name
;
199 /* Nonzero means, when reading a filename in the minibuffer,
200 start out by inserting the default directory into the minibuffer. */
201 int insert_default_directory
;
203 /* On VMS, nonzero means write new files with record format stmlf.
204 Zero means use var format. */
207 /* On NT, specifies the directory separator character, used (eg.) when
208 expanding file names. This can be bound to / or \. */
209 Lisp_Object Vdirectory_sep_char
;
211 extern Lisp_Object Vuser_login_name
;
213 extern int minibuf_level
;
215 extern int minibuffer_auto_raise
;
217 /* These variables describe handlers that have "already" had a chance
218 to handle the current operation.
220 Vinhibit_file_name_handlers is a list of file name handlers.
221 Vinhibit_file_name_operation is the operation being handled.
222 If we try to handle that operation, we ignore those handlers. */
224 static Lisp_Object Vinhibit_file_name_handlers
;
225 static Lisp_Object Vinhibit_file_name_operation
;
227 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
229 Lisp_Object Qfile_name_history
;
231 Lisp_Object Qcar_less_than_car
;
233 static int a_write
P_ ((int, char *, int, int,
234 Lisp_Object
*, struct coding_system
*));
235 static int e_write
P_ ((int, char *, int, struct coding_system
*));
238 report_file_error (string
, data
)
242 Lisp_Object errstring
;
244 errstring
= build_string (strerror (errno
));
246 /* System error messages are capitalized. Downcase the initial
247 unless it is followed by a slash. */
248 if (XSTRING (errstring
)->data
[1] != '/')
249 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
252 Fsignal (Qfile_error
,
253 Fcons (build_string (string
), Fcons (errstring
, data
)));
257 close_file_unwind (fd
)
260 close (XFASTINT (fd
));
264 /* Restore point, having saved it as a marker. */
267 restore_point_unwind (location
)
268 Lisp_Object location
;
270 Fgoto_char (location
);
271 Fset_marker (location
, Qnil
, Qnil
);
275 Lisp_Object Qexpand_file_name
;
276 Lisp_Object Qsubstitute_in_file_name
;
277 Lisp_Object Qdirectory_file_name
;
278 Lisp_Object Qfile_name_directory
;
279 Lisp_Object Qfile_name_nondirectory
;
280 Lisp_Object Qunhandled_file_name_directory
;
281 Lisp_Object Qfile_name_as_directory
;
282 Lisp_Object Qcopy_file
;
283 Lisp_Object Qmake_directory_internal
;
284 Lisp_Object Qdelete_directory
;
285 Lisp_Object Qdelete_file
;
286 Lisp_Object Qrename_file
;
287 Lisp_Object Qadd_name_to_file
;
288 Lisp_Object Qmake_symbolic_link
;
289 Lisp_Object Qfile_exists_p
;
290 Lisp_Object Qfile_executable_p
;
291 Lisp_Object Qfile_readable_p
;
292 Lisp_Object Qfile_writable_p
;
293 Lisp_Object Qfile_symlink_p
;
294 Lisp_Object Qaccess_file
;
295 Lisp_Object Qfile_directory_p
;
296 Lisp_Object Qfile_regular_p
;
297 Lisp_Object Qfile_accessible_directory_p
;
298 Lisp_Object Qfile_modes
;
299 Lisp_Object Qset_file_modes
;
300 Lisp_Object Qfile_newer_than_file_p
;
301 Lisp_Object Qinsert_file_contents
;
302 Lisp_Object Qwrite_region
;
303 Lisp_Object Qverify_visited_file_modtime
;
304 Lisp_Object Qset_visited_file_modtime
;
306 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
307 "Return FILENAME's handler function for OPERATION, if it has one.\n\
308 Otherwise, return nil.\n\
309 A file name is handled if one of the regular expressions in\n\
310 `file-name-handler-alist' matches it.\n\n\
311 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
312 any handlers that are members of `inhibit-file-name-handlers',\n\
313 but we still do run any other handlers. This lets handlers\n\
314 use the standard functions without calling themselves recursively.")
315 (filename
, operation
)
316 Lisp_Object filename
, operation
;
318 /* This function must not munge the match data. */
319 Lisp_Object chain
, inhibited_handlers
;
321 CHECK_STRING (filename
, 0);
323 if (EQ (operation
, Vinhibit_file_name_operation
))
324 inhibited_handlers
= Vinhibit_file_name_handlers
;
326 inhibited_handlers
= Qnil
;
328 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
329 chain
= XCONS (chain
)->cdr
)
332 elt
= XCONS (chain
)->car
;
336 string
= XCONS (elt
)->car
;
337 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
339 Lisp_Object handler
, tem
;
341 handler
= XCONS (elt
)->cdr
;
342 tem
= Fmemq (handler
, inhibited_handlers
);
353 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
355 "Return the directory component in file name FILENAME.\n\
356 Return nil if FILENAME does not include a directory.\n\
357 Otherwise return a directory spec.\n\
358 Given a Unix syntax file name, returns a string ending in slash;\n\
359 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
361 Lisp_Object filename
;
363 register unsigned char *beg
;
364 register unsigned char *p
;
367 CHECK_STRING (filename
, 0);
369 /* If the file name has special constructs in it,
370 call the corresponding file handler. */
371 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
373 return call2 (handler
, Qfile_name_directory
, filename
);
375 #ifdef FILE_SYSTEM_CASE
376 filename
= FILE_SYSTEM_CASE (filename
);
378 beg
= XSTRING (filename
)->data
;
380 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
382 p
= beg
+ XSTRING (filename
)->size
;
384 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
386 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
389 /* only recognise drive specifier at beginning */
390 && !(p
[-1] == ':' && p
== beg
+ 2)
397 /* Expansion of "c:" to drive and default directory. */
398 if (p
== beg
+ 2 && beg
[1] == ':')
400 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
401 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
402 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
404 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
407 p
= beg
+ strlen (beg
);
410 CORRECT_DIR_SEPS (beg
);
413 if (STRING_MULTIBYTE (filename
))
414 return make_string (beg
, p
- beg
);
415 return make_unibyte_string (beg
, p
- beg
);
418 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
419 Sfile_name_nondirectory
, 1, 1, 0,
420 "Return file name FILENAME sans its directory.\n\
421 For example, in a Unix-syntax file name,\n\
422 this is everything after the last slash,\n\
423 or the entire name if it contains no slash.")
425 Lisp_Object filename
;
427 register unsigned char *beg
, *p
, *end
;
430 CHECK_STRING (filename
, 0);
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
436 return call2 (handler
, Qfile_name_nondirectory
, filename
);
438 beg
= XSTRING (filename
)->data
;
439 end
= p
= beg
+ XSTRING (filename
)->size
;
441 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
443 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
446 /* only recognise drive specifier at beginning */
447 && !(p
[-1] == ':' && p
== beg
+ 2)
452 if (STRING_MULTIBYTE (filename
))
453 return make_string (p
, end
- p
);
454 return make_unibyte_string (p
, end
- p
);
457 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
458 Sunhandled_file_name_directory
, 1, 1, 0,
459 "Return a directly usable directory name somehow associated with FILENAME.\n\
460 A `directly usable' directory name is one that may be used without the\n\
461 intervention of any file handler.\n\
462 If FILENAME is a directly usable file itself, return\n\
463 \(file-name-directory FILENAME).\n\
464 The `call-process' and `start-process' functions use this function to\n\
465 get a current directory to run processes in.")
467 Lisp_Object filename
;
471 /* If the file name has special constructs in it,
472 call the corresponding file handler. */
473 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
475 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
477 return Ffile_name_directory (filename
);
482 file_name_as_directory (out
, in
)
485 int size
= strlen (in
) - 1;
497 /* Is it already a directory string? */
498 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
500 /* Is it a VMS directory file name? If so, hack VMS syntax. */
501 else if (! index (in
, '/')
502 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
503 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
504 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
505 || ! strncmp (&in
[size
- 5], ".dir", 4))
506 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
507 && in
[size
] == '1')))
509 register char *p
, *dot
;
513 dir:x.dir --> dir:[x]
514 dir:[x]y.dir --> dir:[x.y] */
516 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
519 strncpy (out
, in
, p
- in
);
538 dot
= index (p
, '.');
541 /* blindly remove any extension */
542 size
= strlen (out
) + (dot
- p
);
543 strncat (out
, p
, dot
- p
);
554 /* For Unix syntax, Append a slash if necessary */
555 if (!IS_DIRECTORY_SEP (out
[size
]))
557 out
[size
+ 1] = DIRECTORY_SEP
;
558 out
[size
+ 2] = '\0';
561 CORRECT_DIR_SEPS (out
);
567 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
568 Sfile_name_as_directory
, 1, 1, 0,
569 "Return a string representing file FILENAME interpreted as a directory.\n\
570 This operation exists because a directory is also a file, but its name as\n\
571 a directory is different from its name as a file.\n\
572 The result can be used as the value of `default-directory'\n\
573 or passed as second argument to `expand-file-name'.\n\
574 For a Unix-syntax file name, just appends a slash.\n\
575 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
582 CHECK_STRING (file
, 0);
586 /* If the file name has special constructs in it,
587 call the corresponding file handler. */
588 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
590 return call2 (handler
, Qfile_name_as_directory
, file
);
592 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
593 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
597 * Convert from directory name to filename.
599 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
600 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
601 * On UNIX, it's simple: just make sure there isn't a terminating /
603 * Value is nonzero if the string output is different from the input.
606 directory_file_name (src
, dst
)
614 struct FAB fab
= cc$rms_fab
;
615 struct NAM nam
= cc$rms_nam
;
616 char esa
[NAM$C_MAXRSS
];
621 if (! index (src
, '/')
622 && (src
[slen
- 1] == ']'
623 || src
[slen
- 1] == ':'
624 || src
[slen
- 1] == '>'))
626 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
628 fab
.fab$b_fns
= slen
;
629 fab
.fab$l_nam
= &nam
;
630 fab
.fab$l_fop
= FAB$M_NAM
;
633 nam
.nam$b_ess
= sizeof esa
;
634 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
636 /* We call SYS$PARSE to handle such things as [--] for us. */
637 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
639 slen
= nam
.nam$b_esl
;
640 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
645 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
647 /* what about when we have logical_name:???? */
648 if (src
[slen
- 1] == ':')
649 { /* Xlate logical name and see what we get */
650 ptr
= strcpy (dst
, src
); /* upper case for getenv */
653 if ('a' <= *ptr
&& *ptr
<= 'z')
657 dst
[slen
- 1] = 0; /* remove colon */
658 if (!(src
= egetenv (dst
)))
660 /* should we jump to the beginning of this procedure?
661 Good points: allows us to use logical names that xlate
663 Bad points: can be a problem if we just translated to a device
665 For now, I'll punt and always expect VMS names, and hope for
668 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
669 { /* no recursion here! */
675 { /* not a directory spec */
680 bracket
= src
[slen
- 1];
682 /* If bracket is ']' or '>', bracket - 2 is the corresponding
684 ptr
= index (src
, bracket
- 2);
686 { /* no opening bracket */
690 if (!(rptr
= rindex (src
, '.')))
693 strncpy (dst
, src
, slen
);
697 dst
[slen
++] = bracket
;
702 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
703 then translate the device and recurse. */
704 if (dst
[slen
- 1] == ':'
705 && dst
[slen
- 2] != ':' /* skip decnet nodes */
706 && strcmp (src
+ slen
, "[000000]") == 0)
708 dst
[slen
- 1] = '\0';
709 if ((ptr
= egetenv (dst
))
710 && (rlen
= strlen (ptr
) - 1) > 0
711 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
712 && ptr
[rlen
- 1] == '.')
714 char * buf
= (char *) alloca (strlen (ptr
) + 1);
718 return directory_file_name (buf
, dst
);
723 strcat (dst
, "[000000]");
727 rlen
= strlen (rptr
) - 1;
728 strncat (dst
, rptr
, rlen
);
729 dst
[slen
+ rlen
] = '\0';
730 strcat (dst
, ".DIR.1");
734 /* Process as Unix format: just remove any final slash.
735 But leave "/" unchanged; do not change it to "". */
738 /* Handle // as root for apollo's. */
739 if ((slen
> 2 && dst
[slen
- 1] == '/')
740 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
744 && IS_DIRECTORY_SEP (dst
[slen
- 1])
746 && !IS_ANY_SEP (dst
[slen
- 2])
752 CORRECT_DIR_SEPS (dst
);
757 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
759 "Returns the file name of the directory named DIRECTORY.\n\
760 This is the name of the file that holds the data for the directory DIRECTORY.\n\
761 This operation exists because a directory is also a file, but its name as\n\
762 a directory is different from its name as a file.\n\
763 In Unix-syntax, this function just removes the final slash.\n\
764 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
765 it returns a file name such as \"[X]Y.DIR.1\".")
767 Lisp_Object directory
;
772 CHECK_STRING (directory
, 0);
774 if (NILP (directory
))
777 /* If the file name has special constructs in it,
778 call the corresponding file handler. */
779 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
781 return call2 (handler
, Qdirectory_file_name
, directory
);
784 /* 20 extra chars is insufficient for VMS, since we might perform a
785 logical name translation. an equivalence string can be up to 255
786 chars long, so grab that much extra space... - sss */
787 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
789 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
791 directory_file_name (XSTRING (directory
)->data
, buf
);
792 return build_string (buf
);
795 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
796 "Generate temporary file name (string) starting with PREFIX (a string).\n\
797 The Emacs process number forms part of the result,\n\
798 so there is no danger of generating a name being used by another process.\n\
799 In addition, this function makes an attempt to choose a name\n\
800 which has no existing file.")
806 /* Don't use too many characters of the restricted 8+3 DOS
808 val
= concat2 (prefix
, build_string ("a.XXX"));
810 val
= concat2 (prefix
, build_string ("XXXXXX"));
812 mktemp (XSTRING (val
)->data
);
814 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
819 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
820 "Convert filename NAME to absolute, and canonicalize it.\n\
821 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
822 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
823 the current buffer's value of default-directory is used.\n\
824 File name components that are `.' are removed, and \n\
825 so are file name components followed by `..', along with the `..' itself;\n\
826 note that these simplifications are done without checking the resulting\n\
827 file names in the file system.\n\
828 An initial `~/' expands to your home directory.\n\
829 An initial `~USER/' expands to USER's home directory.\n\
830 See also the function `substitute-in-file-name'.")
831 (name
, default_directory
)
832 Lisp_Object name
, default_directory
;
836 register unsigned char *newdir
, *p
, *o
;
838 unsigned char *target
;
841 unsigned char * colon
= 0;
842 unsigned char * close
= 0;
843 unsigned char * slash
= 0;
844 unsigned char * brack
= 0;
845 int lbrack
= 0, rbrack
= 0;
850 int collapse_newdir
= 1;
855 CHECK_STRING (name
, 0);
857 /* If the file name has special constructs in it,
858 call the corresponding file handler. */
859 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
861 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
863 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
864 if (NILP (default_directory
))
865 default_directory
= current_buffer
->directory
;
866 if (! STRINGP (default_directory
))
867 default_directory
= build_string ("/");
869 if (!NILP (default_directory
))
871 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
873 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
876 o
= XSTRING (default_directory
)->data
;
878 /* Make sure DEFAULT_DIRECTORY is properly expanded.
879 It would be better to do this down below where we actually use
880 default_directory. Unfortunately, calling Fexpand_file_name recursively
881 could invoke GC, and the strings might be relocated. This would
882 be annoying because we have pointers into strings lying around
883 that would need adjusting, and people would add new pointers to
884 the code and forget to adjust them, resulting in intermittent bugs.
885 Putting this call here avoids all that crud.
887 The EQ test avoids infinite recursion. */
888 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
889 /* Save time in some common cases - as long as default_directory
890 is not relative, it can be canonicalized with name below (if it
891 is needed at all) without requiring it to be expanded now. */
893 /* Detect MSDOS file names with drive specifiers. */
894 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
896 /* Detect Windows file names in UNC format. */
897 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
899 #else /* not DOS_NT */
900 /* Detect Unix absolute file names (/... alone is not absolute on
902 && ! (IS_DIRECTORY_SEP (o
[0]))
903 #endif /* not DOS_NT */
909 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
914 /* Filenames on VMS are always upper case. */
915 name
= Fupcase (name
);
917 #ifdef FILE_SYSTEM_CASE
918 name
= FILE_SYSTEM_CASE (name
);
921 nm
= XSTRING (name
)->data
;
924 /* We will force directory separators to be either all \ or /, so make
925 a local copy to modify, even if there ends up being no change. */
926 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
928 /* Find and remove drive specifier if present; this makes nm absolute
929 even if the rest of the name appears to be relative. */
931 unsigned char *colon
= rindex (nm
, ':');
934 /* Only recognize colon as part of drive specifier if there is a
935 single alphabetic character preceeding the colon (and if the
936 character before the drive letter, if present, is a directory
937 separator); this is to support the remote system syntax used by
938 ange-ftp, and the "po:username" syntax for POP mailboxes. */
942 else if (IS_DRIVE (colon
[-1])
943 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
950 while (--colon
>= nm
)
957 /* If we see "c://somedir", we want to strip the first slash after the
958 colon when stripping the drive letter. Otherwise, this expands to
960 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
962 #endif /* WINDOWSNT */
966 /* Discard any previous drive specifier if nm is now in UNC format. */
967 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
973 /* If nm is absolute, look for /./ or /../ sequences; if none are
974 found, we can probably return right away. We will avoid allocating
975 a new string if name is already fully expanded. */
977 IS_DIRECTORY_SEP (nm
[0])
982 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
989 /* If it turns out that the filename we want to return is just a
990 suffix of FILENAME, we don't need to go through and edit
991 things; we just need to construct a new string using data
992 starting at the middle of FILENAME. If we set lose to a
993 non-zero value, that means we've discovered that we can't do
1000 /* Since we know the name is absolute, we can assume that each
1001 element starts with a "/". */
1003 /* "." and ".." are hairy. */
1004 if (IS_DIRECTORY_SEP (p
[0])
1006 && (IS_DIRECTORY_SEP (p
[2])
1008 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1015 /* if dev:[dir]/, move nm to / */
1016 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1017 nm
= (brack
? brack
+ 1 : colon
+ 1);
1018 lbrack
= rbrack
= 0;
1026 /* VMS pre V4.4,convert '-'s in filenames. */
1027 if (lbrack
== rbrack
)
1029 if (dots
< 2) /* this is to allow negative version numbers */
1034 if (lbrack
> rbrack
&&
1035 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1036 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1042 /* count open brackets, reset close bracket pointer */
1043 if (p
[0] == '[' || p
[0] == '<')
1044 lbrack
++, brack
= 0;
1045 /* count close brackets, set close bracket pointer */
1046 if (p
[0] == ']' || p
[0] == '>')
1047 rbrack
++, brack
= p
;
1048 /* detect ][ or >< */
1049 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1051 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1052 nm
= p
+ 1, lose
= 1;
1053 if (p
[0] == ':' && (colon
|| slash
))
1054 /* if dev1:[dir]dev2:, move nm to dev2: */
1060 /* if /name/dev:, move nm to dev: */
1063 /* if node::dev:, move colon following dev */
1064 else if (colon
&& colon
[-1] == ':')
1066 /* if dev1:dev2:, move nm to dev2: */
1067 else if (colon
&& colon
[-1] != ':')
1072 if (p
[0] == ':' && !colon
)
1078 if (lbrack
== rbrack
)
1081 else if (p
[0] == '.')
1089 if (index (nm
, '/'))
1090 return build_string (sys_translate_unix (nm
));
1093 /* Make sure directories are all separated with / or \ as
1094 desired, but avoid allocation of a new string when not
1096 CORRECT_DIR_SEPS (nm
);
1098 if (IS_DIRECTORY_SEP (nm
[1]))
1100 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1101 name
= build_string (nm
);
1105 /* drive must be set, so this is okay */
1106 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1108 name
= make_string (nm
- 2, p
- nm
+ 2);
1109 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1110 XSTRING (name
)->data
[1] = ':';
1113 #else /* not DOS_NT */
1114 if (nm
== XSTRING (name
)->data
)
1116 return build_string (nm
);
1117 #endif /* not DOS_NT */
1121 /* At this point, nm might or might not be an absolute file name. We
1122 need to expand ~ or ~user if present, otherwise prefix nm with
1123 default_directory if nm is not absolute, and finally collapse /./
1124 and /foo/../ sequences.
1126 We set newdir to be the appropriate prefix if one is needed:
1127 - the relevant user directory if nm starts with ~ or ~user
1128 - the specified drive's working dir (DOS/NT only) if nm does not
1130 - the value of default_directory.
1132 Note that these prefixes are not guaranteed to be absolute (except
1133 for the working dir of a drive). Therefore, to ensure we always
1134 return an absolute name, if the final prefix is not absolute we
1135 append it to the current working directory. */
1139 if (nm
[0] == '~') /* prefix ~ */
1141 if (IS_DIRECTORY_SEP (nm
[1])
1145 || nm
[1] == 0) /* ~ by itself */
1147 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1148 newdir
= (unsigned char *) "";
1151 collapse_newdir
= 0;
1154 nm
++; /* Don't leave the slash in nm. */
1157 else /* ~user/filename */
1159 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1164 o
= (unsigned char *) alloca (p
- nm
+ 1);
1165 bcopy ((char *) nm
, o
, p
- nm
);
1168 pw
= (struct passwd
*) getpwnam (o
+ 1);
1171 newdir
= (unsigned char *) pw
-> pw_dir
;
1173 nm
= p
+ 1; /* skip the terminator */
1177 collapse_newdir
= 0;
1182 /* If we don't find a user of that name, leave the name
1183 unchanged; don't move nm forward to p. */
1188 /* On DOS and Windows, nm is absolute if a drive name was specified;
1189 use the drive's current directory as the prefix if needed. */
1190 if (!newdir
&& drive
)
1192 /* Get default directory if needed to make nm absolute. */
1193 if (!IS_DIRECTORY_SEP (nm
[0]))
1195 newdir
= alloca (MAXPATHLEN
+ 1);
1196 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1201 /* Either nm starts with /, or drive isn't mounted. */
1202 newdir
= alloca (4);
1203 newdir
[0] = DRIVE_LETTER (drive
);
1211 /* Finally, if no prefix has been specified and nm is not absolute,
1212 then it must be expanded relative to default_directory. */
1216 /* /... alone is not absolute on DOS and Windows. */
1217 && !IS_DIRECTORY_SEP (nm
[0])
1220 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1227 newdir
= XSTRING (default_directory
)->data
;
1233 /* First ensure newdir is an absolute name. */
1235 /* Detect MSDOS file names with drive specifiers. */
1236 ! (IS_DRIVE (newdir
[0])
1237 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1239 /* Detect Windows file names in UNC format. */
1240 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1244 /* Effectively, let newdir be (expand-file-name newdir cwd).
1245 Because of the admonition against calling expand-file-name
1246 when we have pointers into lisp strings, we accomplish this
1247 indirectly by prepending newdir to nm if necessary, and using
1248 cwd (or the wd of newdir's drive) as the new newdir. */
1250 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1255 if (!IS_DIRECTORY_SEP (nm
[0]))
1257 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1258 file_name_as_directory (tmp
, newdir
);
1262 newdir
= alloca (MAXPATHLEN
+ 1);
1265 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1272 /* Strip off drive name from prefix, if present. */
1273 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1279 /* Keep only a prefix from newdir if nm starts with slash
1280 (//server/share for UNC, nothing otherwise). */
1281 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1284 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1286 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1288 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1290 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1302 /* Get rid of any slash at the end of newdir, unless newdir is
1303 just // (an incomplete UNC name). */
1304 length
= strlen (newdir
);
1305 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1307 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1311 unsigned char *temp
= (unsigned char *) alloca (length
);
1312 bcopy (newdir
, temp
, length
- 1);
1313 temp
[length
- 1] = 0;
1321 /* Now concatenate the directory and name to new space in the stack frame */
1322 tlen
+= strlen (nm
) + 1;
1324 /* Add reserved space for drive name. (The Microsoft x86 compiler
1325 produces incorrect code if the following two lines are combined.) */
1326 target
= (unsigned char *) alloca (tlen
+ 2);
1328 #else /* not DOS_NT */
1329 target
= (unsigned char *) alloca (tlen
);
1330 #endif /* not DOS_NT */
1336 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1337 strcpy (target
, newdir
);
1340 file_name_as_directory (target
, newdir
);
1343 strcat (target
, nm
);
1345 if (index (target
, '/'))
1346 strcpy (target
, sys_translate_unix (target
));
1349 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1351 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1359 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1365 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1366 /* brackets are offset from each other by 2 */
1369 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1370 /* convert [foo][bar] to [bar] */
1371 while (o
[-1] != '[' && o
[-1] != '<')
1373 else if (*p
== '-' && *o
!= '.')
1376 else if (p
[0] == '-' && o
[-1] == '.' &&
1377 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1378 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1382 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1383 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1385 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1387 /* else [foo.-] ==> [-] */
1393 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1394 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1400 if (!IS_DIRECTORY_SEP (*p
))
1404 else if (IS_DIRECTORY_SEP (p
[0])
1406 && (IS_DIRECTORY_SEP (p
[2])
1409 /* If "/." is the entire filename, keep the "/". Otherwise,
1410 just delete the whole "/.". */
1411 if (o
== target
&& p
[2] == '\0')
1415 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1416 /* `/../' is the "superroot" on certain file systems. */
1418 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1420 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1422 /* Keep initial / only if this is the whole name. */
1423 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1431 #endif /* not VMS */
1435 /* At last, set drive name. */
1437 /* Except for network file name. */
1438 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1439 #endif /* WINDOWSNT */
1441 if (!drive
) abort ();
1443 target
[0] = DRIVE_LETTER (drive
);
1446 CORRECT_DIR_SEPS (target
);
1449 return make_string (target
, o
- target
);
1453 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1454 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1455 "Convert FILENAME to absolute, and canonicalize it.\n\
1456 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1457 (does not start with slash); if DEFAULT is nil or missing,\n\
1458 the current buffer's value of default-directory is used.\n\
1459 Filenames containing `.' or `..' as components are simplified;\n\
1460 initial `~/' expands to your home directory.\n\
1461 See also the function `substitute-in-file-name'.")
1463 Lisp_Object name
, defalt
;
1467 register unsigned char *newdir
, *p
, *o
;
1469 unsigned char *target
;
1473 unsigned char * colon
= 0;
1474 unsigned char * close
= 0;
1475 unsigned char * slash
= 0;
1476 unsigned char * brack
= 0;
1477 int lbrack
= 0, rbrack
= 0;
1481 CHECK_STRING (name
, 0);
1484 /* Filenames on VMS are always upper case. */
1485 name
= Fupcase (name
);
1488 nm
= XSTRING (name
)->data
;
1490 /* If nm is absolute, flush ...// and detect /./ and /../.
1491 If no /./ or /../ we can return right away. */
1503 if (p
[0] == '/' && p
[1] == '/'
1505 /* // at start of filename is meaningful on Apollo system. */
1510 if (p
[0] == '/' && p
[1] == '~')
1511 nm
= p
+ 1, lose
= 1;
1512 if (p
[0] == '/' && p
[1] == '.'
1513 && (p
[2] == '/' || p
[2] == 0
1514 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1520 /* if dev:[dir]/, move nm to / */
1521 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1522 nm
= (brack
? brack
+ 1 : colon
+ 1);
1523 lbrack
= rbrack
= 0;
1531 /* VMS pre V4.4,convert '-'s in filenames. */
1532 if (lbrack
== rbrack
)
1534 if (dots
< 2) /* this is to allow negative version numbers */
1539 if (lbrack
> rbrack
&&
1540 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1541 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1547 /* count open brackets, reset close bracket pointer */
1548 if (p
[0] == '[' || p
[0] == '<')
1549 lbrack
++, brack
= 0;
1550 /* count close brackets, set close bracket pointer */
1551 if (p
[0] == ']' || p
[0] == '>')
1552 rbrack
++, brack
= p
;
1553 /* detect ][ or >< */
1554 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1556 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1557 nm
= p
+ 1, lose
= 1;
1558 if (p
[0] == ':' && (colon
|| slash
))
1559 /* if dev1:[dir]dev2:, move nm to dev2: */
1565 /* If /name/dev:, move nm to dev: */
1568 /* If node::dev:, move colon following dev */
1569 else if (colon
&& colon
[-1] == ':')
1571 /* If dev1:dev2:, move nm to dev2: */
1572 else if (colon
&& colon
[-1] != ':')
1577 if (p
[0] == ':' && !colon
)
1583 if (lbrack
== rbrack
)
1586 else if (p
[0] == '.')
1594 if (index (nm
, '/'))
1595 return build_string (sys_translate_unix (nm
));
1597 if (nm
== XSTRING (name
)->data
)
1599 return build_string (nm
);
1603 /* Now determine directory to start with and put it in NEWDIR */
1607 if (nm
[0] == '~') /* prefix ~ */
1612 || nm
[1] == 0)/* ~/filename */
1614 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1615 newdir
= (unsigned char *) "";
1618 nm
++; /* Don't leave the slash in nm. */
1621 else /* ~user/filename */
1623 /* Get past ~ to user */
1624 unsigned char *user
= nm
+ 1;
1625 /* Find end of name. */
1626 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1627 int len
= ptr
? ptr
- user
: strlen (user
);
1629 unsigned char *ptr1
= index (user
, ':');
1630 if (ptr1
!= 0 && ptr1
- user
< len
)
1633 /* Copy the user name into temp storage. */
1634 o
= (unsigned char *) alloca (len
+ 1);
1635 bcopy ((char *) user
, o
, len
);
1638 /* Look up the user name. */
1639 pw
= (struct passwd
*) getpwnam (o
+ 1);
1641 error ("\"%s\" isn't a registered user", o
+ 1);
1643 newdir
= (unsigned char *) pw
->pw_dir
;
1645 /* Discard the user name from NM. */
1652 #endif /* not VMS */
1656 defalt
= current_buffer
->directory
;
1657 CHECK_STRING (defalt
, 1);
1658 newdir
= XSTRING (defalt
)->data
;
1661 /* Now concatenate the directory and name to new space in the stack frame */
1663 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1664 target
= (unsigned char *) alloca (tlen
);
1670 if (nm
[0] == 0 || nm
[0] == '/')
1671 strcpy (target
, newdir
);
1674 file_name_as_directory (target
, newdir
);
1677 strcat (target
, nm
);
1679 if (index (target
, '/'))
1680 strcpy (target
, sys_translate_unix (target
));
1683 /* Now canonicalize by removing /. and /foo/.. if they appear */
1691 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1697 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1698 /* brackets are offset from each other by 2 */
1701 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1702 /* convert [foo][bar] to [bar] */
1703 while (o
[-1] != '[' && o
[-1] != '<')
1705 else if (*p
== '-' && *o
!= '.')
1708 else if (p
[0] == '-' && o
[-1] == '.' &&
1709 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1710 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1714 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1715 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1717 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1719 /* else [foo.-] ==> [-] */
1725 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1726 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1736 else if (!strncmp (p
, "//", 2)
1738 /* // at start of filename is meaningful in Apollo system. */
1746 else if (p
[0] == '/' && p
[1] == '.' &&
1747 (p
[2] == '/' || p
[2] == 0))
1749 else if (!strncmp (p
, "/..", 3)
1750 /* `/../' is the "superroot" on certain file systems. */
1752 && (p
[3] == '/' || p
[3] == 0))
1754 while (o
!= target
&& *--o
!= '/')
1757 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1761 if (o
== target
&& *o
== '/')
1769 #endif /* not VMS */
1772 return make_string (target
, o
- target
);
1776 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1777 Ssubstitute_in_file_name
, 1, 1, 0,
1778 "Substitute environment variables referred to in FILENAME.\n\
1779 `$FOO' where FOO is an environment variable name means to substitute\n\
1780 the value of that variable. The variable name should be terminated\n\
1781 with a character not a letter, digit or underscore; otherwise, enclose\n\
1782 the entire variable name in braces.\n\
1783 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1784 On VMS, `$' substitution is not done; this function does little and only\n\
1785 duplicates what `expand-file-name' does.")
1787 Lisp_Object filename
;
1791 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1792 unsigned char *target
;
1794 int substituted
= 0;
1796 Lisp_Object handler
;
1798 CHECK_STRING (filename
, 0);
1800 /* If the file name has special constructs in it,
1801 call the corresponding file handler. */
1802 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1803 if (!NILP (handler
))
1804 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1806 nm
= XSTRING (filename
)->data
;
1808 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1809 CORRECT_DIR_SEPS (nm
);
1810 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1812 endp
= nm
+ XSTRING (filename
)->size
;
1814 /* If /~ or // appears, discard everything through first slash. */
1816 for (p
= nm
; p
!= endp
; p
++)
1819 #if defined (APOLLO) || defined (WINDOWSNT)
1820 /* // at start of file name is meaningful in Apollo and
1821 WindowsNT systems. */
1822 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1823 #else /* not (APOLLO || WINDOWSNT) */
1824 || IS_DIRECTORY_SEP (p
[0])
1825 #endif /* not (APOLLO || WINDOWSNT) */
1830 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1832 || IS_DIRECTORY_SEP (p
[-1])))
1838 /* see comment in expand-file-name about drive specifiers */
1839 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1840 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1849 return build_string (nm
);
1852 /* See if any variables are substituted into the string
1853 and find the total length of their values in `total' */
1855 for (p
= nm
; p
!= endp
;)
1865 /* "$$" means a single "$" */
1874 while (p
!= endp
&& *p
!= '}') p
++;
1875 if (*p
!= '}') goto missingclose
;
1881 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1885 /* Copy out the variable name */
1886 target
= (unsigned char *) alloca (s
- o
+ 1);
1887 strncpy (target
, o
, s
- o
);
1890 strupr (target
); /* $home == $HOME etc. */
1893 /* Get variable value */
1894 o
= (unsigned char *) egetenv (target
);
1895 if (!o
) goto badvar
;
1896 total
+= strlen (o
);
1903 /* If substitution required, recopy the string and do it */
1904 /* Make space in stack frame for the new copy */
1905 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1908 /* Copy the rest of the name through, replacing $ constructs with values */
1925 while (p
!= endp
&& *p
!= '}') p
++;
1926 if (*p
!= '}') goto missingclose
;
1932 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1936 /* Copy out the variable name */
1937 target
= (unsigned char *) alloca (s
- o
+ 1);
1938 strncpy (target
, o
, s
- o
);
1941 strupr (target
); /* $home == $HOME etc. */
1944 /* Get variable value */
1945 o
= (unsigned char *) egetenv (target
);
1949 if (STRING_MULTIBYTE (filename
))
1951 /* If the original string is multibyte,
1952 convert what we substitute into multibyte. */
1953 unsigned char workbuf
[4], *str
;
1959 c
= unibyte_char_to_multibyte (c
);
1960 if (! SINGLE_BYTE_CHAR_P (c
))
1962 len
= CHAR_STRING (c
, workbuf
, str
);
1963 bcopy (str
, x
, len
);
1979 /* If /~ or // appears, discard everything through first slash. */
1981 for (p
= xnm
; p
!= x
; p
++)
1983 #if defined (APOLLO) || defined (WINDOWSNT)
1984 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1985 #else /* not (APOLLO || WINDOWSNT) */
1986 || IS_DIRECTORY_SEP (p
[0])
1987 #endif /* not (APOLLO || WINDOWSNT) */
1989 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1992 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1993 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1997 if (STRING_MULTIBYTE (filename
))
1998 return make_string (xnm
, x
- xnm
);
1999 return make_unibyte_string (xnm
, x
- xnm
);
2002 error ("Bad format environment-variable substitution");
2004 error ("Missing \"}\" in environment-variable substitution");
2006 error ("Substituting nonexistent environment variable \"%s\"", target
);
2009 #endif /* not VMS */
2012 /* A slightly faster and more convenient way to get
2013 (directory-file-name (expand-file-name FOO)). */
2016 expand_and_dir_to_file (filename
, defdir
)
2017 Lisp_Object filename
, defdir
;
2019 register Lisp_Object absname
;
2021 absname
= Fexpand_file_name (filename
, defdir
);
2024 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
2025 if (c
== ':' || c
== ']' || c
== '>')
2026 absname
= Fdirectory_file_name (absname
);
2029 /* Remove final slash, if any (unless this is the root dir).
2030 stat behaves differently depending! */
2031 if (XSTRING (absname
)->size
> 1
2032 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
2033 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
2034 /* We cannot take shortcuts; they might be wrong for magic file names. */
2035 absname
= Fdirectory_file_name (absname
);
2040 /* Signal an error if the file ABSNAME already exists.
2041 If INTERACTIVE is nonzero, ask the user whether to proceed,
2042 and bypass the error if the user says to go ahead.
2043 QUERYSTRING is a name for the action that is being considered
2045 *STATPTR is used to store the stat information if the file exists.
2046 If the file does not exist, STATPTR->st_mode is set to 0. */
2049 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
2050 Lisp_Object absname
;
2051 unsigned char *querystring
;
2053 struct stat
*statptr
;
2055 register Lisp_Object tem
;
2056 struct stat statbuf
;
2057 struct gcpro gcpro1
;
2059 /* stat is a good way to tell whether the file exists,
2060 regardless of what access permissions it has. */
2061 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2064 Fsignal (Qfile_already_exists
,
2065 Fcons (build_string ("File already exists"),
2066 Fcons (absname
, Qnil
)));
2068 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2069 XSTRING (absname
)->data
, querystring
));
2072 Fsignal (Qfile_already_exists
,
2073 Fcons (build_string ("File already exists"),
2074 Fcons (absname
, Qnil
)));
2081 statptr
->st_mode
= 0;
2086 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2087 "fCopy file: \nFCopy %s to file: \np\nP",
2088 "Copy FILE to NEWNAME. Both args must be strings.\n\
2089 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2090 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2091 A number as third arg means request confirmation if NEWNAME already exists.\n\
2092 This is what happens in interactive use with M-x.\n\
2093 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2094 last-modified time as the old one. (This works on only some systems.)\n\
2095 A prefix arg makes KEEP-TIME non-nil.")
2096 (file
, newname
, ok_if_already_exists
, keep_date
)
2097 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2100 char buf
[16 * 1024];
2101 struct stat st
, out_st
;
2102 Lisp_Object handler
;
2103 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2104 int count
= specpdl_ptr
- specpdl
;
2105 int input_file_statable_p
;
2106 Lisp_Object encoded_file
, encoded_newname
;
2108 encoded_file
= encoded_newname
= Qnil
;
2109 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2110 CHECK_STRING (file
, 0);
2111 CHECK_STRING (newname
, 1);
2113 file
= Fexpand_file_name (file
, Qnil
);
2114 newname
= Fexpand_file_name (newname
, Qnil
);
2116 /* If the input file name has special constructs in it,
2117 call the corresponding file handler. */
2118 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2119 /* Likewise for output file name. */
2121 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2122 if (!NILP (handler
))
2123 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2124 ok_if_already_exists
, keep_date
));
2126 encoded_file
= ENCODE_FILE (file
);
2127 encoded_newname
= ENCODE_FILE (newname
);
2129 if (NILP (ok_if_already_exists
)
2130 || INTEGERP (ok_if_already_exists
))
2131 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2132 INTEGERP (ok_if_already_exists
), &out_st
);
2133 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2136 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2138 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2140 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2142 /* We can only copy regular files and symbolic links. Other files are not
2144 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2146 #if !defined (MSDOS) || __DJGPP__ > 1
2147 if (out_st
.st_mode
!= 0
2148 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2151 report_file_error ("Input and output files are the same",
2152 Fcons (file
, Fcons (newname
, Qnil
)));
2156 #if defined (S_ISREG) && defined (S_ISLNK)
2157 if (input_file_statable_p
)
2159 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2161 #if defined (EISDIR)
2162 /* Get a better looking error message. */
2165 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2168 #endif /* S_ISREG && S_ISLNK */
2171 /* Create the copy file with the same record format as the input file */
2172 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2175 /* System's default file type was set to binary by _fmode in emacs.c. */
2176 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2177 #else /* not MSDOS */
2178 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2179 #endif /* not MSDOS */
2182 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2184 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2188 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2189 if (write (ofd
, buf
, n
) != n
)
2190 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2193 /* Closing the output clobbers the file times on some systems. */
2194 if (close (ofd
) < 0)
2195 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2197 if (input_file_statable_p
)
2199 if (!NILP (keep_date
))
2201 EMACS_TIME atime
, mtime
;
2202 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2203 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2204 if (set_file_times (XSTRING (encoded_newname
)->data
,
2206 Fsignal (Qfile_date_error
,
2207 Fcons (build_string ("Cannot set file date"),
2208 Fcons (newname
, Qnil
)));
2211 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2213 #if defined (__DJGPP__) && __DJGPP__ > 1
2214 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2215 and if it can't, it tells so. Otherwise, under MSDOS we usually
2216 get only the READ bit, which will make the copied file read-only,
2217 so it's better not to chmod at all. */
2218 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2219 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2220 #endif /* DJGPP version 2 or newer */
2226 /* Discard the unwind protects. */
2227 specpdl_ptr
= specpdl
+ count
;
2233 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2234 Smake_directory_internal
, 1, 1, 0,
2235 "Create a new directory named DIRECTORY.")
2237 Lisp_Object directory
;
2240 Lisp_Object handler
;
2241 Lisp_Object encoded_dir
;
2243 CHECK_STRING (directory
, 0);
2244 directory
= Fexpand_file_name (directory
, Qnil
);
2246 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2247 if (!NILP (handler
))
2248 return call2 (handler
, Qmake_directory_internal
, directory
);
2250 encoded_dir
= ENCODE_FILE (directory
);
2252 dir
= XSTRING (encoded_dir
)->data
;
2255 if (mkdir (dir
) != 0)
2257 if (mkdir (dir
, 0777) != 0)
2259 report_file_error ("Creating directory", Flist (1, &directory
));
2264 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2265 "Delete the directory named DIRECTORY.")
2267 Lisp_Object directory
;
2270 Lisp_Object handler
;
2271 Lisp_Object encoded_dir
;
2273 CHECK_STRING (directory
, 0);
2274 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2276 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2277 if (!NILP (handler
))
2278 return call2 (handler
, Qdelete_directory
, directory
);
2280 encoded_dir
= ENCODE_FILE (directory
);
2282 dir
= XSTRING (encoded_dir
)->data
;
2284 if (rmdir (dir
) != 0)
2285 report_file_error ("Removing directory", Flist (1, &directory
));
2290 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2291 "Delete file named FILENAME.\n\
2292 If file has multiple names, it continues to exist with the other names.")
2294 Lisp_Object filename
;
2296 Lisp_Object handler
;
2297 Lisp_Object encoded_file
;
2299 CHECK_STRING (filename
, 0);
2300 filename
= Fexpand_file_name (filename
, Qnil
);
2302 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2303 if (!NILP (handler
))
2304 return call2 (handler
, Qdelete_file
, filename
);
2306 encoded_file
= ENCODE_FILE (filename
);
2308 if (0 > unlink (XSTRING (encoded_file
)->data
))
2309 report_file_error ("Removing old name", Flist (1, &filename
));
2314 internal_delete_file_1 (ignore
)
2320 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2323 internal_delete_file (filename
)
2324 Lisp_Object filename
;
2326 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2327 Qt
, internal_delete_file_1
));
2330 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2331 "fRename file: \nFRename %s to file: \np",
2332 "Rename FILE as NEWNAME. Both args strings.\n\
2333 If file has names other than FILE, it continues to have those names.\n\
2334 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2335 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2336 A number as third arg means request confirmation if NEWNAME already exists.\n\
2337 This is what happens in interactive use with M-x.")
2338 (file
, newname
, ok_if_already_exists
)
2339 Lisp_Object file
, newname
, ok_if_already_exists
;
2342 Lisp_Object args
[2];
2344 Lisp_Object handler
;
2345 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2346 Lisp_Object encoded_file
, encoded_newname
;
2348 encoded_file
= encoded_newname
= Qnil
;
2349 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2350 CHECK_STRING (file
, 0);
2351 CHECK_STRING (newname
, 1);
2352 file
= Fexpand_file_name (file
, Qnil
);
2353 newname
= Fexpand_file_name (newname
, Qnil
);
2355 /* If the file name has special constructs in it,
2356 call the corresponding file handler. */
2357 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2359 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2360 if (!NILP (handler
))
2361 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2362 file
, newname
, ok_if_already_exists
));
2364 encoded_file
= ENCODE_FILE (file
);
2365 encoded_newname
= ENCODE_FILE (newname
);
2367 if (NILP (ok_if_already_exists
)
2368 || INTEGERP (ok_if_already_exists
))
2369 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2370 INTEGERP (ok_if_already_exists
), 0);
2372 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2374 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2375 || 0 > unlink (XSTRING (encoded_file
)->data
))
2380 Fcopy_file (file
, newname
,
2381 /* We have already prompted if it was an integer,
2382 so don't have copy-file prompt again. */
2383 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2384 Fdelete_file (file
);
2391 report_file_error ("Renaming", Flist (2, args
));
2394 report_file_error ("Renaming", Flist (2, &file
));
2401 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2402 "fAdd name to file: \nFName to add to %s: \np",
2403 "Give FILE additional name NEWNAME. Both args strings.\n\
2404 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2405 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2406 A number as third arg means request confirmation if NEWNAME already exists.\n\
2407 This is what happens in interactive use with M-x.")
2408 (file
, newname
, ok_if_already_exists
)
2409 Lisp_Object file
, newname
, ok_if_already_exists
;
2412 Lisp_Object args
[2];
2414 Lisp_Object handler
;
2415 Lisp_Object encoded_file
, encoded_newname
;
2416 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2418 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2419 encoded_file
= encoded_newname
= Qnil
;
2420 CHECK_STRING (file
, 0);
2421 CHECK_STRING (newname
, 1);
2422 file
= Fexpand_file_name (file
, Qnil
);
2423 newname
= Fexpand_file_name (newname
, Qnil
);
2425 /* If the file name has special constructs in it,
2426 call the corresponding file handler. */
2427 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2428 if (!NILP (handler
))
2429 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2430 newname
, ok_if_already_exists
));
2432 /* If the new name has special constructs in it,
2433 call the corresponding file handler. */
2434 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2435 if (!NILP (handler
))
2436 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2437 newname
, ok_if_already_exists
));
2439 encoded_file
= ENCODE_FILE (file
);
2440 encoded_newname
= ENCODE_FILE (newname
);
2442 if (NILP (ok_if_already_exists
)
2443 || INTEGERP (ok_if_already_exists
))
2444 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2445 INTEGERP (ok_if_already_exists
), 0);
2447 unlink (XSTRING (newname
)->data
);
2448 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2453 report_file_error ("Adding new name", Flist (2, args
));
2455 report_file_error ("Adding new name", Flist (2, &file
));
2464 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2465 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2466 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2467 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2468 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2469 A number as third arg means request confirmation if LINKNAME already exists.\n\
2470 This happens for interactive use with M-x.")
2471 (filename
, linkname
, ok_if_already_exists
)
2472 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2475 Lisp_Object args
[2];
2477 Lisp_Object handler
;
2478 Lisp_Object encoded_filename
, encoded_linkname
;
2479 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2481 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2482 encoded_filename
= encoded_linkname
= Qnil
;
2483 CHECK_STRING (filename
, 0);
2484 CHECK_STRING (linkname
, 1);
2485 /* If the link target has a ~, we must expand it to get
2486 a truly valid file name. Otherwise, do not expand;
2487 we want to permit links to relative file names. */
2488 if (XSTRING (filename
)->data
[0] == '~')
2489 filename
= Fexpand_file_name (filename
, Qnil
);
2490 linkname
= Fexpand_file_name (linkname
, Qnil
);
2492 /* If the file name has special constructs in it,
2493 call the corresponding file handler. */
2494 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2495 if (!NILP (handler
))
2496 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2497 linkname
, ok_if_already_exists
));
2499 /* If the new link name has special constructs in it,
2500 call the corresponding file handler. */
2501 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2502 if (!NILP (handler
))
2503 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2504 linkname
, ok_if_already_exists
));
2506 encoded_filename
= ENCODE_FILE (filename
);
2507 encoded_linkname
= ENCODE_FILE (linkname
);
2509 if (NILP (ok_if_already_exists
)
2510 || INTEGERP (ok_if_already_exists
))
2511 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2512 INTEGERP (ok_if_already_exists
), 0);
2513 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2514 XSTRING (encoded_linkname
)->data
))
2516 /* If we didn't complain already, silently delete existing file. */
2517 if (errno
== EEXIST
)
2519 unlink (XSTRING (encoded_linkname
)->data
);
2520 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2521 XSTRING (encoded_linkname
)->data
))
2531 report_file_error ("Making symbolic link", Flist (2, args
));
2533 report_file_error ("Making symbolic link", Flist (2, &filename
));
2539 #endif /* S_IFLNK */
2543 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2544 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2545 "Define the job-wide logical name NAME to have the value STRING.\n\
2546 If STRING is nil or a null string, the logical name NAME is deleted.")
2551 CHECK_STRING (name
, 0);
2553 delete_logical_name (XSTRING (name
)->data
);
2556 CHECK_STRING (string
, 1);
2558 if (XSTRING (string
)->size
== 0)
2559 delete_logical_name (XSTRING (name
)->data
);
2561 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2570 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2571 "Open a network connection to PATH using LOGIN as the login string.")
2573 Lisp_Object path
, login
;
2577 CHECK_STRING (path
, 0);
2578 CHECK_STRING (login
, 0);
2580 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2582 if (netresult
== -1)
2587 #endif /* HPUX_NET */
2589 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2591 "Return t if file FILENAME specifies an absolute file name.\n\
2592 On Unix, this is a name starting with a `/' or a `~'.")
2594 Lisp_Object filename
;
2598 CHECK_STRING (filename
, 0);
2599 ptr
= XSTRING (filename
)->data
;
2600 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2602 /* ??? This criterion is probably wrong for '<'. */
2603 || index (ptr
, ':') || index (ptr
, '<')
2604 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2608 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2616 /* Return nonzero if file FILENAME exists and can be executed. */
2619 check_executable (filename
)
2623 int len
= strlen (filename
);
2626 if (stat (filename
, &st
) < 0)
2628 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2629 return ((st
.st_mode
& S_IEXEC
) != 0);
2631 return (S_ISREG (st
.st_mode
)
2633 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2634 || stricmp (suffix
, ".exe") == 0
2635 || stricmp (suffix
, ".bat") == 0)
2636 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2637 #endif /* not WINDOWSNT */
2638 #else /* not DOS_NT */
2639 #ifdef HAVE_EUIDACCESS
2640 return (euidaccess (filename
, 1) >= 0);
2642 /* Access isn't quite right because it uses the real uid
2643 and we really want to test with the effective uid.
2644 But Unix doesn't give us a right way to do it. */
2645 return (access (filename
, 1) >= 0);
2647 #endif /* not DOS_NT */
2650 /* Return nonzero if file FILENAME exists and can be written. */
2653 check_writable (filename
)
2658 if (stat (filename
, &st
) < 0)
2660 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2661 #else /* not MSDOS */
2662 #ifdef HAVE_EUIDACCESS
2663 return (euidaccess (filename
, 2) >= 0);
2665 /* Access isn't quite right because it uses the real uid
2666 and we really want to test with the effective uid.
2667 But Unix doesn't give us a right way to do it.
2668 Opening with O_WRONLY could work for an ordinary file,
2669 but would lose for directories. */
2670 return (access (filename
, 2) >= 0);
2672 #endif /* not MSDOS */
2675 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2676 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2677 See also `file-readable-p' and `file-attributes'.")
2679 Lisp_Object filename
;
2681 Lisp_Object absname
;
2682 Lisp_Object handler
;
2683 struct stat statbuf
;
2685 CHECK_STRING (filename
, 0);
2686 absname
= Fexpand_file_name (filename
, Qnil
);
2688 /* If the file name has special constructs in it,
2689 call the corresponding file handler. */
2690 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2691 if (!NILP (handler
))
2692 return call2 (handler
, Qfile_exists_p
, absname
);
2694 absname
= ENCODE_FILE (absname
);
2696 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2699 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2700 "Return t if FILENAME can be executed by you.\n\
2701 For a directory, this means you can access files in that directory.")
2703 Lisp_Object filename
;
2706 Lisp_Object absname
;
2707 Lisp_Object handler
;
2709 CHECK_STRING (filename
, 0);
2710 absname
= Fexpand_file_name (filename
, Qnil
);
2712 /* If the file name has special constructs in it,
2713 call the corresponding file handler. */
2714 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2715 if (!NILP (handler
))
2716 return call2 (handler
, Qfile_executable_p
, absname
);
2718 absname
= ENCODE_FILE (absname
);
2720 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2723 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2724 "Return t if file FILENAME exists and you can read it.\n\
2725 See also `file-exists-p' and `file-attributes'.")
2727 Lisp_Object filename
;
2729 Lisp_Object absname
;
2730 Lisp_Object handler
;
2733 struct stat statbuf
;
2735 CHECK_STRING (filename
, 0);
2736 absname
= Fexpand_file_name (filename
, Qnil
);
2738 /* If the file name has special constructs in it,
2739 call the corresponding file handler. */
2740 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2741 if (!NILP (handler
))
2742 return call2 (handler
, Qfile_readable_p
, absname
);
2744 absname
= ENCODE_FILE (absname
);
2747 /* Under MS-DOS and Windows, open does not work for directories. */
2748 if (access (XSTRING (absname
)->data
, 0) == 0)
2751 #else /* not DOS_NT */
2753 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2754 /* Opening a fifo without O_NONBLOCK can wait.
2755 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2756 except in the case of a fifo, on a system which handles it. */
2757 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2760 if (S_ISFIFO (statbuf
.st_mode
))
2761 flags
|= O_NONBLOCK
;
2763 desc
= open (XSTRING (absname
)->data
, flags
);
2768 #endif /* not DOS_NT */
2771 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2773 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2774 "Return t if file FILENAME can be written or created by you.")
2776 Lisp_Object filename
;
2778 Lisp_Object absname
, dir
, encoded
;
2779 Lisp_Object handler
;
2780 struct stat statbuf
;
2782 CHECK_STRING (filename
, 0);
2783 absname
= Fexpand_file_name (filename
, Qnil
);
2785 /* If the file name has special constructs in it,
2786 call the corresponding file handler. */
2787 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2788 if (!NILP (handler
))
2789 return call2 (handler
, Qfile_writable_p
, absname
);
2791 encoded
= ENCODE_FILE (absname
);
2792 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2793 return (check_writable (XSTRING (encoded
)->data
)
2796 dir
= Ffile_name_directory (absname
);
2799 dir
= Fdirectory_file_name (dir
);
2803 dir
= Fdirectory_file_name (dir
);
2806 dir
= ENCODE_FILE (dir
);
2807 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2811 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2812 "Access file FILENAME, and get an error if that does not work.\n\
2813 The second argument STRING is used in the error message.\n\
2814 If there is no error, we return nil.")
2816 Lisp_Object filename
, string
;
2818 Lisp_Object handler
, encoded_filename
;
2821 CHECK_STRING (filename
, 0);
2823 /* If the file name has special constructs in it,
2824 call the corresponding file handler. */
2825 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2826 if (!NILP (handler
))
2827 return call3 (handler
, Qaccess_file
, filename
, string
);
2829 encoded_filename
= ENCODE_FILE (filename
);
2831 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2833 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2839 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2840 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2841 The value is the name of the file to which it is linked.\n\
2842 Otherwise returns nil.")
2844 Lisp_Object filename
;
2851 Lisp_Object handler
;
2853 CHECK_STRING (filename
, 0);
2854 filename
= Fexpand_file_name (filename
, Qnil
);
2856 /* If the file name has special constructs in it,
2857 call the corresponding file handler. */
2858 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2859 if (!NILP (handler
))
2860 return call2 (handler
, Qfile_symlink_p
, filename
);
2862 filename
= ENCODE_FILE (filename
);
2867 buf
= (char *) xmalloc (bufsize
);
2868 bzero (buf
, bufsize
);
2869 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2870 if (valsize
< bufsize
) break;
2871 /* Buffer was not long enough */
2880 val
= make_string (buf
, valsize
);
2882 return Fdecode_coding_string (val
, Vfile_name_coding_system
, Qt
);
2883 #else /* not S_IFLNK */
2885 #endif /* not S_IFLNK */
2888 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2889 "Return t if FILENAME names an existing directory.")
2891 Lisp_Object filename
;
2893 register Lisp_Object absname
;
2895 Lisp_Object handler
;
2897 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2899 /* If the file name has special constructs in it,
2900 call the corresponding file handler. */
2901 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2902 if (!NILP (handler
))
2903 return call2 (handler
, Qfile_directory_p
, absname
);
2905 absname
= ENCODE_FILE (absname
);
2907 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2909 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2912 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2913 "Return t if file FILENAME is the name of a directory as a file,\n\
2914 and files in that directory can be opened by you. In order to use a\n\
2915 directory as a buffer's current directory, this predicate must return true.\n\
2916 A directory name spec may be given instead; then the value is t\n\
2917 if the directory so specified exists and really is a readable and\n\
2918 searchable directory.")
2920 Lisp_Object filename
;
2922 Lisp_Object handler
;
2924 struct gcpro gcpro1
;
2926 /* If the file name has special constructs in it,
2927 call the corresponding file handler. */
2928 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2929 if (!NILP (handler
))
2930 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2932 /* It's an unlikely combination, but yes we really do need to gcpro:
2933 Suppose that file-accessible-directory-p has no handler, but
2934 file-directory-p does have a handler; this handler causes a GC which
2935 relocates the string in `filename'; and finally file-directory-p
2936 returns non-nil. Then we would end up passing a garbaged string
2937 to file-executable-p. */
2939 tem
= (NILP (Ffile_directory_p (filename
))
2940 || NILP (Ffile_executable_p (filename
)));
2942 return tem
? Qnil
: Qt
;
2945 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2946 "Return t if file FILENAME is the name of a regular file.\n\
2947 This is the sort of file that holds an ordinary stream of data bytes.")
2949 Lisp_Object filename
;
2951 register Lisp_Object absname
;
2953 Lisp_Object handler
;
2955 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2957 /* If the file name has special constructs in it,
2958 call the corresponding file handler. */
2959 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2960 if (!NILP (handler
))
2961 return call2 (handler
, Qfile_regular_p
, absname
);
2963 absname
= ENCODE_FILE (absname
);
2965 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2967 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2970 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2971 "Return mode bits of file named FILENAME, as an integer.")
2973 Lisp_Object filename
;
2975 Lisp_Object absname
;
2977 Lisp_Object handler
;
2979 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2981 /* If the file name has special constructs in it,
2982 call the corresponding file handler. */
2983 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2984 if (!NILP (handler
))
2985 return call2 (handler
, Qfile_modes
, absname
);
2987 absname
= ENCODE_FILE (absname
);
2989 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2991 #if defined (MSDOS) && __DJGPP__ < 2
2992 if (check_executable (XSTRING (absname
)->data
))
2993 st
.st_mode
|= S_IEXEC
;
2994 #endif /* MSDOS && __DJGPP__ < 2 */
2996 return make_number (st
.st_mode
& 07777);
2999 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3000 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3001 Only the 12 low bits of MODE are used.")
3003 Lisp_Object filename
, mode
;
3005 Lisp_Object absname
, encoded_absname
;
3006 Lisp_Object handler
;
3008 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3009 CHECK_NUMBER (mode
, 1);
3011 /* If the file name has special constructs in it,
3012 call the corresponding file handler. */
3013 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3014 if (!NILP (handler
))
3015 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3017 encoded_absname
= ENCODE_FILE (absname
);
3019 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3020 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3025 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3026 "Set the file permission bits for newly created files.\n\
3027 The argument MODE should be an integer; only the low 9 bits are used.\n\
3028 This setting is inherited by subprocesses.")
3032 CHECK_NUMBER (mode
, 0);
3034 umask ((~ XINT (mode
)) & 0777);
3039 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3040 "Return the default file protection for created files.\n\
3041 The value is an integer.")
3047 realmask
= umask (0);
3050 XSETINT (value
, (~ realmask
) & 0777);
3056 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3057 "Tell Unix to finish all pending disk updates.")
3066 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3067 "Return t if file FILE1 is newer than file FILE2.\n\
3068 If FILE1 does not exist, the answer is nil;\n\
3069 otherwise, if FILE2 does not exist, the answer is t.")
3071 Lisp_Object file1
, file2
;
3073 Lisp_Object absname1
, absname2
;
3076 Lisp_Object handler
;
3077 struct gcpro gcpro1
, gcpro2
;
3079 CHECK_STRING (file1
, 0);
3080 CHECK_STRING (file2
, 0);
3083 GCPRO2 (absname1
, file2
);
3084 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3085 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3088 /* If the file name has special constructs in it,
3089 call the corresponding file handler. */
3090 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3092 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3093 if (!NILP (handler
))
3094 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3096 GCPRO2 (absname1
, absname2
);
3097 absname1
= ENCODE_FILE (absname1
);
3098 absname2
= ENCODE_FILE (absname2
);
3101 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3104 mtime1
= st
.st_mtime
;
3106 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3109 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3113 Lisp_Object Qfind_buffer_file_type
;
3116 #ifndef READ_BUF_SIZE
3117 #define READ_BUF_SIZE (64 << 10)
3120 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3122 "Insert contents of file FILENAME after point.\n\
3123 Returns list of absolute file name and number of bytes inserted.\n\
3124 If second argument VISIT is non-nil, the buffer's visited filename\n\
3125 and last save file modtime are set, and it is marked unmodified.\n\
3126 If visiting and the file does not exist, visiting is completed\n\
3127 before the error is signaled.\n\
3128 The optional third and fourth arguments BEG and END\n\
3129 specify what portion of the file to insert.\n\
3130 These arguments count bytes in the file, not characters in the buffer.\n\
3131 If VISIT is non-nil, BEG and END must be nil.\n\
3133 If optional fifth argument REPLACE is non-nil,\n\
3134 it means replace the current buffer contents (in the accessible portion)\n\
3135 with the file contents. This is better than simply deleting and inserting\n\
3136 the whole thing because (1) it preserves some marker positions\n\
3137 and (2) it puts less data in the undo list.\n\
3138 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3139 which is often less than the number of characters to be read.\n\
3140 This does code conversion according to the value of\n\
3141 `coding-system-for-read' or `file-coding-system-alist',\n\
3142 and sets the variable `last-coding-system-used' to the coding system\n\
3144 (filename
, visit
, beg
, end
, replace
)
3145 Lisp_Object filename
, visit
, beg
, end
, replace
;
3150 register int how_much
;
3151 register int unprocessed
;
3152 int count
= specpdl_ptr
- specpdl
;
3153 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3154 Lisp_Object handler
, val
, insval
, orig_filename
;
3157 int not_regular
= 0;
3158 char read_buf
[READ_BUF_SIZE
];
3159 struct coding_system coding
;
3160 unsigned char buffer
[1 << 14];
3161 int replace_handled
= 0;
3162 int set_coding_system
= 0;
3164 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3165 error ("Cannot do file visiting in an indirect buffer");
3167 if (!NILP (current_buffer
->read_only
))
3168 Fbarf_if_buffer_read_only ();
3172 orig_filename
= Qnil
;
3174 GCPRO4 (filename
, val
, p
, orig_filename
);
3176 CHECK_STRING (filename
, 0);
3177 filename
= Fexpand_file_name (filename
, Qnil
);
3179 /* If the file name has special constructs in it,
3180 call the corresponding file handler. */
3181 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3182 if (!NILP (handler
))
3184 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3185 visit
, beg
, end
, replace
);
3189 orig_filename
= filename
;
3190 filename
= ENCODE_FILE (filename
);
3195 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3197 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3198 || fstat (fd
, &st
) < 0)
3199 #endif /* not APOLLO */
3201 if (fd
>= 0) close (fd
);
3204 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3207 if (!NILP (Vcoding_system_for_read
))
3208 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3213 /* This code will need to be changed in order to work on named
3214 pipes, and it's probably just not worth it. So we should at
3215 least signal an error. */
3216 if (!S_ISREG (st
.st_mode
))
3223 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3224 Fsignal (Qfile_error
,
3225 Fcons (build_string ("not a regular file"),
3226 Fcons (orig_filename
, Qnil
)));
3231 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3234 /* Replacement should preserve point as it preserves markers. */
3235 if (!NILP (replace
))
3236 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3238 record_unwind_protect (close_file_unwind
, make_number (fd
));
3240 /* Supposedly happens on VMS. */
3241 if (! not_regular
&& st
.st_size
< 0)
3242 error ("File size is negative");
3244 if (!NILP (beg
) || !NILP (end
))
3246 error ("Attempt to visit less than an entire file");
3249 CHECK_NUMBER (beg
, 0);
3251 XSETFASTINT (beg
, 0);
3254 CHECK_NUMBER (end
, 0);
3259 XSETINT (end
, st
.st_size
);
3260 if (XINT (end
) != st
.st_size
)
3261 error ("Maximum buffer size exceeded");
3265 /* Decide the coding-system of the file. */
3267 Lisp_Object val
= Qnil
;
3269 if (!NILP (Vcoding_system_for_read
))
3270 val
= Vcoding_system_for_read
;
3273 if (! NILP (Vset_auto_coding_function
))
3275 /* Find a coding system specified in the heading two lines
3276 or in the tailing several lines of the file. We assume
3277 that the 1K-byte and 3K-byte for heading and tailing
3278 respectively are sufficient fot this purpose. */
3279 int how_many
, nread
;
3281 if (st
.st_size
<= (1024 * 4))
3282 nread
= read (fd
, read_buf
, 1024 * 4);
3285 nread
= read (fd
, read_buf
, 1024);
3288 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3289 report_file_error ("Setting file position",
3290 Fcons (orig_filename
, Qnil
));
3291 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3296 error ("IO error reading %s: %s",
3297 XSTRING (orig_filename
)->data
, strerror (errno
));
3301 /* Always make this a unibyte string
3302 because we have not yet decoded it. */
3303 tem
= make_unibyte_string (read_buf
, nread
);
3304 val
= call1 (Vset_auto_coding_function
, tem
);
3305 /* Rewind the file for the actual read done later. */
3306 if (lseek (fd
, 0, 0) < 0)
3307 report_file_error ("Setting file position",
3308 Fcons (orig_filename
, Qnil
));
3313 Lisp_Object args
[6], coding_systems
;
3315 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3316 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3317 coding_systems
= Ffind_operation_coding_system (6, args
);
3318 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3322 if (NILP (Vcoding_system_for_read
)
3323 && NILP (current_buffer
->enable_multibyte_characters
))
3325 /* We must suppress all text conversion except for end-of-line
3327 struct coding_system coding_temp
;
3329 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3330 setup_coding_system (Qraw_text
, &coding
);
3331 coding
.eol_type
= coding_temp
.eol_type
;
3334 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3337 /* If requested, replace the accessible part of the buffer
3338 with the file contents. Avoid replacing text at the
3339 beginning or end of the buffer that matches the file contents;
3340 that preserves markers pointing to the unchanged parts.
3342 Here we implement this feature in an optimized way
3343 for the case where code conversion is NOT needed.
3344 The following if-statement handles the case of conversion
3345 in a less optimal way.
3347 If the code conversion is "automatic" then we try using this
3348 method and hope for the best.
3349 But if we discover the need for conversion, we give up on this method
3350 and let the following if-statement handle the replace job. */
3352 && ! CODING_REQUIRE_DECODING (&coding
))
3354 /* same_at_start and same_at_end count bytes,
3355 because file access counts bytes
3356 and BEG and END count bytes. */
3357 int same_at_start
= BEGV_BYTE
;
3358 int same_at_end
= ZV_BYTE
;
3360 /* There is still a possibility we will find the need to do code
3361 conversion. If that happens, we set this variable to 1 to
3362 give up on handling REPLACE in the optimized way. */
3363 int giveup_match_end
= 0;
3365 if (XINT (beg
) != 0)
3367 if (lseek (fd
, XINT (beg
), 0) < 0)
3368 report_file_error ("Setting file position",
3369 Fcons (orig_filename
, Qnil
));
3374 /* Count how many chars at the start of the file
3375 match the text at the beginning of the buffer. */
3380 nread
= read (fd
, buffer
, sizeof buffer
);
3382 error ("IO error reading %s: %s",
3383 XSTRING (orig_filename
)->data
, strerror (errno
));
3384 else if (nread
== 0)
3387 if (coding
.type
== coding_type_undecided
)
3388 detect_coding (&coding
, buffer
, nread
);
3389 if (CODING_REQUIRE_DECODING (&coding
))
3390 /* We found that the file should be decoded somehow.
3391 Let's give up here. */
3393 giveup_match_end
= 1;
3397 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3398 detect_eol (&coding
, buffer
, nread
);
3399 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3400 && coding
.eol_type
!= CODING_EOL_LF
)
3401 /* We found that the format of eol should be decoded.
3402 Let's give up here. */
3404 giveup_match_end
= 1;
3409 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3410 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3411 same_at_start
++, bufpos
++;
3412 /* If we found a discrepancy, stop the scan.
3413 Otherwise loop around and scan the next bufferful. */
3414 if (bufpos
!= nread
)
3418 /* If the file matches the buffer completely,
3419 there's no need to replace anything. */
3420 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3424 /* Truncate the buffer to the size of the file. */
3425 del_range_1 (same_at_start
, same_at_end
, 0);
3430 /* Count how many chars at the end of the file
3431 match the text at the end of the buffer. But, if we have
3432 already found that decoding is necessary, don't waste time. */
3433 while (!giveup_match_end
)
3435 int total_read
, nread
, bufpos
, curpos
, trial
;
3437 /* At what file position are we now scanning? */
3438 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3439 /* If the entire file matches the buffer tail, stop the scan. */
3442 /* How much can we scan in the next step? */
3443 trial
= min (curpos
, sizeof buffer
);
3444 if (lseek (fd
, curpos
- trial
, 0) < 0)
3445 report_file_error ("Setting file position",
3446 Fcons (orig_filename
, Qnil
));
3449 while (total_read
< trial
)
3451 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3453 error ("IO error reading %s: %s",
3454 XSTRING (orig_filename
)->data
, strerror (errno
));
3455 total_read
+= nread
;
3457 /* Scan this bufferful from the end, comparing with
3458 the Emacs buffer. */
3459 bufpos
= total_read
;
3460 /* Compare with same_at_start to avoid counting some buffer text
3461 as matching both at the file's beginning and at the end. */
3462 while (bufpos
> 0 && same_at_end
> same_at_start
3463 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3464 same_at_end
--, bufpos
--;
3466 /* If we found a discrepancy, stop the scan.
3467 Otherwise loop around and scan the preceding bufferful. */
3470 /* If this discrepancy is because of code conversion,
3471 we cannot use this method; giveup and try the other. */
3472 if (same_at_end
> same_at_start
3473 && FETCH_BYTE (same_at_end
- 1) >= 0200
3474 && ! NILP (current_buffer
->enable_multibyte_characters
)
3475 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3476 giveup_match_end
= 1;
3482 if (! giveup_match_end
)
3486 /* We win! We can handle REPLACE the optimized way. */
3488 /* Extends the end of non-matching text area to multibyte
3489 character boundary. */
3490 if (! NILP (current_buffer
->enable_multibyte_characters
))
3491 while (same_at_end
< ZV_BYTE
3492 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3495 /* Don't try to reuse the same piece of text twice. */
3496 overlap
= (same_at_start
- BEGV_BYTE
3497 - (same_at_end
+ st
.st_size
- ZV
));
3499 same_at_end
+= overlap
;
3501 /* Arrange to read only the nonmatching middle part of the file. */
3502 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3503 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3505 del_range_byte (same_at_start
, same_at_end
, 0);
3506 /* Insert from the file at the proper position. */
3507 temp
= BYTE_TO_CHAR (same_at_start
);
3508 SET_PT_BOTH (temp
, same_at_start
);
3510 /* If display currently starts at beginning of line,
3511 keep it that way. */
3512 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3513 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3515 replace_handled
= 1;
3519 /* If requested, replace the accessible part of the buffer
3520 with the file contents. Avoid replacing text at the
3521 beginning or end of the buffer that matches the file contents;
3522 that preserves markers pointing to the unchanged parts.
3524 Here we implement this feature for the case where code conversion
3525 is needed, in a simple way that needs a lot of memory.
3526 The preceding if-statement handles the case of no conversion
3527 in a more optimized way. */
3528 if (!NILP (replace
) && ! replace_handled
)
3530 int same_at_start
= BEGV_BYTE
;
3531 int same_at_end
= ZV_BYTE
;
3534 /* Make sure that the gap is large enough. */
3535 int bufsize
= 2 * st
.st_size
;
3536 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3539 /* First read the whole file, performing code conversion into
3540 CONVERSION_BUFFER. */
3542 if (lseek (fd
, XINT (beg
), 0) < 0)
3544 free (conversion_buffer
);
3545 report_file_error ("Setting file position",
3546 Fcons (orig_filename
, Qnil
));
3549 total
= st
.st_size
; /* Total bytes in the file. */
3550 how_much
= 0; /* Bytes read from file so far. */
3551 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3552 unprocessed
= 0; /* Bytes not processed in previous loop. */
3554 while (how_much
< total
)
3556 /* try is reserved in some compilers (Microsoft C) */
3557 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3558 char *destination
= read_buf
+ unprocessed
;
3561 /* Allow quitting out of the actual I/O. */
3564 this = read (fd
, destination
, trytry
);
3567 if (this < 0 || this + unprocessed
== 0)
3575 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3577 int require
, result
;
3579 this += unprocessed
;
3581 /* If we are using more space than estimated,
3582 make CONVERSION_BUFFER bigger. */
3583 require
= decoding_buffer_size (&coding
, this);
3584 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3586 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3587 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3590 /* Convert this batch with results in CONVERSION_BUFFER. */
3591 if (how_much
>= total
) /* This is the last block. */
3592 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3593 result
= decode_coding (&coding
, read_buf
,
3594 conversion_buffer
+ inserted
,
3595 this, bufsize
- inserted
);
3597 /* Save for next iteration whatever we didn't convert. */
3598 unprocessed
= this - coding
.consumed
;
3599 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3600 this = coding
.produced
;
3606 /* At this point, INSERTED is how many characters (i.e. bytes)
3607 are present in CONVERSION_BUFFER.
3608 HOW_MUCH should equal TOTAL,
3609 or should be <= 0 if we couldn't read the file. */
3613 free (conversion_buffer
);
3616 error ("IO error reading %s: %s",
3617 XSTRING (orig_filename
)->data
, strerror (errno
));
3618 else if (how_much
== -2)
3619 error ("maximum buffer size exceeded");
3622 /* Compare the beginning of the converted file
3623 with the buffer text. */
3626 while (bufpos
< inserted
&& same_at_start
< same_at_end
3627 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3628 same_at_start
++, bufpos
++;
3630 /* If the file matches the buffer completely,
3631 there's no need to replace anything. */
3633 if (bufpos
== inserted
)
3635 free (conversion_buffer
);
3638 /* Truncate the buffer to the size of the file. */
3639 del_range_1 (same_at_start
, same_at_end
, 0);
3643 /* Scan this bufferful from the end, comparing with
3644 the Emacs buffer. */
3647 /* Compare with same_at_start to avoid counting some buffer text
3648 as matching both at the file's beginning and at the end. */
3649 while (bufpos
> 0 && same_at_end
> same_at_start
3650 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3651 same_at_end
--, bufpos
--;
3653 /* Don't try to reuse the same piece of text twice. */
3654 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3656 same_at_end
+= overlap
;
3658 /* If display currently starts at beginning of line,
3659 keep it that way. */
3660 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3661 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3663 /* Replace the chars that we need to replace,
3664 and update INSERTED to equal the number of bytes
3665 we are taking from the file. */
3666 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3667 del_range_byte (same_at_start
, same_at_end
, 0);
3668 SET_PT_BOTH (GPT
, GPT_BYTE
);
3670 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3673 free (conversion_buffer
);
3682 register Lisp_Object temp
;
3684 total
= XINT (end
) - XINT (beg
);
3686 /* Make sure point-max won't overflow after this insertion. */
3687 XSETINT (temp
, total
);
3688 if (total
!= XINT (temp
))
3689 error ("Maximum buffer size exceeded");
3692 /* For a special file, all we can do is guess. */
3693 total
= READ_BUF_SIZE
;
3695 if (NILP (visit
) && total
> 0)
3696 prepare_to_modify_buffer (PT
, PT
, NULL
);
3699 if (GAP_SIZE
< total
)
3700 make_gap (total
- GAP_SIZE
);
3702 if (XINT (beg
) != 0 || !NILP (replace
))
3704 if (lseek (fd
, XINT (beg
), 0) < 0)
3705 report_file_error ("Setting file position",
3706 Fcons (orig_filename
, Qnil
));
3709 /* In the following loop, HOW_MUCH contains the total bytes read so
3710 far for a regular file, and not changed for a special file. But,
3711 before exiting the loop, it is set to a negative value if I/O
3714 /* Total bytes inserted. */
3716 /* Here, we don't do code conversion in the loop. It is done by
3717 code_convert_region after all data are read into the buffer. */
3718 while (how_much
< total
)
3720 /* try is reserved in some compilers (Microsoft C) */
3721 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3724 /* For a special file, GAP_SIZE should be checked every time. */
3725 if (not_regular
&& GAP_SIZE
< trytry
)
3726 make_gap (total
- GAP_SIZE
);
3728 /* Allow quitting out of the actual I/O. */
3731 this = read (fd
, BYTE_POS_ADDR (PT
+ inserted
- 1) + 1, trytry
);
3748 /* For a regular file, where TOTAL is the real size,
3749 count HOW_MUCH to compare with it.
3750 For a special file, where TOTAL is just a buffer size,
3751 so don't bother counting in HOW_MUCH.
3752 (INSERTED is where we count the number of characters inserted.) */
3759 /* Put an anchor to ensure multi-byte form ends at gap. */
3764 /* Discard the unwind protect for closing the file. */
3768 error ("IO error reading %s: %s",
3769 XSTRING (orig_filename
)->data
, strerror (errno
));
3773 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3774 inserted
= code_convert_region (PT
, PT
+ inserted
, &coding
, 0, 0);
3777 /* Use the conversion type to determine buffer-file-type
3778 (find-buffer-file-type is now used to help determine the
3780 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3781 && coding
.eol_type
!= CODING_EOL_LF
)
3782 current_buffer
->buffer_file_type
= Qnil
;
3784 current_buffer
->buffer_file_type
= Qt
;
3787 record_insert (PT
, inserted
);
3789 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3790 offset_intervals (current_buffer
, PT
, inserted
);
3793 if (! NILP (coding
.post_read_conversion
))
3797 val
= call1 (coding
.post_read_conversion
, make_number (inserted
));
3800 CHECK_NUMBER (val
, 0);
3801 inserted
= XFASTINT (val
);
3806 set_coding_system
= 1;
3813 if (!EQ (current_buffer
->undo_list
, Qt
))
3814 current_buffer
->undo_list
= Qnil
;
3816 stat (XSTRING (filename
)->data
, &st
);
3821 current_buffer
->modtime
= st
.st_mtime
;
3822 current_buffer
->filename
= orig_filename
;
3825 SAVE_MODIFF
= MODIFF
;
3826 current_buffer
->auto_save_modified
= MODIFF
;
3827 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3828 #ifdef CLASH_DETECTION
3831 if (!NILP (current_buffer
->file_truename
))
3832 unlock_file (current_buffer
->file_truename
);
3833 unlock_file (filename
);
3835 #endif /* CLASH_DETECTION */
3837 Fsignal (Qfile_error
,
3838 Fcons (build_string ("not a regular file"),
3839 Fcons (orig_filename
, Qnil
)));
3841 /* If visiting nonexistent file, return nil. */
3842 if (current_buffer
->modtime
== -1)
3843 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3846 /* Decode file format */
3849 insval
= call3 (Qformat_decode
,
3850 Qnil
, make_number (inserted
), visit
);
3851 CHECK_NUMBER (insval
, 0);
3852 inserted
= XFASTINT (insval
);
3855 /* Call after-change hooks for the inserted text, aside from the case
3856 of normal visiting (not with REPLACE), which is done in a new buffer
3857 "before" the buffer is changed. */
3858 if (inserted
> 0 && total
> 0
3859 && (NILP (visit
) || !NILP (replace
)))
3860 signal_after_change (PT
, 0, inserted
);
3862 if (set_coding_system
)
3863 Vlast_coding_system_used
= coding
.symbol
;
3867 p
= Vafter_insert_file_functions
;
3870 insval
= call1 (Fcar (p
), make_number (inserted
));
3873 CHECK_NUMBER (insval
, 0);
3874 inserted
= XFASTINT (insval
);
3881 /* ??? Retval needs to be dealt with in all cases consistently. */
3883 val
= Fcons (orig_filename
,
3884 Fcons (make_number (inserted
),
3887 RETURN_UNGCPRO (unbind_to (count
, val
));
3890 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
3893 /* If build_annotations switched buffers, switch back to BUF.
3894 Kill the temporary buffer that was selected in the meantime.
3896 Since this kill only the last temporary buffer, some buffers remain
3897 not killed if build_annotations switched buffers more than once.
3901 build_annotations_unwind (buf
)
3906 if (XBUFFER (buf
) == current_buffer
)
3908 tembuf
= Fcurrent_buffer ();
3910 Fkill_buffer (tembuf
);
3914 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3915 "r\nFWrite region to file: ",
3916 "Write current region into specified file.\n\
3917 When called from a program, takes three arguments:\n\
3918 START, END and FILENAME. START and END are buffer positions.\n\
3919 Optional fourth argument APPEND if non-nil means\n\
3920 append to existing file contents (if any).\n\
3921 Optional fifth argument VISIT if t means\n\
3922 set the last-save-file-modtime of buffer to this file's modtime\n\
3923 and mark buffer not modified.\n\
3924 If VISIT is a string, it is a second file name;\n\
3925 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3926 VISIT is also the file name to lock and unlock for clash detection.\n\
3927 If VISIT is neither t nor nil nor a string,\n\
3928 that means do not print the \"Wrote file\" message.\n\
3929 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3930 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3931 Kludgy feature: if START is a string, then that string is written\n\
3932 to the file, instead of any buffer contents, and END is ignored.")
3933 (start
, end
, filename
, append
, visit
, lockname
)
3934 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3942 int count
= specpdl_ptr
- specpdl
;
3945 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3947 Lisp_Object handler
;
3948 Lisp_Object visit_file
;
3949 Lisp_Object annotations
;
3950 Lisp_Object encoded_filename
;
3951 int visiting
, quietly
;
3952 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3953 struct buffer
*given_buffer
;
3955 int buffer_file_type
= O_BINARY
;
3957 struct coding_system coding
;
3959 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3960 error ("Cannot do file visiting in an indirect buffer");
3962 if (!NILP (start
) && !STRINGP (start
))
3963 validate_region (&start
, &end
);
3965 GCPRO4 (start
, filename
, visit
, lockname
);
3967 /* Decide the coding-system to encode the data with. */
3973 else if (!NILP (Vcoding_system_for_write
))
3974 val
= Vcoding_system_for_write
;
3975 else if (NILP (current_buffer
->enable_multibyte_characters
))
3977 /* If the variable `buffer-file-coding-system' is set locally,
3978 it means that the file was read with some kind of code
3979 conversion or the varialbe is explicitely set by users. We
3980 had better write it out with the same coding system even if
3981 `enable-multibyte-characters' is nil.
3983 If it is not set locally, we anyway have to convert EOL
3984 format if the default value of `buffer-file-coding-system'
3985 tells that it is not Unix-like (LF only) format. */
3986 val
= current_buffer
->buffer_file_coding_system
;
3987 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3989 struct coding_system coding_temp
;
3991 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3992 if (coding_temp
.eol_type
== CODING_EOL_CRLF
3993 || coding_temp
.eol_type
== CODING_EOL_CR
)
3995 setup_coding_system (Qraw_text
, &coding
);
3996 coding
.eol_type
= coding_temp
.eol_type
;
3997 goto done_setup_coding
;
4004 Lisp_Object args
[7], coding_systems
;
4006 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4007 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4009 coding_systems
= Ffind_operation_coding_system (7, args
);
4010 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4011 ? XCONS (coding_systems
)->cdr
4012 : current_buffer
->buffer_file_coding_system
);
4013 /* Confirm that VAL can surely encode the current region. */
4014 if (Ffboundp (Vselect_safe_coding_system_function
))
4015 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4017 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4020 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4021 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4024 Vlast_coding_system_used
= coding
.symbol
;
4026 filename
= Fexpand_file_name (filename
, Qnil
);
4027 if (STRINGP (visit
))
4028 visit_file
= Fexpand_file_name (visit
, Qnil
);
4030 visit_file
= filename
;
4033 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4034 quietly
= !NILP (visit
);
4038 if (NILP (lockname
))
4039 lockname
= visit_file
;
4041 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4043 /* If the file name has special constructs in it,
4044 call the corresponding file handler. */
4045 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4046 /* If FILENAME has no handler, see if VISIT has one. */
4047 if (NILP (handler
) && STRINGP (visit
))
4048 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4050 if (!NILP (handler
))
4053 val
= call6 (handler
, Qwrite_region
, start
, end
,
4054 filename
, append
, visit
);
4058 SAVE_MODIFF
= MODIFF
;
4059 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4060 current_buffer
->filename
= visit_file
;
4066 /* Special kludge to simplify auto-saving. */
4069 XSETFASTINT (start
, BEG
);
4070 XSETFASTINT (end
, Z
);
4073 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4074 count1
= specpdl_ptr
- specpdl
;
4076 given_buffer
= current_buffer
;
4077 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4078 if (current_buffer
!= given_buffer
)
4080 XSETFASTINT (start
, BEGV
);
4081 XSETFASTINT (end
, ZV
);
4084 #ifdef CLASH_DETECTION
4087 #if 0 /* This causes trouble for GNUS. */
4088 /* If we've locked this file for some other buffer,
4089 query before proceeding. */
4090 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4091 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4094 lock_file (lockname
);
4096 #endif /* CLASH_DETECTION */
4098 encoded_filename
= ENCODE_FILE (filename
);
4100 fn
= XSTRING (encoded_filename
)->data
;
4104 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4105 #else /* not DOS_NT */
4106 desc
= open (fn
, O_WRONLY
);
4107 #endif /* not DOS_NT */
4109 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4111 if (auto_saving
) /* Overwrite any previous version of autosave file */
4113 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4114 desc
= open (fn
, O_RDWR
);
4116 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4117 ? XSTRING (current_buffer
->filename
)->data
: 0,
4120 else /* Write to temporary name and rename if no errors */
4122 Lisp_Object temp_name
;
4123 temp_name
= Ffile_name_directory (filename
);
4125 if (!NILP (temp_name
))
4127 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4128 build_string ("$$SAVE$$")));
4129 fname
= XSTRING (filename
)->data
;
4130 fn
= XSTRING (temp_name
)->data
;
4131 desc
= creat_copy_attrs (fname
, fn
);
4134 /* If we can't open the temporary file, try creating a new
4135 version of the original file. VMS "creat" creates a
4136 new version rather than truncating an existing file. */
4139 desc
= creat (fn
, 0666);
4140 #if 0 /* This can clobber an existing file and fail to replace it,
4141 if the user runs out of space. */
4144 /* We can't make a new version;
4145 try to truncate and rewrite existing version if any. */
4147 desc
= open (fn
, O_RDWR
);
4153 desc
= creat (fn
, 0666);
4158 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4159 S_IREAD
| S_IWRITE
);
4160 #else /* not DOS_NT */
4161 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4162 #endif /* not DOS_NT */
4163 #endif /* not VMS */
4169 #ifdef CLASH_DETECTION
4171 if (!auto_saving
) unlock_file (lockname
);
4173 #endif /* CLASH_DETECTION */
4174 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4177 record_unwind_protect (close_file_unwind
, make_number (desc
));
4180 if (lseek (desc
, 0, 2) < 0)
4182 #ifdef CLASH_DETECTION
4183 if (!auto_saving
) unlock_file (lockname
);
4184 #endif /* CLASH_DETECTION */
4185 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4190 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4191 * if we do writes that don't end with a carriage return. Furthermore
4192 * it cannot handle writes of more then 16K. The modified
4193 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4194 * this EXCEPT for the last record (iff it doesn't end with a carriage
4195 * return). This implies that if your buffer doesn't end with a carriage
4196 * return, you get one free... tough. However it also means that if
4197 * we make two calls to sys_write (a la the following code) you can
4198 * get one at the gap as well. The easiest way to fix this (honest)
4199 * is to move the gap to the next newline (or the end of the buffer).
4204 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4205 move_gap (find_next_newline (GPT
, 1));
4207 /* Whether VMS or not, we must move the gap to the next of newline
4208 when we must put designation sequences at beginning of line. */
4209 if (INTEGERP (start
)
4210 && coding
.type
== coding_type_iso2022
4211 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4212 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4214 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4215 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4216 move_gap_both (PT
, PT_BYTE
);
4217 SET_PT_BOTH (opoint
, opoint_byte
);
4224 if (STRINGP (start
))
4226 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4227 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4230 else if (XINT (start
) != XINT (end
))
4232 register int end1
= CHAR_TO_BYTE (XINT (end
));
4234 tem
= CHAR_TO_BYTE (XINT (start
));
4236 if (XINT (start
) < GPT
)
4238 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4239 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4244 if (XINT (end
) > GPT
&& !failure
)
4246 tem
= max (tem
, GPT_BYTE
);
4247 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4248 tem
, &annotations
, &coding
);
4254 /* If file was empty, still need to write the annotations */
4255 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4256 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4260 if (CODING_REQUIRE_FLUSHING (&coding
)
4261 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4264 /* We have to flush out a data. */
4265 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4266 failure
= 0 > e_write (desc
, "", 0, &coding
);
4273 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4274 Disk full in NFS may be reported here. */
4275 /* mib says that closing the file will try to write as fast as NFS can do
4276 it, and that means the fsync here is not crucial for autosave files. */
4277 if (!auto_saving
&& fsync (desc
) < 0)
4279 /* If fsync fails with EINTR, don't treat that as serious. */
4281 failure
= 1, save_errno
= errno
;
4285 /* Spurious "file has changed on disk" warnings have been
4286 observed on Suns as well.
4287 It seems that `close' can change the modtime, under nfs.
4289 (This has supposedly been fixed in Sunos 4,
4290 but who knows about all the other machines with NFS?) */
4293 /* On VMS and APOLLO, must do the stat after the close
4294 since closing changes the modtime. */
4297 /* Recall that #if defined does not work on VMS. */
4304 /* NFS can report a write failure now. */
4305 if (close (desc
) < 0)
4306 failure
= 1, save_errno
= errno
;
4309 /* If we wrote to a temporary name and had no errors, rename to real name. */
4313 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4321 /* Discard the unwind protect for close_file_unwind. */
4322 specpdl_ptr
= specpdl
+ count1
;
4323 /* Restore the original current buffer. */
4324 visit_file
= unbind_to (count
, visit_file
);
4326 #ifdef CLASH_DETECTION
4328 unlock_file (lockname
);
4329 #endif /* CLASH_DETECTION */
4331 /* Do this before reporting IO error
4332 to avoid a "file has changed on disk" warning on
4333 next attempt to save. */
4335 current_buffer
->modtime
= st
.st_mtime
;
4338 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4339 strerror (save_errno
));
4343 SAVE_MODIFF
= MODIFF
;
4344 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4345 current_buffer
->filename
= visit_file
;
4346 update_mode_lines
++;
4352 message_with_string ("Wrote %s", visit_file
, 1);
4357 Lisp_Object
merge ();
4359 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4360 "Return t if (car A) is numerically less than (car B).")
4364 return Flss (Fcar (a
), Fcar (b
));
4367 /* Build the complete list of annotations appropriate for writing out
4368 the text between START and END, by calling all the functions in
4369 write-region-annotate-functions and merging the lists they return.
4370 If one of these functions switches to a different buffer, we assume
4371 that buffer contains altered text. Therefore, the caller must
4372 make sure to restore the current buffer in all cases,
4373 as save-excursion would do. */
4376 build_annotations (start
, end
, pre_write_conversion
)
4377 Lisp_Object start
, end
, pre_write_conversion
;
4379 Lisp_Object annotations
;
4381 struct gcpro gcpro1
, gcpro2
;
4382 Lisp_Object original_buffer
;
4384 XSETBUFFER (original_buffer
, current_buffer
);
4387 p
= Vwrite_region_annotate_functions
;
4388 GCPRO2 (annotations
, p
);
4391 struct buffer
*given_buffer
= current_buffer
;
4392 Vwrite_region_annotations_so_far
= annotations
;
4393 res
= call2 (Fcar (p
), start
, end
);
4394 /* If the function makes a different buffer current,
4395 assume that means this buffer contains altered text to be output.
4396 Reset START and END from the buffer bounds
4397 and discard all previous annotations because they should have
4398 been dealt with by this function. */
4399 if (current_buffer
!= given_buffer
)
4401 XSETFASTINT (start
, BEGV
);
4402 XSETFASTINT (end
, ZV
);
4405 Flength (res
); /* Check basic validity of return value */
4406 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4410 /* Now do the same for annotation functions implied by the file-format */
4411 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4412 p
= Vauto_save_file_format
;
4414 p
= current_buffer
->file_format
;
4417 struct buffer
*given_buffer
= current_buffer
;
4418 Vwrite_region_annotations_so_far
= annotations
;
4419 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4421 if (current_buffer
!= given_buffer
)
4423 XSETFASTINT (start
, BEGV
);
4424 XSETFASTINT (end
, ZV
);
4428 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4432 /* At last, do the same for the function PRE_WRITE_CONVERSION
4433 implied by the current coding-system. */
4434 if (!NILP (pre_write_conversion
))
4436 struct buffer
*given_buffer
= current_buffer
;
4437 Vwrite_region_annotations_so_far
= annotations
;
4438 res
= call2 (pre_write_conversion
, start
, end
);
4440 annotations
= (current_buffer
!= given_buffer
4442 : merge (annotations
, res
, Qcar_less_than_car
));
4449 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4450 assuming they start at byte position BYTEPOS in the buffer.
4451 Intersperse with them the annotations from *ANNOT
4452 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4453 each at its appropriate position.
4455 We modify *ANNOT by discarding elements as we use them up.
4457 The return value is negative in case of system call failure. */
4460 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4462 register char *addr
;
4463 register int nbytes
;
4466 struct coding_system
*coding
;
4470 int lastpos
= bytepos
+ nbytes
;
4472 while (NILP (*annot
) || CONSP (*annot
))
4474 tem
= Fcar_safe (Fcar (*annot
));
4477 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4479 /* If there are no more annotations in this range,
4480 output the rest of the range all at once. */
4481 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4482 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4484 /* Output buffer text up to the next annotation's position. */
4485 if (nextpos
> bytepos
)
4487 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4489 addr
+= nextpos
- bytepos
;
4492 /* Output the annotation. */
4493 tem
= Fcdr (Fcar (*annot
));
4496 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4500 *annot
= Fcdr (*annot
);
4504 #ifndef WRITE_BUF_SIZE
4505 #define WRITE_BUF_SIZE (16 * 1024)
4508 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4509 encoding them with coding system CODING. */
4512 e_write (desc
, addr
, nbytes
, coding
)
4514 register char *addr
;
4515 register int nbytes
;
4516 struct coding_system
*coding
;
4518 char buf
[WRITE_BUF_SIZE
];
4520 /* We used to have a code for handling selective display here. But,
4521 now it is handled within encode_coding. */
4524 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4525 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4526 if (coding
->produced
> 0)
4528 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4529 if (coding
->produced
) return -1;
4537 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4538 Sverify_visited_file_modtime
, 1, 1, 0,
4539 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4540 This means that the file has not been changed since it was visited or saved.")
4546 Lisp_Object handler
;
4547 Lisp_Object filename
;
4549 CHECK_BUFFER (buf
, 0);
4552 if (!STRINGP (b
->filename
)) return Qt
;
4553 if (b
->modtime
== 0) return Qt
;
4555 /* If the file name has special constructs in it,
4556 call the corresponding file handler. */
4557 handler
= Ffind_file_name_handler (b
->filename
,
4558 Qverify_visited_file_modtime
);
4559 if (!NILP (handler
))
4560 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4562 filename
= ENCODE_FILE (b
->filename
);
4564 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4566 /* If the file doesn't exist now and didn't exist before,
4567 we say that it isn't modified, provided the error is a tame one. */
4568 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4573 if (st
.st_mtime
== b
->modtime
4574 /* If both are positive, accept them if they are off by one second. */
4575 || (st
.st_mtime
> 0 && b
->modtime
> 0
4576 && (st
.st_mtime
== b
->modtime
+ 1
4577 || st
.st_mtime
== b
->modtime
- 1)))
4582 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4583 Sclear_visited_file_modtime
, 0, 0, 0,
4584 "Clear out records of last mod time of visited file.\n\
4585 Next attempt to save will certainly not complain of a discrepancy.")
4588 current_buffer
->modtime
= 0;
4592 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4593 Svisited_file_modtime
, 0, 0, 0,
4594 "Return the current buffer's recorded visited file modification time.\n\
4595 The value is a list of the form (HIGH . LOW), like the time values\n\
4596 that `file-attributes' returns.")
4599 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4602 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4603 Sset_visited_file_modtime
, 0, 1, 0,
4604 "Update buffer's recorded modification time from the visited file's time.\n\
4605 Useful if the buffer was not read from the file normally\n\
4606 or if the file itself has been changed for some known benign reason.\n\
4607 An argument specifies the modification time value to use\n\
4608 \(instead of that of the visited file), in the form of a list\n\
4609 \(HIGH . LOW) or (HIGH LOW).")
4611 Lisp_Object time_list
;
4613 if (!NILP (time_list
))
4614 current_buffer
->modtime
= cons_to_long (time_list
);
4617 register Lisp_Object filename
;
4619 Lisp_Object handler
;
4621 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4623 /* If the file name has special constructs in it,
4624 call the corresponding file handler. */
4625 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4626 if (!NILP (handler
))
4627 /* The handler can find the file name the same way we did. */
4628 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4630 filename
= ENCODE_FILE (filename
);
4632 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4633 current_buffer
->modtime
= st
.st_mtime
;
4643 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4644 Fsleep_for (make_number (1), Qnil
);
4645 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4646 Fsleep_for (make_number (1), Qnil
);
4647 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4648 Fsleep_for (make_number (1), Qnil
);
4658 /* Get visited file's mode to become the auto save file's mode. */
4659 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4660 /* But make sure we can overwrite it later! */
4661 auto_save_mode_bits
= st
.st_mode
| 0600;
4663 auto_save_mode_bits
= 0666;
4666 Fwrite_region (Qnil
, Qnil
,
4667 current_buffer
->auto_save_file_name
,
4668 Qnil
, Qlambda
, Qnil
);
4672 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4677 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4678 | XFASTINT (XCONS (stream
)->cdr
)));
4683 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4686 minibuffer_auto_raise
= XINT (value
);
4690 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4691 "Auto-save all buffers that need it.\n\
4692 This is all buffers that have auto-saving enabled\n\
4693 and are changed since last auto-saved.\n\
4694 Auto-saving writes the buffer into a file\n\
4695 so that your editing is not lost if the system crashes.\n\
4696 This file is not the file you visited; that changes only when you save.\n\
4697 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4698 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4699 A non-nil CURRENT-ONLY argument means save only current buffer.")
4700 (no_message
, current_only
)
4701 Lisp_Object no_message
, current_only
;
4703 struct buffer
*old
= current_buffer
, *b
;
4704 Lisp_Object tail
, buf
;
4706 char *omessage
= echo_area_glyphs
;
4707 int omessage_length
= echo_area_glyphs_length
;
4708 int oldmultibyte
= message_enable_multibyte
;
4709 int do_handled_files
;
4712 Lisp_Object lispstream
;
4713 int count
= specpdl_ptr
- specpdl
;
4715 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4717 /* Ordinarily don't quit within this function,
4718 but don't make it impossible to quit (in case we get hung in I/O). */
4722 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4723 point to non-strings reached from Vbuffer_alist. */
4728 if (!NILP (Vrun_hooks
))
4729 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4731 if (STRINGP (Vauto_save_list_file_name
))
4733 Lisp_Object listfile
;
4734 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4735 stream
= fopen (XSTRING (listfile
)->data
, "w");
4738 /* Arrange to close that file whether or not we get an error.
4739 Also reset auto_saving to 0. */
4740 lispstream
= Fcons (Qnil
, Qnil
);
4741 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4742 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4753 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4754 record_unwind_protect (do_auto_save_unwind_1
,
4755 make_number (minibuffer_auto_raise
));
4756 minibuffer_auto_raise
= 0;
4759 /* First, save all files which don't have handlers. If Emacs is
4760 crashing, the handlers may tweak what is causing Emacs to crash
4761 in the first place, and it would be a shame if Emacs failed to
4762 autosave perfectly ordinary files because it couldn't handle some
4764 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4765 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4767 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4770 /* Record all the buffers that have auto save mode
4771 in the special file that lists them. For each of these buffers,
4772 Record visited name (if any) and auto save name. */
4773 if (STRINGP (b
->auto_save_file_name
)
4774 && stream
!= NULL
&& do_handled_files
== 0)
4776 if (!NILP (b
->filename
))
4778 fwrite (XSTRING (b
->filename
)->data
, 1,
4779 XSTRING (b
->filename
)->size
, stream
);
4781 putc ('\n', stream
);
4782 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4783 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4784 putc ('\n', stream
);
4787 if (!NILP (current_only
)
4788 && b
!= current_buffer
)
4791 /* Don't auto-save indirect buffers.
4792 The base buffer takes care of it. */
4796 /* Check for auto save enabled
4797 and file changed since last auto save
4798 and file changed since last real save. */
4799 if (STRINGP (b
->auto_save_file_name
)
4800 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4801 && b
->auto_save_modified
< BUF_MODIFF (b
)
4802 /* -1 means we've turned off autosaving for a while--see below. */
4803 && XINT (b
->save_length
) >= 0
4804 && (do_handled_files
4805 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4808 EMACS_TIME before_time
, after_time
;
4810 EMACS_GET_TIME (before_time
);
4812 /* If we had a failure, don't try again for 20 minutes. */
4813 if (b
->auto_save_failure_time
>= 0
4814 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4817 if ((XFASTINT (b
->save_length
) * 10
4818 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4819 /* A short file is likely to change a large fraction;
4820 spare the user annoying messages. */
4821 && XFASTINT (b
->save_length
) > 5000
4822 /* These messages are frequent and annoying for `*mail*'. */
4823 && !EQ (b
->filename
, Qnil
)
4824 && NILP (no_message
))
4826 /* It has shrunk too much; turn off auto-saving here. */
4827 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4828 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
4830 minibuffer_auto_raise
= 0;
4831 /* Turn off auto-saving until there's a real save,
4832 and prevent any more warnings. */
4833 XSETINT (b
->save_length
, -1);
4834 Fsleep_for (make_number (1), Qnil
);
4837 set_buffer_internal (b
);
4838 if (!auto_saved
&& NILP (no_message
))
4839 message1 ("Auto-saving...");
4840 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4842 b
->auto_save_modified
= BUF_MODIFF (b
);
4843 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4844 set_buffer_internal (old
);
4846 EMACS_GET_TIME (after_time
);
4848 /* If auto-save took more than 60 seconds,
4849 assume it was an NFS failure that got a timeout. */
4850 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4851 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4855 /* Prevent another auto save till enough input events come in. */
4856 record_auto_save ();
4858 if (auto_saved
&& NILP (no_message
))
4862 sit_for (1, 0, 0, 0, 0);
4863 message2 (omessage
, omessage_length
, oldmultibyte
);
4866 message1 ("Auto-saving...done");
4871 unbind_to (count
, Qnil
);
4875 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4876 Sset_buffer_auto_saved
, 0, 0, 0,
4877 "Mark current buffer as auto-saved with its current text.\n\
4878 No auto-save file will be written until the buffer changes again.")
4881 current_buffer
->auto_save_modified
= MODIFF
;
4882 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4883 current_buffer
->auto_save_failure_time
= -1;
4887 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4888 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4889 "Clear any record of a recent auto-save failure in the current buffer.")
4892 current_buffer
->auto_save_failure_time
= -1;
4896 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4898 "Return t if buffer has been auto-saved since last read in or saved.")
4901 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4904 /* Reading and completing file names */
4905 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4907 /* In the string VAL, change each $ to $$ and return the result. */
4910 double_dollars (val
)
4913 register unsigned char *old
, *new;
4917 osize
= XSTRING (val
)->size_byte
;
4919 /* Count the number of $ characters. */
4920 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4921 if (*old
++ == '$') count
++;
4924 old
= XSTRING (val
)->data
;
4925 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
4927 new = XSTRING (val
)->data
;
4928 for (n
= osize
; n
> 0; n
--)
4941 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4943 "Internal subroutine for read-file-name. Do not call this.")
4944 (string
, dir
, action
)
4945 Lisp_Object string
, dir
, action
;
4946 /* action is nil for complete, t for return list of completions,
4947 lambda for verify final value */
4949 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4951 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4953 CHECK_STRING (string
, 0);
4960 /* No need to protect ACTION--we only compare it with t and nil. */
4961 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4963 if (XSTRING (string
)->size
== 0)
4965 if (EQ (action
, Qlambda
))
4973 orig_string
= string
;
4974 string
= Fsubstitute_in_file_name (string
);
4975 changed
= NILP (Fstring_equal (string
, orig_string
));
4976 name
= Ffile_name_nondirectory (string
);
4977 val
= Ffile_name_directory (string
);
4979 realdir
= Fexpand_file_name (val
, realdir
);
4984 specdir
= Ffile_name_directory (string
);
4985 val
= Ffile_name_completion (name
, realdir
);
4990 return double_dollars (string
);
4994 if (!NILP (specdir
))
4995 val
= concat2 (specdir
, val
);
4997 return double_dollars (val
);
5000 #endif /* not VMS */
5004 if (EQ (action
, Qt
))
5005 return Ffile_name_all_completions (name
, realdir
);
5006 /* Only other case actually used is ACTION = lambda */
5008 /* Supposedly this helps commands such as `cd' that read directory names,
5009 but can someone explain how it helps them? -- RMS */
5010 if (XSTRING (name
)->size
== 0)
5013 return Ffile_exists_p (string
);
5016 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5017 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5018 Value is not expanded---you must call `expand-file-name' yourself.\n\
5019 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5020 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5021 except that if INITIAL is specified, that combined with DIR is used.)\n\
5022 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5023 Non-nil and non-t means also require confirmation after completion.\n\
5024 Fifth arg INITIAL specifies text to start with.\n\
5025 DIR defaults to current buffer's directory default.")
5026 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5027 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5029 Lisp_Object val
, insdef
, insdef1
, tem
;
5030 struct gcpro gcpro1
, gcpro2
;
5031 register char *homedir
;
5035 dir
= current_buffer
->directory
;
5036 if (NILP (default_filename
))
5038 if (! NILP (initial
))
5039 default_filename
= Fexpand_file_name (initial
, dir
);
5041 default_filename
= current_buffer
->filename
;
5044 /* If dir starts with user's homedir, change that to ~. */
5045 homedir
= (char *) egetenv ("HOME");
5047 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5048 CORRECT_DIR_SEPS (homedir
);
5052 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5053 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5055 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5056 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5057 XSTRING (dir
)->data
[0] = '~';
5060 if (insert_default_directory
&& STRINGP (dir
))
5063 if (!NILP (initial
))
5065 Lisp_Object args
[2], pos
;
5069 insdef
= Fconcat (2, args
);
5070 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5071 insdef1
= Fcons (double_dollars (insdef
), pos
);
5074 insdef1
= double_dollars (insdef
);
5076 else if (STRINGP (initial
))
5079 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5082 insdef
= Qnil
, insdef1
= Qnil
;
5085 count
= specpdl_ptr
- specpdl
;
5086 specbind (intern ("completion-ignore-case"), Qt
);
5089 GCPRO2 (insdef
, default_filename
);
5090 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5091 dir
, mustmatch
, insdef1
,
5092 Qfile_name_history
, default_filename
, Qnil
);
5093 /* If Fcompleting_read returned the default string itself
5094 (rather than a new string with the same contents),
5095 it has to mean that the user typed RET with the minibuffer empty.
5096 In that case, we really want to return ""
5097 so that commands such as set-visited-file-name can distinguish. */
5098 if (EQ (val
, default_filename
))
5099 val
= build_string ("");
5102 unbind_to (count
, Qnil
);
5107 error ("No file name specified");
5108 tem
= Fstring_equal (val
, insdef
);
5109 if (!NILP (tem
) && !NILP (default_filename
))
5110 return default_filename
;
5111 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5113 if (!NILP (default_filename
))
5114 return default_filename
;
5116 error ("No default file name");
5118 return Fsubstitute_in_file_name (val
);
5121 #if 0 /* Old version */
5122 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5123 /* Don't confuse make-docfile by having two doc strings for this function.
5124 make-docfile does not pay attention to #if, for good reason! */
5126 (prompt
, dir
, defalt
, mustmatch
, initial
)
5127 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
5129 Lisp_Object val
, insdef
, tem
;
5130 struct gcpro gcpro1
, gcpro2
;
5131 register char *homedir
;
5135 dir
= current_buffer
->directory
;
5137 defalt
= current_buffer
->filename
;
5139 /* If dir starts with user's homedir, change that to ~. */
5140 homedir
= (char *) egetenv ("HOME");
5143 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5144 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
5146 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5147 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5148 XSTRING (dir
)->data
[0] = '~';
5151 if (!NILP (initial
))
5153 else if (insert_default_directory
)
5156 insdef
= build_string ("");
5159 count
= specpdl_ptr
- specpdl
;
5160 specbind (intern ("completion-ignore-case"), Qt
);
5163 GCPRO2 (insdef
, defalt
);
5164 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5166 insert_default_directory
? insdef
: Qnil
,
5167 Qfile_name_history
, Qnil
, Qnil
);
5170 unbind_to (count
, Qnil
);
5175 error ("No file name specified");
5176 tem
= Fstring_equal (val
, insdef
);
5177 if (!NILP (tem
) && !NILP (defalt
))
5179 return Fsubstitute_in_file_name (val
);
5181 #endif /* Old version */
5185 Qexpand_file_name
= intern ("expand-file-name");
5186 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5187 Qdirectory_file_name
= intern ("directory-file-name");
5188 Qfile_name_directory
= intern ("file-name-directory");
5189 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5190 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5191 Qfile_name_as_directory
= intern ("file-name-as-directory");
5192 Qcopy_file
= intern ("copy-file");
5193 Qmake_directory_internal
= intern ("make-directory-internal");
5194 Qdelete_directory
= intern ("delete-directory");
5195 Qdelete_file
= intern ("delete-file");
5196 Qrename_file
= intern ("rename-file");
5197 Qadd_name_to_file
= intern ("add-name-to-file");
5198 Qmake_symbolic_link
= intern ("make-symbolic-link");
5199 Qfile_exists_p
= intern ("file-exists-p");
5200 Qfile_executable_p
= intern ("file-executable-p");
5201 Qfile_readable_p
= intern ("file-readable-p");
5202 Qfile_writable_p
= intern ("file-writable-p");
5203 Qfile_symlink_p
= intern ("file-symlink-p");
5204 Qaccess_file
= intern ("access-file");
5205 Qfile_directory_p
= intern ("file-directory-p");
5206 Qfile_regular_p
= intern ("file-regular-p");
5207 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5208 Qfile_modes
= intern ("file-modes");
5209 Qset_file_modes
= intern ("set-file-modes");
5210 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5211 Qinsert_file_contents
= intern ("insert-file-contents");
5212 Qwrite_region
= intern ("write-region");
5213 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5214 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5216 staticpro (&Qexpand_file_name
);
5217 staticpro (&Qsubstitute_in_file_name
);
5218 staticpro (&Qdirectory_file_name
);
5219 staticpro (&Qfile_name_directory
);
5220 staticpro (&Qfile_name_nondirectory
);
5221 staticpro (&Qunhandled_file_name_directory
);
5222 staticpro (&Qfile_name_as_directory
);
5223 staticpro (&Qcopy_file
);
5224 staticpro (&Qmake_directory_internal
);
5225 staticpro (&Qdelete_directory
);
5226 staticpro (&Qdelete_file
);
5227 staticpro (&Qrename_file
);
5228 staticpro (&Qadd_name_to_file
);
5229 staticpro (&Qmake_symbolic_link
);
5230 staticpro (&Qfile_exists_p
);
5231 staticpro (&Qfile_executable_p
);
5232 staticpro (&Qfile_readable_p
);
5233 staticpro (&Qfile_writable_p
);
5234 staticpro (&Qaccess_file
);
5235 staticpro (&Qfile_symlink_p
);
5236 staticpro (&Qfile_directory_p
);
5237 staticpro (&Qfile_regular_p
);
5238 staticpro (&Qfile_accessible_directory_p
);
5239 staticpro (&Qfile_modes
);
5240 staticpro (&Qset_file_modes
);
5241 staticpro (&Qfile_newer_than_file_p
);
5242 staticpro (&Qinsert_file_contents
);
5243 staticpro (&Qwrite_region
);
5244 staticpro (&Qverify_visited_file_modtime
);
5245 staticpro (&Qset_visited_file_modtime
);
5247 Qfile_name_history
= intern ("file-name-history");
5248 Fset (Qfile_name_history
, Qnil
);
5249 staticpro (&Qfile_name_history
);
5251 Qfile_error
= intern ("file-error");
5252 staticpro (&Qfile_error
);
5253 Qfile_already_exists
= intern ("file-already-exists");
5254 staticpro (&Qfile_already_exists
);
5255 Qfile_date_error
= intern ("file-date-error");
5256 staticpro (&Qfile_date_error
);
5259 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5260 staticpro (&Qfind_buffer_file_type
);
5263 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5264 "*Coding system for encoding file names.");
5265 Vfile_name_coding_system
= Qnil
;
5267 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5268 "*Format in which to write auto-save files.\n\
5269 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5270 If it is t, which is the default, auto-save files are written in the\n\
5271 same format as a regular save would use.");
5272 Vauto_save_file_format
= Qt
;
5274 Qformat_decode
= intern ("format-decode");
5275 staticpro (&Qformat_decode
);
5276 Qformat_annotate_function
= intern ("format-annotate-function");
5277 staticpro (&Qformat_annotate_function
);
5279 Qcar_less_than_car
= intern ("car-less-than-car");
5280 staticpro (&Qcar_less_than_car
);
5282 Fput (Qfile_error
, Qerror_conditions
,
5283 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5284 Fput (Qfile_error
, Qerror_message
,
5285 build_string ("File error"));
5287 Fput (Qfile_already_exists
, Qerror_conditions
,
5288 Fcons (Qfile_already_exists
,
5289 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5290 Fput (Qfile_already_exists
, Qerror_message
,
5291 build_string ("File already exists"));
5293 Fput (Qfile_date_error
, Qerror_conditions
,
5294 Fcons (Qfile_date_error
,
5295 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5296 Fput (Qfile_date_error
, Qerror_message
,
5297 build_string ("Cannot set file date"));
5299 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5300 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5301 insert_default_directory
= 1;
5303 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5304 "*Non-nil means write new files with record format `stmlf'.\n\
5305 nil means use format `var'. This variable is meaningful only on VMS.");
5306 vms_stmlf_recfm
= 0;
5308 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5309 "Directory separator character for built-in functions that return file names.\n\
5310 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5311 This variable affects the built-in functions only on Windows,\n\
5312 on other platforms, it is initialized so that Lisp code can find out\n\
5313 what the normal separator is.");
5314 XSETFASTINT (Vdirectory_sep_char
, '/');
5316 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5317 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5318 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5321 The first argument given to HANDLER is the name of the I/O primitive\n\
5322 to be handled; the remaining arguments are the arguments that were\n\
5323 passed to that primitive. For example, if you do\n\
5324 (file-exists-p FILENAME)\n\
5325 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5326 (funcall HANDLER 'file-exists-p FILENAME)\n\
5327 The function `find-file-name-handler' checks this list for a handler\n\
5328 for its argument.");
5329 Vfile_name_handler_alist
= Qnil
;
5331 DEFVAR_LISP ("set-auto-coding-function",
5332 &Vset_auto_coding_function
,
5333 "If non-nil, a function to call to decide a coding system of file.\n\
5334 One argument is passed to this function: the string of concatination\n\
5335 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5336 This function should return a coding system to decode the file contents\n\
5337 specified in the heading lines with the format:\n\
5338 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5339 or local variable spec of the tailing lines with `coding:' tag.");
5340 Vset_auto_coding_function
= Qnil
;
5342 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5343 "A list of functions to be called at the end of `insert-file-contents'.\n\
5344 Each is passed one argument, the number of bytes inserted. It should return\n\
5345 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5346 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5347 responsible for calling the after-insert-file-functions if appropriate.");
5348 Vafter_insert_file_functions
= Qnil
;
5350 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5351 "A list of functions to be called at the start of `write-region'.\n\
5352 Each is passed two arguments, START and END as for `write-region'.\n\
5353 These are usually two numbers but not always; see the documentation\n\
5354 for `write-region'. The function should return a list of pairs\n\
5355 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5356 inserted at the specified positions of the file being written (1 means to\n\
5357 insert before the first byte written). The POSITIONs must be sorted into\n\
5358 increasing order. If there are several functions in the list, the several\n\
5359 lists are merged destructively.");
5360 Vwrite_region_annotate_functions
= Qnil
;
5362 DEFVAR_LISP ("write-region-annotations-so-far",
5363 &Vwrite_region_annotations_so_far
,
5364 "When an annotation function is called, this holds the previous annotations.\n\
5365 These are the annotations made by other annotation functions\n\
5366 that were already called. See also `write-region-annotate-functions'.");
5367 Vwrite_region_annotations_so_far
= Qnil
;
5369 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5370 "A list of file name handlers that temporarily should not be used.\n\
5371 This applies only to the operation `inhibit-file-name-operation'.");
5372 Vinhibit_file_name_handlers
= Qnil
;
5374 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5375 "The operation for which `inhibit-file-name-handlers' is applicable.");
5376 Vinhibit_file_name_operation
= Qnil
;
5378 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5379 "File name in which we write a list of all auto save file names.\n\
5380 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5381 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5383 Vauto_save_list_file_name
= Qnil
;
5385 defsubr (&Sfind_file_name_handler
);
5386 defsubr (&Sfile_name_directory
);
5387 defsubr (&Sfile_name_nondirectory
);
5388 defsubr (&Sunhandled_file_name_directory
);
5389 defsubr (&Sfile_name_as_directory
);
5390 defsubr (&Sdirectory_file_name
);
5391 defsubr (&Smake_temp_name
);
5392 defsubr (&Sexpand_file_name
);
5393 defsubr (&Ssubstitute_in_file_name
);
5394 defsubr (&Scopy_file
);
5395 defsubr (&Smake_directory_internal
);
5396 defsubr (&Sdelete_directory
);
5397 defsubr (&Sdelete_file
);
5398 defsubr (&Srename_file
);
5399 defsubr (&Sadd_name_to_file
);
5401 defsubr (&Smake_symbolic_link
);
5402 #endif /* S_IFLNK */
5404 defsubr (&Sdefine_logical_name
);
5407 defsubr (&Ssysnetunam
);
5408 #endif /* HPUX_NET */
5409 defsubr (&Sfile_name_absolute_p
);
5410 defsubr (&Sfile_exists_p
);
5411 defsubr (&Sfile_executable_p
);
5412 defsubr (&Sfile_readable_p
);
5413 defsubr (&Sfile_writable_p
);
5414 defsubr (&Saccess_file
);
5415 defsubr (&Sfile_symlink_p
);
5416 defsubr (&Sfile_directory_p
);
5417 defsubr (&Sfile_accessible_directory_p
);
5418 defsubr (&Sfile_regular_p
);
5419 defsubr (&Sfile_modes
);
5420 defsubr (&Sset_file_modes
);
5421 defsubr (&Sset_default_file_modes
);
5422 defsubr (&Sdefault_file_modes
);
5423 defsubr (&Sfile_newer_than_file_p
);
5424 defsubr (&Sinsert_file_contents
);
5425 defsubr (&Swrite_region
);
5426 defsubr (&Scar_less_than_car
);
5427 defsubr (&Sverify_visited_file_modtime
);
5428 defsubr (&Sclear_visited_file_modtime
);
5429 defsubr (&Svisited_file_modtime
);
5430 defsubr (&Sset_visited_file_modtime
);
5431 defsubr (&Sdo_auto_save
);
5432 defsubr (&Sset_buffer_auto_saved
);
5433 defsubr (&Sclear_buffer_auto_save_failure
);
5434 defsubr (&Srecent_auto_save_p
);
5436 defsubr (&Sread_file_name_internal
);
5437 defsubr (&Sread_file_name
);
5440 defsubr (&Sunix_sync
);