1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,1999 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)
83 #include "intervals.h"
94 #endif /* not WINDOWSNT */
98 #include <sys/param.h>
106 #define CORRECT_DIR_SEPS(s) \
107 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
108 else unixtodos_filename (s); \
110 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
111 redirector allows the six letters between 'Z' and 'a' as well. */
113 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
116 #define IS_DRIVE(x) isalpha (x)
118 /* Need to lower-case the drive letter, or else expanded
119 filenames will sometimes compare inequal, because
120 `expand-file-name' doesn't always down-case the drive letter. */
121 #define DRIVE_LETTER(x) (tolower (x))
142 #include "commands.h"
143 extern int use_dialog_box
;
157 #define min(a, b) ((a) < (b) ? (a) : (b))
158 #define max(a, b) ((a) > (b) ? (a) : (b))
160 /* Nonzero during writing of auto-save files */
163 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
164 a new file with the same mode as the original */
165 int auto_save_mode_bits
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Format for auto-save files */
179 Lisp_Object Vauto_save_file_format
;
181 /* Lisp functions for translating file formats */
182 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
184 /* Function to be called to decide a coding system of a reading file. */
185 Lisp_Object Vset_auto_coding_function
;
187 /* Functions to be called to process text properties in inserted file. */
188 Lisp_Object Vafter_insert_file_functions
;
190 /* Functions to be called to create text property annotations for file. */
191 Lisp_Object Vwrite_region_annotate_functions
;
193 /* During build_annotations, each time an annotation function is called,
194 this holds the annotations made by the previous functions. */
195 Lisp_Object Vwrite_region_annotations_so_far
;
197 /* File name in which we write a list of all our auto save files. */
198 Lisp_Object Vauto_save_list_file_name
;
200 /* Nonzero means, when reading a filename in the minibuffer,
201 start out by inserting the default directory into the minibuffer. */
202 int insert_default_directory
;
204 /* On VMS, nonzero means write new files with record format stmlf.
205 Zero means use var format. */
208 /* On NT, specifies the directory separator character, used (eg.) when
209 expanding file names. This can be bound to / or \. */
210 Lisp_Object Vdirectory_sep_char
;
212 extern Lisp_Object Vuser_login_name
;
215 extern Lisp_Object Vw32_get_true_file_attributes
;
218 extern int minibuf_level
;
220 extern int minibuffer_auto_raise
;
222 /* These variables describe handlers that have "already" had a chance
223 to handle the current operation.
225 Vinhibit_file_name_handlers is a list of file name handlers.
226 Vinhibit_file_name_operation is the operation being handled.
227 If we try to handle that operation, we ignore those handlers. */
229 static Lisp_Object Vinhibit_file_name_handlers
;
230 static Lisp_Object Vinhibit_file_name_operation
;
232 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
234 Lisp_Object Qfile_name_history
;
236 Lisp_Object Qcar_less_than_car
;
238 static int a_write
P_ ((int, Lisp_Object
, int, int,
239 Lisp_Object
*, struct coding_system
*));
240 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
244 report_file_error (string
, data
)
248 Lisp_Object errstring
;
251 synchronize_system_messages_locale ();
252 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
253 Vlocale_coding_system
, 0);
259 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
262 /* System error messages are capitalized. Downcase the initial
263 unless it is followed by a slash. */
264 if (XSTRING (errstring
)->data
[1] != '/')
265 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
267 Fsignal (Qfile_error
,
268 Fcons (build_string (string
), Fcons (errstring
, data
)));
273 close_file_unwind (fd
)
276 emacs_close (XFASTINT (fd
));
280 /* Restore point, having saved it as a marker. */
283 restore_point_unwind (location
)
284 Lisp_Object location
;
286 Fgoto_char (location
);
287 Fset_marker (location
, Qnil
, Qnil
);
291 Lisp_Object Qexpand_file_name
;
292 Lisp_Object Qsubstitute_in_file_name
;
293 Lisp_Object Qdirectory_file_name
;
294 Lisp_Object Qfile_name_directory
;
295 Lisp_Object Qfile_name_nondirectory
;
296 Lisp_Object Qunhandled_file_name_directory
;
297 Lisp_Object Qfile_name_as_directory
;
298 Lisp_Object Qcopy_file
;
299 Lisp_Object Qmake_directory_internal
;
300 Lisp_Object Qdelete_directory
;
301 Lisp_Object Qdelete_file
;
302 Lisp_Object Qrename_file
;
303 Lisp_Object Qadd_name_to_file
;
304 Lisp_Object Qmake_symbolic_link
;
305 Lisp_Object Qfile_exists_p
;
306 Lisp_Object Qfile_executable_p
;
307 Lisp_Object Qfile_readable_p
;
308 Lisp_Object Qfile_writable_p
;
309 Lisp_Object Qfile_symlink_p
;
310 Lisp_Object Qaccess_file
;
311 Lisp_Object Qfile_directory_p
;
312 Lisp_Object Qfile_regular_p
;
313 Lisp_Object Qfile_accessible_directory_p
;
314 Lisp_Object Qfile_modes
;
315 Lisp_Object Qset_file_modes
;
316 Lisp_Object Qfile_newer_than_file_p
;
317 Lisp_Object Qinsert_file_contents
;
318 Lisp_Object Qwrite_region
;
319 Lisp_Object Qverify_visited_file_modtime
;
320 Lisp_Object Qset_visited_file_modtime
;
322 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
323 "Return FILENAME's handler function for OPERATION, if it has one.\n\
324 Otherwise, return nil.\n\
325 A file name is handled if one of the regular expressions in\n\
326 `file-name-handler-alist' matches it.\n\n\
327 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
328 any handlers that are members of `inhibit-file-name-handlers',\n\
329 but we still do run any other handlers. This lets handlers\n\
330 use the standard functions without calling themselves recursively.")
331 (filename
, operation
)
332 Lisp_Object filename
, operation
;
334 /* This function must not munge the match data. */
335 Lisp_Object chain
, inhibited_handlers
;
337 CHECK_STRING (filename
, 0);
339 if (EQ (operation
, Vinhibit_file_name_operation
))
340 inhibited_handlers
= Vinhibit_file_name_handlers
;
342 inhibited_handlers
= Qnil
;
344 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
345 chain
= XCDR (chain
))
353 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
355 Lisp_Object handler
, tem
;
357 handler
= XCDR (elt
);
358 tem
= Fmemq (handler
, inhibited_handlers
);
369 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
371 "Return the directory component in file name FILENAME.\n\
372 Return nil if FILENAME does not include a directory.\n\
373 Otherwise return a directory spec.\n\
374 Given a Unix syntax file name, returns a string ending in slash;\n\
375 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
377 Lisp_Object filename
;
379 register unsigned char *beg
;
380 register unsigned char *p
;
383 CHECK_STRING (filename
, 0);
385 /* If the file name has special constructs in it,
386 call the corresponding file handler. */
387 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
389 return call2 (handler
, Qfile_name_directory
, filename
);
391 #ifdef FILE_SYSTEM_CASE
392 filename
= FILE_SYSTEM_CASE (filename
);
394 beg
= XSTRING (filename
)->data
;
396 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
398 p
= beg
+ STRING_BYTES (XSTRING (filename
));
400 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
402 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
405 /* only recognise drive specifier at the beginning */
407 /* handle the "/:d:foo" and "/:foo" cases correctly */
408 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
409 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
416 /* Expansion of "c:" to drive and default directory. */
419 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
420 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
421 unsigned char *r
= res
;
423 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
425 strncpy (res
, beg
, 2);
430 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
432 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
435 p
= beg
+ strlen (beg
);
438 CORRECT_DIR_SEPS (beg
);
441 if (STRING_MULTIBYTE (filename
))
442 return make_string (beg
, p
- beg
);
443 return make_unibyte_string (beg
, p
- beg
);
446 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
447 Sfile_name_nondirectory
, 1, 1, 0,
448 "Return file name FILENAME sans its directory.\n\
449 For example, in a Unix-syntax file name,\n\
450 this is everything after the last slash,\n\
451 or the entire name if it contains no slash.")
453 Lisp_Object filename
;
455 register unsigned char *beg
, *p
, *end
;
458 CHECK_STRING (filename
, 0);
460 /* If the file name has special constructs in it,
461 call the corresponding file handler. */
462 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
464 return call2 (handler
, Qfile_name_nondirectory
, filename
);
466 beg
= XSTRING (filename
)->data
;
467 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
469 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
471 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
474 /* only recognise drive specifier at beginning */
476 /* handle the "/:d:foo" case correctly */
477 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
482 if (STRING_MULTIBYTE (filename
))
483 return make_string (p
, end
- p
);
484 return make_unibyte_string (p
, end
- p
);
487 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
488 Sunhandled_file_name_directory
, 1, 1, 0,
489 "Return a directly usable directory name somehow associated with FILENAME.\n\
490 A `directly usable' directory name is one that may be used without the\n\
491 intervention of any file handler.\n\
492 If FILENAME is a directly usable file itself, return\n\
493 \(file-name-directory FILENAME).\n\
494 The `call-process' and `start-process' functions use this function to\n\
495 get a current directory to run processes in.")
497 Lisp_Object filename
;
501 /* If the file name has special constructs in it,
502 call the corresponding file handler. */
503 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
505 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
507 return Ffile_name_directory (filename
);
512 file_name_as_directory (out
, in
)
515 int size
= strlen (in
) - 1;
528 /* Is it already a directory string? */
529 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
531 /* Is it a VMS directory file name? If so, hack VMS syntax. */
532 else if (! index (in
, '/')
533 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
534 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
535 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
536 || ! strncmp (&in
[size
- 5], ".dir", 4))
537 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
538 && in
[size
] == '1')))
540 register char *p
, *dot
;
544 dir:x.dir --> dir:[x]
545 dir:[x]y.dir --> dir:[x.y] */
547 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
550 strncpy (out
, in
, p
- in
);
569 dot
= index (p
, '.');
572 /* blindly remove any extension */
573 size
= strlen (out
) + (dot
- p
);
574 strncat (out
, p
, dot
- p
);
585 /* For Unix syntax, Append a slash if necessary */
586 if (!IS_DIRECTORY_SEP (out
[size
]))
588 out
[size
+ 1] = DIRECTORY_SEP
;
589 out
[size
+ 2] = '\0';
592 CORRECT_DIR_SEPS (out
);
598 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
599 Sfile_name_as_directory
, 1, 1, 0,
600 "Return a string representing file FILENAME interpreted as a directory.\n\
601 This operation exists because a directory is also a file, but its name as\n\
602 a directory is different from its name as a file.\n\
603 The result can be used as the value of `default-directory'\n\
604 or passed as second argument to `expand-file-name'.\n\
605 For a Unix-syntax file name, just appends a slash.\n\
606 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
613 CHECK_STRING (file
, 0);
617 /* If the file name has special constructs in it,
618 call the corresponding file handler. */
619 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
621 return call2 (handler
, Qfile_name_as_directory
, file
);
623 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
624 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
628 * Convert from directory name to filename.
630 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
631 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
632 * On UNIX, it's simple: just make sure there isn't a terminating /
634 * Value is nonzero if the string output is different from the input.
638 directory_file_name (src
, dst
)
646 struct FAB fab
= cc$rms_fab
;
647 struct NAM nam
= cc$rms_nam
;
648 char esa
[NAM$C_MAXRSS
];
653 if (! index (src
, '/')
654 && (src
[slen
- 1] == ']'
655 || src
[slen
- 1] == ':'
656 || src
[slen
- 1] == '>'))
658 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
660 fab
.fab$b_fns
= slen
;
661 fab
.fab$l_nam
= &nam
;
662 fab
.fab$l_fop
= FAB$M_NAM
;
665 nam
.nam$b_ess
= sizeof esa
;
666 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
668 /* We call SYS$PARSE to handle such things as [--] for us. */
669 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
671 slen
= nam
.nam$b_esl
;
672 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
677 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
679 /* what about when we have logical_name:???? */
680 if (src
[slen
- 1] == ':')
681 { /* Xlate logical name and see what we get */
682 ptr
= strcpy (dst
, src
); /* upper case for getenv */
685 if ('a' <= *ptr
&& *ptr
<= 'z')
689 dst
[slen
- 1] = 0; /* remove colon */
690 if (!(src
= egetenv (dst
)))
692 /* should we jump to the beginning of this procedure?
693 Good points: allows us to use logical names that xlate
695 Bad points: can be a problem if we just translated to a device
697 For now, I'll punt and always expect VMS names, and hope for
700 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
701 { /* no recursion here! */
707 { /* not a directory spec */
712 bracket
= src
[slen
- 1];
714 /* If bracket is ']' or '>', bracket - 2 is the corresponding
716 ptr
= index (src
, bracket
- 2);
718 { /* no opening bracket */
722 if (!(rptr
= rindex (src
, '.')))
725 strncpy (dst
, src
, slen
);
729 dst
[slen
++] = bracket
;
734 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
735 then translate the device and recurse. */
736 if (dst
[slen
- 1] == ':'
737 && dst
[slen
- 2] != ':' /* skip decnet nodes */
738 && strcmp (src
+ slen
, "[000000]") == 0)
740 dst
[slen
- 1] = '\0';
741 if ((ptr
= egetenv (dst
))
742 && (rlen
= strlen (ptr
) - 1) > 0
743 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
744 && ptr
[rlen
- 1] == '.')
746 char * buf
= (char *) alloca (strlen (ptr
) + 1);
750 return directory_file_name (buf
, dst
);
755 strcat (dst
, "[000000]");
759 rlen
= strlen (rptr
) - 1;
760 strncat (dst
, rptr
, rlen
);
761 dst
[slen
+ rlen
] = '\0';
762 strcat (dst
, ".DIR.1");
766 /* Process as Unix format: just remove any final slash.
767 But leave "/" unchanged; do not change it to "". */
770 /* Handle // as root for apollo's. */
771 if ((slen
> 2 && dst
[slen
- 1] == '/')
772 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
776 && IS_DIRECTORY_SEP (dst
[slen
- 1])
778 && !IS_ANY_SEP (dst
[slen
- 2])
784 CORRECT_DIR_SEPS (dst
);
789 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
791 "Returns the file name of the directory named DIRECTORY.\n\
792 This is the name of the file that holds the data for the directory DIRECTORY.\n\
793 This operation exists because a directory is also a file, but its name as\n\
794 a directory is different from its name as a file.\n\
795 In Unix-syntax, this function just removes the final slash.\n\
796 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
797 it returns a file name such as \"[X]Y.DIR.1\".")
799 Lisp_Object directory
;
804 CHECK_STRING (directory
, 0);
806 if (NILP (directory
))
809 /* If the file name has special constructs in it,
810 call the corresponding file handler. */
811 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
813 return call2 (handler
, Qdirectory_file_name
, directory
);
816 /* 20 extra chars is insufficient for VMS, since we might perform a
817 logical name translation. an equivalence string can be up to 255
818 chars long, so grab that much extra space... - sss */
819 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
821 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
823 directory_file_name (XSTRING (directory
)->data
, buf
);
824 return build_string (buf
);
827 static char make_temp_name_tbl
[64] =
829 'A','B','C','D','E','F','G','H',
830 'I','J','K','L','M','N','O','P',
831 'Q','R','S','T','U','V','W','X',
832 'Y','Z','a','b','c','d','e','f',
833 'g','h','i','j','k','l','m','n',
834 'o','p','q','r','s','t','u','v',
835 'w','x','y','z','0','1','2','3',
836 '4','5','6','7','8','9','-','_'
838 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
840 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
841 "Generate temporary file name (string) starting with PREFIX (a string).\n\
842 The Emacs process number forms part of the result,\n\
843 so there is no danger of generating a name being used by another process.\n\
845 In addition, this function makes an attempt to choose a name\n\
846 which has no existing file. To make this work,\n\
847 PREFIX should be an absolute file name.\n\
849 There is a race condition between calling `make-temp-name' and creating the\n\
850 file which opens all kinds of security holes. For that reason, you should\n\
851 probably use `make-temp-file' instead.")
858 unsigned char *p
, *data
;
862 CHECK_STRING (prefix
, 0);
864 /* VAL is created by adding 6 characters to PREFIX. The first
865 three are the PID of this process, in base 64, and the second
866 three are incremented if the file already exists. This ensures
867 262144 unique file names per PID per PREFIX. */
869 pid
= (int) getpid ();
871 #ifdef HAVE_LONG_FILE_NAMES
872 sprintf (pidbuf
, "%d", pid
);
873 pidlen
= strlen (pidbuf
);
875 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
876 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
877 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
881 len
= XSTRING (prefix
)->size
;
882 val
= make_uninit_string (len
+ 3 + pidlen
);
883 data
= XSTRING (val
)->data
;
884 bcopy(XSTRING (prefix
)->data
, data
, len
);
887 bcopy (pidbuf
, p
, pidlen
);
890 /* Here we try to minimize useless stat'ing when this function is
891 invoked many times successively with the same PREFIX. We achieve
892 this by initializing count to a random value, and incrementing it
895 We don't want make-temp-name to be called while dumping,
896 because then make_temp_name_count_initialized_p would get set
897 and then make_temp_name_count would not be set when Emacs starts. */
899 if (!make_temp_name_count_initialized_p
)
901 make_temp_name_count
= (unsigned) time (NULL
);
902 make_temp_name_count_initialized_p
= 1;
908 unsigned num
= make_temp_name_count
;
910 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
911 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
912 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
914 /* Poor man's congruential RN generator. Replace with
915 ++make_temp_name_count for debugging. */
916 make_temp_name_count
+= 25229;
917 make_temp_name_count
%= 225307;
919 if (stat (data
, &ignored
) < 0)
921 /* We want to return only if errno is ENOENT. */
925 /* The error here is dubious, but there is little else we
926 can do. The alternatives are to return nil, which is
927 as bad as (and in many cases worse than) throwing the
928 error, or to ignore the error, which will likely result
929 in looping through 225307 stat's, which is not only
930 dog-slow, but also useless since it will fallback to
931 the errow below, anyway. */
932 report_file_error ("Cannot create temporary name for prefix `%s'",
933 Fcons (prefix
, Qnil
));
938 error ("Cannot create temporary name for prefix `%s'",
939 XSTRING (prefix
)->data
);
944 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
945 "Convert filename NAME to absolute, and canonicalize it.\n\
946 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
947 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
948 the current buffer's value of default-directory is used.\n\
949 File name components that are `.' are removed, and \n\
950 so are file name components followed by `..', along with the `..' itself;\n\
951 note that these simplifications are done without checking the resulting\n\
952 file names in the file system.\n\
953 An initial `~/' expands to your home directory.\n\
954 An initial `~USER/' expands to USER's home directory.\n\
955 See also the function `substitute-in-file-name'.")
956 (name
, default_directory
)
957 Lisp_Object name
, default_directory
;
961 register unsigned char *newdir
, *p
, *o
;
963 unsigned char *target
;
966 unsigned char * colon
= 0;
967 unsigned char * close
= 0;
968 unsigned char * slash
= 0;
969 unsigned char * brack
= 0;
970 int lbrack
= 0, rbrack
= 0;
975 int collapse_newdir
= 1;
981 CHECK_STRING (name
, 0);
983 /* If the file name has special constructs in it,
984 call the corresponding file handler. */
985 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
987 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
989 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
990 if (NILP (default_directory
))
991 default_directory
= current_buffer
->directory
;
992 if (! STRINGP (default_directory
))
993 default_directory
= build_string ("/");
995 if (!NILP (default_directory
))
997 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
999 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1002 o
= XSTRING (default_directory
)->data
;
1004 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1005 It would be better to do this down below where we actually use
1006 default_directory. Unfortunately, calling Fexpand_file_name recursively
1007 could invoke GC, and the strings might be relocated. This would
1008 be annoying because we have pointers into strings lying around
1009 that would need adjusting, and people would add new pointers to
1010 the code and forget to adjust them, resulting in intermittent bugs.
1011 Putting this call here avoids all that crud.
1013 The EQ test avoids infinite recursion. */
1014 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1015 /* Save time in some common cases - as long as default_directory
1016 is not relative, it can be canonicalized with name below (if it
1017 is needed at all) without requiring it to be expanded now. */
1019 /* Detect MSDOS file names with drive specifiers. */
1020 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1022 /* Detect Windows file names in UNC format. */
1023 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1025 #else /* not DOS_NT */
1026 /* Detect Unix absolute file names (/... alone is not absolute on
1028 && ! (IS_DIRECTORY_SEP (o
[0]))
1029 #endif /* not DOS_NT */
1032 struct gcpro gcpro1
;
1035 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1040 /* Filenames on VMS are always upper case. */
1041 name
= Fupcase (name
);
1043 #ifdef FILE_SYSTEM_CASE
1044 name
= FILE_SYSTEM_CASE (name
);
1047 nm
= XSTRING (name
)->data
;
1050 /* We will force directory separators to be either all \ or /, so make
1051 a local copy to modify, even if there ends up being no change. */
1052 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1054 /* Note if special escape prefix is present, but remove for now. */
1055 if (nm
[0] == '/' && nm
[1] == ':')
1061 /* Find and remove drive specifier if present; this makes nm absolute
1062 even if the rest of the name appears to be relative. Only look for
1063 drive specifier at the beginning. */
1064 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1071 /* If we see "c://somedir", we want to strip the first slash after the
1072 colon when stripping the drive letter. Otherwise, this expands to
1074 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1076 #endif /* WINDOWSNT */
1080 /* Discard any previous drive specifier if nm is now in UNC format. */
1081 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1087 /* If nm is absolute, look for /./ or /../ sequences; if none are
1088 found, we can probably return right away. We will avoid allocating
1089 a new string if name is already fully expanded. */
1091 IS_DIRECTORY_SEP (nm
[0])
1093 && drive
&& !is_escaped
1096 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1103 /* If it turns out that the filename we want to return is just a
1104 suffix of FILENAME, we don't need to go through and edit
1105 things; we just need to construct a new string using data
1106 starting at the middle of FILENAME. If we set lose to a
1107 non-zero value, that means we've discovered that we can't do
1114 /* Since we know the name is absolute, we can assume that each
1115 element starts with a "/". */
1117 /* "." and ".." are hairy. */
1118 if (IS_DIRECTORY_SEP (p
[0])
1120 && (IS_DIRECTORY_SEP (p
[2])
1122 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1129 /* if dev:[dir]/, move nm to / */
1130 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1131 nm
= (brack
? brack
+ 1 : colon
+ 1);
1132 lbrack
= rbrack
= 0;
1140 /* VMS pre V4.4,convert '-'s in filenames. */
1141 if (lbrack
== rbrack
)
1143 if (dots
< 2) /* this is to allow negative version numbers */
1148 if (lbrack
> rbrack
&&
1149 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1150 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1156 /* count open brackets, reset close bracket pointer */
1157 if (p
[0] == '[' || p
[0] == '<')
1158 lbrack
++, brack
= 0;
1159 /* count close brackets, set close bracket pointer */
1160 if (p
[0] == ']' || p
[0] == '>')
1161 rbrack
++, brack
= p
;
1162 /* detect ][ or >< */
1163 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1165 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1166 nm
= p
+ 1, lose
= 1;
1167 if (p
[0] == ':' && (colon
|| slash
))
1168 /* if dev1:[dir]dev2:, move nm to dev2: */
1174 /* if /name/dev:, move nm to dev: */
1177 /* if node::dev:, move colon following dev */
1178 else if (colon
&& colon
[-1] == ':')
1180 /* if dev1:dev2:, move nm to dev2: */
1181 else if (colon
&& colon
[-1] != ':')
1186 if (p
[0] == ':' && !colon
)
1192 if (lbrack
== rbrack
)
1195 else if (p
[0] == '.')
1203 if (index (nm
, '/'))
1204 return build_string (sys_translate_unix (nm
));
1207 /* Make sure directories are all separated with / or \ as
1208 desired, but avoid allocation of a new string when not
1210 CORRECT_DIR_SEPS (nm
);
1212 if (IS_DIRECTORY_SEP (nm
[1]))
1214 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1215 name
= build_string (nm
);
1219 /* drive must be set, so this is okay */
1220 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1222 name
= make_string (nm
- 2, p
- nm
+ 2);
1223 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1224 XSTRING (name
)->data
[1] = ':';
1227 #else /* not DOS_NT */
1228 if (nm
== XSTRING (name
)->data
)
1230 return build_string (nm
);
1231 #endif /* not DOS_NT */
1235 /* At this point, nm might or might not be an absolute file name. We
1236 need to expand ~ or ~user if present, otherwise prefix nm with
1237 default_directory if nm is not absolute, and finally collapse /./
1238 and /foo/../ sequences.
1240 We set newdir to be the appropriate prefix if one is needed:
1241 - the relevant user directory if nm starts with ~ or ~user
1242 - the specified drive's working dir (DOS/NT only) if nm does not
1244 - the value of default_directory.
1246 Note that these prefixes are not guaranteed to be absolute (except
1247 for the working dir of a drive). Therefore, to ensure we always
1248 return an absolute name, if the final prefix is not absolute we
1249 append it to the current working directory. */
1253 if (nm
[0] == '~') /* prefix ~ */
1255 if (IS_DIRECTORY_SEP (nm
[1])
1259 || nm
[1] == 0) /* ~ by itself */
1261 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1262 newdir
= (unsigned char *) "";
1265 collapse_newdir
= 0;
1268 nm
++; /* Don't leave the slash in nm. */
1271 else /* ~user/filename */
1273 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1278 o
= (unsigned char *) alloca (p
- nm
+ 1);
1279 bcopy ((char *) nm
, o
, p
- nm
);
1282 pw
= (struct passwd
*) getpwnam (o
+ 1);
1285 newdir
= (unsigned char *) pw
-> pw_dir
;
1287 nm
= p
+ 1; /* skip the terminator */
1291 collapse_newdir
= 0;
1296 /* If we don't find a user of that name, leave the name
1297 unchanged; don't move nm forward to p. */
1302 /* On DOS and Windows, nm is absolute if a drive name was specified;
1303 use the drive's current directory as the prefix if needed. */
1304 if (!newdir
&& drive
)
1306 /* Get default directory if needed to make nm absolute. */
1307 if (!IS_DIRECTORY_SEP (nm
[0]))
1309 newdir
= alloca (MAXPATHLEN
+ 1);
1310 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1315 /* Either nm starts with /, or drive isn't mounted. */
1316 newdir
= alloca (4);
1317 newdir
[0] = DRIVE_LETTER (drive
);
1325 /* Finally, if no prefix has been specified and nm is not absolute,
1326 then it must be expanded relative to default_directory. */
1330 /* /... alone is not absolute on DOS and Windows. */
1331 && !IS_DIRECTORY_SEP (nm
[0])
1334 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1341 newdir
= XSTRING (default_directory
)->data
;
1343 /* Note if special escape prefix is present, but remove for now. */
1344 if (newdir
[0] == '/' && newdir
[1] == ':')
1355 /* First ensure newdir is an absolute name. */
1357 /* Detect MSDOS file names with drive specifiers. */
1358 ! (IS_DRIVE (newdir
[0])
1359 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1361 /* Detect Windows file names in UNC format. */
1362 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1366 /* Effectively, let newdir be (expand-file-name newdir cwd).
1367 Because of the admonition against calling expand-file-name
1368 when we have pointers into lisp strings, we accomplish this
1369 indirectly by prepending newdir to nm if necessary, and using
1370 cwd (or the wd of newdir's drive) as the new newdir. */
1372 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1377 if (!IS_DIRECTORY_SEP (nm
[0]))
1379 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1380 file_name_as_directory (tmp
, newdir
);
1384 newdir
= alloca (MAXPATHLEN
+ 1);
1387 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1394 /* Strip off drive name from prefix, if present. */
1395 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1401 /* Keep only a prefix from newdir if nm starts with slash
1402 (//server/share for UNC, nothing otherwise). */
1403 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1406 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1408 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1410 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1412 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1424 /* Get rid of any slash at the end of newdir, unless newdir is
1425 just / or // (an incomplete UNC name). */
1426 length
= strlen (newdir
);
1427 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1429 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1433 unsigned char *temp
= (unsigned char *) alloca (length
);
1434 bcopy (newdir
, temp
, length
- 1);
1435 temp
[length
- 1] = 0;
1443 /* Now concatenate the directory and name to new space in the stack frame */
1444 tlen
+= strlen (nm
) + 1;
1446 /* Reserve space for drive specifier and escape prefix, since either
1447 or both may need to be inserted. (The Microsoft x86 compiler
1448 produces incorrect code if the following two lines are combined.) */
1449 target
= (unsigned char *) alloca (tlen
+ 4);
1451 #else /* not DOS_NT */
1452 target
= (unsigned char *) alloca (tlen
);
1453 #endif /* not DOS_NT */
1459 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1462 /* If newdir is effectively "C:/", then the drive letter will have
1463 been stripped and newdir will be "/". Concatenating with an
1464 absolute directory in nm produces "//", which will then be
1465 incorrectly treated as a network share. Ignore newdir in
1466 this case (keeping the drive letter). */
1467 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1468 && newdir
[1] == '\0'))
1470 strcpy (target
, newdir
);
1474 file_name_as_directory (target
, newdir
);
1477 strcat (target
, nm
);
1479 if (index (target
, '/'))
1480 strcpy (target
, sys_translate_unix (target
));
1483 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1485 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1493 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1499 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1500 /* brackets are offset from each other by 2 */
1503 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1504 /* convert [foo][bar] to [bar] */
1505 while (o
[-1] != '[' && o
[-1] != '<')
1507 else if (*p
== '-' && *o
!= '.')
1510 else if (p
[0] == '-' && o
[-1] == '.' &&
1511 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1512 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1516 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1517 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1519 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1521 /* else [foo.-] ==> [-] */
1527 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1528 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1534 if (!IS_DIRECTORY_SEP (*p
))
1538 else if (IS_DIRECTORY_SEP (p
[0])
1540 && (IS_DIRECTORY_SEP (p
[2])
1543 /* If "/." is the entire filename, keep the "/". Otherwise,
1544 just delete the whole "/.". */
1545 if (o
== target
&& p
[2] == '\0')
1549 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1550 /* `/../' is the "superroot" on certain file systems. */
1552 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1554 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1556 /* Keep initial / only if this is the whole name. */
1557 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1565 #endif /* not VMS */
1569 /* At last, set drive name. */
1571 /* Except for network file name. */
1572 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1573 #endif /* WINDOWSNT */
1575 if (!drive
) abort ();
1577 target
[0] = DRIVE_LETTER (drive
);
1580 /* Reinsert the escape prefix if required. */
1587 CORRECT_DIR_SEPS (target
);
1590 return make_string (target
, o
- target
);
1594 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1595 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1596 "Convert FILENAME to absolute, and canonicalize it.\n\
1597 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1598 (does not start with slash); if DEFAULT is nil or missing,\n\
1599 the current buffer's value of default-directory is used.\n\
1600 Filenames containing `.' or `..' as components are simplified;\n\
1601 initial `~/' expands to your home directory.\n\
1602 See also the function `substitute-in-file-name'.")
1604 Lisp_Object name
, defalt
;
1608 register unsigned char *newdir
, *p
, *o
;
1610 unsigned char *target
;
1614 unsigned char * colon
= 0;
1615 unsigned char * close
= 0;
1616 unsigned char * slash
= 0;
1617 unsigned char * brack
= 0;
1618 int lbrack
= 0, rbrack
= 0;
1622 CHECK_STRING (name
, 0);
1625 /* Filenames on VMS are always upper case. */
1626 name
= Fupcase (name
);
1629 nm
= XSTRING (name
)->data
;
1631 /* If nm is absolute, flush ...// and detect /./ and /../.
1632 If no /./ or /../ we can return right away. */
1644 if (p
[0] == '/' && p
[1] == '/'
1646 /* // at start of filename is meaningful on Apollo system. */
1651 if (p
[0] == '/' && p
[1] == '~')
1652 nm
= p
+ 1, lose
= 1;
1653 if (p
[0] == '/' && p
[1] == '.'
1654 && (p
[2] == '/' || p
[2] == 0
1655 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1661 /* if dev:[dir]/, move nm to / */
1662 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1663 nm
= (brack
? brack
+ 1 : colon
+ 1);
1664 lbrack
= rbrack
= 0;
1672 /* VMS pre V4.4,convert '-'s in filenames. */
1673 if (lbrack
== rbrack
)
1675 if (dots
< 2) /* this is to allow negative version numbers */
1680 if (lbrack
> rbrack
&&
1681 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1682 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1688 /* count open brackets, reset close bracket pointer */
1689 if (p
[0] == '[' || p
[0] == '<')
1690 lbrack
++, brack
= 0;
1691 /* count close brackets, set close bracket pointer */
1692 if (p
[0] == ']' || p
[0] == '>')
1693 rbrack
++, brack
= p
;
1694 /* detect ][ or >< */
1695 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1697 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1698 nm
= p
+ 1, lose
= 1;
1699 if (p
[0] == ':' && (colon
|| slash
))
1700 /* if dev1:[dir]dev2:, move nm to dev2: */
1706 /* If /name/dev:, move nm to dev: */
1709 /* If node::dev:, move colon following dev */
1710 else if (colon
&& colon
[-1] == ':')
1712 /* If dev1:dev2:, move nm to dev2: */
1713 else if (colon
&& colon
[-1] != ':')
1718 if (p
[0] == ':' && !colon
)
1724 if (lbrack
== rbrack
)
1727 else if (p
[0] == '.')
1735 if (index (nm
, '/'))
1736 return build_string (sys_translate_unix (nm
));
1738 if (nm
== XSTRING (name
)->data
)
1740 return build_string (nm
);
1744 /* Now determine directory to start with and put it in NEWDIR */
1748 if (nm
[0] == '~') /* prefix ~ */
1753 || nm
[1] == 0)/* ~/filename */
1755 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1756 newdir
= (unsigned char *) "";
1759 nm
++; /* Don't leave the slash in nm. */
1762 else /* ~user/filename */
1764 /* Get past ~ to user */
1765 unsigned char *user
= nm
+ 1;
1766 /* Find end of name. */
1767 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1768 int len
= ptr
? ptr
- user
: strlen (user
);
1770 unsigned char *ptr1
= index (user
, ':');
1771 if (ptr1
!= 0 && ptr1
- user
< len
)
1774 /* Copy the user name into temp storage. */
1775 o
= (unsigned char *) alloca (len
+ 1);
1776 bcopy ((char *) user
, o
, len
);
1779 /* Look up the user name. */
1780 pw
= (struct passwd
*) getpwnam (o
+ 1);
1782 error ("\"%s\" isn't a registered user", o
+ 1);
1784 newdir
= (unsigned char *) pw
->pw_dir
;
1786 /* Discard the user name from NM. */
1793 #endif /* not VMS */
1797 defalt
= current_buffer
->directory
;
1798 CHECK_STRING (defalt
, 1);
1799 newdir
= XSTRING (defalt
)->data
;
1802 /* Now concatenate the directory and name to new space in the stack frame */
1804 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1805 target
= (unsigned char *) alloca (tlen
);
1811 if (nm
[0] == 0 || nm
[0] == '/')
1812 strcpy (target
, newdir
);
1815 file_name_as_directory (target
, newdir
);
1818 strcat (target
, nm
);
1820 if (index (target
, '/'))
1821 strcpy (target
, sys_translate_unix (target
));
1824 /* Now canonicalize by removing /. and /foo/.. if they appear */
1832 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1838 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1839 /* brackets are offset from each other by 2 */
1842 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1843 /* convert [foo][bar] to [bar] */
1844 while (o
[-1] != '[' && o
[-1] != '<')
1846 else if (*p
== '-' && *o
!= '.')
1849 else if (p
[0] == '-' && o
[-1] == '.' &&
1850 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1851 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1855 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1856 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1858 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1860 /* else [foo.-] ==> [-] */
1866 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1867 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1877 else if (!strncmp (p
, "//", 2)
1879 /* // at start of filename is meaningful in Apollo system. */
1887 else if (p
[0] == '/' && p
[1] == '.' &&
1888 (p
[2] == '/' || p
[2] == 0))
1890 else if (!strncmp (p
, "/..", 3)
1891 /* `/../' is the "superroot" on certain file systems. */
1893 && (p
[3] == '/' || p
[3] == 0))
1895 while (o
!= target
&& *--o
!= '/')
1898 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1902 if (o
== target
&& *o
== '/')
1910 #endif /* not VMS */
1913 return make_string (target
, o
- target
);
1917 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1918 Ssubstitute_in_file_name
, 1, 1, 0,
1919 "Substitute environment variables referred to in FILENAME.\n\
1920 `$FOO' where FOO is an environment variable name means to substitute\n\
1921 the value of that variable. The variable name should be terminated\n\
1922 with a character not a letter, digit or underscore; otherwise, enclose\n\
1923 the entire variable name in braces.\n\
1924 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1925 On VMS, `$' substitution is not done; this function does little and only\n\
1926 duplicates what `expand-file-name' does.")
1928 Lisp_Object filename
;
1932 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1933 unsigned char *target
;
1935 int substituted
= 0;
1937 Lisp_Object handler
;
1939 CHECK_STRING (filename
, 0);
1941 /* If the file name has special constructs in it,
1942 call the corresponding file handler. */
1943 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1944 if (!NILP (handler
))
1945 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1947 nm
= XSTRING (filename
)->data
;
1949 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1950 CORRECT_DIR_SEPS (nm
);
1951 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1953 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1955 /* If /~ or // appears, discard everything through first slash. */
1957 for (p
= nm
; p
!= endp
; p
++)
1960 #if defined (APOLLO) || defined (WINDOWSNT)
1961 /* // at start of file name is meaningful in Apollo and
1962 WindowsNT systems. */
1963 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1964 #else /* not (APOLLO || WINDOWSNT) */
1965 || IS_DIRECTORY_SEP (p
[0])
1966 #endif /* not (APOLLO || WINDOWSNT) */
1971 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1973 || IS_DIRECTORY_SEP (p
[-1])))
1979 /* see comment in expand-file-name about drive specifiers */
1980 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1981 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1990 return build_string (nm
);
1993 /* See if any variables are substituted into the string
1994 and find the total length of their values in `total' */
1996 for (p
= nm
; p
!= endp
;)
2006 /* "$$" means a single "$" */
2015 while (p
!= endp
&& *p
!= '}') p
++;
2016 if (*p
!= '}') goto missingclose
;
2022 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2026 /* Copy out the variable name */
2027 target
= (unsigned char *) alloca (s
- o
+ 1);
2028 strncpy (target
, o
, s
- o
);
2031 strupr (target
); /* $home == $HOME etc. */
2034 /* Get variable value */
2035 o
= (unsigned char *) egetenv (target
);
2036 if (!o
) goto badvar
;
2037 total
+= strlen (o
);
2044 /* If substitution required, recopy the string and do it */
2045 /* Make space in stack frame for the new copy */
2046 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2049 /* Copy the rest of the name through, replacing $ constructs with values */
2066 while (p
!= endp
&& *p
!= '}') p
++;
2067 if (*p
!= '}') goto missingclose
;
2073 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2077 /* Copy out the variable name */
2078 target
= (unsigned char *) alloca (s
- o
+ 1);
2079 strncpy (target
, o
, s
- o
);
2082 strupr (target
); /* $home == $HOME etc. */
2085 /* Get variable value */
2086 o
= (unsigned char *) egetenv (target
);
2090 if (STRING_MULTIBYTE (filename
))
2092 /* If the original string is multibyte,
2093 convert what we substitute into multibyte. */
2096 int c
= unibyte_char_to_multibyte (*o
++);
2097 x
+= CHAR_STRING (c
, x
);
2109 /* If /~ or // appears, discard everything through first slash. */
2111 for (p
= xnm
; p
!= x
; p
++)
2113 #if defined (APOLLO) || defined (WINDOWSNT)
2114 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2115 #else /* not (APOLLO || WINDOWSNT) */
2116 || IS_DIRECTORY_SEP (p
[0])
2117 #endif /* not (APOLLO || WINDOWSNT) */
2119 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2122 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2123 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2127 if (STRING_MULTIBYTE (filename
))
2128 return make_string (xnm
, x
- xnm
);
2129 return make_unibyte_string (xnm
, x
- xnm
);
2132 error ("Bad format environment-variable substitution");
2134 error ("Missing \"}\" in environment-variable substitution");
2136 error ("Substituting nonexistent environment variable \"%s\"", target
);
2139 #endif /* not VMS */
2142 /* A slightly faster and more convenient way to get
2143 (directory-file-name (expand-file-name FOO)). */
2146 expand_and_dir_to_file (filename
, defdir
)
2147 Lisp_Object filename
, defdir
;
2149 register Lisp_Object absname
;
2151 absname
= Fexpand_file_name (filename
, defdir
);
2154 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2155 if (c
== ':' || c
== ']' || c
== '>')
2156 absname
= Fdirectory_file_name (absname
);
2159 /* Remove final slash, if any (unless this is the root dir).
2160 stat behaves differently depending! */
2161 if (XSTRING (absname
)->size
> 1
2162 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2163 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2164 /* We cannot take shortcuts; they might be wrong for magic file names. */
2165 absname
= Fdirectory_file_name (absname
);
2170 /* Signal an error if the file ABSNAME already exists.
2171 If INTERACTIVE is nonzero, ask the user whether to proceed,
2172 and bypass the error if the user says to go ahead.
2173 QUERYSTRING is a name for the action that is being considered
2176 *STATPTR is used to store the stat information if the file exists.
2177 If the file does not exist, STATPTR->st_mode is set to 0.
2178 If STATPTR is null, we don't store into it.
2180 If QUICK is nonzero, we ask for y or n, not yes or no. */
2183 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2184 Lisp_Object absname
;
2185 unsigned char *querystring
;
2187 struct stat
*statptr
;
2190 register Lisp_Object tem
, encoded_filename
;
2191 struct stat statbuf
;
2192 struct gcpro gcpro1
;
2194 encoded_filename
= ENCODE_FILE (absname
);
2196 /* stat is a good way to tell whether the file exists,
2197 regardless of what access permissions it has. */
2198 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2201 Fsignal (Qfile_already_exists
,
2202 Fcons (build_string ("File already exists"),
2203 Fcons (absname
, Qnil
)));
2205 tem
= format1 ("File %s already exists; %s anyway? ",
2206 XSTRING (absname
)->data
, querystring
);
2208 tem
= Fy_or_n_p (tem
);
2210 tem
= do_yes_or_no_p (tem
);
2213 Fsignal (Qfile_already_exists
,
2214 Fcons (build_string ("File already exists"),
2215 Fcons (absname
, Qnil
)));
2222 statptr
->st_mode
= 0;
2227 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2228 "fCopy file: \nFCopy %s to file: \np\nP",
2229 "Copy FILE to NEWNAME. Both args must be strings.\n\
2230 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2231 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2232 A number as third arg means request confirmation if NEWNAME already exists.\n\
2233 This is what happens in interactive use with M-x.\n\
2234 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2235 last-modified time as the old one. (This works on only some systems.)\n\
2236 A prefix arg makes KEEP-TIME non-nil.")
2237 (file
, newname
, ok_if_already_exists
, keep_date
)
2238 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2241 char buf
[16 * 1024];
2242 struct stat st
, out_st
;
2243 Lisp_Object handler
;
2244 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2245 int count
= specpdl_ptr
- specpdl
;
2246 int input_file_statable_p
;
2247 Lisp_Object encoded_file
, encoded_newname
;
2249 encoded_file
= encoded_newname
= Qnil
;
2250 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2251 CHECK_STRING (file
, 0);
2252 CHECK_STRING (newname
, 1);
2254 file
= Fexpand_file_name (file
, Qnil
);
2255 newname
= Fexpand_file_name (newname
, Qnil
);
2257 /* If the input file name has special constructs in it,
2258 call the corresponding file handler. */
2259 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2260 /* Likewise for output file name. */
2262 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2263 if (!NILP (handler
))
2264 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2265 ok_if_already_exists
, keep_date
));
2267 encoded_file
= ENCODE_FILE (file
);
2268 encoded_newname
= ENCODE_FILE (newname
);
2270 if (NILP (ok_if_already_exists
)
2271 || INTEGERP (ok_if_already_exists
))
2272 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2273 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2274 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2277 ifd
= emacs_open (XSTRING (encoded_file
)->data
, O_RDONLY
, 0);
2279 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2281 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2283 /* We can only copy regular files and symbolic links. Other files are not
2285 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2287 #if !defined (DOS_NT) || __DJGPP__ > 1
2288 if (out_st
.st_mode
!= 0
2289 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2292 report_file_error ("Input and output files are the same",
2293 Fcons (file
, Fcons (newname
, Qnil
)));
2297 #if defined (S_ISREG) && defined (S_ISLNK)
2298 if (input_file_statable_p
)
2300 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2302 #if defined (EISDIR)
2303 /* Get a better looking error message. */
2306 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2309 #endif /* S_ISREG && S_ISLNK */
2312 /* Create the copy file with the same record format as the input file */
2313 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2316 /* System's default file type was set to binary by _fmode in emacs.c. */
2317 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2318 #else /* not MSDOS */
2319 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2320 #endif /* not MSDOS */
2323 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2325 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2329 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2330 if (emacs_write (ofd
, buf
, n
) != n
)
2331 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2334 /* Closing the output clobbers the file times on some systems. */
2335 if (emacs_close (ofd
) < 0)
2336 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2338 if (input_file_statable_p
)
2340 if (!NILP (keep_date
))
2342 EMACS_TIME atime
, mtime
;
2343 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2344 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2345 if (set_file_times (XSTRING (encoded_newname
)->data
,
2347 Fsignal (Qfile_date_error
,
2348 Fcons (build_string ("Cannot set file date"),
2349 Fcons (newname
, Qnil
)));
2352 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2354 #if defined (__DJGPP__) && __DJGPP__ > 1
2355 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2356 and if it can't, it tells so. Otherwise, under MSDOS we usually
2357 get only the READ bit, which will make the copied file read-only,
2358 so it's better not to chmod at all. */
2359 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2360 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2361 #endif /* DJGPP version 2 or newer */
2367 /* Discard the unwind protects. */
2368 specpdl_ptr
= specpdl
+ count
;
2374 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2375 Smake_directory_internal
, 1, 1, 0,
2376 "Create a new directory named DIRECTORY.")
2378 Lisp_Object directory
;
2381 Lisp_Object handler
;
2382 Lisp_Object encoded_dir
;
2384 CHECK_STRING (directory
, 0);
2385 directory
= Fexpand_file_name (directory
, Qnil
);
2387 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2388 if (!NILP (handler
))
2389 return call2 (handler
, Qmake_directory_internal
, directory
);
2391 encoded_dir
= ENCODE_FILE (directory
);
2393 dir
= XSTRING (encoded_dir
)->data
;
2396 if (mkdir (dir
) != 0)
2398 if (mkdir (dir
, 0777) != 0)
2400 report_file_error ("Creating directory", Flist (1, &directory
));
2405 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2406 "Delete the directory named DIRECTORY.")
2408 Lisp_Object directory
;
2411 Lisp_Object handler
;
2412 Lisp_Object encoded_dir
;
2414 CHECK_STRING (directory
, 0);
2415 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2417 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2418 if (!NILP (handler
))
2419 return call2 (handler
, Qdelete_directory
, directory
);
2421 encoded_dir
= ENCODE_FILE (directory
);
2423 dir
= XSTRING (encoded_dir
)->data
;
2425 if (rmdir (dir
) != 0)
2426 report_file_error ("Removing directory", Flist (1, &directory
));
2431 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2432 "Delete file named FILENAME.\n\
2433 If file has multiple names, it continues to exist with the other names.")
2435 Lisp_Object filename
;
2437 Lisp_Object handler
;
2438 Lisp_Object encoded_file
;
2440 CHECK_STRING (filename
, 0);
2441 filename
= Fexpand_file_name (filename
, Qnil
);
2443 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2444 if (!NILP (handler
))
2445 return call2 (handler
, Qdelete_file
, filename
);
2447 encoded_file
= ENCODE_FILE (filename
);
2449 if (0 > unlink (XSTRING (encoded_file
)->data
))
2450 report_file_error ("Removing old name", Flist (1, &filename
));
2455 internal_delete_file_1 (ignore
)
2461 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2464 internal_delete_file (filename
)
2465 Lisp_Object filename
;
2467 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2468 Qt
, internal_delete_file_1
));
2471 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2472 "fRename file: \nFRename %s to file: \np",
2473 "Rename FILE as NEWNAME. Both args strings.\n\
2474 If file has names other than FILE, it continues to have those names.\n\
2475 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2476 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2477 A number as third arg means request confirmation if NEWNAME already exists.\n\
2478 This is what happens in interactive use with M-x.")
2479 (file
, newname
, ok_if_already_exists
)
2480 Lisp_Object file
, newname
, ok_if_already_exists
;
2483 Lisp_Object args
[2];
2485 Lisp_Object handler
;
2486 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2487 Lisp_Object encoded_file
, encoded_newname
;
2489 encoded_file
= encoded_newname
= Qnil
;
2490 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2491 CHECK_STRING (file
, 0);
2492 CHECK_STRING (newname
, 1);
2493 file
= Fexpand_file_name (file
, Qnil
);
2494 newname
= Fexpand_file_name (newname
, Qnil
);
2496 /* If the file name has special constructs in it,
2497 call the corresponding file handler. */
2498 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2500 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2501 if (!NILP (handler
))
2502 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2503 file
, newname
, ok_if_already_exists
));
2505 encoded_file
= ENCODE_FILE (file
);
2506 encoded_newname
= ENCODE_FILE (newname
);
2508 if (NILP (ok_if_already_exists
)
2509 || INTEGERP (ok_if_already_exists
))
2510 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2511 INTEGERP (ok_if_already_exists
), 0, 0);
2513 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2515 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2516 || 0 > unlink (XSTRING (encoded_file
)->data
))
2521 Fcopy_file (file
, newname
,
2522 /* We have already prompted if it was an integer,
2523 so don't have copy-file prompt again. */
2524 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2525 Fdelete_file (file
);
2532 report_file_error ("Renaming", Flist (2, args
));
2535 report_file_error ("Renaming", Flist (2, &file
));
2542 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2543 "fAdd name to file: \nFName to add to %s: \np",
2544 "Give FILE additional name NEWNAME. Both args strings.\n\
2545 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2546 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2547 A number as third arg means request confirmation if NEWNAME already exists.\n\
2548 This is what happens in interactive use with M-x.")
2549 (file
, newname
, ok_if_already_exists
)
2550 Lisp_Object file
, newname
, ok_if_already_exists
;
2553 Lisp_Object args
[2];
2555 Lisp_Object handler
;
2556 Lisp_Object encoded_file
, encoded_newname
;
2557 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2559 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2560 encoded_file
= encoded_newname
= Qnil
;
2561 CHECK_STRING (file
, 0);
2562 CHECK_STRING (newname
, 1);
2563 file
= Fexpand_file_name (file
, Qnil
);
2564 newname
= Fexpand_file_name (newname
, Qnil
);
2566 /* If the file name has special constructs in it,
2567 call the corresponding file handler. */
2568 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2569 if (!NILP (handler
))
2570 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2571 newname
, ok_if_already_exists
));
2573 /* If the new name has special constructs in it,
2574 call the corresponding file handler. */
2575 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2576 if (!NILP (handler
))
2577 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2578 newname
, ok_if_already_exists
));
2580 encoded_file
= ENCODE_FILE (file
);
2581 encoded_newname
= ENCODE_FILE (newname
);
2583 if (NILP (ok_if_already_exists
)
2584 || INTEGERP (ok_if_already_exists
))
2585 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2586 INTEGERP (ok_if_already_exists
), 0, 0);
2588 unlink (XSTRING (newname
)->data
);
2589 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2594 report_file_error ("Adding new name", Flist (2, args
));
2596 report_file_error ("Adding new name", Flist (2, &file
));
2605 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2606 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2607 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2608 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2609 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2610 A number as third arg means request confirmation if LINKNAME already exists.\n\
2611 This happens for interactive use with M-x.")
2612 (filename
, linkname
, ok_if_already_exists
)
2613 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2616 Lisp_Object args
[2];
2618 Lisp_Object handler
;
2619 Lisp_Object encoded_filename
, encoded_linkname
;
2620 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2622 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2623 encoded_filename
= encoded_linkname
= Qnil
;
2624 CHECK_STRING (filename
, 0);
2625 CHECK_STRING (linkname
, 1);
2626 /* If the link target has a ~, we must expand it to get
2627 a truly valid file name. Otherwise, do not expand;
2628 we want to permit links to relative file names. */
2629 if (XSTRING (filename
)->data
[0] == '~')
2630 filename
= Fexpand_file_name (filename
, Qnil
);
2631 linkname
= Fexpand_file_name (linkname
, Qnil
);
2633 /* If the file name has special constructs in it,
2634 call the corresponding file handler. */
2635 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2636 if (!NILP (handler
))
2637 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2638 linkname
, ok_if_already_exists
));
2640 /* If the new link name has special constructs in it,
2641 call the corresponding file handler. */
2642 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2643 if (!NILP (handler
))
2644 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2645 linkname
, ok_if_already_exists
));
2647 encoded_filename
= ENCODE_FILE (filename
);
2648 encoded_linkname
= ENCODE_FILE (linkname
);
2650 if (NILP (ok_if_already_exists
)
2651 || INTEGERP (ok_if_already_exists
))
2652 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2653 INTEGERP (ok_if_already_exists
), 0, 0);
2654 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2655 XSTRING (encoded_linkname
)->data
))
2657 /* If we didn't complain already, silently delete existing file. */
2658 if (errno
== EEXIST
)
2660 unlink (XSTRING (encoded_linkname
)->data
);
2661 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2662 XSTRING (encoded_linkname
)->data
))
2672 report_file_error ("Making symbolic link", Flist (2, args
));
2674 report_file_error ("Making symbolic link", Flist (2, &filename
));
2680 #endif /* S_IFLNK */
2684 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2685 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2686 "Define the job-wide logical name NAME to have the value STRING.\n\
2687 If STRING is nil or a null string, the logical name NAME is deleted.")
2692 CHECK_STRING (name
, 0);
2694 delete_logical_name (XSTRING (name
)->data
);
2697 CHECK_STRING (string
, 1);
2699 if (XSTRING (string
)->size
== 0)
2700 delete_logical_name (XSTRING (name
)->data
);
2702 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2711 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2712 "Open a network connection to PATH using LOGIN as the login string.")
2714 Lisp_Object path
, login
;
2718 CHECK_STRING (path
, 0);
2719 CHECK_STRING (login
, 0);
2721 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2723 if (netresult
== -1)
2728 #endif /* HPUX_NET */
2730 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2732 "Return t if file FILENAME specifies an absolute file name.\n\
2733 On Unix, this is a name starting with a `/' or a `~'.")
2735 Lisp_Object filename
;
2739 CHECK_STRING (filename
, 0);
2740 ptr
= XSTRING (filename
)->data
;
2741 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2743 /* ??? This criterion is probably wrong for '<'. */
2744 || index (ptr
, ':') || index (ptr
, '<')
2745 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2749 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2757 /* Return nonzero if file FILENAME exists and can be executed. */
2760 check_executable (filename
)
2764 int len
= strlen (filename
);
2767 if (stat (filename
, &st
) < 0)
2769 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2770 return ((st
.st_mode
& S_IEXEC
) != 0);
2772 return (S_ISREG (st
.st_mode
)
2774 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2775 || stricmp (suffix
, ".exe") == 0
2776 || stricmp (suffix
, ".bat") == 0)
2777 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2778 #endif /* not WINDOWSNT */
2779 #else /* not DOS_NT */
2780 #ifdef HAVE_EUIDACCESS
2781 return (euidaccess (filename
, 1) >= 0);
2783 /* Access isn't quite right because it uses the real uid
2784 and we really want to test with the effective uid.
2785 But Unix doesn't give us a right way to do it. */
2786 return (access (filename
, 1) >= 0);
2788 #endif /* not DOS_NT */
2791 /* Return nonzero if file FILENAME exists and can be written. */
2794 check_writable (filename
)
2799 if (stat (filename
, &st
) < 0)
2801 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2802 #else /* not MSDOS */
2803 #ifdef HAVE_EUIDACCESS
2804 return (euidaccess (filename
, 2) >= 0);
2806 /* Access isn't quite right because it uses the real uid
2807 and we really want to test with the effective uid.
2808 But Unix doesn't give us a right way to do it.
2809 Opening with O_WRONLY could work for an ordinary file,
2810 but would lose for directories. */
2811 return (access (filename
, 2) >= 0);
2813 #endif /* not MSDOS */
2816 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2817 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2818 See also `file-readable-p' and `file-attributes'.")
2820 Lisp_Object filename
;
2822 Lisp_Object absname
;
2823 Lisp_Object handler
;
2824 struct stat statbuf
;
2826 CHECK_STRING (filename
, 0);
2827 absname
= Fexpand_file_name (filename
, Qnil
);
2829 /* If the file name has special constructs in it,
2830 call the corresponding file handler. */
2831 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2832 if (!NILP (handler
))
2833 return call2 (handler
, Qfile_exists_p
, absname
);
2835 absname
= ENCODE_FILE (absname
);
2837 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2840 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2841 "Return t if FILENAME can be executed by you.\n\
2842 For a directory, this means you can access files in that directory.")
2844 Lisp_Object filename
;
2847 Lisp_Object absname
;
2848 Lisp_Object handler
;
2850 CHECK_STRING (filename
, 0);
2851 absname
= Fexpand_file_name (filename
, Qnil
);
2853 /* If the file name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2856 if (!NILP (handler
))
2857 return call2 (handler
, Qfile_executable_p
, absname
);
2859 absname
= ENCODE_FILE (absname
);
2861 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2864 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2865 "Return t if file FILENAME exists and you can read it.\n\
2866 See also `file-exists-p' and `file-attributes'.")
2868 Lisp_Object filename
;
2870 Lisp_Object absname
;
2871 Lisp_Object handler
;
2874 struct stat statbuf
;
2876 CHECK_STRING (filename
, 0);
2877 absname
= Fexpand_file_name (filename
, Qnil
);
2879 /* If the file name has special constructs in it,
2880 call the corresponding file handler. */
2881 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2882 if (!NILP (handler
))
2883 return call2 (handler
, Qfile_readable_p
, absname
);
2885 absname
= ENCODE_FILE (absname
);
2888 /* Under MS-DOS and Windows, open does not work for directories. */
2889 if (access (XSTRING (absname
)->data
, 0) == 0)
2892 #else /* not DOS_NT */
2894 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2895 /* Opening a fifo without O_NONBLOCK can wait.
2896 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2897 except in the case of a fifo, on a system which handles it. */
2898 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2901 if (S_ISFIFO (statbuf
.st_mode
))
2902 flags
|= O_NONBLOCK
;
2904 desc
= emacs_open (XSTRING (absname
)->data
, flags
, 0);
2909 #endif /* not DOS_NT */
2912 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2914 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2915 "Return t if file FILENAME can be written or created by you.")
2917 Lisp_Object filename
;
2919 Lisp_Object absname
, dir
, encoded
;
2920 Lisp_Object handler
;
2921 struct stat statbuf
;
2923 CHECK_STRING (filename
, 0);
2924 absname
= Fexpand_file_name (filename
, Qnil
);
2926 /* If the file name has special constructs in it,
2927 call the corresponding file handler. */
2928 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2929 if (!NILP (handler
))
2930 return call2 (handler
, Qfile_writable_p
, absname
);
2932 encoded
= ENCODE_FILE (absname
);
2933 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2934 return (check_writable (XSTRING (encoded
)->data
)
2937 dir
= Ffile_name_directory (absname
);
2940 dir
= Fdirectory_file_name (dir
);
2944 dir
= Fdirectory_file_name (dir
);
2947 dir
= ENCODE_FILE (dir
);
2948 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2952 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2953 "Access file FILENAME, and get an error if that does not work.\n\
2954 The second argument STRING is used in the error message.\n\
2955 If there is no error, we return nil.")
2957 Lisp_Object filename
, string
;
2959 Lisp_Object handler
, encoded_filename
;
2962 CHECK_STRING (filename
, 0);
2963 CHECK_STRING (string
, 1);
2965 /* If the file name has special constructs in it,
2966 call the corresponding file handler. */
2967 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2968 if (!NILP (handler
))
2969 return call3 (handler
, Qaccess_file
, filename
, string
);
2971 encoded_filename
= ENCODE_FILE (filename
);
2973 fd
= emacs_open (XSTRING (encoded_filename
)->data
, O_RDONLY
, 0);
2975 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2981 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2982 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2983 The value is the name of the file to which it is linked.\n\
2984 Otherwise returns nil.")
2986 Lisp_Object filename
;
2993 Lisp_Object handler
;
2995 CHECK_STRING (filename
, 0);
2996 filename
= Fexpand_file_name (filename
, Qnil
);
2998 /* If the file name has special constructs in it,
2999 call the corresponding file handler. */
3000 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3001 if (!NILP (handler
))
3002 return call2 (handler
, Qfile_symlink_p
, filename
);
3004 filename
= ENCODE_FILE (filename
);
3009 buf
= (char *) xmalloc (bufsize
);
3010 bzero (buf
, bufsize
);
3011 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3012 if (valsize
< bufsize
) break;
3013 /* Buffer was not long enough */
3022 val
= make_string (buf
, valsize
);
3024 val
= DECODE_FILE (val
);
3026 #else /* not S_IFLNK */
3028 #endif /* not S_IFLNK */
3031 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3032 "Return t if FILENAME names an existing directory.\n\
3033 Symbolic links to directories count as directories.\n\
3034 See `file-symlink-p' to distinguish symlinks.")
3036 Lisp_Object filename
;
3038 register Lisp_Object absname
;
3040 Lisp_Object handler
;
3042 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3044 /* If the file name has special constructs in it,
3045 call the corresponding file handler. */
3046 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3047 if (!NILP (handler
))
3048 return call2 (handler
, Qfile_directory_p
, absname
);
3050 absname
= ENCODE_FILE (absname
);
3052 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3054 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3057 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3058 "Return t if file FILENAME is the name of a directory as a file,\n\
3059 and files in that directory can be opened by you. In order to use a\n\
3060 directory as a buffer's current directory, this predicate must return true.\n\
3061 A directory name spec may be given instead; then the value is t\n\
3062 if the directory so specified exists and really is a readable and\n\
3063 searchable directory.")
3065 Lisp_Object filename
;
3067 Lisp_Object handler
;
3069 struct gcpro gcpro1
;
3071 /* If the file name has special constructs in it,
3072 call the corresponding file handler. */
3073 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3074 if (!NILP (handler
))
3075 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3077 /* It's an unlikely combination, but yes we really do need to gcpro:
3078 Suppose that file-accessible-directory-p has no handler, but
3079 file-directory-p does have a handler; this handler causes a GC which
3080 relocates the string in `filename'; and finally file-directory-p
3081 returns non-nil. Then we would end up passing a garbaged string
3082 to file-executable-p. */
3084 tem
= (NILP (Ffile_directory_p (filename
))
3085 || NILP (Ffile_executable_p (filename
)));
3087 return tem
? Qnil
: Qt
;
3090 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3091 "Return t if file FILENAME is the name of a regular file.\n\
3092 This is the sort of file that holds an ordinary stream of data bytes.")
3094 Lisp_Object filename
;
3096 register Lisp_Object absname
;
3098 Lisp_Object handler
;
3100 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3102 /* If the file name has special constructs in it,
3103 call the corresponding file handler. */
3104 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3105 if (!NILP (handler
))
3106 return call2 (handler
, Qfile_regular_p
, absname
);
3108 absname
= ENCODE_FILE (absname
);
3113 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3115 /* Tell stat to use expensive method to get accurate info. */
3116 Vw32_get_true_file_attributes
= Qt
;
3117 result
= stat (XSTRING (absname
)->data
, &st
);
3118 Vw32_get_true_file_attributes
= tem
;
3122 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3125 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3127 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3131 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3132 "Return mode bits of file named FILENAME, as an integer.")
3134 Lisp_Object filename
;
3136 Lisp_Object absname
;
3138 Lisp_Object handler
;
3140 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3142 /* If the file name has special constructs in it,
3143 call the corresponding file handler. */
3144 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3145 if (!NILP (handler
))
3146 return call2 (handler
, Qfile_modes
, absname
);
3148 absname
= ENCODE_FILE (absname
);
3150 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3152 #if defined (MSDOS) && __DJGPP__ < 2
3153 if (check_executable (XSTRING (absname
)->data
))
3154 st
.st_mode
|= S_IEXEC
;
3155 #endif /* MSDOS && __DJGPP__ < 2 */
3157 return make_number (st
.st_mode
& 07777);
3160 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3161 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3162 Only the 12 low bits of MODE are used.")
3164 Lisp_Object filename
, mode
;
3166 Lisp_Object absname
, encoded_absname
;
3167 Lisp_Object handler
;
3169 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3170 CHECK_NUMBER (mode
, 1);
3172 /* If the file name has special constructs in it,
3173 call the corresponding file handler. */
3174 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3175 if (!NILP (handler
))
3176 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3178 encoded_absname
= ENCODE_FILE (absname
);
3180 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3181 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3186 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3187 "Set the file permission bits for newly created files.\n\
3188 The argument MODE should be an integer; only the low 9 bits are used.\n\
3189 This setting is inherited by subprocesses.")
3193 CHECK_NUMBER (mode
, 0);
3195 umask ((~ XINT (mode
)) & 0777);
3200 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3201 "Return the default file protection for created files.\n\
3202 The value is an integer.")
3208 realmask
= umask (0);
3211 XSETINT (value
, (~ realmask
) & 0777);
3217 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3218 "Tell Unix to finish all pending disk updates.")
3227 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3228 "Return t if file FILE1 is newer than file FILE2.\n\
3229 If FILE1 does not exist, the answer is nil;\n\
3230 otherwise, if FILE2 does not exist, the answer is t.")
3232 Lisp_Object file1
, file2
;
3234 Lisp_Object absname1
, absname2
;
3237 Lisp_Object handler
;
3238 struct gcpro gcpro1
, gcpro2
;
3240 CHECK_STRING (file1
, 0);
3241 CHECK_STRING (file2
, 0);
3244 GCPRO2 (absname1
, file2
);
3245 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3246 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3249 /* If the file name has special constructs in it,
3250 call the corresponding file handler. */
3251 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3253 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3254 if (!NILP (handler
))
3255 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3257 GCPRO2 (absname1
, absname2
);
3258 absname1
= ENCODE_FILE (absname1
);
3259 absname2
= ENCODE_FILE (absname2
);
3262 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3265 mtime1
= st
.st_mtime
;
3267 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3270 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3274 Lisp_Object Qfind_buffer_file_type
;
3277 #ifndef READ_BUF_SIZE
3278 #define READ_BUF_SIZE (64 << 10)
3281 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3283 /* This function is called after Lisp functions to decide a coding
3284 system are called, or when they cause an error. Before they are
3285 called, the current buffer is set unibyte and it contains only a
3286 newly inserted text (thus the buffer was empty before the
3289 The functions may set markers, overlays, text properties, or even
3290 alter the buffer contents, change the current buffer.
3292 Here, we reset all those changes by:
3293 o set back the current buffer.
3294 o move all markers and overlays to BEG.
3295 o remove all text properties.
3296 o set back the buffer multibyteness. */
3299 decide_coding_unwind (unwind_data
)
3300 Lisp_Object unwind_data
;
3302 Lisp_Object multibyte
, undo_list
, buffer
;
3304 multibyte
= XCAR (unwind_data
);
3305 unwind_data
= XCDR (unwind_data
);
3306 undo_list
= XCAR (unwind_data
);
3307 buffer
= XCDR (unwind_data
);
3309 if (current_buffer
!= XBUFFER (buffer
))
3310 set_buffer_internal (XBUFFER (buffer
));
3311 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3312 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3313 BUF_INTERVALS (current_buffer
) = 0;
3314 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3316 /* Now we are safe to change the buffer's multibyteness directly. */
3317 current_buffer
->enable_multibyte_characters
= multibyte
;
3318 current_buffer
->undo_list
= undo_list
;
3323 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3325 "Insert contents of file FILENAME after point.\n\
3326 Returns list of absolute file name and number of bytes inserted.\n\
3327 If second argument VISIT is non-nil, the buffer's visited filename\n\
3328 and last save file modtime are set, and it is marked unmodified.\n\
3329 If visiting and the file does not exist, visiting is completed\n\
3330 before the error is signaled.\n\
3331 The optional third and fourth arguments BEG and END\n\
3332 specify what portion of the file to insert.\n\
3333 These arguments count bytes in the file, not characters in the buffer.\n\
3334 If VISIT is non-nil, BEG and END must be nil.\n\
3336 If optional fifth argument REPLACE is non-nil,\n\
3337 it means replace the current buffer contents (in the accessible portion)\n\
3338 with the file contents. This is better than simply deleting and inserting\n\
3339 the whole thing because (1) it preserves some marker positions\n\
3340 and (2) it puts less data in the undo list.\n\
3341 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3342 which is often less than the number of characters to be read.\n\
3344 This does code conversion according to the value of\n\
3345 `coding-system-for-read' or `file-coding-system-alist',\n\
3346 and sets the variable `last-coding-system-used' to the coding system\n\
3348 (filename
, visit
, beg
, end
, replace
)
3349 Lisp_Object filename
, visit
, beg
, end
, replace
;
3354 register int how_much
;
3355 register int unprocessed
;
3356 int count
= specpdl_ptr
- specpdl
;
3357 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3358 Lisp_Object handler
, val
, insval
, orig_filename
;
3361 int not_regular
= 0;
3362 unsigned char read_buf
[READ_BUF_SIZE
];
3363 struct coding_system coding
;
3364 unsigned char buffer
[1 << 14];
3365 int replace_handled
= 0;
3366 int set_coding_system
= 0;
3367 int coding_system_decided
= 0;
3369 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3370 error ("Cannot do file visiting in an indirect buffer");
3372 if (!NILP (current_buffer
->read_only
))
3373 Fbarf_if_buffer_read_only ();
3377 orig_filename
= Qnil
;
3379 GCPRO4 (filename
, val
, p
, orig_filename
);
3381 CHECK_STRING (filename
, 0);
3382 filename
= Fexpand_file_name (filename
, Qnil
);
3384 /* If the file name has special constructs in it,
3385 call the corresponding file handler. */
3386 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3387 if (!NILP (handler
))
3389 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3390 visit
, beg
, end
, replace
);
3391 if (CONSP (val
) && CONSP (XCDR (val
)))
3392 inserted
= XINT (XCAR (XCDR (val
)));
3396 orig_filename
= filename
;
3397 filename
= ENCODE_FILE (filename
);
3403 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3405 /* Tell stat to use expensive method to get accurate info. */
3406 Vw32_get_true_file_attributes
= Qt
;
3407 total
= stat (XSTRING (filename
)->data
, &st
);
3408 Vw32_get_true_file_attributes
= tem
;
3413 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3415 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0
3416 || fstat (fd
, &st
) < 0)
3417 #endif /* not APOLLO */
3418 #endif /* WINDOWSNT */
3420 if (fd
>= 0) emacs_close (fd
);
3423 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3426 if (!NILP (Vcoding_system_for_read
))
3427 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3432 /* This code will need to be changed in order to work on named
3433 pipes, and it's probably just not worth it. So we should at
3434 least signal an error. */
3435 if (!S_ISREG (st
.st_mode
))
3442 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3443 Fsignal (Qfile_error
,
3444 Fcons (build_string ("not a regular file"),
3445 Fcons (orig_filename
, Qnil
)));
3450 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0)
3453 /* Replacement should preserve point as it preserves markers. */
3454 if (!NILP (replace
))
3455 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3457 record_unwind_protect (close_file_unwind
, make_number (fd
));
3459 /* Supposedly happens on VMS. */
3460 if (! not_regular
&& st
.st_size
< 0)
3461 error ("File size is negative");
3463 /* Prevent redisplay optimizations. */
3464 current_buffer
->clip_changed
= 1;
3466 if (!NILP (beg
) || !NILP (end
))
3468 error ("Attempt to visit less than an entire file");
3471 CHECK_NUMBER (beg
, 0);
3473 XSETFASTINT (beg
, 0);
3476 CHECK_NUMBER (end
, 0);
3481 XSETINT (end
, st
.st_size
);
3483 /* Arithmetic overflow can occur if an Emacs integer cannot
3484 represent the file size, or if the calculations below
3485 overflow. The calculations below double the file size
3486 twice, so check that it can be multiplied by 4 safely. */
3487 if (XINT (end
) != st
.st_size
3488 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3489 error ("Maximum buffer size exceeded");
3495 /* Decide the coding system to use for reading the file now
3496 because we can't use an optimized method for handling
3497 `coding:' tag if the current buffer is not empty. */
3501 if (!NILP (Vcoding_system_for_read
))
3502 val
= Vcoding_system_for_read
;
3503 else if (! NILP (replace
))
3504 /* In REPLACE mode, we can use the same coding system
3505 that was used to visit the file. */
3506 val
= current_buffer
->buffer_file_coding_system
;
3509 /* Don't try looking inside a file for a coding system
3510 specification if it is not seekable. */
3511 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3513 /* Find a coding system specified in the heading two
3514 lines or in the tailing several lines of the file.
3515 We assume that the 1K-byte and 3K-byte for heading
3516 and tailing respectively are sufficient for this
3518 int how_many
, nread
;
3520 if (st
.st_size
<= (1024 * 4))
3521 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3524 nread
= emacs_read (fd
, read_buf
, 1024);
3527 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3528 report_file_error ("Setting file position",
3529 Fcons (orig_filename
, Qnil
));
3530 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3535 error ("IO error reading %s: %s",
3536 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3539 int count
= specpdl_ptr
- specpdl
;
3540 struct buffer
*prev
= current_buffer
;
3542 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3543 temp_output_buffer_setup (" *code-converting-work*");
3544 set_buffer_internal (XBUFFER (Vstandard_output
));
3545 current_buffer
->enable_multibyte_characters
= Qnil
;
3546 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3547 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3548 val
= call2 (Vset_auto_coding_function
,
3549 filename
, make_number (nread
));
3550 set_buffer_internal (prev
);
3551 /* Discard the unwind protect for recovering the
3555 /* Rewind the file for the actual read done later. */
3556 if (lseek (fd
, 0, 0) < 0)
3557 report_file_error ("Setting file position",
3558 Fcons (orig_filename
, Qnil
));
3564 /* If we have not yet decided a coding system, check
3565 file-coding-system-alist. */
3566 Lisp_Object args
[6], coding_systems
;
3568 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3569 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3570 coding_systems
= Ffind_operation_coding_system (6, args
);
3571 if (CONSP (coding_systems
))
3572 val
= XCAR (coding_systems
);
3576 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3578 if (NILP (current_buffer
->enable_multibyte_characters
)
3580 /* We must suppress all character code conversion except for
3581 end-of-line conversion. */
3582 setup_raw_text_coding_system (&coding
);
3584 coding_system_decided
= 1;
3587 /* Ensure we always set Vlast_coding_system_used. */
3588 set_coding_system
= 1;
3590 /* If requested, replace the accessible part of the buffer
3591 with the file contents. Avoid replacing text at the
3592 beginning or end of the buffer that matches the file contents;
3593 that preserves markers pointing to the unchanged parts.
3595 Here we implement this feature in an optimized way
3596 for the case where code conversion is NOT needed.
3597 The following if-statement handles the case of conversion
3598 in a less optimal way.
3600 If the code conversion is "automatic" then we try using this
3601 method and hope for the best.
3602 But if we discover the need for conversion, we give up on this method
3603 and let the following if-statement handle the replace job. */
3606 && ! CODING_REQUIRE_DECODING (&coding
)
3607 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3608 || coding
.eol_type
== CODING_EOL_LF
))
3610 /* same_at_start and same_at_end count bytes,
3611 because file access counts bytes
3612 and BEG and END count bytes. */
3613 int same_at_start
= BEGV_BYTE
;
3614 int same_at_end
= ZV_BYTE
;
3616 /* There is still a possibility we will find the need to do code
3617 conversion. If that happens, we set this variable to 1 to
3618 give up on handling REPLACE in the optimized way. */
3619 int giveup_match_end
= 0;
3621 if (XINT (beg
) != 0)
3623 if (lseek (fd
, XINT (beg
), 0) < 0)
3624 report_file_error ("Setting file position",
3625 Fcons (orig_filename
, Qnil
));
3630 /* Count how many chars at the start of the file
3631 match the text at the beginning of the buffer. */
3636 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3638 error ("IO error reading %s: %s",
3639 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3640 else if (nread
== 0)
3643 if (coding
.type
== coding_type_undecided
)
3644 detect_coding (&coding
, buffer
, nread
);
3645 if (CODING_REQUIRE_DECODING (&coding
))
3646 /* We found that the file should be decoded somehow.
3647 Let's give up here. */
3649 giveup_match_end
= 1;
3653 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3654 detect_eol (&coding
, buffer
, nread
);
3655 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3656 && coding
.eol_type
!= CODING_EOL_LF
)
3657 /* We found that the format of eol should be decoded.
3658 Let's give up here. */
3660 giveup_match_end
= 1;
3665 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3666 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3667 same_at_start
++, bufpos
++;
3668 /* If we found a discrepancy, stop the scan.
3669 Otherwise loop around and scan the next bufferful. */
3670 if (bufpos
!= nread
)
3674 /* If the file matches the buffer completely,
3675 there's no need to replace anything. */
3676 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3680 /* Truncate the buffer to the size of the file. */
3681 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3686 /* Count how many chars at the end of the file
3687 match the text at the end of the buffer. But, if we have
3688 already found that decoding is necessary, don't waste time. */
3689 while (!giveup_match_end
)
3691 int total_read
, nread
, bufpos
, curpos
, trial
;
3693 /* At what file position are we now scanning? */
3694 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3695 /* If the entire file matches the buffer tail, stop the scan. */
3698 /* How much can we scan in the next step? */
3699 trial
= min (curpos
, sizeof buffer
);
3700 if (lseek (fd
, curpos
- trial
, 0) < 0)
3701 report_file_error ("Setting file position",
3702 Fcons (orig_filename
, Qnil
));
3705 while (total_read
< trial
)
3707 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3709 error ("IO error reading %s: %s",
3710 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3711 total_read
+= nread
;
3713 /* Scan this bufferful from the end, comparing with
3714 the Emacs buffer. */
3715 bufpos
= total_read
;
3716 /* Compare with same_at_start to avoid counting some buffer text
3717 as matching both at the file's beginning and at the end. */
3718 while (bufpos
> 0 && same_at_end
> same_at_start
3719 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3720 same_at_end
--, bufpos
--;
3722 /* If we found a discrepancy, stop the scan.
3723 Otherwise loop around and scan the preceding bufferful. */
3726 /* If this discrepancy is because of code conversion,
3727 we cannot use this method; giveup and try the other. */
3728 if (same_at_end
> same_at_start
3729 && FETCH_BYTE (same_at_end
- 1) >= 0200
3730 && ! NILP (current_buffer
->enable_multibyte_characters
)
3731 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3732 giveup_match_end
= 1;
3738 if (! giveup_match_end
)
3742 /* We win! We can handle REPLACE the optimized way. */
3744 /* Extend the start of non-matching text area to multibyte
3745 character boundary. */
3746 if (! NILP (current_buffer
->enable_multibyte_characters
))
3747 while (same_at_start
> BEGV_BYTE
3748 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3751 /* Extend the end of non-matching text area to multibyte
3752 character boundary. */
3753 if (! NILP (current_buffer
->enable_multibyte_characters
))
3754 while (same_at_end
< ZV_BYTE
3755 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3758 /* Don't try to reuse the same piece of text twice. */
3759 overlap
= (same_at_start
- BEGV_BYTE
3760 - (same_at_end
+ st
.st_size
- ZV
));
3762 same_at_end
+= overlap
;
3764 /* Arrange to read only the nonmatching middle part of the file. */
3765 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3766 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3768 del_range_byte (same_at_start
, same_at_end
, 0);
3769 /* Insert from the file at the proper position. */
3770 temp
= BYTE_TO_CHAR (same_at_start
);
3771 SET_PT_BOTH (temp
, same_at_start
);
3773 /* If display currently starts at beginning of line,
3774 keep it that way. */
3775 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3776 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3778 replace_handled
= 1;
3782 /* If requested, replace the accessible part of the buffer
3783 with the file contents. Avoid replacing text at the
3784 beginning or end of the buffer that matches the file contents;
3785 that preserves markers pointing to the unchanged parts.
3787 Here we implement this feature for the case where code conversion
3788 is needed, in a simple way that needs a lot of memory.
3789 The preceding if-statement handles the case of no conversion
3790 in a more optimized way. */
3791 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3793 int same_at_start
= BEGV_BYTE
;
3794 int same_at_end
= ZV_BYTE
;
3797 /* Make sure that the gap is large enough. */
3798 int bufsize
= 2 * st
.st_size
;
3799 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3802 /* First read the whole file, performing code conversion into
3803 CONVERSION_BUFFER. */
3805 if (lseek (fd
, XINT (beg
), 0) < 0)
3807 xfree (conversion_buffer
);
3808 report_file_error ("Setting file position",
3809 Fcons (orig_filename
, Qnil
));
3812 total
= st
.st_size
; /* Total bytes in the file. */
3813 how_much
= 0; /* Bytes read from file so far. */
3814 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3815 unprocessed
= 0; /* Bytes not processed in previous loop. */
3817 while (how_much
< total
)
3819 /* try is reserved in some compilers (Microsoft C) */
3820 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3821 unsigned char *destination
= read_buf
+ unprocessed
;
3824 /* Allow quitting out of the actual I/O. */
3827 this = emacs_read (fd
, destination
, trytry
);
3830 if (this < 0 || this + unprocessed
== 0)
3838 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3840 int require
, result
;
3842 this += unprocessed
;
3844 /* If we are using more space than estimated,
3845 make CONVERSION_BUFFER bigger. */
3846 require
= decoding_buffer_size (&coding
, this);
3847 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3849 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3850 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3853 /* Convert this batch with results in CONVERSION_BUFFER. */
3854 if (how_much
>= total
) /* This is the last block. */
3855 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3856 result
= decode_coding (&coding
, read_buf
,
3857 conversion_buffer
+ inserted
,
3858 this, bufsize
- inserted
);
3860 /* Save for next iteration whatever we didn't convert. */
3861 unprocessed
= this - coding
.consumed
;
3862 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3863 this = coding
.produced
;
3869 /* At this point, INSERTED is how many characters (i.e. bytes)
3870 are present in CONVERSION_BUFFER.
3871 HOW_MUCH should equal TOTAL,
3872 or should be <= 0 if we couldn't read the file. */
3876 xfree (conversion_buffer
);
3879 error ("IO error reading %s: %s",
3880 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3881 else if (how_much
== -2)
3882 error ("maximum buffer size exceeded");
3885 /* Compare the beginning of the converted file
3886 with the buffer text. */
3889 while (bufpos
< inserted
&& same_at_start
< same_at_end
3890 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3891 same_at_start
++, bufpos
++;
3893 /* If the file matches the buffer completely,
3894 there's no need to replace anything. */
3896 if (bufpos
== inserted
)
3898 xfree (conversion_buffer
);
3901 /* Truncate the buffer to the size of the file. */
3902 del_range_byte (same_at_start
, same_at_end
, 0);
3907 /* Extend the start of non-matching text area to multibyte
3908 character boundary. */
3909 if (! NILP (current_buffer
->enable_multibyte_characters
))
3910 while (same_at_start
> BEGV_BYTE
3911 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3914 /* Scan this bufferful from the end, comparing with
3915 the Emacs buffer. */
3918 /* Compare with same_at_start to avoid counting some buffer text
3919 as matching both at the file's beginning and at the end. */
3920 while (bufpos
> 0 && same_at_end
> same_at_start
3921 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3922 same_at_end
--, bufpos
--;
3924 /* Extend the end of non-matching text area to multibyte
3925 character boundary. */
3926 if (! NILP (current_buffer
->enable_multibyte_characters
))
3927 while (same_at_end
< ZV_BYTE
3928 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3931 /* Don't try to reuse the same piece of text twice. */
3932 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3934 same_at_end
+= overlap
;
3936 /* If display currently starts at beginning of line,
3937 keep it that way. */
3938 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3939 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3941 /* Replace the chars that we need to replace,
3942 and update INSERTED to equal the number of bytes
3943 we are taking from the file. */
3944 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3946 if (same_at_end
!= same_at_start
)
3948 del_range_byte (same_at_start
, same_at_end
, 0);
3950 same_at_start
= GPT_BYTE
;
3954 temp
= BYTE_TO_CHAR (same_at_start
);
3956 /* Insert from the file at the proper position. */
3957 SET_PT_BOTH (temp
, same_at_start
);
3958 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3960 /* Set `inserted' to the number of inserted characters. */
3961 inserted
= PT
- temp
;
3963 free (conversion_buffer
);
3972 register Lisp_Object temp
;
3974 total
= XINT (end
) - XINT (beg
);
3976 /* Make sure point-max won't overflow after this insertion. */
3977 XSETINT (temp
, total
);
3978 if (total
!= XINT (temp
))
3979 error ("Maximum buffer size exceeded");
3982 /* For a special file, all we can do is guess. */
3983 total
= READ_BUF_SIZE
;
3985 if (NILP (visit
) && total
> 0)
3986 prepare_to_modify_buffer (PT
, PT
, NULL
);
3989 if (GAP_SIZE
< total
)
3990 make_gap (total
- GAP_SIZE
);
3992 if (XINT (beg
) != 0 || !NILP (replace
))
3994 if (lseek (fd
, XINT (beg
), 0) < 0)
3995 report_file_error ("Setting file position",
3996 Fcons (orig_filename
, Qnil
));
3999 /* In the following loop, HOW_MUCH contains the total bytes read so
4000 far for a regular file, and not changed for a special file. But,
4001 before exiting the loop, it is set to a negative value if I/O
4004 /* Total bytes inserted. */
4006 /* Here, we don't do code conversion in the loop. It is done by
4007 code_convert_region after all data are read into the buffer. */
4008 while (how_much
< total
)
4010 /* try is reserved in some compilers (Microsoft C) */
4011 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4014 /* For a special file, GAP_SIZE should be checked every time. */
4015 if (not_regular
&& GAP_SIZE
< trytry
)
4016 make_gap (total
- GAP_SIZE
);
4018 /* Allow quitting out of the actual I/O. */
4021 this = emacs_read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1,
4039 /* For a regular file, where TOTAL is the real size,
4040 count HOW_MUCH to compare with it.
4041 For a special file, where TOTAL is just a buffer size,
4042 so don't bother counting in HOW_MUCH.
4043 (INSERTED is where we count the number of characters inserted.) */
4050 /* Put an anchor to ensure multi-byte form ends at gap. */
4055 /* Discard the unwind protect for closing the file. */
4059 error ("IO error reading %s: %s",
4060 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4062 if (! coding_system_decided
)
4064 /* The coding system is not yet decided. Decide it by an
4065 optimized method for handling `coding:' tag.
4067 Note that we can get here only if the buffer was empty
4068 before the insertion. */
4072 if (!NILP (Vcoding_system_for_read
))
4073 val
= Vcoding_system_for_read
;
4076 /* Since we are sure that the current buffer was empty
4077 before the insertion, we can toggle
4078 enable-multibyte-characters directly here without taking
4079 care of marker adjustment and byte combining problem. By
4080 this way, we can run Lisp program safely before decoding
4081 the inserted text. */
4082 Lisp_Object unwind_data
;
4083 int count
= specpdl_ptr
- specpdl
;
4085 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4086 Fcons (current_buffer
->undo_list
,
4087 Fcurrent_buffer ()));
4088 current_buffer
->enable_multibyte_characters
= Qnil
;
4089 current_buffer
->undo_list
= Qt
;
4090 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4092 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4094 val
= call2 (Vset_auto_coding_function
,
4095 filename
, make_number (inserted
));
4100 /* If the coding system is not yet decided, check
4101 file-coding-system-alist. */
4102 Lisp_Object args
[6], coding_systems
;
4104 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4105 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4106 coding_systems
= Ffind_operation_coding_system (6, args
);
4107 if (CONSP (coding_systems
))
4108 val
= XCAR (coding_systems
);
4111 unbind_to (count
, Qnil
);
4112 inserted
= Z_BYTE
- BEG_BYTE
;
4115 /* The following kludgy code is to avoid some compiler bug.
4117 setup_coding_system (val, &coding);
4120 struct coding_system temp_coding
;
4121 setup_coding_system (val
, &temp_coding
);
4122 bcopy (&temp_coding
, &coding
, sizeof coding
);
4125 if (NILP (current_buffer
->enable_multibyte_characters
)
4127 /* We must suppress all character code conversion except for
4128 end-of-line conversion. */
4129 setup_raw_text_coding_system (&coding
);
4132 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4134 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4136 /* Here, we don't have to consider byte combining (see the
4137 comment below) because code_convert_region takes care of
4139 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4141 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4142 ? coding
.produced
: coding
.produced_char
);
4144 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4146 int inserted_byte
= inserted
;
4148 /* There's a possibility that we must combine bytes at the
4149 head (resp. the tail) of the just inserted text with the
4150 bytes before (resp. after) the gap to form a single
4152 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4153 adjust_after_insert (PT
, PT_BYTE
,
4154 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4158 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4163 /* Use the conversion type to determine buffer-file-type
4164 (find-buffer-file-type is now used to help determine the
4166 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4167 || coding
.eol_type
== CODING_EOL_LF
)
4168 && ! CODING_REQUIRE_DECODING (&coding
))
4169 current_buffer
->buffer_file_type
= Qt
;
4171 current_buffer
->buffer_file_type
= Qnil
;
4179 if (!EQ (current_buffer
->undo_list
, Qt
))
4180 current_buffer
->undo_list
= Qnil
;
4182 stat (XSTRING (filename
)->data
, &st
);
4187 current_buffer
->modtime
= st
.st_mtime
;
4188 current_buffer
->filename
= orig_filename
;
4191 SAVE_MODIFF
= MODIFF
;
4192 current_buffer
->auto_save_modified
= MODIFF
;
4193 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4194 #ifdef CLASH_DETECTION
4197 if (!NILP (current_buffer
->file_truename
))
4198 unlock_file (current_buffer
->file_truename
);
4199 unlock_file (filename
);
4201 #endif /* CLASH_DETECTION */
4203 Fsignal (Qfile_error
,
4204 Fcons (build_string ("not a regular file"),
4205 Fcons (orig_filename
, Qnil
)));
4207 /* If visiting nonexistent file, return nil. */
4208 if (current_buffer
->modtime
== -1)
4209 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4212 /* Decode file format */
4215 insval
= call3 (Qformat_decode
,
4216 Qnil
, make_number (inserted
), visit
);
4217 CHECK_NUMBER (insval
, 0);
4218 inserted
= XFASTINT (insval
);
4221 if (set_coding_system
)
4222 Vlast_coding_system_used
= coding
.symbol
;
4224 /* Call after-change hooks for the inserted text, aside from the case
4225 of normal visiting (not with REPLACE), which is done in a new buffer
4226 "before" the buffer is changed. */
4227 if (inserted
> 0 && total
> 0
4228 && (NILP (visit
) || !NILP (replace
)))
4230 signal_after_change (PT
, 0, inserted
);
4231 update_compositions (PT
, PT
, CHECK_BORDER
);
4236 p
= Vafter_insert_file_functions
;
4239 insval
= call1 (Fcar (p
), make_number (inserted
));
4242 CHECK_NUMBER (insval
, 0);
4243 inserted
= XFASTINT (insval
);
4250 /* ??? Retval needs to be dealt with in all cases consistently. */
4252 val
= Fcons (orig_filename
,
4253 Fcons (make_number (inserted
),
4256 RETURN_UNGCPRO (unbind_to (count
, val
));
4259 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4262 /* If build_annotations switched buffers, switch back to BUF.
4263 Kill the temporary buffer that was selected in the meantime.
4265 Since this kill only the last temporary buffer, some buffers remain
4266 not killed if build_annotations switched buffers more than once.
4270 build_annotations_unwind (buf
)
4275 if (XBUFFER (buf
) == current_buffer
)
4277 tembuf
= Fcurrent_buffer ();
4279 Fkill_buffer (tembuf
);
4283 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4284 "r\nFWrite region to file: \ni\ni\ni\np",
4285 "Write current region into specified file.\n\
4286 When called from a program, takes three arguments:\n\
4287 START, END and FILENAME. START and END are buffer positions.\n\
4288 Optional fourth argument APPEND if non-nil means\n\
4289 append to existing file contents (if any).\n\
4290 Optional fifth argument VISIT if t means\n\
4291 set the last-save-file-modtime of buffer to this file's modtime\n\
4292 and mark buffer not modified.\n\
4293 If VISIT is a string, it is a second file name;\n\
4294 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4295 VISIT is also the file name to lock and unlock for clash detection.\n\
4296 If VISIT is neither t nor nil nor a string,\n\
4297 that means do not print the \"Wrote file\" message.\n\
4298 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4299 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4300 The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
4301 for an existing file with the same name. If MUSTBENEW is `excl',\n\
4302 that means to get an error if the file already exists; never overwrite.\n\
4303 If MUSTBENEW is neither nil nor `excl', that means ask for\n\
4304 confirmation before overwriting, but do go ahead and overwrite the file\n\
4305 if the user confirms.\n\
4306 Kludgy feature: if START is a string, then that string is written\n\
4307 to the file, instead of any buffer contents, and END is ignored.\n\
4309 This does code conversion according to the value of\n\
4310 `coding-system-for-write', `buffer-file-coding-system', or\n\
4311 `file-coding-system-alist', and sets the variable\n\
4312 `last-coding-system-used' to the coding system actually used.")
4314 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4315 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4323 int count
= specpdl_ptr
- specpdl
;
4326 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4328 Lisp_Object handler
;
4329 Lisp_Object visit_file
;
4330 Lisp_Object annotations
;
4331 Lisp_Object encoded_filename
;
4332 int visiting
, quietly
;
4333 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4334 struct buffer
*given_buffer
;
4336 int buffer_file_type
= O_BINARY
;
4338 struct coding_system coding
;
4340 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4341 error ("Cannot do file visiting in an indirect buffer");
4343 if (!NILP (start
) && !STRINGP (start
))
4344 validate_region (&start
, &end
);
4346 GCPRO4 (start
, filename
, visit
, lockname
);
4348 /* Decide the coding-system to encode the data with. */
4354 else if (!NILP (Vcoding_system_for_write
))
4355 val
= Vcoding_system_for_write
;
4358 /* If the variable `buffer-file-coding-system' is set locally,
4359 it means that the file was read with some kind of code
4360 conversion or the varialbe is explicitely set by users. We
4361 had better write it out with the same coding system even if
4362 `enable-multibyte-characters' is nil.
4364 If it is not set locally, we anyway have to convert EOL
4365 format if the default value of `buffer-file-coding-system'
4366 tells that it is not Unix-like (LF only) format. */
4367 int using_default_coding
= 0;
4368 int force_raw_text
= 0;
4370 val
= current_buffer
->buffer_file_coding_system
;
4372 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4375 if (NILP (current_buffer
->enable_multibyte_characters
))
4381 /* Check file-coding-system-alist. */
4382 Lisp_Object args
[7], coding_systems
;
4384 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4385 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4387 coding_systems
= Ffind_operation_coding_system (7, args
);
4388 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4389 val
= XCDR (coding_systems
);
4393 && !NILP (current_buffer
->buffer_file_coding_system
))
4395 /* If we still have not decided a coding system, use the
4396 default value of buffer-file-coding-system. */
4397 val
= current_buffer
->buffer_file_coding_system
;
4398 using_default_coding
= 1;
4402 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4403 /* Confirm that VAL can surely encode the current region. */
4404 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4406 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4407 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4408 && !using_default_coding
)
4410 if (! EQ (default_buffer_file_coding
.symbol
,
4411 buffer_defaults
.buffer_file_coding_system
))
4412 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4413 &default_buffer_file_coding
);
4414 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4416 Lisp_Object subsidiaries
;
4418 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4419 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4420 if (VECTORP (subsidiaries
)
4421 && XVECTOR (subsidiaries
)->size
== 3)
4423 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4428 setup_raw_text_coding_system (&coding
);
4429 goto done_setup_coding
;
4432 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4435 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4436 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4439 Vlast_coding_system_used
= coding
.symbol
;
4441 filename
= Fexpand_file_name (filename
, Qnil
);
4443 if (! NILP (mustbenew
) && mustbenew
!= Qexcl
)
4444 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4446 if (STRINGP (visit
))
4447 visit_file
= Fexpand_file_name (visit
, Qnil
);
4449 visit_file
= filename
;
4452 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4453 quietly
= !NILP (visit
);
4457 if (NILP (lockname
))
4458 lockname
= visit_file
;
4460 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4462 /* If the file name has special constructs in it,
4463 call the corresponding file handler. */
4464 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4465 /* If FILENAME has no handler, see if VISIT has one. */
4466 if (NILP (handler
) && STRINGP (visit
))
4467 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4469 if (!NILP (handler
))
4472 val
= call6 (handler
, Qwrite_region
, start
, end
,
4473 filename
, append
, visit
);
4477 SAVE_MODIFF
= MODIFF
;
4478 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4479 current_buffer
->filename
= visit_file
;
4485 /* Special kludge to simplify auto-saving. */
4488 XSETFASTINT (start
, BEG
);
4489 XSETFASTINT (end
, Z
);
4492 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4493 count1
= specpdl_ptr
- specpdl
;
4495 given_buffer
= current_buffer
;
4496 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4497 if (current_buffer
!= given_buffer
)
4499 XSETFASTINT (start
, BEGV
);
4500 XSETFASTINT (end
, ZV
);
4503 #ifdef CLASH_DETECTION
4506 #if 0 /* This causes trouble for GNUS. */
4507 /* If we've locked this file for some other buffer,
4508 query before proceeding. */
4509 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4510 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4513 lock_file (lockname
);
4515 #endif /* CLASH_DETECTION */
4517 encoded_filename
= ENCODE_FILE (filename
);
4519 fn
= XSTRING (encoded_filename
)->data
;
4523 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4524 #else /* not DOS_NT */
4525 desc
= emacs_open (fn
, O_WRONLY
, 0);
4526 #endif /* not DOS_NT */
4528 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4530 if (auto_saving
) /* Overwrite any previous version of autosave file */
4532 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4533 desc
= emacs_open (fn
, O_RDWR
, 0);
4535 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4536 ? XSTRING (current_buffer
->filename
)->data
: 0,
4539 else /* Write to temporary name and rename if no errors */
4541 Lisp_Object temp_name
;
4542 temp_name
= Ffile_name_directory (filename
);
4544 if (!NILP (temp_name
))
4546 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4547 build_string ("$$SAVE$$")));
4548 fname
= XSTRING (filename
)->data
;
4549 fn
= XSTRING (temp_name
)->data
;
4550 desc
= creat_copy_attrs (fname
, fn
);
4553 /* If we can't open the temporary file, try creating a new
4554 version of the original file. VMS "creat" creates a
4555 new version rather than truncating an existing file. */
4558 desc
= creat (fn
, 0666);
4559 #if 0 /* This can clobber an existing file and fail to replace it,
4560 if the user runs out of space. */
4563 /* We can't make a new version;
4564 try to truncate and rewrite existing version if any. */
4566 desc
= emacs_open (fn
, O_RDWR
, 0);
4572 desc
= creat (fn
, 0666);
4576 desc
= emacs_open (fn
,
4577 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
4578 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4579 S_IREAD
| S_IWRITE
);
4580 #else /* not DOS_NT */
4581 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4582 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4583 auto_saving
? auto_save_mode_bits
: 0666);
4584 #endif /* not DOS_NT */
4585 #endif /* not VMS */
4591 #ifdef CLASH_DETECTION
4593 if (!auto_saving
) unlock_file (lockname
);
4595 #endif /* CLASH_DETECTION */
4596 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4599 record_unwind_protect (close_file_unwind
, make_number (desc
));
4601 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4602 if (lseek (desc
, 0, 2) < 0)
4604 #ifdef CLASH_DETECTION
4605 if (!auto_saving
) unlock_file (lockname
);
4606 #endif /* CLASH_DETECTION */
4607 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4612 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4613 * if we do writes that don't end with a carriage return. Furthermore
4614 * it cannot handle writes of more then 16K. The modified
4615 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4616 * this EXCEPT for the last record (iff it doesn't end with a carriage
4617 * return). This implies that if your buffer doesn't end with a carriage
4618 * return, you get one free... tough. However it also means that if
4619 * we make two calls to sys_write (a la the following code) you can
4620 * get one at the gap as well. The easiest way to fix this (honest)
4621 * is to move the gap to the next newline (or the end of the buffer).
4626 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4627 move_gap (find_next_newline (GPT
, 1));
4629 /* Whether VMS or not, we must move the gap to the next of newline
4630 when we must put designation sequences at beginning of line. */
4631 if (INTEGERP (start
)
4632 && coding
.type
== coding_type_iso2022
4633 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4634 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4636 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4637 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4638 move_gap_both (PT
, PT_BYTE
);
4639 SET_PT_BOTH (opoint
, opoint_byte
);
4646 if (STRINGP (start
))
4648 failure
= 0 > a_write (desc
, start
, 0, XSTRING (start
)->size
,
4649 &annotations
, &coding
);
4652 else if (XINT (start
) != XINT (end
))
4654 register int end1
= CHAR_TO_BYTE (XINT (end
));
4656 tem
= CHAR_TO_BYTE (XINT (start
));
4658 if (XINT (start
) < GPT
)
4660 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
4661 min (GPT
, XINT (end
)) - XINT (start
),
4662 &annotations
, &coding
);
4666 if (XINT (end
) > GPT
&& !failure
)
4668 tem
= max (XINT (start
), GPT
);
4669 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
4670 &annotations
, &coding
);
4676 /* If file was empty, still need to write the annotations */
4677 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4678 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4682 if (CODING_REQUIRE_FLUSHING (&coding
)
4683 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4686 /* We have to flush out a data. */
4687 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4688 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
4695 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4696 Disk full in NFS may be reported here. */
4697 /* mib says that closing the file will try to write as fast as NFS can do
4698 it, and that means the fsync here is not crucial for autosave files. */
4699 if (!auto_saving
&& fsync (desc
) < 0)
4701 /* If fsync fails with EINTR, don't treat that as serious. */
4703 failure
= 1, save_errno
= errno
;
4707 /* Spurious "file has changed on disk" warnings have been
4708 observed on Suns as well.
4709 It seems that `close' can change the modtime, under nfs.
4711 (This has supposedly been fixed in Sunos 4,
4712 but who knows about all the other machines with NFS?) */
4715 /* On VMS and APOLLO, must do the stat after the close
4716 since closing changes the modtime. */
4719 /* Recall that #if defined does not work on VMS. */
4726 /* NFS can report a write failure now. */
4727 if (emacs_close (desc
) < 0)
4728 failure
= 1, save_errno
= errno
;
4731 /* If we wrote to a temporary name and had no errors, rename to real name. */
4735 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4743 /* Discard the unwind protect for close_file_unwind. */
4744 specpdl_ptr
= specpdl
+ count1
;
4745 /* Restore the original current buffer. */
4746 visit_file
= unbind_to (count
, visit_file
);
4748 #ifdef CLASH_DETECTION
4750 unlock_file (lockname
);
4751 #endif /* CLASH_DETECTION */
4753 /* Do this before reporting IO error
4754 to avoid a "file has changed on disk" warning on
4755 next attempt to save. */
4757 current_buffer
->modtime
= st
.st_mtime
;
4760 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4761 emacs_strerror (save_errno
));
4765 SAVE_MODIFF
= MODIFF
;
4766 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4767 current_buffer
->filename
= visit_file
;
4768 update_mode_lines
++;
4774 message_with_string ("Wrote %s", visit_file
, 1);
4779 Lisp_Object
merge ();
4781 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4782 "Return t if (car A) is numerically less than (car B).")
4786 return Flss (Fcar (a
), Fcar (b
));
4789 /* Build the complete list of annotations appropriate for writing out
4790 the text between START and END, by calling all the functions in
4791 write-region-annotate-functions and merging the lists they return.
4792 If one of these functions switches to a different buffer, we assume
4793 that buffer contains altered text. Therefore, the caller must
4794 make sure to restore the current buffer in all cases,
4795 as save-excursion would do. */
4798 build_annotations (start
, end
, pre_write_conversion
)
4799 Lisp_Object start
, end
, pre_write_conversion
;
4801 Lisp_Object annotations
;
4803 struct gcpro gcpro1
, gcpro2
;
4804 Lisp_Object original_buffer
;
4806 XSETBUFFER (original_buffer
, current_buffer
);
4809 p
= Vwrite_region_annotate_functions
;
4810 GCPRO2 (annotations
, p
);
4813 struct buffer
*given_buffer
= current_buffer
;
4814 Vwrite_region_annotations_so_far
= annotations
;
4815 res
= call2 (Fcar (p
), start
, end
);
4816 /* If the function makes a different buffer current,
4817 assume that means this buffer contains altered text to be output.
4818 Reset START and END from the buffer bounds
4819 and discard all previous annotations because they should have
4820 been dealt with by this function. */
4821 if (current_buffer
!= given_buffer
)
4823 XSETFASTINT (start
, BEGV
);
4824 XSETFASTINT (end
, ZV
);
4827 Flength (res
); /* Check basic validity of return value */
4828 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4832 /* Now do the same for annotation functions implied by the file-format */
4833 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4834 p
= Vauto_save_file_format
;
4836 p
= current_buffer
->file_format
;
4839 struct buffer
*given_buffer
= current_buffer
;
4840 Vwrite_region_annotations_so_far
= annotations
;
4841 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4843 if (current_buffer
!= given_buffer
)
4845 XSETFASTINT (start
, BEGV
);
4846 XSETFASTINT (end
, ZV
);
4850 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4854 /* At last, do the same for the function PRE_WRITE_CONVERSION
4855 implied by the current coding-system. */
4856 if (!NILP (pre_write_conversion
))
4858 struct buffer
*given_buffer
= current_buffer
;
4859 Vwrite_region_annotations_so_far
= annotations
;
4860 res
= call2 (pre_write_conversion
, start
, end
);
4862 annotations
= (current_buffer
!= given_buffer
4864 : merge (annotations
, res
, Qcar_less_than_car
));
4871 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4872 If STRING is nil, POS is the character position in the current buffer.
4873 Intersperse with them the annotations from *ANNOT
4874 which fall within the range of POS to POS + NCHARS,
4875 each at its appropriate position.
4877 We modify *ANNOT by discarding elements as we use them up.
4879 The return value is negative in case of system call failure. */
4882 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
4885 register int nchars
;
4888 struct coding_system
*coding
;
4892 int lastpos
= pos
+ nchars
;
4894 while (NILP (*annot
) || CONSP (*annot
))
4896 tem
= Fcar_safe (Fcar (*annot
));
4899 nextpos
= XFASTINT (tem
);
4901 /* If there are no more annotations in this range,
4902 output the rest of the range all at once. */
4903 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4904 return e_write (desc
, string
, pos
, lastpos
, coding
);
4906 /* Output buffer text up to the next annotation's position. */
4909 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
));
4913 /* Output the annotation. */
4914 tem
= Fcdr (Fcar (*annot
));
4917 if (0 > e_write (desc
, tem
, 0, XSTRING (tem
)->size
, coding
));
4920 *annot
= Fcdr (*annot
);
4925 #ifndef WRITE_BUF_SIZE
4926 #define WRITE_BUF_SIZE (16 * 1024)
4929 /* Write text in the range START and END into descriptor DESC,
4930 encoding them with coding system CODING. If STRING is nil, START
4931 and END are character positions of the current buffer, else they
4932 are indexes to the string STRING. */
4935 e_write (desc
, string
, start
, end
, coding
)
4939 struct coding_system
*coding
;
4941 register char *addr
;
4942 register int nbytes
;
4943 char buf
[WRITE_BUF_SIZE
];
4944 int composing
= coding
->composing
;
4948 coding
->composing
= COMPOSITION_DISABLED
;
4949 if (coding
->composing
!= COMPOSITION_DISABLED
)
4950 coding_save_composition (coding
, start
, end
, string
);
4952 if (STRINGP (string
))
4954 addr
= XSTRING (string
)->data
;
4955 nbytes
= STRING_BYTES (XSTRING (string
));
4957 else if (start
< end
)
4959 /* It is assured that the gap is not in the range START and END-1. */
4960 addr
= CHAR_POS_ADDR (start
);
4961 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
4969 /* We used to have a code for handling selective display here. But,
4970 now it is handled within encode_coding. */
4975 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4976 if (coding
->produced
> 0)
4978 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
4979 if (coding
->produced
)
4985 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4987 /* The source text ends by an incomplete multibyte form.
4988 There's no way other than write it out as is. */
4989 nbytes
-= emacs_write (desc
, addr
, nbytes
);
4998 nbytes
-= coding
->consumed
;
4999 addr
+= coding
->consumed
;
5000 start
+= coding
->consumed_char
;
5001 if (coding
->cmp_data
)
5002 coding_adjust_composition_offset (coding
, start
);
5007 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5008 Sverify_visited_file_modtime
, 1, 1, 0,
5009 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
5010 This means that the file has not been changed since it was visited or saved.")
5016 Lisp_Object handler
;
5017 Lisp_Object filename
;
5019 CHECK_BUFFER (buf
, 0);
5022 if (!STRINGP (b
->filename
)) return Qt
;
5023 if (b
->modtime
== 0) return Qt
;
5025 /* If the file name has special constructs in it,
5026 call the corresponding file handler. */
5027 handler
= Ffind_file_name_handler (b
->filename
,
5028 Qverify_visited_file_modtime
);
5029 if (!NILP (handler
))
5030 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5032 filename
= ENCODE_FILE (b
->filename
);
5034 if (stat (XSTRING (filename
)->data
, &st
) < 0)
5036 /* If the file doesn't exist now and didn't exist before,
5037 we say that it isn't modified, provided the error is a tame one. */
5038 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5043 if (st
.st_mtime
== b
->modtime
5044 /* If both are positive, accept them if they are off by one second. */
5045 || (st
.st_mtime
> 0 && b
->modtime
> 0
5046 && (st
.st_mtime
== b
->modtime
+ 1
5047 || st
.st_mtime
== b
->modtime
- 1)))
5052 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5053 Sclear_visited_file_modtime
, 0, 0, 0,
5054 "Clear out records of last mod time of visited file.\n\
5055 Next attempt to save will certainly not complain of a discrepancy.")
5058 current_buffer
->modtime
= 0;
5062 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5063 Svisited_file_modtime
, 0, 0, 0,
5064 "Return the current buffer's recorded visited file modification time.\n\
5065 The value is a list of the form (HIGH . LOW), like the time values\n\
5066 that `file-attributes' returns.")
5069 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5072 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5073 Sset_visited_file_modtime
, 0, 1, 0,
5074 "Update buffer's recorded modification time from the visited file's time.\n\
5075 Useful if the buffer was not read from the file normally\n\
5076 or if the file itself has been changed for some known benign reason.\n\
5077 An argument specifies the modification time value to use\n\
5078 \(instead of that of the visited file), in the form of a list\n\
5079 \(HIGH . LOW) or (HIGH LOW).")
5081 Lisp_Object time_list
;
5083 if (!NILP (time_list
))
5084 current_buffer
->modtime
= cons_to_long (time_list
);
5087 register Lisp_Object filename
;
5089 Lisp_Object handler
;
5091 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5093 /* If the file name has special constructs in it,
5094 call the corresponding file handler. */
5095 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5096 if (!NILP (handler
))
5097 /* The handler can find the file name the same way we did. */
5098 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5100 filename
= ENCODE_FILE (filename
);
5102 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5103 current_buffer
->modtime
= st
.st_mtime
;
5113 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5114 Fsleep_for (make_number (1), Qnil
);
5115 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5116 Fsleep_for (make_number (1), Qnil
);
5117 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5118 Fsleep_for (make_number (1), Qnil
);
5128 /* Get visited file's mode to become the auto save file's mode. */
5129 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5130 /* But make sure we can overwrite it later! */
5131 auto_save_mode_bits
= st
.st_mode
| 0600;
5133 auto_save_mode_bits
= 0666;
5136 Fwrite_region (Qnil
, Qnil
,
5137 current_buffer
->auto_save_file_name
,
5138 Qnil
, Qlambda
, Qnil
, Qnil
);
5142 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5147 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5148 | XFASTINT (XCDR (stream
))));
5153 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5156 minibuffer_auto_raise
= XINT (value
);
5160 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5161 "Auto-save all buffers that need it.\n\
5162 This is all buffers that have auto-saving enabled\n\
5163 and are changed since last auto-saved.\n\
5164 Auto-saving writes the buffer into a file\n\
5165 so that your editing is not lost if the system crashes.\n\
5166 This file is not the file you visited; that changes only when you save.\n\
5167 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5168 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5169 A non-nil CURRENT-ONLY argument means save only current buffer.")
5170 (no_message
, current_only
)
5171 Lisp_Object no_message
, current_only
;
5173 struct buffer
*old
= current_buffer
, *b
;
5174 Lisp_Object tail
, buf
;
5176 int do_handled_files
;
5179 Lisp_Object lispstream
;
5180 int count
= specpdl_ptr
- specpdl
;
5182 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5183 int message_p
= push_message ();
5185 /* Ordinarily don't quit within this function,
5186 but don't make it impossible to quit (in case we get hung in I/O). */
5190 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5191 point to non-strings reached from Vbuffer_alist. */
5196 if (!NILP (Vrun_hooks
))
5197 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5199 if (STRINGP (Vauto_save_list_file_name
))
5201 Lisp_Object listfile
;
5202 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5203 stream
= fopen (XSTRING (listfile
)->data
, "w");
5206 /* Arrange to close that file whether or not we get an error.
5207 Also reset auto_saving to 0. */
5208 lispstream
= Fcons (Qnil
, Qnil
);
5209 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
5210 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
5221 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5222 record_unwind_protect (do_auto_save_unwind_1
,
5223 make_number (minibuffer_auto_raise
));
5224 minibuffer_auto_raise
= 0;
5227 /* First, save all files which don't have handlers. If Emacs is
5228 crashing, the handlers may tweak what is causing Emacs to crash
5229 in the first place, and it would be a shame if Emacs failed to
5230 autosave perfectly ordinary files because it couldn't handle some
5232 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5233 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5235 buf
= XCDR (XCAR (tail
));
5238 /* Record all the buffers that have auto save mode
5239 in the special file that lists them. For each of these buffers,
5240 Record visited name (if any) and auto save name. */
5241 if (STRINGP (b
->auto_save_file_name
)
5242 && stream
!= NULL
&& do_handled_files
== 0)
5244 if (!NILP (b
->filename
))
5246 fwrite (XSTRING (b
->filename
)->data
, 1,
5247 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5249 putc ('\n', stream
);
5250 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5251 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5252 putc ('\n', stream
);
5255 if (!NILP (current_only
)
5256 && b
!= current_buffer
)
5259 /* Don't auto-save indirect buffers.
5260 The base buffer takes care of it. */
5264 /* Check for auto save enabled
5265 and file changed since last auto save
5266 and file changed since last real save. */
5267 if (STRINGP (b
->auto_save_file_name
)
5268 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5269 && b
->auto_save_modified
< BUF_MODIFF (b
)
5270 /* -1 means we've turned off autosaving for a while--see below. */
5271 && XINT (b
->save_length
) >= 0
5272 && (do_handled_files
5273 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5276 EMACS_TIME before_time
, after_time
;
5278 EMACS_GET_TIME (before_time
);
5280 /* If we had a failure, don't try again for 20 minutes. */
5281 if (b
->auto_save_failure_time
>= 0
5282 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5285 if ((XFASTINT (b
->save_length
) * 10
5286 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5287 /* A short file is likely to change a large fraction;
5288 spare the user annoying messages. */
5289 && XFASTINT (b
->save_length
) > 5000
5290 /* These messages are frequent and annoying for `*mail*'. */
5291 && !EQ (b
->filename
, Qnil
)
5292 && NILP (no_message
))
5294 /* It has shrunk too much; turn off auto-saving here. */
5295 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5296 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5298 minibuffer_auto_raise
= 0;
5299 /* Turn off auto-saving until there's a real save,
5300 and prevent any more warnings. */
5301 XSETINT (b
->save_length
, -1);
5302 Fsleep_for (make_number (1), Qnil
);
5305 set_buffer_internal (b
);
5306 if (!auto_saved
&& NILP (no_message
))
5307 message1 ("Auto-saving...");
5308 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5310 b
->auto_save_modified
= BUF_MODIFF (b
);
5311 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5312 set_buffer_internal (old
);
5314 EMACS_GET_TIME (after_time
);
5316 /* If auto-save took more than 60 seconds,
5317 assume it was an NFS failure that got a timeout. */
5318 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5319 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5323 /* Prevent another auto save till enough input events come in. */
5324 record_auto_save ();
5326 if (auto_saved
&& NILP (no_message
))
5330 sit_for (1, 0, 0, 0, 0);
5334 message1 ("Auto-saving...done");
5340 unbind_to (count
, Qnil
);
5344 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5345 Sset_buffer_auto_saved
, 0, 0, 0,
5346 "Mark current buffer as auto-saved with its current text.\n\
5347 No auto-save file will be written until the buffer changes again.")
5350 current_buffer
->auto_save_modified
= MODIFF
;
5351 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5352 current_buffer
->auto_save_failure_time
= -1;
5356 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5357 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5358 "Clear any record of a recent auto-save failure in the current buffer.")
5361 current_buffer
->auto_save_failure_time
= -1;
5365 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5367 "Return t if buffer has been auto-saved since last read in or saved.")
5370 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5373 /* Reading and completing file names */
5374 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5376 /* In the string VAL, change each $ to $$ and return the result. */
5379 double_dollars (val
)
5382 register unsigned char *old
, *new;
5386 osize
= STRING_BYTES (XSTRING (val
));
5388 /* Count the number of $ characters. */
5389 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5390 if (*old
++ == '$') count
++;
5393 old
= XSTRING (val
)->data
;
5394 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5396 new = XSTRING (val
)->data
;
5397 for (n
= osize
; n
> 0; n
--)
5410 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5412 "Internal subroutine for read-file-name. Do not call this.")
5413 (string
, dir
, action
)
5414 Lisp_Object string
, dir
, action
;
5415 /* action is nil for complete, t for return list of completions,
5416 lambda for verify final value */
5418 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5420 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5422 CHECK_STRING (string
, 0);
5429 /* No need to protect ACTION--we only compare it with t and nil. */
5430 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5432 if (XSTRING (string
)->size
== 0)
5434 if (EQ (action
, Qlambda
))
5442 orig_string
= string
;
5443 string
= Fsubstitute_in_file_name (string
);
5444 changed
= NILP (Fstring_equal (string
, orig_string
));
5445 name
= Ffile_name_nondirectory (string
);
5446 val
= Ffile_name_directory (string
);
5448 realdir
= Fexpand_file_name (val
, realdir
);
5453 specdir
= Ffile_name_directory (string
);
5454 val
= Ffile_name_completion (name
, realdir
);
5459 return double_dollars (string
);
5463 if (!NILP (specdir
))
5464 val
= concat2 (specdir
, val
);
5466 return double_dollars (val
);
5469 #endif /* not VMS */
5473 if (EQ (action
, Qt
))
5474 return Ffile_name_all_completions (name
, realdir
);
5475 /* Only other case actually used is ACTION = lambda */
5477 /* Supposedly this helps commands such as `cd' that read directory names,
5478 but can someone explain how it helps them? -- RMS */
5479 if (XSTRING (name
)->size
== 0)
5482 return Ffile_exists_p (string
);
5485 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5486 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5487 Value is not expanded---you must call `expand-file-name' yourself.\n\
5488 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5489 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5490 except that if INITIAL is specified, that combined with DIR is used.)\n\
5491 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5492 Non-nil and non-t means also require confirmation after completion.\n\
5493 Fifth arg INITIAL specifies text to start with.\n\
5494 DIR defaults to current buffer's directory default.")
5495 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5496 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5498 Lisp_Object val
, insdef
, tem
;
5499 struct gcpro gcpro1
, gcpro2
;
5500 register char *homedir
;
5501 int replace_in_history
= 0;
5502 int add_to_history
= 0;
5506 dir
= current_buffer
->directory
;
5507 if (NILP (default_filename
))
5509 if (! NILP (initial
))
5510 default_filename
= Fexpand_file_name (initial
, dir
);
5512 default_filename
= current_buffer
->filename
;
5515 /* If dir starts with user's homedir, change that to ~. */
5516 homedir
= (char *) egetenv ("HOME");
5518 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5519 CORRECT_DIR_SEPS (homedir
);
5523 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5524 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5526 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5527 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5528 XSTRING (dir
)->data
[0] = '~';
5530 /* Likewise for default_filename. */
5532 && STRINGP (default_filename
)
5533 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5534 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5537 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5538 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5539 XSTRING (default_filename
)->data
[0] = '~';
5541 if (!NILP (default_filename
))
5543 CHECK_STRING (default_filename
, 3);
5544 default_filename
= double_dollars (default_filename
);
5547 if (insert_default_directory
&& STRINGP (dir
))
5550 if (!NILP (initial
))
5552 Lisp_Object args
[2], pos
;
5556 insdef
= Fconcat (2, args
);
5557 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5558 insdef
= Fcons (double_dollars (insdef
), pos
);
5561 insdef
= double_dollars (insdef
);
5563 else if (STRINGP (initial
))
5564 insdef
= Fcons (double_dollars (initial
), make_number (0));
5568 count
= specpdl_ptr
- specpdl
;
5570 specbind (intern ("completion-ignore-case"), Qt
);
5573 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5575 GCPRO2 (insdef
, default_filename
);
5578 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5582 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5587 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5588 dir
, mustmatch
, insdef
,
5589 Qfile_name_history
, default_filename
, Qnil
);
5591 tem
= Fsymbol_value (Qfile_name_history
);
5592 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
5593 replace_in_history
= 1;
5595 /* If Fcompleting_read returned the inserted default string itself
5596 (rather than a new string with the same contents),
5597 it has to mean that the user typed RET with the minibuffer empty.
5598 In that case, we really want to return ""
5599 so that commands such as set-visited-file-name can distinguish. */
5600 if (EQ (val
, default_filename
))
5602 /* In this case, Fcompleting_read has not added an element
5603 to the history. Maybe we should. */
5604 if (! replace_in_history
)
5607 val
= build_string ("");
5610 unbind_to (count
, Qnil
);
5613 error ("No file name specified");
5615 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5617 if (!NILP (tem
) && !NILP (default_filename
))
5618 val
= default_filename
;
5619 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5621 if (!NILP (default_filename
))
5622 val
= default_filename
;
5624 error ("No default file name");
5626 val
= Fsubstitute_in_file_name (val
);
5628 if (replace_in_history
)
5629 /* Replace what Fcompleting_read added to the history
5630 with what we will actually return. */
5631 XCAR (Fsymbol_value (Qfile_name_history
)) = double_dollars (val
);
5632 else if (add_to_history
)
5634 /* Add the value to the history--but not if it matches
5635 the last value already there. */
5636 Lisp_Object val1
= double_dollars (val
);
5637 tem
= Fsymbol_value (Qfile_name_history
);
5638 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
5639 Fset (Qfile_name_history
,
5650 /* Must be set before any path manipulation is performed. */
5651 XSETFASTINT (Vdirectory_sep_char
, '/');
5658 Qexpand_file_name
= intern ("expand-file-name");
5659 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5660 Qdirectory_file_name
= intern ("directory-file-name");
5661 Qfile_name_directory
= intern ("file-name-directory");
5662 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5663 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5664 Qfile_name_as_directory
= intern ("file-name-as-directory");
5665 Qcopy_file
= intern ("copy-file");
5666 Qmake_directory_internal
= intern ("make-directory-internal");
5667 Qdelete_directory
= intern ("delete-directory");
5668 Qdelete_file
= intern ("delete-file");
5669 Qrename_file
= intern ("rename-file");
5670 Qadd_name_to_file
= intern ("add-name-to-file");
5671 Qmake_symbolic_link
= intern ("make-symbolic-link");
5672 Qfile_exists_p
= intern ("file-exists-p");
5673 Qfile_executable_p
= intern ("file-executable-p");
5674 Qfile_readable_p
= intern ("file-readable-p");
5675 Qfile_writable_p
= intern ("file-writable-p");
5676 Qfile_symlink_p
= intern ("file-symlink-p");
5677 Qaccess_file
= intern ("access-file");
5678 Qfile_directory_p
= intern ("file-directory-p");
5679 Qfile_regular_p
= intern ("file-regular-p");
5680 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5681 Qfile_modes
= intern ("file-modes");
5682 Qset_file_modes
= intern ("set-file-modes");
5683 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5684 Qinsert_file_contents
= intern ("insert-file-contents");
5685 Qwrite_region
= intern ("write-region");
5686 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5687 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5689 staticpro (&Qexpand_file_name
);
5690 staticpro (&Qsubstitute_in_file_name
);
5691 staticpro (&Qdirectory_file_name
);
5692 staticpro (&Qfile_name_directory
);
5693 staticpro (&Qfile_name_nondirectory
);
5694 staticpro (&Qunhandled_file_name_directory
);
5695 staticpro (&Qfile_name_as_directory
);
5696 staticpro (&Qcopy_file
);
5697 staticpro (&Qmake_directory_internal
);
5698 staticpro (&Qdelete_directory
);
5699 staticpro (&Qdelete_file
);
5700 staticpro (&Qrename_file
);
5701 staticpro (&Qadd_name_to_file
);
5702 staticpro (&Qmake_symbolic_link
);
5703 staticpro (&Qfile_exists_p
);
5704 staticpro (&Qfile_executable_p
);
5705 staticpro (&Qfile_readable_p
);
5706 staticpro (&Qfile_writable_p
);
5707 staticpro (&Qaccess_file
);
5708 staticpro (&Qfile_symlink_p
);
5709 staticpro (&Qfile_directory_p
);
5710 staticpro (&Qfile_regular_p
);
5711 staticpro (&Qfile_accessible_directory_p
);
5712 staticpro (&Qfile_modes
);
5713 staticpro (&Qset_file_modes
);
5714 staticpro (&Qfile_newer_than_file_p
);
5715 staticpro (&Qinsert_file_contents
);
5716 staticpro (&Qwrite_region
);
5717 staticpro (&Qverify_visited_file_modtime
);
5718 staticpro (&Qset_visited_file_modtime
);
5720 Qfile_name_history
= intern ("file-name-history");
5721 Fset (Qfile_name_history
, Qnil
);
5722 staticpro (&Qfile_name_history
);
5724 Qfile_error
= intern ("file-error");
5725 staticpro (&Qfile_error
);
5726 Qfile_already_exists
= intern ("file-already-exists");
5727 staticpro (&Qfile_already_exists
);
5728 Qfile_date_error
= intern ("file-date-error");
5729 staticpro (&Qfile_date_error
);
5730 Qexcl
= intern ("excl");
5734 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5735 staticpro (&Qfind_buffer_file_type
);
5738 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5739 "*Coding system for encoding file names.\n\
5740 If it is nil, default-file-name-coding-system (which see) is used.");
5741 Vfile_name_coding_system
= Qnil
;
5743 DEFVAR_LISP ("default-file-name-coding-system",
5744 &Vdefault_file_name_coding_system
,
5745 "Default coding system for encoding file names.\n\
5746 This variable is used only when file-name-coding-system is nil.\n\
5748 This variable is set/changed by the command set-language-environment.\n\
5749 User should not set this variable manually,\n\
5750 instead use file-name-coding-system to get a constant encoding\n\
5751 of file names regardless of the current language environment.");
5752 Vdefault_file_name_coding_system
= Qnil
;
5754 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5755 "*Format in which to write auto-save files.\n\
5756 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5757 If it is t, which is the default, auto-save files are written in the\n\
5758 same format as a regular save would use.");
5759 Vauto_save_file_format
= Qt
;
5761 Qformat_decode
= intern ("format-decode");
5762 staticpro (&Qformat_decode
);
5763 Qformat_annotate_function
= intern ("format-annotate-function");
5764 staticpro (&Qformat_annotate_function
);
5766 Qcar_less_than_car
= intern ("car-less-than-car");
5767 staticpro (&Qcar_less_than_car
);
5769 Fput (Qfile_error
, Qerror_conditions
,
5770 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5771 Fput (Qfile_error
, Qerror_message
,
5772 build_string ("File error"));
5774 Fput (Qfile_already_exists
, Qerror_conditions
,
5775 Fcons (Qfile_already_exists
,
5776 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5777 Fput (Qfile_already_exists
, Qerror_message
,
5778 build_string ("File already exists"));
5780 Fput (Qfile_date_error
, Qerror_conditions
,
5781 Fcons (Qfile_date_error
,
5782 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5783 Fput (Qfile_date_error
, Qerror_message
,
5784 build_string ("Cannot set file date"));
5786 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5787 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5788 insert_default_directory
= 1;
5790 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5791 "*Non-nil means write new files with record format `stmlf'.\n\
5792 nil means use format `var'. This variable is meaningful only on VMS.");
5793 vms_stmlf_recfm
= 0;
5795 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5796 "Directory separator character for built-in functions that return file names.\n\
5797 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5798 This variable affects the built-in functions only on Windows,\n\
5799 on other platforms, it is initialized so that Lisp code can find out\n\
5800 what the normal separator is.");
5802 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5803 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5804 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5807 The first argument given to HANDLER is the name of the I/O primitive\n\
5808 to be handled; the remaining arguments are the arguments that were\n\
5809 passed to that primitive. For example, if you do\n\
5810 (file-exists-p FILENAME)\n\
5811 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5812 (funcall HANDLER 'file-exists-p FILENAME)\n\
5813 The function `find-file-name-handler' checks this list for a handler\n\
5814 for its argument.");
5815 Vfile_name_handler_alist
= Qnil
;
5817 DEFVAR_LISP ("set-auto-coding-function",
5818 &Vset_auto_coding_function
,
5819 "If non-nil, a function to call to decide a coding system of file.\n\
5820 Two arguments are passed to this function: the file name\n\
5821 and the length of a file contents following the point.\n\
5822 This function should return a coding system to decode the file contents.\n\
5823 It should check the file name against `auto-coding-alist'.\n\
5824 If no coding system is decided, it should check a coding system\n\
5825 specified in the heading lines with the format:\n\
5826 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5827 or local variable spec of the tailing lines with `coding:' tag.");
5828 Vset_auto_coding_function
= Qnil
;
5830 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5831 "A list of functions to be called at the end of `insert-file-contents'.\n\
5832 Each is passed one argument, the number of bytes inserted. It should return\n\
5833 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5834 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5835 responsible for calling the after-insert-file-functions if appropriate.");
5836 Vafter_insert_file_functions
= Qnil
;
5838 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5839 "A list of functions to be called at the start of `write-region'.\n\
5840 Each is passed two arguments, START and END as for `write-region'.\n\
5841 These are usually two numbers but not always; see the documentation\n\
5842 for `write-region'. The function should return a list of pairs\n\
5843 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5844 inserted at the specified positions of the file being written (1 means to\n\
5845 insert before the first byte written). The POSITIONs must be sorted into\n\
5846 increasing order. If there are several functions in the list, the several\n\
5847 lists are merged destructively.");
5848 Vwrite_region_annotate_functions
= Qnil
;
5850 DEFVAR_LISP ("write-region-annotations-so-far",
5851 &Vwrite_region_annotations_so_far
,
5852 "When an annotation function is called, this holds the previous annotations.\n\
5853 These are the annotations made by other annotation functions\n\
5854 that were already called. See also `write-region-annotate-functions'.");
5855 Vwrite_region_annotations_so_far
= Qnil
;
5857 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5858 "A list of file name handlers that temporarily should not be used.\n\
5859 This applies only to the operation `inhibit-file-name-operation'.");
5860 Vinhibit_file_name_handlers
= Qnil
;
5862 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5863 "The operation for which `inhibit-file-name-handlers' is applicable.");
5864 Vinhibit_file_name_operation
= Qnil
;
5866 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5867 "File name in which we write a list of all auto save file names.\n\
5868 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5869 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5871 Vauto_save_list_file_name
= Qnil
;
5873 defsubr (&Sfind_file_name_handler
);
5874 defsubr (&Sfile_name_directory
);
5875 defsubr (&Sfile_name_nondirectory
);
5876 defsubr (&Sunhandled_file_name_directory
);
5877 defsubr (&Sfile_name_as_directory
);
5878 defsubr (&Sdirectory_file_name
);
5879 defsubr (&Smake_temp_name
);
5880 defsubr (&Sexpand_file_name
);
5881 defsubr (&Ssubstitute_in_file_name
);
5882 defsubr (&Scopy_file
);
5883 defsubr (&Smake_directory_internal
);
5884 defsubr (&Sdelete_directory
);
5885 defsubr (&Sdelete_file
);
5886 defsubr (&Srename_file
);
5887 defsubr (&Sadd_name_to_file
);
5889 defsubr (&Smake_symbolic_link
);
5890 #endif /* S_IFLNK */
5892 defsubr (&Sdefine_logical_name
);
5895 defsubr (&Ssysnetunam
);
5896 #endif /* HPUX_NET */
5897 defsubr (&Sfile_name_absolute_p
);
5898 defsubr (&Sfile_exists_p
);
5899 defsubr (&Sfile_executable_p
);
5900 defsubr (&Sfile_readable_p
);
5901 defsubr (&Sfile_writable_p
);
5902 defsubr (&Saccess_file
);
5903 defsubr (&Sfile_symlink_p
);
5904 defsubr (&Sfile_directory_p
);
5905 defsubr (&Sfile_accessible_directory_p
);
5906 defsubr (&Sfile_regular_p
);
5907 defsubr (&Sfile_modes
);
5908 defsubr (&Sset_file_modes
);
5909 defsubr (&Sset_default_file_modes
);
5910 defsubr (&Sdefault_file_modes
);
5911 defsubr (&Sfile_newer_than_file_p
);
5912 defsubr (&Sinsert_file_contents
);
5913 defsubr (&Swrite_region
);
5914 defsubr (&Scar_less_than_car
);
5915 defsubr (&Sverify_visited_file_modtime
);
5916 defsubr (&Sclear_visited_file_modtime
);
5917 defsubr (&Svisited_file_modtime
);
5918 defsubr (&Sset_visited_file_modtime
);
5919 defsubr (&Sdo_auto_save
);
5920 defsubr (&Sset_buffer_auto_saved
);
5921 defsubr (&Sclear_buffer_auto_save_failure
);
5922 defsubr (&Srecent_auto_save_p
);
5924 defsubr (&Sread_file_name_internal
);
5925 defsubr (&Sread_file_name
);
5928 defsubr (&Sunix_sync
);