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_byte
;
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
2046 *STATPTR is used to store the stat information if the file exists.
2047 If the file does not exist, STATPTR->st_mode is set to 0.
2048 If STATPTR is null, we don't store into it. */
2051 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
2052 Lisp_Object absname
;
2053 unsigned char *querystring
;
2055 struct stat
*statptr
;
2057 register Lisp_Object tem
;
2058 struct stat statbuf
;
2059 struct gcpro gcpro1
;
2061 /* stat is a good way to tell whether the file exists,
2062 regardless of what access permissions it has. */
2063 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2066 Fsignal (Qfile_already_exists
,
2067 Fcons (build_string ("File already exists"),
2068 Fcons (absname
, Qnil
)));
2070 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2071 XSTRING (absname
)->data
, querystring
));
2074 Fsignal (Qfile_already_exists
,
2075 Fcons (build_string ("File already exists"),
2076 Fcons (absname
, Qnil
)));
2083 statptr
->st_mode
= 0;
2088 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2089 "fCopy file: \nFCopy %s to file: \np\nP",
2090 "Copy FILE to NEWNAME. Both args must be strings.\n\
2091 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2092 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2093 A number as third arg means request confirmation if NEWNAME already exists.\n\
2094 This is what happens in interactive use with M-x.\n\
2095 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2096 last-modified time as the old one. (This works on only some systems.)\n\
2097 A prefix arg makes KEEP-TIME non-nil.")
2098 (file
, newname
, ok_if_already_exists
, keep_date
)
2099 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2102 char buf
[16 * 1024];
2103 struct stat st
, out_st
;
2104 Lisp_Object handler
;
2105 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2106 int count
= specpdl_ptr
- specpdl
;
2107 int input_file_statable_p
;
2108 Lisp_Object encoded_file
, encoded_newname
;
2110 encoded_file
= encoded_newname
= Qnil
;
2111 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2112 CHECK_STRING (file
, 0);
2113 CHECK_STRING (newname
, 1);
2115 file
= Fexpand_file_name (file
, Qnil
);
2116 newname
= Fexpand_file_name (newname
, Qnil
);
2118 /* If the input file name has special constructs in it,
2119 call the corresponding file handler. */
2120 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2121 /* Likewise for output file name. */
2123 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2124 if (!NILP (handler
))
2125 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2126 ok_if_already_exists
, keep_date
));
2128 encoded_file
= ENCODE_FILE (file
);
2129 encoded_newname
= ENCODE_FILE (newname
);
2131 if (NILP (ok_if_already_exists
)
2132 || INTEGERP (ok_if_already_exists
))
2133 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2134 INTEGERP (ok_if_already_exists
), &out_st
);
2135 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2138 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2140 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2142 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2144 /* We can only copy regular files and symbolic links. Other files are not
2146 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2148 #if !defined (MSDOS) || __DJGPP__ > 1
2149 if (out_st
.st_mode
!= 0
2150 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2153 report_file_error ("Input and output files are the same",
2154 Fcons (file
, Fcons (newname
, Qnil
)));
2158 #if defined (S_ISREG) && defined (S_ISLNK)
2159 if (input_file_statable_p
)
2161 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2163 #if defined (EISDIR)
2164 /* Get a better looking error message. */
2167 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2170 #endif /* S_ISREG && S_ISLNK */
2173 /* Create the copy file with the same record format as the input file */
2174 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2177 /* System's default file type was set to binary by _fmode in emacs.c. */
2178 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2179 #else /* not MSDOS */
2180 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2181 #endif /* not MSDOS */
2184 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2186 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2190 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2191 if (write (ofd
, buf
, n
) != n
)
2192 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2195 /* Closing the output clobbers the file times on some systems. */
2196 if (close (ofd
) < 0)
2197 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2199 if (input_file_statable_p
)
2201 if (!NILP (keep_date
))
2203 EMACS_TIME atime
, mtime
;
2204 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2205 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2206 if (set_file_times (XSTRING (encoded_newname
)->data
,
2208 Fsignal (Qfile_date_error
,
2209 Fcons (build_string ("Cannot set file date"),
2210 Fcons (newname
, Qnil
)));
2213 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2215 #if defined (__DJGPP__) && __DJGPP__ > 1
2216 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2217 and if it can't, it tells so. Otherwise, under MSDOS we usually
2218 get only the READ bit, which will make the copied file read-only,
2219 so it's better not to chmod at all. */
2220 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2221 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2222 #endif /* DJGPP version 2 or newer */
2228 /* Discard the unwind protects. */
2229 specpdl_ptr
= specpdl
+ count
;
2235 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2236 Smake_directory_internal
, 1, 1, 0,
2237 "Create a new directory named DIRECTORY.")
2239 Lisp_Object directory
;
2242 Lisp_Object handler
;
2243 Lisp_Object encoded_dir
;
2245 CHECK_STRING (directory
, 0);
2246 directory
= Fexpand_file_name (directory
, Qnil
);
2248 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2249 if (!NILP (handler
))
2250 return call2 (handler
, Qmake_directory_internal
, directory
);
2252 encoded_dir
= ENCODE_FILE (directory
);
2254 dir
= XSTRING (encoded_dir
)->data
;
2257 if (mkdir (dir
) != 0)
2259 if (mkdir (dir
, 0777) != 0)
2261 report_file_error ("Creating directory", Flist (1, &directory
));
2266 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2267 "Delete the directory named DIRECTORY.")
2269 Lisp_Object directory
;
2272 Lisp_Object handler
;
2273 Lisp_Object encoded_dir
;
2275 CHECK_STRING (directory
, 0);
2276 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2278 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2279 if (!NILP (handler
))
2280 return call2 (handler
, Qdelete_directory
, directory
);
2282 encoded_dir
= ENCODE_FILE (directory
);
2284 dir
= XSTRING (encoded_dir
)->data
;
2286 if (rmdir (dir
) != 0)
2287 report_file_error ("Removing directory", Flist (1, &directory
));
2292 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2293 "Delete file named FILENAME.\n\
2294 If file has multiple names, it continues to exist with the other names.")
2296 Lisp_Object filename
;
2298 Lisp_Object handler
;
2299 Lisp_Object encoded_file
;
2301 CHECK_STRING (filename
, 0);
2302 filename
= Fexpand_file_name (filename
, Qnil
);
2304 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2305 if (!NILP (handler
))
2306 return call2 (handler
, Qdelete_file
, filename
);
2308 encoded_file
= ENCODE_FILE (filename
);
2310 if (0 > unlink (XSTRING (encoded_file
)->data
))
2311 report_file_error ("Removing old name", Flist (1, &filename
));
2316 internal_delete_file_1 (ignore
)
2322 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2325 internal_delete_file (filename
)
2326 Lisp_Object filename
;
2328 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2329 Qt
, internal_delete_file_1
));
2332 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2333 "fRename file: \nFRename %s to file: \np",
2334 "Rename FILE as NEWNAME. Both args strings.\n\
2335 If file has names other than FILE, it continues to have those names.\n\
2336 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2337 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2338 A number as third arg means request confirmation if NEWNAME already exists.\n\
2339 This is what happens in interactive use with M-x.")
2340 (file
, newname
, ok_if_already_exists
)
2341 Lisp_Object file
, newname
, ok_if_already_exists
;
2344 Lisp_Object args
[2];
2346 Lisp_Object handler
;
2347 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2348 Lisp_Object encoded_file
, encoded_newname
;
2350 encoded_file
= encoded_newname
= Qnil
;
2351 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2352 CHECK_STRING (file
, 0);
2353 CHECK_STRING (newname
, 1);
2354 file
= Fexpand_file_name (file
, Qnil
);
2355 newname
= Fexpand_file_name (newname
, Qnil
);
2357 /* If the file name has special constructs in it,
2358 call the corresponding file handler. */
2359 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2361 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2362 if (!NILP (handler
))
2363 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2364 file
, newname
, ok_if_already_exists
));
2366 encoded_file
= ENCODE_FILE (file
);
2367 encoded_newname
= ENCODE_FILE (newname
);
2369 if (NILP (ok_if_already_exists
)
2370 || INTEGERP (ok_if_already_exists
))
2371 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2372 INTEGERP (ok_if_already_exists
), 0);
2374 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2376 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2377 || 0 > unlink (XSTRING (encoded_file
)->data
))
2382 Fcopy_file (file
, newname
,
2383 /* We have already prompted if it was an integer,
2384 so don't have copy-file prompt again. */
2385 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2386 Fdelete_file (file
);
2393 report_file_error ("Renaming", Flist (2, args
));
2396 report_file_error ("Renaming", Flist (2, &file
));
2403 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2404 "fAdd name to file: \nFName to add to %s: \np",
2405 "Give FILE additional name NEWNAME. Both args strings.\n\
2406 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2407 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2408 A number as third arg means request confirmation if NEWNAME already exists.\n\
2409 This is what happens in interactive use with M-x.")
2410 (file
, newname
, ok_if_already_exists
)
2411 Lisp_Object file
, newname
, ok_if_already_exists
;
2414 Lisp_Object args
[2];
2416 Lisp_Object handler
;
2417 Lisp_Object encoded_file
, encoded_newname
;
2418 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2420 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2421 encoded_file
= encoded_newname
= Qnil
;
2422 CHECK_STRING (file
, 0);
2423 CHECK_STRING (newname
, 1);
2424 file
= Fexpand_file_name (file
, Qnil
);
2425 newname
= Fexpand_file_name (newname
, Qnil
);
2427 /* If the file name has special constructs in it,
2428 call the corresponding file handler. */
2429 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2430 if (!NILP (handler
))
2431 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2432 newname
, ok_if_already_exists
));
2434 /* If the new name has special constructs in it,
2435 call the corresponding file handler. */
2436 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2437 if (!NILP (handler
))
2438 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2439 newname
, ok_if_already_exists
));
2441 encoded_file
= ENCODE_FILE (file
);
2442 encoded_newname
= ENCODE_FILE (newname
);
2444 if (NILP (ok_if_already_exists
)
2445 || INTEGERP (ok_if_already_exists
))
2446 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2447 INTEGERP (ok_if_already_exists
), 0);
2449 unlink (XSTRING (newname
)->data
);
2450 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2455 report_file_error ("Adding new name", Flist (2, args
));
2457 report_file_error ("Adding new name", Flist (2, &file
));
2466 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2467 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2468 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2469 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2470 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2471 A number as third arg means request confirmation if LINKNAME already exists.\n\
2472 This happens for interactive use with M-x.")
2473 (filename
, linkname
, ok_if_already_exists
)
2474 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2477 Lisp_Object args
[2];
2479 Lisp_Object handler
;
2480 Lisp_Object encoded_filename
, encoded_linkname
;
2481 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2483 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2484 encoded_filename
= encoded_linkname
= Qnil
;
2485 CHECK_STRING (filename
, 0);
2486 CHECK_STRING (linkname
, 1);
2487 /* If the link target has a ~, we must expand it to get
2488 a truly valid file name. Otherwise, do not expand;
2489 we want to permit links to relative file names. */
2490 if (XSTRING (filename
)->data
[0] == '~')
2491 filename
= Fexpand_file_name (filename
, Qnil
);
2492 linkname
= Fexpand_file_name (linkname
, Qnil
);
2494 /* If the file name has special constructs in it,
2495 call the corresponding file handler. */
2496 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2497 if (!NILP (handler
))
2498 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2499 linkname
, ok_if_already_exists
));
2501 /* If the new link name has special constructs in it,
2502 call the corresponding file handler. */
2503 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2504 if (!NILP (handler
))
2505 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2506 linkname
, ok_if_already_exists
));
2508 encoded_filename
= ENCODE_FILE (filename
);
2509 encoded_linkname
= ENCODE_FILE (linkname
);
2511 if (NILP (ok_if_already_exists
)
2512 || INTEGERP (ok_if_already_exists
))
2513 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2514 INTEGERP (ok_if_already_exists
), 0);
2515 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2516 XSTRING (encoded_linkname
)->data
))
2518 /* If we didn't complain already, silently delete existing file. */
2519 if (errno
== EEXIST
)
2521 unlink (XSTRING (encoded_linkname
)->data
);
2522 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2523 XSTRING (encoded_linkname
)->data
))
2533 report_file_error ("Making symbolic link", Flist (2, args
));
2535 report_file_error ("Making symbolic link", Flist (2, &filename
));
2541 #endif /* S_IFLNK */
2545 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2546 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2547 "Define the job-wide logical name NAME to have the value STRING.\n\
2548 If STRING is nil or a null string, the logical name NAME is deleted.")
2553 CHECK_STRING (name
, 0);
2555 delete_logical_name (XSTRING (name
)->data
);
2558 CHECK_STRING (string
, 1);
2560 if (XSTRING (string
)->size
== 0)
2561 delete_logical_name (XSTRING (name
)->data
);
2563 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2572 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2573 "Open a network connection to PATH using LOGIN as the login string.")
2575 Lisp_Object path
, login
;
2579 CHECK_STRING (path
, 0);
2580 CHECK_STRING (login
, 0);
2582 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2584 if (netresult
== -1)
2589 #endif /* HPUX_NET */
2591 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2593 "Return t if file FILENAME specifies an absolute file name.\n\
2594 On Unix, this is a name starting with a `/' or a `~'.")
2596 Lisp_Object filename
;
2600 CHECK_STRING (filename
, 0);
2601 ptr
= XSTRING (filename
)->data
;
2602 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2604 /* ??? This criterion is probably wrong for '<'. */
2605 || index (ptr
, ':') || index (ptr
, '<')
2606 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2610 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2618 /* Return nonzero if file FILENAME exists and can be executed. */
2621 check_executable (filename
)
2625 int len
= strlen (filename
);
2628 if (stat (filename
, &st
) < 0)
2630 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2631 return ((st
.st_mode
& S_IEXEC
) != 0);
2633 return (S_ISREG (st
.st_mode
)
2635 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2636 || stricmp (suffix
, ".exe") == 0
2637 || stricmp (suffix
, ".bat") == 0)
2638 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2639 #endif /* not WINDOWSNT */
2640 #else /* not DOS_NT */
2641 #ifdef HAVE_EUIDACCESS
2642 return (euidaccess (filename
, 1) >= 0);
2644 /* Access isn't quite right because it uses the real uid
2645 and we really want to test with the effective uid.
2646 But Unix doesn't give us a right way to do it. */
2647 return (access (filename
, 1) >= 0);
2649 #endif /* not DOS_NT */
2652 /* Return nonzero if file FILENAME exists and can be written. */
2655 check_writable (filename
)
2660 if (stat (filename
, &st
) < 0)
2662 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2663 #else /* not MSDOS */
2664 #ifdef HAVE_EUIDACCESS
2665 return (euidaccess (filename
, 2) >= 0);
2667 /* Access isn't quite right because it uses the real uid
2668 and we really want to test with the effective uid.
2669 But Unix doesn't give us a right way to do it.
2670 Opening with O_WRONLY could work for an ordinary file,
2671 but would lose for directories. */
2672 return (access (filename
, 2) >= 0);
2674 #endif /* not MSDOS */
2677 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2678 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2679 See also `file-readable-p' and `file-attributes'.")
2681 Lisp_Object filename
;
2683 Lisp_Object absname
;
2684 Lisp_Object handler
;
2685 struct stat statbuf
;
2687 CHECK_STRING (filename
, 0);
2688 absname
= Fexpand_file_name (filename
, Qnil
);
2690 /* If the file name has special constructs in it,
2691 call the corresponding file handler. */
2692 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2693 if (!NILP (handler
))
2694 return call2 (handler
, Qfile_exists_p
, absname
);
2696 absname
= ENCODE_FILE (absname
);
2698 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2701 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2702 "Return t if FILENAME can be executed by you.\n\
2703 For a directory, this means you can access files in that directory.")
2705 Lisp_Object filename
;
2708 Lisp_Object absname
;
2709 Lisp_Object handler
;
2711 CHECK_STRING (filename
, 0);
2712 absname
= Fexpand_file_name (filename
, Qnil
);
2714 /* If the file name has special constructs in it,
2715 call the corresponding file handler. */
2716 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2717 if (!NILP (handler
))
2718 return call2 (handler
, Qfile_executable_p
, absname
);
2720 absname
= ENCODE_FILE (absname
);
2722 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2725 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2726 "Return t if file FILENAME exists and you can read it.\n\
2727 See also `file-exists-p' and `file-attributes'.")
2729 Lisp_Object filename
;
2731 Lisp_Object absname
;
2732 Lisp_Object handler
;
2735 struct stat statbuf
;
2737 CHECK_STRING (filename
, 0);
2738 absname
= Fexpand_file_name (filename
, Qnil
);
2740 /* If the file name has special constructs in it,
2741 call the corresponding file handler. */
2742 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2743 if (!NILP (handler
))
2744 return call2 (handler
, Qfile_readable_p
, absname
);
2746 absname
= ENCODE_FILE (absname
);
2749 /* Under MS-DOS and Windows, open does not work for directories. */
2750 if (access (XSTRING (absname
)->data
, 0) == 0)
2753 #else /* not DOS_NT */
2755 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2756 /* Opening a fifo without O_NONBLOCK can wait.
2757 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2758 except in the case of a fifo, on a system which handles it. */
2759 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2762 if (S_ISFIFO (statbuf
.st_mode
))
2763 flags
|= O_NONBLOCK
;
2765 desc
= open (XSTRING (absname
)->data
, flags
);
2770 #endif /* not DOS_NT */
2773 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2775 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2776 "Return t if file FILENAME can be written or created by you.")
2778 Lisp_Object filename
;
2780 Lisp_Object absname
, dir
, encoded
;
2781 Lisp_Object handler
;
2782 struct stat statbuf
;
2784 CHECK_STRING (filename
, 0);
2785 absname
= Fexpand_file_name (filename
, Qnil
);
2787 /* If the file name has special constructs in it,
2788 call the corresponding file handler. */
2789 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2790 if (!NILP (handler
))
2791 return call2 (handler
, Qfile_writable_p
, absname
);
2793 encoded
= ENCODE_FILE (absname
);
2794 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2795 return (check_writable (XSTRING (encoded
)->data
)
2798 dir
= Ffile_name_directory (absname
);
2801 dir
= Fdirectory_file_name (dir
);
2805 dir
= Fdirectory_file_name (dir
);
2808 dir
= ENCODE_FILE (dir
);
2809 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2813 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2814 "Access file FILENAME, and get an error if that does not work.\n\
2815 The second argument STRING is used in the error message.\n\
2816 If there is no error, we return nil.")
2818 Lisp_Object filename
, string
;
2820 Lisp_Object handler
, encoded_filename
;
2823 CHECK_STRING (filename
, 0);
2825 /* If the file name has special constructs in it,
2826 call the corresponding file handler. */
2827 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2828 if (!NILP (handler
))
2829 return call3 (handler
, Qaccess_file
, filename
, string
);
2831 encoded_filename
= ENCODE_FILE (filename
);
2833 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2835 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2841 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2842 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2843 The value is the name of the file to which it is linked.\n\
2844 Otherwise returns nil.")
2846 Lisp_Object filename
;
2853 Lisp_Object handler
;
2855 CHECK_STRING (filename
, 0);
2856 filename
= Fexpand_file_name (filename
, Qnil
);
2858 /* If the file name has special constructs in it,
2859 call the corresponding file handler. */
2860 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2861 if (!NILP (handler
))
2862 return call2 (handler
, Qfile_symlink_p
, filename
);
2864 filename
= ENCODE_FILE (filename
);
2869 buf
= (char *) xmalloc (bufsize
);
2870 bzero (buf
, bufsize
);
2871 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2872 if (valsize
< bufsize
) break;
2873 /* Buffer was not long enough */
2882 val
= make_string (buf
, valsize
);
2884 return Fdecode_coding_string (val
, Vfile_name_coding_system
, Qt
);
2885 #else /* not S_IFLNK */
2887 #endif /* not S_IFLNK */
2890 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2891 "Return t if FILENAME names an existing directory.")
2893 Lisp_Object filename
;
2895 register Lisp_Object absname
;
2897 Lisp_Object handler
;
2899 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2901 /* If the file name has special constructs in it,
2902 call the corresponding file handler. */
2903 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2904 if (!NILP (handler
))
2905 return call2 (handler
, Qfile_directory_p
, absname
);
2907 absname
= ENCODE_FILE (absname
);
2909 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2911 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2914 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2915 "Return t if file FILENAME is the name of a directory as a file,\n\
2916 and files in that directory can be opened by you. In order to use a\n\
2917 directory as a buffer's current directory, this predicate must return true.\n\
2918 A directory name spec may be given instead; then the value is t\n\
2919 if the directory so specified exists and really is a readable and\n\
2920 searchable directory.")
2922 Lisp_Object filename
;
2924 Lisp_Object handler
;
2926 struct gcpro gcpro1
;
2928 /* If the file name has special constructs in it,
2929 call the corresponding file handler. */
2930 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2931 if (!NILP (handler
))
2932 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2934 /* It's an unlikely combination, but yes we really do need to gcpro:
2935 Suppose that file-accessible-directory-p has no handler, but
2936 file-directory-p does have a handler; this handler causes a GC which
2937 relocates the string in `filename'; and finally file-directory-p
2938 returns non-nil. Then we would end up passing a garbaged string
2939 to file-executable-p. */
2941 tem
= (NILP (Ffile_directory_p (filename
))
2942 || NILP (Ffile_executable_p (filename
)));
2944 return tem
? Qnil
: Qt
;
2947 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2948 "Return t if file FILENAME is the name of a regular file.\n\
2949 This is the sort of file that holds an ordinary stream of data bytes.")
2951 Lisp_Object filename
;
2953 register Lisp_Object absname
;
2955 Lisp_Object handler
;
2957 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2959 /* If the file name has special constructs in it,
2960 call the corresponding file handler. */
2961 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2962 if (!NILP (handler
))
2963 return call2 (handler
, Qfile_regular_p
, absname
);
2965 absname
= ENCODE_FILE (absname
);
2967 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2969 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2972 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2973 "Return mode bits of file named FILENAME, as an integer.")
2975 Lisp_Object filename
;
2977 Lisp_Object absname
;
2979 Lisp_Object handler
;
2981 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2983 /* If the file name has special constructs in it,
2984 call the corresponding file handler. */
2985 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2986 if (!NILP (handler
))
2987 return call2 (handler
, Qfile_modes
, absname
);
2989 absname
= ENCODE_FILE (absname
);
2991 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2993 #if defined (MSDOS) && __DJGPP__ < 2
2994 if (check_executable (XSTRING (absname
)->data
))
2995 st
.st_mode
|= S_IEXEC
;
2996 #endif /* MSDOS && __DJGPP__ < 2 */
2998 return make_number (st
.st_mode
& 07777);
3001 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3002 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3003 Only the 12 low bits of MODE are used.")
3005 Lisp_Object filename
, mode
;
3007 Lisp_Object absname
, encoded_absname
;
3008 Lisp_Object handler
;
3010 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3011 CHECK_NUMBER (mode
, 1);
3013 /* If the file name has special constructs in it,
3014 call the corresponding file handler. */
3015 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3016 if (!NILP (handler
))
3017 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3019 encoded_absname
= ENCODE_FILE (absname
);
3021 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3022 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3027 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3028 "Set the file permission bits for newly created files.\n\
3029 The argument MODE should be an integer; only the low 9 bits are used.\n\
3030 This setting is inherited by subprocesses.")
3034 CHECK_NUMBER (mode
, 0);
3036 umask ((~ XINT (mode
)) & 0777);
3041 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3042 "Return the default file protection for created files.\n\
3043 The value is an integer.")
3049 realmask
= umask (0);
3052 XSETINT (value
, (~ realmask
) & 0777);
3058 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3059 "Tell Unix to finish all pending disk updates.")
3068 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3069 "Return t if file FILE1 is newer than file FILE2.\n\
3070 If FILE1 does not exist, the answer is nil;\n\
3071 otherwise, if FILE2 does not exist, the answer is t.")
3073 Lisp_Object file1
, file2
;
3075 Lisp_Object absname1
, absname2
;
3078 Lisp_Object handler
;
3079 struct gcpro gcpro1
, gcpro2
;
3081 CHECK_STRING (file1
, 0);
3082 CHECK_STRING (file2
, 0);
3085 GCPRO2 (absname1
, file2
);
3086 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3087 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3090 /* If the file name has special constructs in it,
3091 call the corresponding file handler. */
3092 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3094 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3095 if (!NILP (handler
))
3096 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3098 GCPRO2 (absname1
, absname2
);
3099 absname1
= ENCODE_FILE (absname1
);
3100 absname2
= ENCODE_FILE (absname2
);
3103 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3106 mtime1
= st
.st_mtime
;
3108 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3111 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3115 Lisp_Object Qfind_buffer_file_type
;
3118 #ifndef READ_BUF_SIZE
3119 #define READ_BUF_SIZE (64 << 10)
3122 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3124 "Insert contents of file FILENAME after point.\n\
3125 Returns list of absolute file name and number of bytes inserted.\n\
3126 If second argument VISIT is non-nil, the buffer's visited filename\n\
3127 and last save file modtime are set, and it is marked unmodified.\n\
3128 If visiting and the file does not exist, visiting is completed\n\
3129 before the error is signaled.\n\
3130 The optional third and fourth arguments BEG and END\n\
3131 specify what portion of the file to insert.\n\
3132 These arguments count bytes in the file, not characters in the buffer.\n\
3133 If VISIT is non-nil, BEG and END must be nil.\n\
3135 If optional fifth argument REPLACE is non-nil,\n\
3136 it means replace the current buffer contents (in the accessible portion)\n\
3137 with the file contents. This is better than simply deleting and inserting\n\
3138 the whole thing because (1) it preserves some marker positions\n\
3139 and (2) it puts less data in the undo list.\n\
3140 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3141 which is often less than the number of characters to be read.\n\
3142 This does code conversion according to the value of\n\
3143 `coding-system-for-read' or `file-coding-system-alist',\n\
3144 and sets the variable `last-coding-system-used' to the coding system\n\
3146 (filename
, visit
, beg
, end
, replace
)
3147 Lisp_Object filename
, visit
, beg
, end
, replace
;
3152 register int how_much
;
3153 register int unprocessed
;
3154 int count
= specpdl_ptr
- specpdl
;
3155 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3156 Lisp_Object handler
, val
, insval
, orig_filename
;
3159 int not_regular
= 0;
3160 char read_buf
[READ_BUF_SIZE
];
3161 struct coding_system coding
;
3162 unsigned char buffer
[1 << 14];
3163 int replace_handled
= 0;
3164 int set_coding_system
= 0;
3166 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3167 error ("Cannot do file visiting in an indirect buffer");
3169 if (!NILP (current_buffer
->read_only
))
3170 Fbarf_if_buffer_read_only ();
3174 orig_filename
= Qnil
;
3176 GCPRO4 (filename
, val
, p
, orig_filename
);
3178 CHECK_STRING (filename
, 0);
3179 filename
= Fexpand_file_name (filename
, Qnil
);
3181 /* If the file name has special constructs in it,
3182 call the corresponding file handler. */
3183 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3184 if (!NILP (handler
))
3186 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3187 visit
, beg
, end
, replace
);
3191 orig_filename
= filename
;
3192 filename
= ENCODE_FILE (filename
);
3197 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3199 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3200 || fstat (fd
, &st
) < 0)
3201 #endif /* not APOLLO */
3203 if (fd
>= 0) close (fd
);
3206 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3209 if (!NILP (Vcoding_system_for_read
))
3210 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3215 /* This code will need to be changed in order to work on named
3216 pipes, and it's probably just not worth it. So we should at
3217 least signal an error. */
3218 if (!S_ISREG (st
.st_mode
))
3225 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3226 Fsignal (Qfile_error
,
3227 Fcons (build_string ("not a regular file"),
3228 Fcons (orig_filename
, Qnil
)));
3233 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3236 /* Replacement should preserve point as it preserves markers. */
3237 if (!NILP (replace
))
3238 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3240 record_unwind_protect (close_file_unwind
, make_number (fd
));
3242 /* Supposedly happens on VMS. */
3243 if (! not_regular
&& st
.st_size
< 0)
3244 error ("File size is negative");
3246 if (!NILP (beg
) || !NILP (end
))
3248 error ("Attempt to visit less than an entire file");
3251 CHECK_NUMBER (beg
, 0);
3253 XSETFASTINT (beg
, 0);
3256 CHECK_NUMBER (end
, 0);
3261 XSETINT (end
, st
.st_size
);
3262 if (XINT (end
) != st
.st_size
)
3263 error ("Maximum buffer size exceeded");
3267 /* Decide the coding-system of the file. */
3269 Lisp_Object val
= Qnil
;
3271 if (!NILP (Vcoding_system_for_read
))
3272 val
= Vcoding_system_for_read
;
3275 if (! NILP (Vset_auto_coding_function
))
3277 /* Find a coding system specified in the heading two lines
3278 or in the tailing several lines of the file. We assume
3279 that the 1K-byte and 3K-byte for heading and tailing
3280 respectively are sufficient fot this purpose. */
3281 int how_many
, nread
;
3283 if (st
.st_size
<= (1024 * 4))
3284 nread
= read (fd
, read_buf
, 1024 * 4);
3287 nread
= read (fd
, read_buf
, 1024);
3290 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3291 report_file_error ("Setting file position",
3292 Fcons (orig_filename
, Qnil
));
3293 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3298 error ("IO error reading %s: %s",
3299 XSTRING (orig_filename
)->data
, strerror (errno
));
3303 /* Always make this a unibyte string
3304 because we have not yet decoded it. */
3305 tem
= make_unibyte_string (read_buf
, nread
);
3306 val
= call1 (Vset_auto_coding_function
, tem
);
3307 /* Rewind the file for the actual read done later. */
3308 if (lseek (fd
, 0, 0) < 0)
3309 report_file_error ("Setting file position",
3310 Fcons (orig_filename
, Qnil
));
3315 Lisp_Object args
[6], coding_systems
;
3317 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3318 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3319 coding_systems
= Ffind_operation_coding_system (6, args
);
3320 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3324 if (NILP (Vcoding_system_for_read
)
3325 && NILP (current_buffer
->enable_multibyte_characters
))
3327 /* We must suppress all text conversion except for end-of-line
3329 struct coding_system coding_temp
;
3331 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3332 setup_coding_system (Qraw_text
, &coding
);
3333 coding
.eol_type
= coding_temp
.eol_type
;
3336 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3339 /* If requested, replace the accessible part of the buffer
3340 with the file contents. Avoid replacing text at the
3341 beginning or end of the buffer that matches the file contents;
3342 that preserves markers pointing to the unchanged parts.
3344 Here we implement this feature in an optimized way
3345 for the case where code conversion is NOT needed.
3346 The following if-statement handles the case of conversion
3347 in a less optimal way.
3349 If the code conversion is "automatic" then we try using this
3350 method and hope for the best.
3351 But if we discover the need for conversion, we give up on this method
3352 and let the following if-statement handle the replace job. */
3354 && ! CODING_REQUIRE_DECODING (&coding
))
3356 /* same_at_start and same_at_end count bytes,
3357 because file access counts bytes
3358 and BEG and END count bytes. */
3359 int same_at_start
= BEGV_BYTE
;
3360 int same_at_end
= ZV_BYTE
;
3362 /* There is still a possibility we will find the need to do code
3363 conversion. If that happens, we set this variable to 1 to
3364 give up on handling REPLACE in the optimized way. */
3365 int giveup_match_end
= 0;
3367 if (XINT (beg
) != 0)
3369 if (lseek (fd
, XINT (beg
), 0) < 0)
3370 report_file_error ("Setting file position",
3371 Fcons (orig_filename
, Qnil
));
3376 /* Count how many chars at the start of the file
3377 match the text at the beginning of the buffer. */
3382 nread
= read (fd
, buffer
, sizeof buffer
);
3384 error ("IO error reading %s: %s",
3385 XSTRING (orig_filename
)->data
, strerror (errno
));
3386 else if (nread
== 0)
3389 if (coding
.type
== coding_type_undecided
)
3390 detect_coding (&coding
, buffer
, nread
);
3391 if (CODING_REQUIRE_DECODING (&coding
))
3392 /* We found that the file should be decoded somehow.
3393 Let's give up here. */
3395 giveup_match_end
= 1;
3399 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3400 detect_eol (&coding
, buffer
, nread
);
3401 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3402 && coding
.eol_type
!= CODING_EOL_LF
)
3403 /* We found that the format of eol should be decoded.
3404 Let's give up here. */
3406 giveup_match_end
= 1;
3411 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3412 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3413 same_at_start
++, bufpos
++;
3414 /* If we found a discrepancy, stop the scan.
3415 Otherwise loop around and scan the next bufferful. */
3416 if (bufpos
!= nread
)
3420 /* If the file matches the buffer completely,
3421 there's no need to replace anything. */
3422 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3426 /* Truncate the buffer to the size of the file. */
3427 del_range_1 (same_at_start
, same_at_end
, 0);
3432 /* Count how many chars at the end of the file
3433 match the text at the end of the buffer. But, if we have
3434 already found that decoding is necessary, don't waste time. */
3435 while (!giveup_match_end
)
3437 int total_read
, nread
, bufpos
, curpos
, trial
;
3439 /* At what file position are we now scanning? */
3440 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3441 /* If the entire file matches the buffer tail, stop the scan. */
3444 /* How much can we scan in the next step? */
3445 trial
= min (curpos
, sizeof buffer
);
3446 if (lseek (fd
, curpos
- trial
, 0) < 0)
3447 report_file_error ("Setting file position",
3448 Fcons (orig_filename
, Qnil
));
3451 while (total_read
< trial
)
3453 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3455 error ("IO error reading %s: %s",
3456 XSTRING (orig_filename
)->data
, strerror (errno
));
3457 total_read
+= nread
;
3459 /* Scan this bufferful from the end, comparing with
3460 the Emacs buffer. */
3461 bufpos
= total_read
;
3462 /* Compare with same_at_start to avoid counting some buffer text
3463 as matching both at the file's beginning and at the end. */
3464 while (bufpos
> 0 && same_at_end
> same_at_start
3465 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3466 same_at_end
--, bufpos
--;
3468 /* If we found a discrepancy, stop the scan.
3469 Otherwise loop around and scan the preceding bufferful. */
3472 /* If this discrepancy is because of code conversion,
3473 we cannot use this method; giveup and try the other. */
3474 if (same_at_end
> same_at_start
3475 && FETCH_BYTE (same_at_end
- 1) >= 0200
3476 && ! NILP (current_buffer
->enable_multibyte_characters
)
3477 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3478 giveup_match_end
= 1;
3484 if (! giveup_match_end
)
3488 /* We win! We can handle REPLACE the optimized way. */
3490 /* Extends the end of non-matching text area to multibyte
3491 character boundary. */
3492 if (! NILP (current_buffer
->enable_multibyte_characters
))
3493 while (same_at_end
< ZV_BYTE
3494 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3497 /* Don't try to reuse the same piece of text twice. */
3498 overlap
= (same_at_start
- BEGV_BYTE
3499 - (same_at_end
+ st
.st_size
- ZV
));
3501 same_at_end
+= overlap
;
3503 /* Arrange to read only the nonmatching middle part of the file. */
3504 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3505 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3507 del_range_byte (same_at_start
, same_at_end
, 0);
3508 /* Insert from the file at the proper position. */
3509 temp
= BYTE_TO_CHAR (same_at_start
);
3510 SET_PT_BOTH (temp
, same_at_start
);
3512 /* If display currently starts at beginning of line,
3513 keep it that way. */
3514 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3515 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3517 replace_handled
= 1;
3521 /* If requested, replace the accessible part of the buffer
3522 with the file contents. Avoid replacing text at the
3523 beginning or end of the buffer that matches the file contents;
3524 that preserves markers pointing to the unchanged parts.
3526 Here we implement this feature for the case where code conversion
3527 is needed, in a simple way that needs a lot of memory.
3528 The preceding if-statement handles the case of no conversion
3529 in a more optimized way. */
3530 if (!NILP (replace
) && ! replace_handled
)
3532 int same_at_start
= BEGV_BYTE
;
3533 int same_at_end
= ZV_BYTE
;
3536 /* Make sure that the gap is large enough. */
3537 int bufsize
= 2 * st
.st_size
;
3538 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3541 /* First read the whole file, performing code conversion into
3542 CONVERSION_BUFFER. */
3544 if (lseek (fd
, XINT (beg
), 0) < 0)
3546 free (conversion_buffer
);
3547 report_file_error ("Setting file position",
3548 Fcons (orig_filename
, Qnil
));
3551 total
= st
.st_size
; /* Total bytes in the file. */
3552 how_much
= 0; /* Bytes read from file so far. */
3553 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3554 unprocessed
= 0; /* Bytes not processed in previous loop. */
3556 while (how_much
< total
)
3558 /* try is reserved in some compilers (Microsoft C) */
3559 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3560 char *destination
= read_buf
+ unprocessed
;
3563 /* Allow quitting out of the actual I/O. */
3566 this = read (fd
, destination
, trytry
);
3569 if (this < 0 || this + unprocessed
== 0)
3577 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3579 int require
, result
;
3581 this += unprocessed
;
3583 /* If we are using more space than estimated,
3584 make CONVERSION_BUFFER bigger. */
3585 require
= decoding_buffer_size (&coding
, this);
3586 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3588 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3589 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3592 /* Convert this batch with results in CONVERSION_BUFFER. */
3593 if (how_much
>= total
) /* This is the last block. */
3594 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3595 result
= decode_coding (&coding
, read_buf
,
3596 conversion_buffer
+ inserted
,
3597 this, bufsize
- inserted
);
3599 /* Save for next iteration whatever we didn't convert. */
3600 unprocessed
= this - coding
.consumed
;
3601 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3602 this = coding
.produced
;
3608 /* At this point, INSERTED is how many characters (i.e. bytes)
3609 are present in CONVERSION_BUFFER.
3610 HOW_MUCH should equal TOTAL,
3611 or should be <= 0 if we couldn't read the file. */
3615 free (conversion_buffer
);
3618 error ("IO error reading %s: %s",
3619 XSTRING (orig_filename
)->data
, strerror (errno
));
3620 else if (how_much
== -2)
3621 error ("maximum buffer size exceeded");
3624 /* Compare the beginning of the converted file
3625 with the buffer text. */
3628 while (bufpos
< inserted
&& same_at_start
< same_at_end
3629 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3630 same_at_start
++, bufpos
++;
3632 /* If the file matches the buffer completely,
3633 there's no need to replace anything. */
3635 if (bufpos
== inserted
)
3637 free (conversion_buffer
);
3640 /* Truncate the buffer to the size of the file. */
3641 del_range_1 (same_at_start
, same_at_end
, 0);
3645 /* Scan this bufferful from the end, comparing with
3646 the Emacs buffer. */
3649 /* Compare with same_at_start to avoid counting some buffer text
3650 as matching both at the file's beginning and at the end. */
3651 while (bufpos
> 0 && same_at_end
> same_at_start
3652 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3653 same_at_end
--, bufpos
--;
3655 /* Don't try to reuse the same piece of text twice. */
3656 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3658 same_at_end
+= overlap
;
3660 /* If display currently starts at beginning of line,
3661 keep it that way. */
3662 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3663 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3665 /* Replace the chars that we need to replace,
3666 and update INSERTED to equal the number of bytes
3667 we are taking from the file. */
3668 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3669 del_range_byte (same_at_start
, same_at_end
, 0);
3670 SET_PT_BOTH (GPT
, GPT_BYTE
);
3672 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3675 free (conversion_buffer
);
3684 register Lisp_Object temp
;
3686 total
= XINT (end
) - XINT (beg
);
3688 /* Make sure point-max won't overflow after this insertion. */
3689 XSETINT (temp
, total
);
3690 if (total
!= XINT (temp
))
3691 error ("Maximum buffer size exceeded");
3694 /* For a special file, all we can do is guess. */
3695 total
= READ_BUF_SIZE
;
3697 if (NILP (visit
) && total
> 0)
3698 prepare_to_modify_buffer (PT
, PT
, NULL
);
3701 if (GAP_SIZE
< total
)
3702 make_gap (total
- GAP_SIZE
);
3704 if (XINT (beg
) != 0 || !NILP (replace
))
3706 if (lseek (fd
, XINT (beg
), 0) < 0)
3707 report_file_error ("Setting file position",
3708 Fcons (orig_filename
, Qnil
));
3711 /* In the following loop, HOW_MUCH contains the total bytes read so
3712 far for a regular file, and not changed for a special file. But,
3713 before exiting the loop, it is set to a negative value if I/O
3716 /* Total bytes inserted. */
3718 /* Here, we don't do code conversion in the loop. It is done by
3719 code_convert_region after all data are read into the buffer. */
3720 while (how_much
< total
)
3722 /* try is reserved in some compilers (Microsoft C) */
3723 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3726 /* For a special file, GAP_SIZE should be checked every time. */
3727 if (not_regular
&& GAP_SIZE
< trytry
)
3728 make_gap (total
- GAP_SIZE
);
3730 /* Allow quitting out of the actual I/O. */
3733 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3750 /* For a regular file, where TOTAL is the real size,
3751 count HOW_MUCH to compare with it.
3752 For a special file, where TOTAL is just a buffer size,
3753 so don't bother counting in HOW_MUCH.
3754 (INSERTED is where we count the number of characters inserted.) */
3761 /* Put an anchor to ensure multi-byte form ends at gap. */
3766 /* Discard the unwind protect for closing the file. */
3770 error ("IO error reading %s: %s",
3771 XSTRING (orig_filename
)->data
, strerror (errno
));
3775 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3777 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3779 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
3780 ? coding
.produced
: coding
.produced_char
);
3784 /* Use the conversion type to determine buffer-file-type
3785 (find-buffer-file-type is now used to help determine the
3787 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3788 && coding
.eol_type
!= CODING_EOL_LF
)
3789 current_buffer
->buffer_file_type
= Qnil
;
3791 current_buffer
->buffer_file_type
= Qt
;
3794 record_insert (PT
, inserted
);
3796 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3797 offset_intervals (current_buffer
, PT
, inserted
);
3800 if (! NILP (coding
.post_read_conversion
))
3804 val
= call1 (coding
.post_read_conversion
, make_number (inserted
));
3807 CHECK_NUMBER (val
, 0);
3808 inserted
= XFASTINT (val
);
3813 set_coding_system
= 1;
3820 if (!EQ (current_buffer
->undo_list
, Qt
))
3821 current_buffer
->undo_list
= Qnil
;
3823 stat (XSTRING (filename
)->data
, &st
);
3828 current_buffer
->modtime
= st
.st_mtime
;
3829 current_buffer
->filename
= orig_filename
;
3832 SAVE_MODIFF
= MODIFF
;
3833 current_buffer
->auto_save_modified
= MODIFF
;
3834 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3835 #ifdef CLASH_DETECTION
3838 if (!NILP (current_buffer
->file_truename
))
3839 unlock_file (current_buffer
->file_truename
);
3840 unlock_file (filename
);
3842 #endif /* CLASH_DETECTION */
3844 Fsignal (Qfile_error
,
3845 Fcons (build_string ("not a regular file"),
3846 Fcons (orig_filename
, Qnil
)));
3848 /* If visiting nonexistent file, return nil. */
3849 if (current_buffer
->modtime
== -1)
3850 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3853 /* Decode file format */
3856 insval
= call3 (Qformat_decode
,
3857 Qnil
, make_number (inserted
), visit
);
3858 CHECK_NUMBER (insval
, 0);
3859 inserted
= XFASTINT (insval
);
3862 /* Call after-change hooks for the inserted text, aside from the case
3863 of normal visiting (not with REPLACE), which is done in a new buffer
3864 "before" the buffer is changed. */
3865 if (inserted
> 0 && total
> 0
3866 && (NILP (visit
) || !NILP (replace
)))
3867 signal_after_change (PT
, 0, inserted
);
3869 if (set_coding_system
)
3870 Vlast_coding_system_used
= coding
.symbol
;
3874 p
= Vafter_insert_file_functions
;
3877 insval
= call1 (Fcar (p
), make_number (inserted
));
3880 CHECK_NUMBER (insval
, 0);
3881 inserted
= XFASTINT (insval
);
3888 /* ??? Retval needs to be dealt with in all cases consistently. */
3890 val
= Fcons (orig_filename
,
3891 Fcons (make_number (inserted
),
3894 RETURN_UNGCPRO (unbind_to (count
, val
));
3897 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
3900 /* If build_annotations switched buffers, switch back to BUF.
3901 Kill the temporary buffer that was selected in the meantime.
3903 Since this kill only the last temporary buffer, some buffers remain
3904 not killed if build_annotations switched buffers more than once.
3908 build_annotations_unwind (buf
)
3913 if (XBUFFER (buf
) == current_buffer
)
3915 tembuf
= Fcurrent_buffer ();
3917 Fkill_buffer (tembuf
);
3921 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
3922 "r\nFWrite region to file: \ni\ni\ni\np",
3923 "Write current region into specified file.\n\
3924 When called from a program, takes three arguments:\n\
3925 START, END and FILENAME. START and END are buffer positions.\n\
3926 Optional fourth argument APPEND if non-nil means\n\
3927 append to existing file contents (if any).\n\
3928 Optional fifth argument VISIT if t means\n\
3929 set the last-save-file-modtime of buffer to this file's modtime\n\
3930 and mark buffer not modified.\n\
3931 If VISIT is a string, it is a second file name;\n\
3932 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3933 VISIT is also the file name to lock and unlock for clash detection.\n\
3934 If VISIT is neither t nor nil nor a string,\n\
3935 that means do not print the \"Wrote file\" message.\n\
3936 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3937 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3938 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
3939 before overwriting an existing file.\n\
3940 Kludgy feature: if START is a string, then that string is written\n\
3941 to the file, instead of any buffer contents, and END is ignored.")
3942 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
3943 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
3951 int count
= specpdl_ptr
- specpdl
;
3954 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3956 Lisp_Object handler
;
3957 Lisp_Object visit_file
;
3958 Lisp_Object annotations
;
3959 Lisp_Object encoded_filename
;
3960 int visiting
, quietly
;
3961 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3962 struct buffer
*given_buffer
;
3964 int buffer_file_type
= O_BINARY
;
3966 struct coding_system coding
;
3968 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3969 error ("Cannot do file visiting in an indirect buffer");
3971 if (!NILP (start
) && !STRINGP (start
))
3972 validate_region (&start
, &end
);
3974 GCPRO4 (start
, filename
, visit
, lockname
);
3976 /* Decide the coding-system to encode the data with. */
3982 else if (!NILP (Vcoding_system_for_write
))
3983 val
= Vcoding_system_for_write
;
3984 else if (NILP (current_buffer
->enable_multibyte_characters
))
3986 /* If the variable `buffer-file-coding-system' is set locally,
3987 it means that the file was read with some kind of code
3988 conversion or the varialbe is explicitely set by users. We
3989 had better write it out with the same coding system even if
3990 `enable-multibyte-characters' is nil.
3992 If it is not set locally, we anyway have to convert EOL
3993 format if the default value of `buffer-file-coding-system'
3994 tells that it is not Unix-like (LF only) format. */
3995 val
= current_buffer
->buffer_file_coding_system
;
3996 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3998 struct coding_system coding_temp
;
4000 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4001 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4002 || coding_temp
.eol_type
== CODING_EOL_CR
)
4004 setup_coding_system (Qraw_text
, &coding
);
4005 coding
.eol_type
= coding_temp
.eol_type
;
4006 goto done_setup_coding
;
4013 Lisp_Object args
[7], coding_systems
;
4015 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4016 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4018 coding_systems
= Ffind_operation_coding_system (7, args
);
4019 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4020 ? XCONS (coding_systems
)->cdr
4021 : current_buffer
->buffer_file_coding_system
);
4022 /* Confirm that VAL can surely encode the current region. */
4023 if (Ffboundp (Vselect_safe_coding_system_function
))
4024 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4026 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4029 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4030 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4033 Vlast_coding_system_used
= coding
.symbol
;
4035 filename
= Fexpand_file_name (filename
, Qnil
);
4037 if (! NILP (confirm
))
4038 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0);
4040 if (STRINGP (visit
))
4041 visit_file
= Fexpand_file_name (visit
, Qnil
);
4043 visit_file
= filename
;
4046 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4047 quietly
= !NILP (visit
);
4051 if (NILP (lockname
))
4052 lockname
= visit_file
;
4054 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4056 /* If the file name has special constructs in it,
4057 call the corresponding file handler. */
4058 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4059 /* If FILENAME has no handler, see if VISIT has one. */
4060 if (NILP (handler
) && STRINGP (visit
))
4061 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4063 if (!NILP (handler
))
4066 val
= call6 (handler
, Qwrite_region
, start
, end
,
4067 filename
, append
, visit
);
4071 SAVE_MODIFF
= MODIFF
;
4072 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4073 current_buffer
->filename
= visit_file
;
4079 /* Special kludge to simplify auto-saving. */
4082 XSETFASTINT (start
, BEG
);
4083 XSETFASTINT (end
, Z
);
4086 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4087 count1
= specpdl_ptr
- specpdl
;
4089 given_buffer
= current_buffer
;
4090 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4091 if (current_buffer
!= given_buffer
)
4093 XSETFASTINT (start
, BEGV
);
4094 XSETFASTINT (end
, ZV
);
4097 #ifdef CLASH_DETECTION
4100 #if 0 /* This causes trouble for GNUS. */
4101 /* If we've locked this file for some other buffer,
4102 query before proceeding. */
4103 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4104 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4107 lock_file (lockname
);
4109 #endif /* CLASH_DETECTION */
4111 encoded_filename
= ENCODE_FILE (filename
);
4113 fn
= XSTRING (encoded_filename
)->data
;
4117 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4118 #else /* not DOS_NT */
4119 desc
= open (fn
, O_WRONLY
);
4120 #endif /* not DOS_NT */
4122 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4124 if (auto_saving
) /* Overwrite any previous version of autosave file */
4126 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4127 desc
= open (fn
, O_RDWR
);
4129 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4130 ? XSTRING (current_buffer
->filename
)->data
: 0,
4133 else /* Write to temporary name and rename if no errors */
4135 Lisp_Object temp_name
;
4136 temp_name
= Ffile_name_directory (filename
);
4138 if (!NILP (temp_name
))
4140 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4141 build_string ("$$SAVE$$")));
4142 fname
= XSTRING (filename
)->data
;
4143 fn
= XSTRING (temp_name
)->data
;
4144 desc
= creat_copy_attrs (fname
, fn
);
4147 /* If we can't open the temporary file, try creating a new
4148 version of the original file. VMS "creat" creates a
4149 new version rather than truncating an existing file. */
4152 desc
= creat (fn
, 0666);
4153 #if 0 /* This can clobber an existing file and fail to replace it,
4154 if the user runs out of space. */
4157 /* We can't make a new version;
4158 try to truncate and rewrite existing version if any. */
4160 desc
= open (fn
, O_RDWR
);
4166 desc
= creat (fn
, 0666);
4171 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4172 S_IREAD
| S_IWRITE
);
4173 #else /* not DOS_NT */
4174 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4175 #endif /* not DOS_NT */
4176 #endif /* not VMS */
4182 #ifdef CLASH_DETECTION
4184 if (!auto_saving
) unlock_file (lockname
);
4186 #endif /* CLASH_DETECTION */
4187 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4190 record_unwind_protect (close_file_unwind
, make_number (desc
));
4193 if (lseek (desc
, 0, 2) < 0)
4195 #ifdef CLASH_DETECTION
4196 if (!auto_saving
) unlock_file (lockname
);
4197 #endif /* CLASH_DETECTION */
4198 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4203 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4204 * if we do writes that don't end with a carriage return. Furthermore
4205 * it cannot handle writes of more then 16K. The modified
4206 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4207 * this EXCEPT for the last record (iff it doesn't end with a carriage
4208 * return). This implies that if your buffer doesn't end with a carriage
4209 * return, you get one free... tough. However it also means that if
4210 * we make two calls to sys_write (a la the following code) you can
4211 * get one at the gap as well. The easiest way to fix this (honest)
4212 * is to move the gap to the next newline (or the end of the buffer).
4217 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4218 move_gap (find_next_newline (GPT
, 1));
4220 /* Whether VMS or not, we must move the gap to the next of newline
4221 when we must put designation sequences at beginning of line. */
4222 if (INTEGERP (start
)
4223 && coding
.type
== coding_type_iso2022
4224 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4225 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4227 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4228 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4229 move_gap_both (PT
, PT_BYTE
);
4230 SET_PT_BOTH (opoint
, opoint_byte
);
4237 if (STRINGP (start
))
4239 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4240 XSTRING (start
)->size_byte
, 0, &annotations
,
4244 else if (XINT (start
) != XINT (end
))
4246 register int end1
= CHAR_TO_BYTE (XINT (end
));
4248 tem
= CHAR_TO_BYTE (XINT (start
));
4250 if (XINT (start
) < GPT
)
4252 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4253 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4258 if (XINT (end
) > GPT
&& !failure
)
4260 tem
= max (tem
, GPT_BYTE
);
4261 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4262 tem
, &annotations
, &coding
);
4268 /* If file was empty, still need to write the annotations */
4269 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4270 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4274 if (CODING_REQUIRE_FLUSHING (&coding
)
4275 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4278 /* We have to flush out a data. */
4279 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4280 failure
= 0 > e_write (desc
, "", 0, &coding
);
4287 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4288 Disk full in NFS may be reported here. */
4289 /* mib says that closing the file will try to write as fast as NFS can do
4290 it, and that means the fsync here is not crucial for autosave files. */
4291 if (!auto_saving
&& fsync (desc
) < 0)
4293 /* If fsync fails with EINTR, don't treat that as serious. */
4295 failure
= 1, save_errno
= errno
;
4299 /* Spurious "file has changed on disk" warnings have been
4300 observed on Suns as well.
4301 It seems that `close' can change the modtime, under nfs.
4303 (This has supposedly been fixed in Sunos 4,
4304 but who knows about all the other machines with NFS?) */
4307 /* On VMS and APOLLO, must do the stat after the close
4308 since closing changes the modtime. */
4311 /* Recall that #if defined does not work on VMS. */
4318 /* NFS can report a write failure now. */
4319 if (close (desc
) < 0)
4320 failure
= 1, save_errno
= errno
;
4323 /* If we wrote to a temporary name and had no errors, rename to real name. */
4327 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4335 /* Discard the unwind protect for close_file_unwind. */
4336 specpdl_ptr
= specpdl
+ count1
;
4337 /* Restore the original current buffer. */
4338 visit_file
= unbind_to (count
, visit_file
);
4340 #ifdef CLASH_DETECTION
4342 unlock_file (lockname
);
4343 #endif /* CLASH_DETECTION */
4345 /* Do this before reporting IO error
4346 to avoid a "file has changed on disk" warning on
4347 next attempt to save. */
4349 current_buffer
->modtime
= st
.st_mtime
;
4352 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4353 strerror (save_errno
));
4357 SAVE_MODIFF
= MODIFF
;
4358 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4359 current_buffer
->filename
= visit_file
;
4360 update_mode_lines
++;
4366 message_with_string ("Wrote %s", visit_file
, 1);
4371 Lisp_Object
merge ();
4373 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4374 "Return t if (car A) is numerically less than (car B).")
4378 return Flss (Fcar (a
), Fcar (b
));
4381 /* Build the complete list of annotations appropriate for writing out
4382 the text between START and END, by calling all the functions in
4383 write-region-annotate-functions and merging the lists they return.
4384 If one of these functions switches to a different buffer, we assume
4385 that buffer contains altered text. Therefore, the caller must
4386 make sure to restore the current buffer in all cases,
4387 as save-excursion would do. */
4390 build_annotations (start
, end
, pre_write_conversion
)
4391 Lisp_Object start
, end
, pre_write_conversion
;
4393 Lisp_Object annotations
;
4395 struct gcpro gcpro1
, gcpro2
;
4396 Lisp_Object original_buffer
;
4398 XSETBUFFER (original_buffer
, current_buffer
);
4401 p
= Vwrite_region_annotate_functions
;
4402 GCPRO2 (annotations
, p
);
4405 struct buffer
*given_buffer
= current_buffer
;
4406 Vwrite_region_annotations_so_far
= annotations
;
4407 res
= call2 (Fcar (p
), start
, end
);
4408 /* If the function makes a different buffer current,
4409 assume that means this buffer contains altered text to be output.
4410 Reset START and END from the buffer bounds
4411 and discard all previous annotations because they should have
4412 been dealt with by this function. */
4413 if (current_buffer
!= given_buffer
)
4415 XSETFASTINT (start
, BEGV
);
4416 XSETFASTINT (end
, ZV
);
4419 Flength (res
); /* Check basic validity of return value */
4420 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4424 /* Now do the same for annotation functions implied by the file-format */
4425 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4426 p
= Vauto_save_file_format
;
4428 p
= current_buffer
->file_format
;
4431 struct buffer
*given_buffer
= current_buffer
;
4432 Vwrite_region_annotations_so_far
= annotations
;
4433 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4435 if (current_buffer
!= given_buffer
)
4437 XSETFASTINT (start
, BEGV
);
4438 XSETFASTINT (end
, ZV
);
4442 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4446 /* At last, do the same for the function PRE_WRITE_CONVERSION
4447 implied by the current coding-system. */
4448 if (!NILP (pre_write_conversion
))
4450 struct buffer
*given_buffer
= current_buffer
;
4451 Vwrite_region_annotations_so_far
= annotations
;
4452 res
= call2 (pre_write_conversion
, start
, end
);
4454 annotations
= (current_buffer
!= given_buffer
4456 : merge (annotations
, res
, Qcar_less_than_car
));
4463 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4464 assuming they start at byte position BYTEPOS in the buffer.
4465 Intersperse with them the annotations from *ANNOT
4466 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4467 each at its appropriate position.
4469 We modify *ANNOT by discarding elements as we use them up.
4471 The return value is negative in case of system call failure. */
4474 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4476 register char *addr
;
4477 register int nbytes
;
4480 struct coding_system
*coding
;
4484 int lastpos
= bytepos
+ nbytes
;
4486 while (NILP (*annot
) || CONSP (*annot
))
4488 tem
= Fcar_safe (Fcar (*annot
));
4489 nextpos
= bytepos
- 1;
4491 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4493 /* If there are no more annotations in this range,
4494 output the rest of the range all at once. */
4495 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4496 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4498 /* Output buffer text up to the next annotation's position. */
4499 if (nextpos
> bytepos
)
4501 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4503 addr
+= nextpos
- bytepos
;
4506 /* Output the annotation. */
4507 tem
= Fcdr (Fcar (*annot
));
4510 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size_byte
,
4514 *annot
= Fcdr (*annot
);
4518 #ifndef WRITE_BUF_SIZE
4519 #define WRITE_BUF_SIZE (16 * 1024)
4522 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4523 encoding them with coding system CODING. */
4526 e_write (desc
, addr
, nbytes
, coding
)
4528 register char *addr
;
4529 register int nbytes
;
4530 struct coding_system
*coding
;
4532 char buf
[WRITE_BUF_SIZE
];
4534 /* We used to have a code for handling selective display here. But,
4535 now it is handled within encode_coding. */
4538 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4539 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4540 if (coding
->produced
> 0)
4542 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4543 if (coding
->produced
) return -1;
4551 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4552 Sverify_visited_file_modtime
, 1, 1, 0,
4553 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4554 This means that the file has not been changed since it was visited or saved.")
4560 Lisp_Object handler
;
4561 Lisp_Object filename
;
4563 CHECK_BUFFER (buf
, 0);
4566 if (!STRINGP (b
->filename
)) return Qt
;
4567 if (b
->modtime
== 0) return Qt
;
4569 /* If the file name has special constructs in it,
4570 call the corresponding file handler. */
4571 handler
= Ffind_file_name_handler (b
->filename
,
4572 Qverify_visited_file_modtime
);
4573 if (!NILP (handler
))
4574 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4576 filename
= ENCODE_FILE (b
->filename
);
4578 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4580 /* If the file doesn't exist now and didn't exist before,
4581 we say that it isn't modified, provided the error is a tame one. */
4582 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4587 if (st
.st_mtime
== b
->modtime
4588 /* If both are positive, accept them if they are off by one second. */
4589 || (st
.st_mtime
> 0 && b
->modtime
> 0
4590 && (st
.st_mtime
== b
->modtime
+ 1
4591 || st
.st_mtime
== b
->modtime
- 1)))
4596 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4597 Sclear_visited_file_modtime
, 0, 0, 0,
4598 "Clear out records of last mod time of visited file.\n\
4599 Next attempt to save will certainly not complain of a discrepancy.")
4602 current_buffer
->modtime
= 0;
4606 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4607 Svisited_file_modtime
, 0, 0, 0,
4608 "Return the current buffer's recorded visited file modification time.\n\
4609 The value is a list of the form (HIGH . LOW), like the time values\n\
4610 that `file-attributes' returns.")
4613 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4616 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4617 Sset_visited_file_modtime
, 0, 1, 0,
4618 "Update buffer's recorded modification time from the visited file's time.\n\
4619 Useful if the buffer was not read from the file normally\n\
4620 or if the file itself has been changed for some known benign reason.\n\
4621 An argument specifies the modification time value to use\n\
4622 \(instead of that of the visited file), in the form of a list\n\
4623 \(HIGH . LOW) or (HIGH LOW).")
4625 Lisp_Object time_list
;
4627 if (!NILP (time_list
))
4628 current_buffer
->modtime
= cons_to_long (time_list
);
4631 register Lisp_Object filename
;
4633 Lisp_Object handler
;
4635 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4637 /* If the file name has special constructs in it,
4638 call the corresponding file handler. */
4639 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4640 if (!NILP (handler
))
4641 /* The handler can find the file name the same way we did. */
4642 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4644 filename
= ENCODE_FILE (filename
);
4646 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4647 current_buffer
->modtime
= st
.st_mtime
;
4657 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4658 Fsleep_for (make_number (1), Qnil
);
4659 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4660 Fsleep_for (make_number (1), Qnil
);
4661 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4662 Fsleep_for (make_number (1), Qnil
);
4672 /* Get visited file's mode to become the auto save file's mode. */
4673 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4674 /* But make sure we can overwrite it later! */
4675 auto_save_mode_bits
= st
.st_mode
| 0600;
4677 auto_save_mode_bits
= 0666;
4680 Fwrite_region (Qnil
, Qnil
,
4681 current_buffer
->auto_save_file_name
,
4682 Qnil
, Qlambda
, Qnil
, Qnil
);
4686 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4691 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4692 | XFASTINT (XCONS (stream
)->cdr
)));
4697 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4700 minibuffer_auto_raise
= XINT (value
);
4704 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4705 "Auto-save all buffers that need it.\n\
4706 This is all buffers that have auto-saving enabled\n\
4707 and are changed since last auto-saved.\n\
4708 Auto-saving writes the buffer into a file\n\
4709 so that your editing is not lost if the system crashes.\n\
4710 This file is not the file you visited; that changes only when you save.\n\
4711 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4712 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4713 A non-nil CURRENT-ONLY argument means save only current buffer.")
4714 (no_message
, current_only
)
4715 Lisp_Object no_message
, current_only
;
4717 struct buffer
*old
= current_buffer
, *b
;
4718 Lisp_Object tail
, buf
;
4720 char *omessage
= echo_area_glyphs
;
4721 int omessage_length
= echo_area_glyphs_length
;
4722 int oldmultibyte
= message_enable_multibyte
;
4723 int do_handled_files
;
4726 Lisp_Object lispstream
;
4727 int count
= specpdl_ptr
- specpdl
;
4729 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4731 /* Ordinarily don't quit within this function,
4732 but don't make it impossible to quit (in case we get hung in I/O). */
4736 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4737 point to non-strings reached from Vbuffer_alist. */
4742 if (!NILP (Vrun_hooks
))
4743 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4745 if (STRINGP (Vauto_save_list_file_name
))
4747 Lisp_Object listfile
;
4748 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4749 stream
= fopen (XSTRING (listfile
)->data
, "w");
4752 /* Arrange to close that file whether or not we get an error.
4753 Also reset auto_saving to 0. */
4754 lispstream
= Fcons (Qnil
, Qnil
);
4755 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4756 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4767 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4768 record_unwind_protect (do_auto_save_unwind_1
,
4769 make_number (minibuffer_auto_raise
));
4770 minibuffer_auto_raise
= 0;
4773 /* First, save all files which don't have handlers. If Emacs is
4774 crashing, the handlers may tweak what is causing Emacs to crash
4775 in the first place, and it would be a shame if Emacs failed to
4776 autosave perfectly ordinary files because it couldn't handle some
4778 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4779 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4781 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4784 /* Record all the buffers that have auto save mode
4785 in the special file that lists them. For each of these buffers,
4786 Record visited name (if any) and auto save name. */
4787 if (STRINGP (b
->auto_save_file_name
)
4788 && stream
!= NULL
&& do_handled_files
== 0)
4790 if (!NILP (b
->filename
))
4792 fwrite (XSTRING (b
->filename
)->data
, 1,
4793 XSTRING (b
->filename
)->size
, stream
);
4795 putc ('\n', stream
);
4796 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4797 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4798 putc ('\n', stream
);
4801 if (!NILP (current_only
)
4802 && b
!= current_buffer
)
4805 /* Don't auto-save indirect buffers.
4806 The base buffer takes care of it. */
4810 /* Check for auto save enabled
4811 and file changed since last auto save
4812 and file changed since last real save. */
4813 if (STRINGP (b
->auto_save_file_name
)
4814 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4815 && b
->auto_save_modified
< BUF_MODIFF (b
)
4816 /* -1 means we've turned off autosaving for a while--see below. */
4817 && XINT (b
->save_length
) >= 0
4818 && (do_handled_files
4819 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4822 EMACS_TIME before_time
, after_time
;
4824 EMACS_GET_TIME (before_time
);
4826 /* If we had a failure, don't try again for 20 minutes. */
4827 if (b
->auto_save_failure_time
>= 0
4828 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4831 if ((XFASTINT (b
->save_length
) * 10
4832 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4833 /* A short file is likely to change a large fraction;
4834 spare the user annoying messages. */
4835 && XFASTINT (b
->save_length
) > 5000
4836 /* These messages are frequent and annoying for `*mail*'. */
4837 && !EQ (b
->filename
, Qnil
)
4838 && NILP (no_message
))
4840 /* It has shrunk too much; turn off auto-saving here. */
4841 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4842 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
4844 minibuffer_auto_raise
= 0;
4845 /* Turn off auto-saving until there's a real save,
4846 and prevent any more warnings. */
4847 XSETINT (b
->save_length
, -1);
4848 Fsleep_for (make_number (1), Qnil
);
4851 set_buffer_internal (b
);
4852 if (!auto_saved
&& NILP (no_message
))
4853 message1 ("Auto-saving...");
4854 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4856 b
->auto_save_modified
= BUF_MODIFF (b
);
4857 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4858 set_buffer_internal (old
);
4860 EMACS_GET_TIME (after_time
);
4862 /* If auto-save took more than 60 seconds,
4863 assume it was an NFS failure that got a timeout. */
4864 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4865 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4869 /* Prevent another auto save till enough input events come in. */
4870 record_auto_save ();
4872 if (auto_saved
&& NILP (no_message
))
4876 sit_for (1, 0, 0, 0, 0);
4877 message2 (omessage
, omessage_length
, oldmultibyte
);
4880 message1 ("Auto-saving...done");
4885 unbind_to (count
, Qnil
);
4889 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4890 Sset_buffer_auto_saved
, 0, 0, 0,
4891 "Mark current buffer as auto-saved with its current text.\n\
4892 No auto-save file will be written until the buffer changes again.")
4895 current_buffer
->auto_save_modified
= MODIFF
;
4896 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4897 current_buffer
->auto_save_failure_time
= -1;
4901 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4902 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4903 "Clear any record of a recent auto-save failure in the current buffer.")
4906 current_buffer
->auto_save_failure_time
= -1;
4910 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4912 "Return t if buffer has been auto-saved since last read in or saved.")
4915 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4918 /* Reading and completing file names */
4919 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4921 /* In the string VAL, change each $ to $$ and return the result. */
4924 double_dollars (val
)
4927 register unsigned char *old
, *new;
4931 osize
= XSTRING (val
)->size_byte
;
4933 /* Count the number of $ characters. */
4934 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4935 if (*old
++ == '$') count
++;
4938 old
= XSTRING (val
)->data
;
4939 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
4941 new = XSTRING (val
)->data
;
4942 for (n
= osize
; n
> 0; n
--)
4955 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4957 "Internal subroutine for read-file-name. Do not call this.")
4958 (string
, dir
, action
)
4959 Lisp_Object string
, dir
, action
;
4960 /* action is nil for complete, t for return list of completions,
4961 lambda for verify final value */
4963 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4965 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4967 CHECK_STRING (string
, 0);
4974 /* No need to protect ACTION--we only compare it with t and nil. */
4975 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4977 if (XSTRING (string
)->size
== 0)
4979 if (EQ (action
, Qlambda
))
4987 orig_string
= string
;
4988 string
= Fsubstitute_in_file_name (string
);
4989 changed
= NILP (Fstring_equal (string
, orig_string
));
4990 name
= Ffile_name_nondirectory (string
);
4991 val
= Ffile_name_directory (string
);
4993 realdir
= Fexpand_file_name (val
, realdir
);
4998 specdir
= Ffile_name_directory (string
);
4999 val
= Ffile_name_completion (name
, realdir
);
5004 return double_dollars (string
);
5008 if (!NILP (specdir
))
5009 val
= concat2 (specdir
, val
);
5011 return double_dollars (val
);
5014 #endif /* not VMS */
5018 if (EQ (action
, Qt
))
5019 return Ffile_name_all_completions (name
, realdir
);
5020 /* Only other case actually used is ACTION = lambda */
5022 /* Supposedly this helps commands such as `cd' that read directory names,
5023 but can someone explain how it helps them? -- RMS */
5024 if (XSTRING (name
)->size
== 0)
5027 return Ffile_exists_p (string
);
5030 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5031 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5032 Value is not expanded---you must call `expand-file-name' yourself.\n\
5033 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5034 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5035 except that if INITIAL is specified, that combined with DIR is used.)\n\
5036 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5037 Non-nil and non-t means also require confirmation after completion.\n\
5038 Fifth arg INITIAL specifies text to start with.\n\
5039 DIR defaults to current buffer's directory default.")
5040 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5041 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5043 Lisp_Object val
, insdef
, insdef1
, tem
;
5044 struct gcpro gcpro1
, gcpro2
;
5045 register char *homedir
;
5046 int replace_in_history
= 0;
5047 int add_to_history
= 0;
5051 dir
= current_buffer
->directory
;
5052 if (NILP (default_filename
))
5054 if (! NILP (initial
))
5055 default_filename
= Fexpand_file_name (initial
, dir
);
5057 default_filename
= current_buffer
->filename
;
5060 /* If dir starts with user's homedir, change that to ~. */
5061 homedir
= (char *) egetenv ("HOME");
5063 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5064 CORRECT_DIR_SEPS (homedir
);
5068 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5069 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5071 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5072 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5073 XSTRING (dir
)->data
[0] = '~';
5076 if (insert_default_directory
&& STRINGP (dir
))
5079 if (!NILP (initial
))
5081 Lisp_Object args
[2], pos
;
5085 insdef
= Fconcat (2, args
);
5086 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5087 insdef1
= Fcons (double_dollars (insdef
), pos
);
5090 insdef1
= double_dollars (insdef
);
5092 else if (STRINGP (initial
))
5095 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5098 insdef
= Qnil
, insdef1
= Qnil
;
5101 count
= specpdl_ptr
- specpdl
;
5102 specbind (intern ("completion-ignore-case"), Qt
);
5105 GCPRO2 (insdef
, default_filename
);
5106 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5107 dir
, mustmatch
, insdef1
,
5108 Qfile_name_history
, default_filename
, Qnil
);
5110 tem
= Fsymbol_value (Qfile_name_history
);
5111 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5112 replace_in_history
= 1;
5114 /* If Fcompleting_read returned the inserted default string itself
5115 (rather than a new string with the same contents),
5116 it has to mean that the user typed RET with the minibuffer empty.
5117 In that case, we really want to return ""
5118 so that commands such as set-visited-file-name can distinguish. */
5119 if (EQ (val
, default_filename
))
5121 /* In this case, Fcompleting_read has not added an element
5122 to the history. Maybe we should. */
5123 if (! replace_in_history
)
5126 val
= build_string ("");
5130 unbind_to (count
, Qnil
);
5135 error ("No file name specified");
5137 tem
= Fstring_equal (val
, insdef
);
5139 if (!NILP (tem
) && !NILP (default_filename
))
5140 val
= default_filename
;
5141 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5143 if (!NILP (default_filename
))
5144 val
= default_filename
;
5146 error ("No default file name");
5148 val
= Fsubstitute_in_file_name (val
);
5150 if (replace_in_history
)
5151 /* Replace what Fcompleting_read added to the history
5152 with what we will actually return. */
5153 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5154 else if (add_to_history
)
5156 /* Add the value to the history--but not if it matches
5157 the last value already there. */
5158 tem
= Fsymbol_value (Qfile_name_history
);
5159 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5160 Fset (Qfile_name_history
,
5168 Qexpand_file_name
= intern ("expand-file-name");
5169 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5170 Qdirectory_file_name
= intern ("directory-file-name");
5171 Qfile_name_directory
= intern ("file-name-directory");
5172 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5173 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5174 Qfile_name_as_directory
= intern ("file-name-as-directory");
5175 Qcopy_file
= intern ("copy-file");
5176 Qmake_directory_internal
= intern ("make-directory-internal");
5177 Qdelete_directory
= intern ("delete-directory");
5178 Qdelete_file
= intern ("delete-file");
5179 Qrename_file
= intern ("rename-file");
5180 Qadd_name_to_file
= intern ("add-name-to-file");
5181 Qmake_symbolic_link
= intern ("make-symbolic-link");
5182 Qfile_exists_p
= intern ("file-exists-p");
5183 Qfile_executable_p
= intern ("file-executable-p");
5184 Qfile_readable_p
= intern ("file-readable-p");
5185 Qfile_writable_p
= intern ("file-writable-p");
5186 Qfile_symlink_p
= intern ("file-symlink-p");
5187 Qaccess_file
= intern ("access-file");
5188 Qfile_directory_p
= intern ("file-directory-p");
5189 Qfile_regular_p
= intern ("file-regular-p");
5190 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5191 Qfile_modes
= intern ("file-modes");
5192 Qset_file_modes
= intern ("set-file-modes");
5193 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5194 Qinsert_file_contents
= intern ("insert-file-contents");
5195 Qwrite_region
= intern ("write-region");
5196 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5197 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5199 staticpro (&Qexpand_file_name
);
5200 staticpro (&Qsubstitute_in_file_name
);
5201 staticpro (&Qdirectory_file_name
);
5202 staticpro (&Qfile_name_directory
);
5203 staticpro (&Qfile_name_nondirectory
);
5204 staticpro (&Qunhandled_file_name_directory
);
5205 staticpro (&Qfile_name_as_directory
);
5206 staticpro (&Qcopy_file
);
5207 staticpro (&Qmake_directory_internal
);
5208 staticpro (&Qdelete_directory
);
5209 staticpro (&Qdelete_file
);
5210 staticpro (&Qrename_file
);
5211 staticpro (&Qadd_name_to_file
);
5212 staticpro (&Qmake_symbolic_link
);
5213 staticpro (&Qfile_exists_p
);
5214 staticpro (&Qfile_executable_p
);
5215 staticpro (&Qfile_readable_p
);
5216 staticpro (&Qfile_writable_p
);
5217 staticpro (&Qaccess_file
);
5218 staticpro (&Qfile_symlink_p
);
5219 staticpro (&Qfile_directory_p
);
5220 staticpro (&Qfile_regular_p
);
5221 staticpro (&Qfile_accessible_directory_p
);
5222 staticpro (&Qfile_modes
);
5223 staticpro (&Qset_file_modes
);
5224 staticpro (&Qfile_newer_than_file_p
);
5225 staticpro (&Qinsert_file_contents
);
5226 staticpro (&Qwrite_region
);
5227 staticpro (&Qverify_visited_file_modtime
);
5228 staticpro (&Qset_visited_file_modtime
);
5230 Qfile_name_history
= intern ("file-name-history");
5231 Fset (Qfile_name_history
, Qnil
);
5232 staticpro (&Qfile_name_history
);
5234 Qfile_error
= intern ("file-error");
5235 staticpro (&Qfile_error
);
5236 Qfile_already_exists
= intern ("file-already-exists");
5237 staticpro (&Qfile_already_exists
);
5238 Qfile_date_error
= intern ("file-date-error");
5239 staticpro (&Qfile_date_error
);
5242 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5243 staticpro (&Qfind_buffer_file_type
);
5246 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5247 "*Coding system for encoding file names.");
5248 Vfile_name_coding_system
= Qnil
;
5250 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5251 "*Format in which to write auto-save files.\n\
5252 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5253 If it is t, which is the default, auto-save files are written in the\n\
5254 same format as a regular save would use.");
5255 Vauto_save_file_format
= Qt
;
5257 Qformat_decode
= intern ("format-decode");
5258 staticpro (&Qformat_decode
);
5259 Qformat_annotate_function
= intern ("format-annotate-function");
5260 staticpro (&Qformat_annotate_function
);
5262 Qcar_less_than_car
= intern ("car-less-than-car");
5263 staticpro (&Qcar_less_than_car
);
5265 Fput (Qfile_error
, Qerror_conditions
,
5266 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5267 Fput (Qfile_error
, Qerror_message
,
5268 build_string ("File error"));
5270 Fput (Qfile_already_exists
, Qerror_conditions
,
5271 Fcons (Qfile_already_exists
,
5272 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5273 Fput (Qfile_already_exists
, Qerror_message
,
5274 build_string ("File already exists"));
5276 Fput (Qfile_date_error
, Qerror_conditions
,
5277 Fcons (Qfile_date_error
,
5278 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5279 Fput (Qfile_date_error
, Qerror_message
,
5280 build_string ("Cannot set file date"));
5282 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5283 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5284 insert_default_directory
= 1;
5286 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5287 "*Non-nil means write new files with record format `stmlf'.\n\
5288 nil means use format `var'. This variable is meaningful only on VMS.");
5289 vms_stmlf_recfm
= 0;
5291 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5292 "Directory separator character for built-in functions that return file names.\n\
5293 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5294 This variable affects the built-in functions only on Windows,\n\
5295 on other platforms, it is initialized so that Lisp code can find out\n\
5296 what the normal separator is.");
5297 XSETFASTINT (Vdirectory_sep_char
, '/');
5299 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5300 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5301 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5304 The first argument given to HANDLER is the name of the I/O primitive\n\
5305 to be handled; the remaining arguments are the arguments that were\n\
5306 passed to that primitive. For example, if you do\n\
5307 (file-exists-p FILENAME)\n\
5308 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5309 (funcall HANDLER 'file-exists-p FILENAME)\n\
5310 The function `find-file-name-handler' checks this list for a handler\n\
5311 for its argument.");
5312 Vfile_name_handler_alist
= Qnil
;
5314 DEFVAR_LISP ("set-auto-coding-function",
5315 &Vset_auto_coding_function
,
5316 "If non-nil, a function to call to decide a coding system of file.\n\
5317 One argument is passed to this function: the string of concatination\n\
5318 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5319 This function should return a coding system to decode the file contents\n\
5320 specified in the heading lines with the format:\n\
5321 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5322 or local variable spec of the tailing lines with `coding:' tag.");
5323 Vset_auto_coding_function
= Qnil
;
5325 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5326 "A list of functions to be called at the end of `insert-file-contents'.\n\
5327 Each is passed one argument, the number of bytes inserted. It should return\n\
5328 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5329 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5330 responsible for calling the after-insert-file-functions if appropriate.");
5331 Vafter_insert_file_functions
= Qnil
;
5333 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5334 "A list of functions to be called at the start of `write-region'.\n\
5335 Each is passed two arguments, START and END as for `write-region'.\n\
5336 These are usually two numbers but not always; see the documentation\n\
5337 for `write-region'. The function should return a list of pairs\n\
5338 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5339 inserted at the specified positions of the file being written (1 means to\n\
5340 insert before the first byte written). The POSITIONs must be sorted into\n\
5341 increasing order. If there are several functions in the list, the several\n\
5342 lists are merged destructively.");
5343 Vwrite_region_annotate_functions
= Qnil
;
5345 DEFVAR_LISP ("write-region-annotations-so-far",
5346 &Vwrite_region_annotations_so_far
,
5347 "When an annotation function is called, this holds the previous annotations.\n\
5348 These are the annotations made by other annotation functions\n\
5349 that were already called. See also `write-region-annotate-functions'.");
5350 Vwrite_region_annotations_so_far
= Qnil
;
5352 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5353 "A list of file name handlers that temporarily should not be used.\n\
5354 This applies only to the operation `inhibit-file-name-operation'.");
5355 Vinhibit_file_name_handlers
= Qnil
;
5357 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5358 "The operation for which `inhibit-file-name-handlers' is applicable.");
5359 Vinhibit_file_name_operation
= Qnil
;
5361 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5362 "File name in which we write a list of all auto save file names.\n\
5363 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5364 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5366 Vauto_save_list_file_name
= Qnil
;
5368 defsubr (&Sfind_file_name_handler
);
5369 defsubr (&Sfile_name_directory
);
5370 defsubr (&Sfile_name_nondirectory
);
5371 defsubr (&Sunhandled_file_name_directory
);
5372 defsubr (&Sfile_name_as_directory
);
5373 defsubr (&Sdirectory_file_name
);
5374 defsubr (&Smake_temp_name
);
5375 defsubr (&Sexpand_file_name
);
5376 defsubr (&Ssubstitute_in_file_name
);
5377 defsubr (&Scopy_file
);
5378 defsubr (&Smake_directory_internal
);
5379 defsubr (&Sdelete_directory
);
5380 defsubr (&Sdelete_file
);
5381 defsubr (&Srename_file
);
5382 defsubr (&Sadd_name_to_file
);
5384 defsubr (&Smake_symbolic_link
);
5385 #endif /* S_IFLNK */
5387 defsubr (&Sdefine_logical_name
);
5390 defsubr (&Ssysnetunam
);
5391 #endif /* HPUX_NET */
5392 defsubr (&Sfile_name_absolute_p
);
5393 defsubr (&Sfile_exists_p
);
5394 defsubr (&Sfile_executable_p
);
5395 defsubr (&Sfile_readable_p
);
5396 defsubr (&Sfile_writable_p
);
5397 defsubr (&Saccess_file
);
5398 defsubr (&Sfile_symlink_p
);
5399 defsubr (&Sfile_directory_p
);
5400 defsubr (&Sfile_accessible_directory_p
);
5401 defsubr (&Sfile_regular_p
);
5402 defsubr (&Sfile_modes
);
5403 defsubr (&Sset_file_modes
);
5404 defsubr (&Sset_default_file_modes
);
5405 defsubr (&Sdefault_file_modes
);
5406 defsubr (&Sfile_newer_than_file_p
);
5407 defsubr (&Sinsert_file_contents
);
5408 defsubr (&Swrite_region
);
5409 defsubr (&Scar_less_than_car
);
5410 defsubr (&Sverify_visited_file_modtime
);
5411 defsubr (&Sclear_visited_file_modtime
);
5412 defsubr (&Svisited_file_modtime
);
5413 defsubr (&Sset_visited_file_modtime
);
5414 defsubr (&Sdo_auto_save
);
5415 defsubr (&Sset_buffer_auto_saved
);
5416 defsubr (&Sclear_buffer_auto_save_failure
);
5417 defsubr (&Srecent_auto_save_p
);
5419 defsubr (&Sread_file_name_internal
);
5420 defsubr (&Sread_file_name
);
5423 defsubr (&Sunix_sync
);