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)
68 extern char *strerror ();
85 #include "intervals.h"
96 #endif /* not WINDOWSNT */
100 #include <sys/param.h>
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
144 #include "commands.h"
145 extern int use_dialog_box
;
159 #define min(a, b) ((a) < (b) ? (a) : (b))
160 #define max(a, b) ((a) > (b) ? (a) : (b))
162 /* Nonzero during writing of auto-save files */
165 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
166 a new file with the same mode as the original */
167 int auto_save_mode_bits
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Format for auto-save files */
181 Lisp_Object Vauto_save_file_format
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Nonzero means, when reading a filename in the minibuffer,
203 start out by inserting the default directory into the minibuffer. */
204 int insert_default_directory
;
206 /* On VMS, nonzero means write new files with record format stmlf.
207 Zero means use var format. */
210 /* On NT, specifies the directory separator character, used (eg.) when
211 expanding file names. This can be bound to / or \. */
212 Lisp_Object Vdirectory_sep_char
;
214 extern Lisp_Object Vuser_login_name
;
217 extern Lisp_Object Vw32_get_true_file_attributes
;
220 extern int minibuf_level
;
222 extern int minibuffer_auto_raise
;
224 /* These variables describe handlers that have "already" had a chance
225 to handle the current operation.
227 Vinhibit_file_name_handlers is a list of file name handlers.
228 Vinhibit_file_name_operation is the operation being handled.
229 If we try to handle that operation, we ignore those handlers. */
231 static Lisp_Object Vinhibit_file_name_handlers
;
232 static Lisp_Object Vinhibit_file_name_operation
;
234 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
236 Lisp_Object Qfile_name_history
;
238 Lisp_Object Qcar_less_than_car
;
240 static int a_write
P_ ((int, char *, int, int,
241 Lisp_Object
*, struct coding_system
*));
242 static int e_write
P_ ((int, char *, int, struct coding_system
*));
245 report_file_error (string
, data
)
249 Lisp_Object errstring
;
252 synchronize_messages_locale ();
253 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
254 Vlocale_coding_system
, 0);
260 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
263 /* System error messages are capitalized. Downcase the initial
264 unless it is followed by a slash. */
265 if (XSTRING (errstring
)->data
[1] != '/')
266 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
268 Fsignal (Qfile_error
,
269 Fcons (build_string (string
), Fcons (errstring
, data
)));
274 close_file_unwind (fd
)
277 emacs_close (XFASTINT (fd
));
281 /* Restore point, having saved it as a marker. */
284 restore_point_unwind (location
)
285 Lisp_Object location
;
287 Fgoto_char (location
);
288 Fset_marker (location
, Qnil
, Qnil
);
292 Lisp_Object Qexpand_file_name
;
293 Lisp_Object Qsubstitute_in_file_name
;
294 Lisp_Object Qdirectory_file_name
;
295 Lisp_Object Qfile_name_directory
;
296 Lisp_Object Qfile_name_nondirectory
;
297 Lisp_Object Qunhandled_file_name_directory
;
298 Lisp_Object Qfile_name_as_directory
;
299 Lisp_Object Qcopy_file
;
300 Lisp_Object Qmake_directory_internal
;
301 Lisp_Object Qdelete_directory
;
302 Lisp_Object Qdelete_file
;
303 Lisp_Object Qrename_file
;
304 Lisp_Object Qadd_name_to_file
;
305 Lisp_Object Qmake_symbolic_link
;
306 Lisp_Object Qfile_exists_p
;
307 Lisp_Object Qfile_executable_p
;
308 Lisp_Object Qfile_readable_p
;
309 Lisp_Object Qfile_writable_p
;
310 Lisp_Object Qfile_symlink_p
;
311 Lisp_Object Qaccess_file
;
312 Lisp_Object Qfile_directory_p
;
313 Lisp_Object Qfile_regular_p
;
314 Lisp_Object Qfile_accessible_directory_p
;
315 Lisp_Object Qfile_modes
;
316 Lisp_Object Qset_file_modes
;
317 Lisp_Object Qfile_newer_than_file_p
;
318 Lisp_Object Qinsert_file_contents
;
319 Lisp_Object Qwrite_region
;
320 Lisp_Object Qverify_visited_file_modtime
;
321 Lisp_Object Qset_visited_file_modtime
;
323 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
324 "Return FILENAME's handler function for OPERATION, if it has one.\n\
325 Otherwise, return nil.\n\
326 A file name is handled if one of the regular expressions in\n\
327 `file-name-handler-alist' matches it.\n\n\
328 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
329 any handlers that are members of `inhibit-file-name-handlers',\n\
330 but we still do run any other handlers. This lets handlers\n\
331 use the standard functions without calling themselves recursively.")
332 (filename
, operation
)
333 Lisp_Object filename
, operation
;
335 /* This function must not munge the match data. */
336 Lisp_Object chain
, inhibited_handlers
;
338 CHECK_STRING (filename
, 0);
340 if (EQ (operation
, Vinhibit_file_name_operation
))
341 inhibited_handlers
= Vinhibit_file_name_handlers
;
343 inhibited_handlers
= Qnil
;
345 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
346 chain
= XCDR (chain
))
354 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
356 Lisp_Object handler
, tem
;
358 handler
= XCDR (elt
);
359 tem
= Fmemq (handler
, inhibited_handlers
);
370 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
372 "Return the directory component in file name FILENAME.\n\
373 Return nil if FILENAME does not include a directory.\n\
374 Otherwise return a directory spec.\n\
375 Given a Unix syntax file name, returns a string ending in slash;\n\
376 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
378 Lisp_Object filename
;
380 register unsigned char *beg
;
381 register unsigned char *p
;
384 CHECK_STRING (filename
, 0);
386 /* If the file name has special constructs in it,
387 call the corresponding file handler. */
388 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
390 return call2 (handler
, Qfile_name_directory
, filename
);
392 #ifdef FILE_SYSTEM_CASE
393 filename
= FILE_SYSTEM_CASE (filename
);
395 beg
= XSTRING (filename
)->data
;
397 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
399 p
= beg
+ STRING_BYTES (XSTRING (filename
));
401 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
403 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
406 /* only recognise drive specifier at the beginning */
408 /* handle the "/:d:foo" and "/:foo" cases correctly */
409 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
410 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
417 /* Expansion of "c:" to drive and default directory. */
420 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
421 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
422 unsigned char *r
= res
;
424 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
426 strncpy (res
, beg
, 2);
431 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
433 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
436 p
= beg
+ strlen (beg
);
439 CORRECT_DIR_SEPS (beg
);
442 if (STRING_MULTIBYTE (filename
))
443 return make_string (beg
, p
- beg
);
444 return make_unibyte_string (beg
, p
- beg
);
447 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
448 Sfile_name_nondirectory
, 1, 1, 0,
449 "Return file name FILENAME sans its directory.\n\
450 For example, in a Unix-syntax file name,\n\
451 this is everything after the last slash,\n\
452 or the entire name if it contains no slash.")
454 Lisp_Object filename
;
456 register unsigned char *beg
, *p
, *end
;
459 CHECK_STRING (filename
, 0);
461 /* If the file name has special constructs in it,
462 call the corresponding file handler. */
463 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
465 return call2 (handler
, Qfile_name_nondirectory
, filename
);
467 beg
= XSTRING (filename
)->data
;
468 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
470 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
472 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
475 /* only recognise drive specifier at beginning */
477 /* handle the "/:d:foo" case correctly */
478 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
483 if (STRING_MULTIBYTE (filename
))
484 return make_string (p
, end
- p
);
485 return make_unibyte_string (p
, end
- p
);
488 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
489 Sunhandled_file_name_directory
, 1, 1, 0,
490 "Return a directly usable directory name somehow associated with FILENAME.\n\
491 A `directly usable' directory name is one that may be used without the\n\
492 intervention of any file handler.\n\
493 If FILENAME is a directly usable file itself, return\n\
494 \(file-name-directory FILENAME).\n\
495 The `call-process' and `start-process' functions use this function to\n\
496 get a current directory to run processes in.")
498 Lisp_Object filename
;
502 /* If the file name has special constructs in it,
503 call the corresponding file handler. */
504 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
506 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
508 return Ffile_name_directory (filename
);
513 file_name_as_directory (out
, in
)
516 int size
= strlen (in
) - 1;
529 /* Is it already a directory string? */
530 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
532 /* Is it a VMS directory file name? If so, hack VMS syntax. */
533 else if (! index (in
, '/')
534 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
535 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
536 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
537 || ! strncmp (&in
[size
- 5], ".dir", 4))
538 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
539 && in
[size
] == '1')))
541 register char *p
, *dot
;
545 dir:x.dir --> dir:[x]
546 dir:[x]y.dir --> dir:[x.y] */
548 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
551 strncpy (out
, in
, p
- in
);
570 dot
= index (p
, '.');
573 /* blindly remove any extension */
574 size
= strlen (out
) + (dot
- p
);
575 strncat (out
, p
, dot
- p
);
586 /* For Unix syntax, Append a slash if necessary */
587 if (!IS_DIRECTORY_SEP (out
[size
]))
589 out
[size
+ 1] = DIRECTORY_SEP
;
590 out
[size
+ 2] = '\0';
593 CORRECT_DIR_SEPS (out
);
599 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
600 Sfile_name_as_directory
, 1, 1, 0,
601 "Return a string representing file FILENAME interpreted as a directory.\n\
602 This operation exists because a directory is also a file, but its name as\n\
603 a directory is different from its name as a file.\n\
604 The result can be used as the value of `default-directory'\n\
605 or passed as second argument to `expand-file-name'.\n\
606 For a Unix-syntax file name, just appends a slash.\n\
607 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
614 CHECK_STRING (file
, 0);
618 /* If the file name has special constructs in it,
619 call the corresponding file handler. */
620 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
622 return call2 (handler
, Qfile_name_as_directory
, file
);
624 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
625 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
629 * Convert from directory name to filename.
631 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
632 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
633 * On UNIX, it's simple: just make sure there isn't a terminating /
635 * Value is nonzero if the string output is different from the input.
639 directory_file_name (src
, dst
)
647 struct FAB fab
= cc$rms_fab
;
648 struct NAM nam
= cc$rms_nam
;
649 char esa
[NAM$C_MAXRSS
];
654 if (! index (src
, '/')
655 && (src
[slen
- 1] == ']'
656 || src
[slen
- 1] == ':'
657 || src
[slen
- 1] == '>'))
659 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
661 fab
.fab$b_fns
= slen
;
662 fab
.fab$l_nam
= &nam
;
663 fab
.fab$l_fop
= FAB$M_NAM
;
666 nam
.nam$b_ess
= sizeof esa
;
667 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
669 /* We call SYS$PARSE to handle such things as [--] for us. */
670 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
672 slen
= nam
.nam$b_esl
;
673 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
678 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
680 /* what about when we have logical_name:???? */
681 if (src
[slen
- 1] == ':')
682 { /* Xlate logical name and see what we get */
683 ptr
= strcpy (dst
, src
); /* upper case for getenv */
686 if ('a' <= *ptr
&& *ptr
<= 'z')
690 dst
[slen
- 1] = 0; /* remove colon */
691 if (!(src
= egetenv (dst
)))
693 /* should we jump to the beginning of this procedure?
694 Good points: allows us to use logical names that xlate
696 Bad points: can be a problem if we just translated to a device
698 For now, I'll punt and always expect VMS names, and hope for
701 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
702 { /* no recursion here! */
708 { /* not a directory spec */
713 bracket
= src
[slen
- 1];
715 /* If bracket is ']' or '>', bracket - 2 is the corresponding
717 ptr
= index (src
, bracket
- 2);
719 { /* no opening bracket */
723 if (!(rptr
= rindex (src
, '.')))
726 strncpy (dst
, src
, slen
);
730 dst
[slen
++] = bracket
;
735 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
736 then translate the device and recurse. */
737 if (dst
[slen
- 1] == ':'
738 && dst
[slen
- 2] != ':' /* skip decnet nodes */
739 && strcmp (src
+ slen
, "[000000]") == 0)
741 dst
[slen
- 1] = '\0';
742 if ((ptr
= egetenv (dst
))
743 && (rlen
= strlen (ptr
) - 1) > 0
744 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
745 && ptr
[rlen
- 1] == '.')
747 char * buf
= (char *) alloca (strlen (ptr
) + 1);
751 return directory_file_name (buf
, dst
);
756 strcat (dst
, "[000000]");
760 rlen
= strlen (rptr
) - 1;
761 strncat (dst
, rptr
, rlen
);
762 dst
[slen
+ rlen
] = '\0';
763 strcat (dst
, ".DIR.1");
767 /* Process as Unix format: just remove any final slash.
768 But leave "/" unchanged; do not change it to "". */
771 /* Handle // as root for apollo's. */
772 if ((slen
> 2 && dst
[slen
- 1] == '/')
773 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
777 && IS_DIRECTORY_SEP (dst
[slen
- 1])
779 && !IS_ANY_SEP (dst
[slen
- 2])
785 CORRECT_DIR_SEPS (dst
);
790 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
792 "Returns the file name of the directory named DIRECTORY.\n\
793 This is the name of the file that holds the data for the directory DIRECTORY.\n\
794 This operation exists because a directory is also a file, but its name as\n\
795 a directory is different from its name as a file.\n\
796 In Unix-syntax, this function just removes the final slash.\n\
797 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
798 it returns a file name such as \"[X]Y.DIR.1\".")
800 Lisp_Object directory
;
805 CHECK_STRING (directory
, 0);
807 if (NILP (directory
))
810 /* If the file name has special constructs in it,
811 call the corresponding file handler. */
812 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
814 return call2 (handler
, Qdirectory_file_name
, directory
);
817 /* 20 extra chars is insufficient for VMS, since we might perform a
818 logical name translation. an equivalence string can be up to 255
819 chars long, so grab that much extra space... - sss */
820 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
822 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
824 directory_file_name (XSTRING (directory
)->data
, buf
);
825 return build_string (buf
);
828 static char make_temp_name_tbl
[64] =
830 'A','B','C','D','E','F','G','H',
831 'I','J','K','L','M','N','O','P',
832 'Q','R','S','T','U','V','W','X',
833 'Y','Z','a','b','c','d','e','f',
834 'g','h','i','j','k','l','m','n',
835 'o','p','q','r','s','t','u','v',
836 'w','x','y','z','0','1','2','3',
837 '4','5','6','7','8','9','-','_'
839 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
841 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
842 "Generate temporary file name (string) starting with PREFIX (a string).\n\
843 The Emacs process number forms part of the result,\n\
844 so there is no danger of generating a name being used by another process.\n\
846 In addition, this function makes an attempt to choose a name\n\
847 which has no existing file. To make this work,\n\
848 PREFIX should be an absolute file name.\n\
850 There is a race condition between calling `make-temp-name' and creating the\n\
851 file which opens all kinds of security holes. For that reason, you should\n\
852 probably use `make-temp-file' instead.")
859 unsigned char *p
, *data
;
863 CHECK_STRING (prefix
, 0);
865 /* VAL is created by adding 6 characters to PREFIX. The first
866 three are the PID of this process, in base 64, and the second
867 three are incremented if the file already exists. This ensures
868 262144 unique file names per PID per PREFIX. */
870 pid
= (int) getpid ();
872 #ifdef HAVE_LONG_FILE_NAMES
873 sprintf (pidbuf
, "%d", pid
);
874 pidlen
= strlen (pidbuf
);
876 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
877 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
878 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
882 len
= XSTRING (prefix
)->size
;
883 val
= make_uninit_string (len
+ 3 + pidlen
);
884 data
= XSTRING (val
)->data
;
885 bcopy(XSTRING (prefix
)->data
, data
, len
);
888 bcopy (pidbuf
, p
, pidlen
);
891 /* Here we try to minimize useless stat'ing when this function is
892 invoked many times successively with the same PREFIX. We achieve
893 this by initializing count to a random value, and incrementing it
896 We don't want make-temp-name to be called while dumping,
897 because then make_temp_name_count_initialized_p would get set
898 and then make_temp_name_count would not be set when Emacs starts. */
900 if (!make_temp_name_count_initialized_p
)
902 make_temp_name_count
= (unsigned) time (NULL
);
903 make_temp_name_count_initialized_p
= 1;
909 unsigned num
= make_temp_name_count
;
911 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
912 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
913 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
915 /* Poor man's congruential RN generator. Replace with
916 ++make_temp_name_count for debugging. */
917 make_temp_name_count
+= 25229;
918 make_temp_name_count
%= 225307;
920 if (stat (data
, &ignored
) < 0)
922 /* We want to return only if errno is ENOENT. */
926 /* The error here is dubious, but there is little else we
927 can do. The alternatives are to return nil, which is
928 as bad as (and in many cases worse than) throwing the
929 error, or to ignore the error, which will likely result
930 in looping through 225307 stat's, which is not only
931 dog-slow, but also useless since it will fallback to
932 the errow below, anyway. */
933 report_file_error ("Cannot create temporary name for prefix `%s'",
934 Fcons (prefix
, Qnil
));
939 error ("Cannot create temporary name for prefix `%s'",
940 XSTRING (prefix
)->data
);
945 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
946 "Convert filename NAME to absolute, and canonicalize it.\n\
947 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
948 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
949 the current buffer's value of default-directory is used.\n\
950 File name components that are `.' are removed, and \n\
951 so are file name components followed by `..', along with the `..' itself;\n\
952 note that these simplifications are done without checking the resulting\n\
953 file names in the file system.\n\
954 An initial `~/' expands to your home directory.\n\
955 An initial `~USER/' expands to USER's home directory.\n\
956 See also the function `substitute-in-file-name'.")
957 (name
, default_directory
)
958 Lisp_Object name
, default_directory
;
962 register unsigned char *newdir
, *p
, *o
;
964 unsigned char *target
;
967 unsigned char * colon
= 0;
968 unsigned char * close
= 0;
969 unsigned char * slash
= 0;
970 unsigned char * brack
= 0;
971 int lbrack
= 0, rbrack
= 0;
976 int collapse_newdir
= 1;
982 CHECK_STRING (name
, 0);
984 /* If the file name has special constructs in it,
985 call the corresponding file handler. */
986 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
988 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
990 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
991 if (NILP (default_directory
))
992 default_directory
= current_buffer
->directory
;
993 if (! STRINGP (default_directory
))
994 default_directory
= build_string ("/");
996 if (!NILP (default_directory
))
998 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1000 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1003 o
= XSTRING (default_directory
)->data
;
1005 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1006 It would be better to do this down below where we actually use
1007 default_directory. Unfortunately, calling Fexpand_file_name recursively
1008 could invoke GC, and the strings might be relocated. This would
1009 be annoying because we have pointers into strings lying around
1010 that would need adjusting, and people would add new pointers to
1011 the code and forget to adjust them, resulting in intermittent bugs.
1012 Putting this call here avoids all that crud.
1014 The EQ test avoids infinite recursion. */
1015 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1016 /* Save time in some common cases - as long as default_directory
1017 is not relative, it can be canonicalized with name below (if it
1018 is needed at all) without requiring it to be expanded now. */
1020 /* Detect MSDOS file names with drive specifiers. */
1021 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1023 /* Detect Windows file names in UNC format. */
1024 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1026 #else /* not DOS_NT */
1027 /* Detect Unix absolute file names (/... alone is not absolute on
1029 && ! (IS_DIRECTORY_SEP (o
[0]))
1030 #endif /* not DOS_NT */
1033 struct gcpro gcpro1
;
1036 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1041 /* Filenames on VMS are always upper case. */
1042 name
= Fupcase (name
);
1044 #ifdef FILE_SYSTEM_CASE
1045 name
= FILE_SYSTEM_CASE (name
);
1048 nm
= XSTRING (name
)->data
;
1051 /* We will force directory separators to be either all \ or /, so make
1052 a local copy to modify, even if there ends up being no change. */
1053 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1055 /* Note if special escape prefix is present, but remove for now. */
1056 if (nm
[0] == '/' && nm
[1] == ':')
1062 /* Find and remove drive specifier if present; this makes nm absolute
1063 even if the rest of the name appears to be relative. Only look for
1064 drive specifier at the beginning. */
1065 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1072 /* If we see "c://somedir", we want to strip the first slash after the
1073 colon when stripping the drive letter. Otherwise, this expands to
1075 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1077 #endif /* WINDOWSNT */
1081 /* Discard any previous drive specifier if nm is now in UNC format. */
1082 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1088 /* If nm is absolute, look for /./ or /../ sequences; if none are
1089 found, we can probably return right away. We will avoid allocating
1090 a new string if name is already fully expanded. */
1092 IS_DIRECTORY_SEP (nm
[0])
1094 && drive
&& !is_escaped
1097 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1104 /* If it turns out that the filename we want to return is just a
1105 suffix of FILENAME, we don't need to go through and edit
1106 things; we just need to construct a new string using data
1107 starting at the middle of FILENAME. If we set lose to a
1108 non-zero value, that means we've discovered that we can't do
1115 /* Since we know the name is absolute, we can assume that each
1116 element starts with a "/". */
1118 /* "." and ".." are hairy. */
1119 if (IS_DIRECTORY_SEP (p
[0])
1121 && (IS_DIRECTORY_SEP (p
[2])
1123 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1130 /* if dev:[dir]/, move nm to / */
1131 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1132 nm
= (brack
? brack
+ 1 : colon
+ 1);
1133 lbrack
= rbrack
= 0;
1141 /* VMS pre V4.4,convert '-'s in filenames. */
1142 if (lbrack
== rbrack
)
1144 if (dots
< 2) /* this is to allow negative version numbers */
1149 if (lbrack
> rbrack
&&
1150 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1151 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1157 /* count open brackets, reset close bracket pointer */
1158 if (p
[0] == '[' || p
[0] == '<')
1159 lbrack
++, brack
= 0;
1160 /* count close brackets, set close bracket pointer */
1161 if (p
[0] == ']' || p
[0] == '>')
1162 rbrack
++, brack
= p
;
1163 /* detect ][ or >< */
1164 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1166 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1167 nm
= p
+ 1, lose
= 1;
1168 if (p
[0] == ':' && (colon
|| slash
))
1169 /* if dev1:[dir]dev2:, move nm to dev2: */
1175 /* if /name/dev:, move nm to dev: */
1178 /* if node::dev:, move colon following dev */
1179 else if (colon
&& colon
[-1] == ':')
1181 /* if dev1:dev2:, move nm to dev2: */
1182 else if (colon
&& colon
[-1] != ':')
1187 if (p
[0] == ':' && !colon
)
1193 if (lbrack
== rbrack
)
1196 else if (p
[0] == '.')
1204 if (index (nm
, '/'))
1205 return build_string (sys_translate_unix (nm
));
1208 /* Make sure directories are all separated with / or \ as
1209 desired, but avoid allocation of a new string when not
1211 CORRECT_DIR_SEPS (nm
);
1213 if (IS_DIRECTORY_SEP (nm
[1]))
1215 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1216 name
= build_string (nm
);
1220 /* drive must be set, so this is okay */
1221 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1223 name
= make_string (nm
- 2, p
- nm
+ 2);
1224 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1225 XSTRING (name
)->data
[1] = ':';
1228 #else /* not DOS_NT */
1229 if (nm
== XSTRING (name
)->data
)
1231 return build_string (nm
);
1232 #endif /* not DOS_NT */
1236 /* At this point, nm might or might not be an absolute file name. We
1237 need to expand ~ or ~user if present, otherwise prefix nm with
1238 default_directory if nm is not absolute, and finally collapse /./
1239 and /foo/../ sequences.
1241 We set newdir to be the appropriate prefix if one is needed:
1242 - the relevant user directory if nm starts with ~ or ~user
1243 - the specified drive's working dir (DOS/NT only) if nm does not
1245 - the value of default_directory.
1247 Note that these prefixes are not guaranteed to be absolute (except
1248 for the working dir of a drive). Therefore, to ensure we always
1249 return an absolute name, if the final prefix is not absolute we
1250 append it to the current working directory. */
1254 if (nm
[0] == '~') /* prefix ~ */
1256 if (IS_DIRECTORY_SEP (nm
[1])
1260 || nm
[1] == 0) /* ~ by itself */
1262 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1263 newdir
= (unsigned char *) "";
1266 collapse_newdir
= 0;
1269 nm
++; /* Don't leave the slash in nm. */
1272 else /* ~user/filename */
1274 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1279 o
= (unsigned char *) alloca (p
- nm
+ 1);
1280 bcopy ((char *) nm
, o
, p
- nm
);
1283 pw
= (struct passwd
*) getpwnam (o
+ 1);
1286 newdir
= (unsigned char *) pw
-> pw_dir
;
1288 nm
= p
+ 1; /* skip the terminator */
1292 collapse_newdir
= 0;
1297 /* If we don't find a user of that name, leave the name
1298 unchanged; don't move nm forward to p. */
1303 /* On DOS and Windows, nm is absolute if a drive name was specified;
1304 use the drive's current directory as the prefix if needed. */
1305 if (!newdir
&& drive
)
1307 /* Get default directory if needed to make nm absolute. */
1308 if (!IS_DIRECTORY_SEP (nm
[0]))
1310 newdir
= alloca (MAXPATHLEN
+ 1);
1311 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1316 /* Either nm starts with /, or drive isn't mounted. */
1317 newdir
= alloca (4);
1318 newdir
[0] = DRIVE_LETTER (drive
);
1326 /* Finally, if no prefix has been specified and nm is not absolute,
1327 then it must be expanded relative to default_directory. */
1331 /* /... alone is not absolute on DOS and Windows. */
1332 && !IS_DIRECTORY_SEP (nm
[0])
1335 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1342 newdir
= XSTRING (default_directory
)->data
;
1344 /* Note if special escape prefix is present, but remove for now. */
1345 if (newdir
[0] == '/' && newdir
[1] == ':')
1356 /* First ensure newdir is an absolute name. */
1358 /* Detect MSDOS file names with drive specifiers. */
1359 ! (IS_DRIVE (newdir
[0])
1360 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1362 /* Detect Windows file names in UNC format. */
1363 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1367 /* Effectively, let newdir be (expand-file-name newdir cwd).
1368 Because of the admonition against calling expand-file-name
1369 when we have pointers into lisp strings, we accomplish this
1370 indirectly by prepending newdir to nm if necessary, and using
1371 cwd (or the wd of newdir's drive) as the new newdir. */
1373 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1378 if (!IS_DIRECTORY_SEP (nm
[0]))
1380 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1381 file_name_as_directory (tmp
, newdir
);
1385 newdir
= alloca (MAXPATHLEN
+ 1);
1388 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1395 /* Strip off drive name from prefix, if present. */
1396 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1402 /* Keep only a prefix from newdir if nm starts with slash
1403 (//server/share for UNC, nothing otherwise). */
1404 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1407 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1409 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1411 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1413 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1425 /* Get rid of any slash at the end of newdir, unless newdir is
1426 just / or // (an incomplete UNC name). */
1427 length
= strlen (newdir
);
1428 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1430 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1434 unsigned char *temp
= (unsigned char *) alloca (length
);
1435 bcopy (newdir
, temp
, length
- 1);
1436 temp
[length
- 1] = 0;
1444 /* Now concatenate the directory and name to new space in the stack frame */
1445 tlen
+= strlen (nm
) + 1;
1447 /* Reserve space for drive specifier and escape prefix, since either
1448 or both may need to be inserted. (The Microsoft x86 compiler
1449 produces incorrect code if the following two lines are combined.) */
1450 target
= (unsigned char *) alloca (tlen
+ 4);
1452 #else /* not DOS_NT */
1453 target
= (unsigned char *) alloca (tlen
);
1454 #endif /* not DOS_NT */
1460 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1463 /* If newdir is effectively "C:/", then the drive letter will have
1464 been stripped and newdir will be "/". Concatenating with an
1465 absolute directory in nm produces "//", which will then be
1466 incorrectly treated as a network share. Ignore newdir in
1467 this case (keeping the drive letter). */
1468 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1469 && newdir
[1] == '\0'))
1471 strcpy (target
, newdir
);
1475 file_name_as_directory (target
, newdir
);
1478 strcat (target
, nm
);
1480 if (index (target
, '/'))
1481 strcpy (target
, sys_translate_unix (target
));
1484 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1486 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1494 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1500 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1501 /* brackets are offset from each other by 2 */
1504 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1505 /* convert [foo][bar] to [bar] */
1506 while (o
[-1] != '[' && o
[-1] != '<')
1508 else if (*p
== '-' && *o
!= '.')
1511 else if (p
[0] == '-' && o
[-1] == '.' &&
1512 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1513 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1517 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1518 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1520 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1522 /* else [foo.-] ==> [-] */
1528 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1529 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1535 if (!IS_DIRECTORY_SEP (*p
))
1539 else if (IS_DIRECTORY_SEP (p
[0])
1541 && (IS_DIRECTORY_SEP (p
[2])
1544 /* If "/." is the entire filename, keep the "/". Otherwise,
1545 just delete the whole "/.". */
1546 if (o
== target
&& p
[2] == '\0')
1550 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1551 /* `/../' is the "superroot" on certain file systems. */
1553 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1555 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1557 /* Keep initial / only if this is the whole name. */
1558 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1566 #endif /* not VMS */
1570 /* At last, set drive name. */
1572 /* Except for network file name. */
1573 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1574 #endif /* WINDOWSNT */
1576 if (!drive
) abort ();
1578 target
[0] = DRIVE_LETTER (drive
);
1581 /* Reinsert the escape prefix if required. */
1588 CORRECT_DIR_SEPS (target
);
1591 return make_string (target
, o
- target
);
1595 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1596 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1597 "Convert FILENAME to absolute, and canonicalize it.\n\
1598 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1599 (does not start with slash); if DEFAULT is nil or missing,\n\
1600 the current buffer's value of default-directory is used.\n\
1601 Filenames containing `.' or `..' as components are simplified;\n\
1602 initial `~/' expands to your home directory.\n\
1603 See also the function `substitute-in-file-name'.")
1605 Lisp_Object name
, defalt
;
1609 register unsigned char *newdir
, *p
, *o
;
1611 unsigned char *target
;
1615 unsigned char * colon
= 0;
1616 unsigned char * close
= 0;
1617 unsigned char * slash
= 0;
1618 unsigned char * brack
= 0;
1619 int lbrack
= 0, rbrack
= 0;
1623 CHECK_STRING (name
, 0);
1626 /* Filenames on VMS are always upper case. */
1627 name
= Fupcase (name
);
1630 nm
= XSTRING (name
)->data
;
1632 /* If nm is absolute, flush ...// and detect /./ and /../.
1633 If no /./ or /../ we can return right away. */
1645 if (p
[0] == '/' && p
[1] == '/'
1647 /* // at start of filename is meaningful on Apollo system. */
1652 if (p
[0] == '/' && p
[1] == '~')
1653 nm
= p
+ 1, lose
= 1;
1654 if (p
[0] == '/' && p
[1] == '.'
1655 && (p
[2] == '/' || p
[2] == 0
1656 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1662 /* if dev:[dir]/, move nm to / */
1663 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1664 nm
= (brack
? brack
+ 1 : colon
+ 1);
1665 lbrack
= rbrack
= 0;
1673 /* VMS pre V4.4,convert '-'s in filenames. */
1674 if (lbrack
== rbrack
)
1676 if (dots
< 2) /* this is to allow negative version numbers */
1681 if (lbrack
> rbrack
&&
1682 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1683 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1689 /* count open brackets, reset close bracket pointer */
1690 if (p
[0] == '[' || p
[0] == '<')
1691 lbrack
++, brack
= 0;
1692 /* count close brackets, set close bracket pointer */
1693 if (p
[0] == ']' || p
[0] == '>')
1694 rbrack
++, brack
= p
;
1695 /* detect ][ or >< */
1696 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1698 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1699 nm
= p
+ 1, lose
= 1;
1700 if (p
[0] == ':' && (colon
|| slash
))
1701 /* if dev1:[dir]dev2:, move nm to dev2: */
1707 /* If /name/dev:, move nm to dev: */
1710 /* If node::dev:, move colon following dev */
1711 else if (colon
&& colon
[-1] == ':')
1713 /* If dev1:dev2:, move nm to dev2: */
1714 else if (colon
&& colon
[-1] != ':')
1719 if (p
[0] == ':' && !colon
)
1725 if (lbrack
== rbrack
)
1728 else if (p
[0] == '.')
1736 if (index (nm
, '/'))
1737 return build_string (sys_translate_unix (nm
));
1739 if (nm
== XSTRING (name
)->data
)
1741 return build_string (nm
);
1745 /* Now determine directory to start with and put it in NEWDIR */
1749 if (nm
[0] == '~') /* prefix ~ */
1754 || nm
[1] == 0)/* ~/filename */
1756 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1757 newdir
= (unsigned char *) "";
1760 nm
++; /* Don't leave the slash in nm. */
1763 else /* ~user/filename */
1765 /* Get past ~ to user */
1766 unsigned char *user
= nm
+ 1;
1767 /* Find end of name. */
1768 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1769 int len
= ptr
? ptr
- user
: strlen (user
);
1771 unsigned char *ptr1
= index (user
, ':');
1772 if (ptr1
!= 0 && ptr1
- user
< len
)
1775 /* Copy the user name into temp storage. */
1776 o
= (unsigned char *) alloca (len
+ 1);
1777 bcopy ((char *) user
, o
, len
);
1780 /* Look up the user name. */
1781 pw
= (struct passwd
*) getpwnam (o
+ 1);
1783 error ("\"%s\" isn't a registered user", o
+ 1);
1785 newdir
= (unsigned char *) pw
->pw_dir
;
1787 /* Discard the user name from NM. */
1794 #endif /* not VMS */
1798 defalt
= current_buffer
->directory
;
1799 CHECK_STRING (defalt
, 1);
1800 newdir
= XSTRING (defalt
)->data
;
1803 /* Now concatenate the directory and name to new space in the stack frame */
1805 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1806 target
= (unsigned char *) alloca (tlen
);
1812 if (nm
[0] == 0 || nm
[0] == '/')
1813 strcpy (target
, newdir
);
1816 file_name_as_directory (target
, newdir
);
1819 strcat (target
, nm
);
1821 if (index (target
, '/'))
1822 strcpy (target
, sys_translate_unix (target
));
1825 /* Now canonicalize by removing /. and /foo/.. if they appear */
1833 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1839 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1840 /* brackets are offset from each other by 2 */
1843 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1844 /* convert [foo][bar] to [bar] */
1845 while (o
[-1] != '[' && o
[-1] != '<')
1847 else if (*p
== '-' && *o
!= '.')
1850 else if (p
[0] == '-' && o
[-1] == '.' &&
1851 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1852 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1856 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1857 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1859 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1861 /* else [foo.-] ==> [-] */
1867 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1868 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1878 else if (!strncmp (p
, "//", 2)
1880 /* // at start of filename is meaningful in Apollo system. */
1888 else if (p
[0] == '/' && p
[1] == '.' &&
1889 (p
[2] == '/' || p
[2] == 0))
1891 else if (!strncmp (p
, "/..", 3)
1892 /* `/../' is the "superroot" on certain file systems. */
1894 && (p
[3] == '/' || p
[3] == 0))
1896 while (o
!= target
&& *--o
!= '/')
1899 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1903 if (o
== target
&& *o
== '/')
1911 #endif /* not VMS */
1914 return make_string (target
, o
- target
);
1918 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1919 Ssubstitute_in_file_name
, 1, 1, 0,
1920 "Substitute environment variables referred to in FILENAME.\n\
1921 `$FOO' where FOO is an environment variable name means to substitute\n\
1922 the value of that variable. The variable name should be terminated\n\
1923 with a character not a letter, digit or underscore; otherwise, enclose\n\
1924 the entire variable name in braces.\n\
1925 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1926 On VMS, `$' substitution is not done; this function does little and only\n\
1927 duplicates what `expand-file-name' does.")
1929 Lisp_Object filename
;
1933 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1934 unsigned char *target
;
1936 int substituted
= 0;
1938 Lisp_Object handler
;
1940 CHECK_STRING (filename
, 0);
1942 /* If the file name has special constructs in it,
1943 call the corresponding file handler. */
1944 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1945 if (!NILP (handler
))
1946 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1948 nm
= XSTRING (filename
)->data
;
1950 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1951 CORRECT_DIR_SEPS (nm
);
1952 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1954 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1956 /* If /~ or // appears, discard everything through first slash. */
1958 for (p
= nm
; p
!= endp
; p
++)
1961 #if defined (APOLLO) || defined (WINDOWSNT)
1962 /* // at start of file name is meaningful in Apollo and
1963 WindowsNT systems. */
1964 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1965 #else /* not (APOLLO || WINDOWSNT) */
1966 || IS_DIRECTORY_SEP (p
[0])
1967 #endif /* not (APOLLO || WINDOWSNT) */
1972 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1974 || IS_DIRECTORY_SEP (p
[-1])))
1980 /* see comment in expand-file-name about drive specifiers */
1981 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1982 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1991 return build_string (nm
);
1994 /* See if any variables are substituted into the string
1995 and find the total length of their values in `total' */
1997 for (p
= nm
; p
!= endp
;)
2007 /* "$$" means a single "$" */
2016 while (p
!= endp
&& *p
!= '}') p
++;
2017 if (*p
!= '}') goto missingclose
;
2023 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2027 /* Copy out the variable name */
2028 target
= (unsigned char *) alloca (s
- o
+ 1);
2029 strncpy (target
, o
, s
- o
);
2032 strupr (target
); /* $home == $HOME etc. */
2035 /* Get variable value */
2036 o
= (unsigned char *) egetenv (target
);
2037 if (!o
) goto badvar
;
2038 total
+= strlen (o
);
2045 /* If substitution required, recopy the string and do it */
2046 /* Make space in stack frame for the new copy */
2047 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2050 /* Copy the rest of the name through, replacing $ constructs with values */
2067 while (p
!= endp
&& *p
!= '}') p
++;
2068 if (*p
!= '}') goto missingclose
;
2074 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2078 /* Copy out the variable name */
2079 target
= (unsigned char *) alloca (s
- o
+ 1);
2080 strncpy (target
, o
, s
- o
);
2083 strupr (target
); /* $home == $HOME etc. */
2086 /* Get variable value */
2087 o
= (unsigned char *) egetenv (target
);
2091 if (STRING_MULTIBYTE (filename
))
2093 /* If the original string is multibyte,
2094 convert what we substitute into multibyte. */
2095 unsigned char workbuf
[4], *str
;
2101 c
= unibyte_char_to_multibyte (c
);
2102 if (! SINGLE_BYTE_CHAR_P (c
))
2104 len
= CHAR_STRING (c
, workbuf
, str
);
2105 bcopy (str
, x
, len
);
2121 /* If /~ or // appears, discard everything through first slash. */
2123 for (p
= xnm
; p
!= x
; p
++)
2125 #if defined (APOLLO) || defined (WINDOWSNT)
2126 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2127 #else /* not (APOLLO || WINDOWSNT) */
2128 || IS_DIRECTORY_SEP (p
[0])
2129 #endif /* not (APOLLO || WINDOWSNT) */
2131 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2134 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2135 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2139 if (STRING_MULTIBYTE (filename
))
2140 return make_string (xnm
, x
- xnm
);
2141 return make_unibyte_string (xnm
, x
- xnm
);
2144 error ("Bad format environment-variable substitution");
2146 error ("Missing \"}\" in environment-variable substitution");
2148 error ("Substituting nonexistent environment variable \"%s\"", target
);
2151 #endif /* not VMS */
2154 /* A slightly faster and more convenient way to get
2155 (directory-file-name (expand-file-name FOO)). */
2158 expand_and_dir_to_file (filename
, defdir
)
2159 Lisp_Object filename
, defdir
;
2161 register Lisp_Object absname
;
2163 absname
= Fexpand_file_name (filename
, defdir
);
2166 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2167 if (c
== ':' || c
== ']' || c
== '>')
2168 absname
= Fdirectory_file_name (absname
);
2171 /* Remove final slash, if any (unless this is the root dir).
2172 stat behaves differently depending! */
2173 if (XSTRING (absname
)->size
> 1
2174 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2175 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2176 /* We cannot take shortcuts; they might be wrong for magic file names. */
2177 absname
= Fdirectory_file_name (absname
);
2182 /* Signal an error if the file ABSNAME already exists.
2183 If INTERACTIVE is nonzero, ask the user whether to proceed,
2184 and bypass the error if the user says to go ahead.
2185 QUERYSTRING is a name for the action that is being considered
2188 *STATPTR is used to store the stat information if the file exists.
2189 If the file does not exist, STATPTR->st_mode is set to 0.
2190 If STATPTR is null, we don't store into it.
2192 If QUICK is nonzero, we ask for y or n, not yes or no. */
2195 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2196 Lisp_Object absname
;
2197 unsigned char *querystring
;
2199 struct stat
*statptr
;
2202 register Lisp_Object tem
, encoded_filename
;
2203 struct stat statbuf
;
2204 struct gcpro gcpro1
;
2206 encoded_filename
= ENCODE_FILE (absname
);
2208 /* stat is a good way to tell whether the file exists,
2209 regardless of what access permissions it has. */
2210 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2213 Fsignal (Qfile_already_exists
,
2214 Fcons (build_string ("File already exists"),
2215 Fcons (absname
, Qnil
)));
2217 tem
= format1 ("File %s already exists; %s anyway? ",
2218 XSTRING (absname
)->data
, querystring
);
2220 tem
= Fy_or_n_p (tem
);
2222 tem
= do_yes_or_no_p (tem
);
2225 Fsignal (Qfile_already_exists
,
2226 Fcons (build_string ("File already exists"),
2227 Fcons (absname
, Qnil
)));
2234 statptr
->st_mode
= 0;
2239 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2240 "fCopy file: \nFCopy %s to file: \np\nP",
2241 "Copy FILE to NEWNAME. Both args must be strings.\n\
2242 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2243 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2244 A number as third arg means request confirmation if NEWNAME already exists.\n\
2245 This is what happens in interactive use with M-x.\n\
2246 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2247 last-modified time as the old one. (This works on only some systems.)\n\
2248 A prefix arg makes KEEP-TIME non-nil.")
2249 (file
, newname
, ok_if_already_exists
, keep_date
)
2250 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2253 char buf
[16 * 1024];
2254 struct stat st
, out_st
;
2255 Lisp_Object handler
;
2256 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2257 int count
= specpdl_ptr
- specpdl
;
2258 int input_file_statable_p
;
2259 Lisp_Object encoded_file
, encoded_newname
;
2261 encoded_file
= encoded_newname
= Qnil
;
2262 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2263 CHECK_STRING (file
, 0);
2264 CHECK_STRING (newname
, 1);
2266 file
= Fexpand_file_name (file
, Qnil
);
2267 newname
= Fexpand_file_name (newname
, Qnil
);
2269 /* If the input file name has special constructs in it,
2270 call the corresponding file handler. */
2271 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2272 /* Likewise for output file name. */
2274 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2275 if (!NILP (handler
))
2276 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2277 ok_if_already_exists
, keep_date
));
2279 encoded_file
= ENCODE_FILE (file
);
2280 encoded_newname
= ENCODE_FILE (newname
);
2282 if (NILP (ok_if_already_exists
)
2283 || INTEGERP (ok_if_already_exists
))
2284 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2285 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2286 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2289 ifd
= emacs_open (XSTRING (encoded_file
)->data
, O_RDONLY
, 0);
2291 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2293 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2295 /* We can only copy regular files and symbolic links. Other files are not
2297 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2299 #if !defined (DOS_NT) || __DJGPP__ > 1
2300 if (out_st
.st_mode
!= 0
2301 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2304 report_file_error ("Input and output files are the same",
2305 Fcons (file
, Fcons (newname
, Qnil
)));
2309 #if defined (S_ISREG) && defined (S_ISLNK)
2310 if (input_file_statable_p
)
2312 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2314 #if defined (EISDIR)
2315 /* Get a better looking error message. */
2318 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2321 #endif /* S_ISREG && S_ISLNK */
2324 /* Create the copy file with the same record format as the input file */
2325 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2328 /* System's default file type was set to binary by _fmode in emacs.c. */
2329 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2330 #else /* not MSDOS */
2331 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2332 #endif /* not MSDOS */
2335 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2337 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2341 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2342 if (emacs_write (ofd
, buf
, n
) != n
)
2343 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2346 /* Closing the output clobbers the file times on some systems. */
2347 if (emacs_close (ofd
) < 0)
2348 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2350 if (input_file_statable_p
)
2352 if (!NILP (keep_date
))
2354 EMACS_TIME atime
, mtime
;
2355 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2356 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2357 if (set_file_times (XSTRING (encoded_newname
)->data
,
2359 Fsignal (Qfile_date_error
,
2360 Fcons (build_string ("Cannot set file date"),
2361 Fcons (newname
, Qnil
)));
2364 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2366 #if defined (__DJGPP__) && __DJGPP__ > 1
2367 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2368 and if it can't, it tells so. Otherwise, under MSDOS we usually
2369 get only the READ bit, which will make the copied file read-only,
2370 so it's better not to chmod at all. */
2371 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2372 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2373 #endif /* DJGPP version 2 or newer */
2379 /* Discard the unwind protects. */
2380 specpdl_ptr
= specpdl
+ count
;
2386 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2387 Smake_directory_internal
, 1, 1, 0,
2388 "Create a new directory named DIRECTORY.")
2390 Lisp_Object directory
;
2393 Lisp_Object handler
;
2394 Lisp_Object encoded_dir
;
2396 CHECK_STRING (directory
, 0);
2397 directory
= Fexpand_file_name (directory
, Qnil
);
2399 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2400 if (!NILP (handler
))
2401 return call2 (handler
, Qmake_directory_internal
, directory
);
2403 encoded_dir
= ENCODE_FILE (directory
);
2405 dir
= XSTRING (encoded_dir
)->data
;
2408 if (mkdir (dir
) != 0)
2410 if (mkdir (dir
, 0777) != 0)
2412 report_file_error ("Creating directory", Flist (1, &directory
));
2417 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2418 "Delete the directory named DIRECTORY.")
2420 Lisp_Object directory
;
2423 Lisp_Object handler
;
2424 Lisp_Object encoded_dir
;
2426 CHECK_STRING (directory
, 0);
2427 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2429 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2430 if (!NILP (handler
))
2431 return call2 (handler
, Qdelete_directory
, directory
);
2433 encoded_dir
= ENCODE_FILE (directory
);
2435 dir
= XSTRING (encoded_dir
)->data
;
2437 if (rmdir (dir
) != 0)
2438 report_file_error ("Removing directory", Flist (1, &directory
));
2443 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2444 "Delete file named FILENAME.\n\
2445 If file has multiple names, it continues to exist with the other names.")
2447 Lisp_Object filename
;
2449 Lisp_Object handler
;
2450 Lisp_Object encoded_file
;
2452 CHECK_STRING (filename
, 0);
2453 filename
= Fexpand_file_name (filename
, Qnil
);
2455 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2456 if (!NILP (handler
))
2457 return call2 (handler
, Qdelete_file
, filename
);
2459 encoded_file
= ENCODE_FILE (filename
);
2461 if (0 > unlink (XSTRING (encoded_file
)->data
))
2462 report_file_error ("Removing old name", Flist (1, &filename
));
2467 internal_delete_file_1 (ignore
)
2473 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2476 internal_delete_file (filename
)
2477 Lisp_Object filename
;
2479 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2480 Qt
, internal_delete_file_1
));
2483 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2484 "fRename file: \nFRename %s to file: \np",
2485 "Rename FILE as NEWNAME. Both args strings.\n\
2486 If file has names other than FILE, it continues to have those names.\n\
2487 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2488 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2489 A number as third arg means request confirmation if NEWNAME already exists.\n\
2490 This is what happens in interactive use with M-x.")
2491 (file
, newname
, ok_if_already_exists
)
2492 Lisp_Object file
, newname
, ok_if_already_exists
;
2495 Lisp_Object args
[2];
2497 Lisp_Object handler
;
2498 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2499 Lisp_Object encoded_file
, encoded_newname
;
2501 encoded_file
= encoded_newname
= Qnil
;
2502 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2503 CHECK_STRING (file
, 0);
2504 CHECK_STRING (newname
, 1);
2505 file
= Fexpand_file_name (file
, Qnil
);
2506 newname
= Fexpand_file_name (newname
, Qnil
);
2508 /* If the file name has special constructs in it,
2509 call the corresponding file handler. */
2510 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2512 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2513 if (!NILP (handler
))
2514 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2515 file
, newname
, ok_if_already_exists
));
2517 encoded_file
= ENCODE_FILE (file
);
2518 encoded_newname
= ENCODE_FILE (newname
);
2520 if (NILP (ok_if_already_exists
)
2521 || INTEGERP (ok_if_already_exists
))
2522 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2523 INTEGERP (ok_if_already_exists
), 0, 0);
2525 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2527 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2528 || 0 > unlink (XSTRING (encoded_file
)->data
))
2533 Fcopy_file (file
, newname
,
2534 /* We have already prompted if it was an integer,
2535 so don't have copy-file prompt again. */
2536 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2537 Fdelete_file (file
);
2544 report_file_error ("Renaming", Flist (2, args
));
2547 report_file_error ("Renaming", Flist (2, &file
));
2554 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2555 "fAdd name to file: \nFName to add to %s: \np",
2556 "Give FILE additional name NEWNAME. Both args strings.\n\
2557 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2558 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2559 A number as third arg means request confirmation if NEWNAME already exists.\n\
2560 This is what happens in interactive use with M-x.")
2561 (file
, newname
, ok_if_already_exists
)
2562 Lisp_Object file
, newname
, ok_if_already_exists
;
2565 Lisp_Object args
[2];
2567 Lisp_Object handler
;
2568 Lisp_Object encoded_file
, encoded_newname
;
2569 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2571 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2572 encoded_file
= encoded_newname
= Qnil
;
2573 CHECK_STRING (file
, 0);
2574 CHECK_STRING (newname
, 1);
2575 file
= Fexpand_file_name (file
, Qnil
);
2576 newname
= Fexpand_file_name (newname
, Qnil
);
2578 /* If the file name has special constructs in it,
2579 call the corresponding file handler. */
2580 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2581 if (!NILP (handler
))
2582 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2583 newname
, ok_if_already_exists
));
2585 /* If the new name has special constructs in it,
2586 call the corresponding file handler. */
2587 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2588 if (!NILP (handler
))
2589 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2590 newname
, ok_if_already_exists
));
2592 encoded_file
= ENCODE_FILE (file
);
2593 encoded_newname
= ENCODE_FILE (newname
);
2595 if (NILP (ok_if_already_exists
)
2596 || INTEGERP (ok_if_already_exists
))
2597 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2598 INTEGERP (ok_if_already_exists
), 0, 0);
2600 unlink (XSTRING (newname
)->data
);
2601 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2606 report_file_error ("Adding new name", Flist (2, args
));
2608 report_file_error ("Adding new name", Flist (2, &file
));
2617 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2618 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2619 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2620 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2621 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2622 A number as third arg means request confirmation if LINKNAME already exists.\n\
2623 This happens for interactive use with M-x.")
2624 (filename
, linkname
, ok_if_already_exists
)
2625 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2628 Lisp_Object args
[2];
2630 Lisp_Object handler
;
2631 Lisp_Object encoded_filename
, encoded_linkname
;
2632 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2634 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2635 encoded_filename
= encoded_linkname
= Qnil
;
2636 CHECK_STRING (filename
, 0);
2637 CHECK_STRING (linkname
, 1);
2638 /* If the link target has a ~, we must expand it to get
2639 a truly valid file name. Otherwise, do not expand;
2640 we want to permit links to relative file names. */
2641 if (XSTRING (filename
)->data
[0] == '~')
2642 filename
= Fexpand_file_name (filename
, Qnil
);
2643 linkname
= Fexpand_file_name (linkname
, Qnil
);
2645 /* If the file name has special constructs in it,
2646 call the corresponding file handler. */
2647 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2648 if (!NILP (handler
))
2649 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2650 linkname
, ok_if_already_exists
));
2652 /* If the new link name has special constructs in it,
2653 call the corresponding file handler. */
2654 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2655 if (!NILP (handler
))
2656 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2657 linkname
, ok_if_already_exists
));
2659 encoded_filename
= ENCODE_FILE (filename
);
2660 encoded_linkname
= ENCODE_FILE (linkname
);
2662 if (NILP (ok_if_already_exists
)
2663 || INTEGERP (ok_if_already_exists
))
2664 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2665 INTEGERP (ok_if_already_exists
), 0, 0);
2666 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2667 XSTRING (encoded_linkname
)->data
))
2669 /* If we didn't complain already, silently delete existing file. */
2670 if (errno
== EEXIST
)
2672 unlink (XSTRING (encoded_linkname
)->data
);
2673 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2674 XSTRING (encoded_linkname
)->data
))
2684 report_file_error ("Making symbolic link", Flist (2, args
));
2686 report_file_error ("Making symbolic link", Flist (2, &filename
));
2692 #endif /* S_IFLNK */
2696 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2697 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2698 "Define the job-wide logical name NAME to have the value STRING.\n\
2699 If STRING is nil or a null string, the logical name NAME is deleted.")
2704 CHECK_STRING (name
, 0);
2706 delete_logical_name (XSTRING (name
)->data
);
2709 CHECK_STRING (string
, 1);
2711 if (XSTRING (string
)->size
== 0)
2712 delete_logical_name (XSTRING (name
)->data
);
2714 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2723 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2724 "Open a network connection to PATH using LOGIN as the login string.")
2726 Lisp_Object path
, login
;
2730 CHECK_STRING (path
, 0);
2731 CHECK_STRING (login
, 0);
2733 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2735 if (netresult
== -1)
2740 #endif /* HPUX_NET */
2742 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2744 "Return t if file FILENAME specifies an absolute file name.\n\
2745 On Unix, this is a name starting with a `/' or a `~'.")
2747 Lisp_Object filename
;
2751 CHECK_STRING (filename
, 0);
2752 ptr
= XSTRING (filename
)->data
;
2753 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2755 /* ??? This criterion is probably wrong for '<'. */
2756 || index (ptr
, ':') || index (ptr
, '<')
2757 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2761 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2769 /* Return nonzero if file FILENAME exists and can be executed. */
2772 check_executable (filename
)
2776 int len
= strlen (filename
);
2779 if (stat (filename
, &st
) < 0)
2781 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2782 return ((st
.st_mode
& S_IEXEC
) != 0);
2784 return (S_ISREG (st
.st_mode
)
2786 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2787 || stricmp (suffix
, ".exe") == 0
2788 || stricmp (suffix
, ".bat") == 0)
2789 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2790 #endif /* not WINDOWSNT */
2791 #else /* not DOS_NT */
2792 #ifdef HAVE_EUIDACCESS
2793 return (euidaccess (filename
, 1) >= 0);
2795 /* Access isn't quite right because it uses the real uid
2796 and we really want to test with the effective uid.
2797 But Unix doesn't give us a right way to do it. */
2798 return (access (filename
, 1) >= 0);
2800 #endif /* not DOS_NT */
2803 /* Return nonzero if file FILENAME exists and can be written. */
2806 check_writable (filename
)
2811 if (stat (filename
, &st
) < 0)
2813 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2814 #else /* not MSDOS */
2815 #ifdef HAVE_EUIDACCESS
2816 return (euidaccess (filename
, 2) >= 0);
2818 /* Access isn't quite right because it uses the real uid
2819 and we really want to test with the effective uid.
2820 But Unix doesn't give us a right way to do it.
2821 Opening with O_WRONLY could work for an ordinary file,
2822 but would lose for directories. */
2823 return (access (filename
, 2) >= 0);
2825 #endif /* not MSDOS */
2828 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2829 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2830 See also `file-readable-p' and `file-attributes'.")
2832 Lisp_Object filename
;
2834 Lisp_Object absname
;
2835 Lisp_Object handler
;
2836 struct stat statbuf
;
2838 CHECK_STRING (filename
, 0);
2839 absname
= Fexpand_file_name (filename
, Qnil
);
2841 /* If the file name has special constructs in it,
2842 call the corresponding file handler. */
2843 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2844 if (!NILP (handler
))
2845 return call2 (handler
, Qfile_exists_p
, absname
);
2847 absname
= ENCODE_FILE (absname
);
2849 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2852 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2853 "Return t if FILENAME can be executed by you.\n\
2854 For a directory, this means you can access files in that directory.")
2856 Lisp_Object filename
;
2859 Lisp_Object absname
;
2860 Lisp_Object handler
;
2862 CHECK_STRING (filename
, 0);
2863 absname
= Fexpand_file_name (filename
, Qnil
);
2865 /* If the file name has special constructs in it,
2866 call the corresponding file handler. */
2867 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2868 if (!NILP (handler
))
2869 return call2 (handler
, Qfile_executable_p
, absname
);
2871 absname
= ENCODE_FILE (absname
);
2873 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2876 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2877 "Return t if file FILENAME exists and you can read it.\n\
2878 See also `file-exists-p' and `file-attributes'.")
2880 Lisp_Object filename
;
2882 Lisp_Object absname
;
2883 Lisp_Object handler
;
2886 struct stat statbuf
;
2888 CHECK_STRING (filename
, 0);
2889 absname
= Fexpand_file_name (filename
, Qnil
);
2891 /* If the file name has special constructs in it,
2892 call the corresponding file handler. */
2893 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2894 if (!NILP (handler
))
2895 return call2 (handler
, Qfile_readable_p
, absname
);
2897 absname
= ENCODE_FILE (absname
);
2900 /* Under MS-DOS and Windows, open does not work for directories. */
2901 if (access (XSTRING (absname
)->data
, 0) == 0)
2904 #else /* not DOS_NT */
2906 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2907 /* Opening a fifo without O_NONBLOCK can wait.
2908 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2909 except in the case of a fifo, on a system which handles it. */
2910 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2913 if (S_ISFIFO (statbuf
.st_mode
))
2914 flags
|= O_NONBLOCK
;
2916 desc
= emacs_open (XSTRING (absname
)->data
, flags
, 0);
2921 #endif /* not DOS_NT */
2924 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2926 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2927 "Return t if file FILENAME can be written or created by you.")
2929 Lisp_Object filename
;
2931 Lisp_Object absname
, dir
, encoded
;
2932 Lisp_Object handler
;
2933 struct stat statbuf
;
2935 CHECK_STRING (filename
, 0);
2936 absname
= Fexpand_file_name (filename
, Qnil
);
2938 /* If the file name has special constructs in it,
2939 call the corresponding file handler. */
2940 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2941 if (!NILP (handler
))
2942 return call2 (handler
, Qfile_writable_p
, absname
);
2944 encoded
= ENCODE_FILE (absname
);
2945 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2946 return (check_writable (XSTRING (encoded
)->data
)
2949 dir
= Ffile_name_directory (absname
);
2952 dir
= Fdirectory_file_name (dir
);
2956 dir
= Fdirectory_file_name (dir
);
2959 dir
= ENCODE_FILE (dir
);
2960 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2964 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2965 "Access file FILENAME, and get an error if that does not work.\n\
2966 The second argument STRING is used in the error message.\n\
2967 If there is no error, we return nil.")
2969 Lisp_Object filename
, string
;
2971 Lisp_Object handler
, encoded_filename
;
2974 CHECK_STRING (filename
, 0);
2975 CHECK_STRING (string
, 1);
2977 /* If the file name has special constructs in it,
2978 call the corresponding file handler. */
2979 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2980 if (!NILP (handler
))
2981 return call3 (handler
, Qaccess_file
, filename
, string
);
2983 encoded_filename
= ENCODE_FILE (filename
);
2985 fd
= emacs_open (XSTRING (encoded_filename
)->data
, O_RDONLY
, 0);
2987 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2993 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2994 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2995 The value is the name of the file to which it is linked.\n\
2996 Otherwise returns nil.")
2998 Lisp_Object filename
;
3005 Lisp_Object handler
;
3007 CHECK_STRING (filename
, 0);
3008 filename
= Fexpand_file_name (filename
, Qnil
);
3010 /* If the file name has special constructs in it,
3011 call the corresponding file handler. */
3012 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3013 if (!NILP (handler
))
3014 return call2 (handler
, Qfile_symlink_p
, filename
);
3016 filename
= ENCODE_FILE (filename
);
3021 buf
= (char *) xmalloc (bufsize
);
3022 bzero (buf
, bufsize
);
3023 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3024 if (valsize
< bufsize
) break;
3025 /* Buffer was not long enough */
3034 val
= make_string (buf
, valsize
);
3036 val
= DECODE_FILE (val
);
3038 #else /* not S_IFLNK */
3040 #endif /* not S_IFLNK */
3043 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3044 "Return t if FILENAME names an existing directory.\n\
3045 Symbolic links to directories count as directories.\n\
3046 See `file-symlink-p' to distinguish symlinks.")
3048 Lisp_Object filename
;
3050 register Lisp_Object absname
;
3052 Lisp_Object handler
;
3054 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3056 /* If the file name has special constructs in it,
3057 call the corresponding file handler. */
3058 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3059 if (!NILP (handler
))
3060 return call2 (handler
, Qfile_directory_p
, absname
);
3062 absname
= ENCODE_FILE (absname
);
3064 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3066 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3069 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3070 "Return t if file FILENAME is the name of a directory as a file,\n\
3071 and files in that directory can be opened by you. In order to use a\n\
3072 directory as a buffer's current directory, this predicate must return true.\n\
3073 A directory name spec may be given instead; then the value is t\n\
3074 if the directory so specified exists and really is a readable and\n\
3075 searchable directory.")
3077 Lisp_Object filename
;
3079 Lisp_Object handler
;
3081 struct gcpro gcpro1
;
3083 /* If the file name has special constructs in it,
3084 call the corresponding file handler. */
3085 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3086 if (!NILP (handler
))
3087 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3089 /* It's an unlikely combination, but yes we really do need to gcpro:
3090 Suppose that file-accessible-directory-p has no handler, but
3091 file-directory-p does have a handler; this handler causes a GC which
3092 relocates the string in `filename'; and finally file-directory-p
3093 returns non-nil. Then we would end up passing a garbaged string
3094 to file-executable-p. */
3096 tem
= (NILP (Ffile_directory_p (filename
))
3097 || NILP (Ffile_executable_p (filename
)));
3099 return tem
? Qnil
: Qt
;
3102 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3103 "Return t if file FILENAME is the name of a regular file.\n\
3104 This is the sort of file that holds an ordinary stream of data bytes.")
3106 Lisp_Object filename
;
3108 register Lisp_Object absname
;
3110 Lisp_Object handler
;
3112 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3114 /* If the file name has special constructs in it,
3115 call the corresponding file handler. */
3116 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3117 if (!NILP (handler
))
3118 return call2 (handler
, Qfile_regular_p
, absname
);
3120 absname
= ENCODE_FILE (absname
);
3125 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3127 /* Tell stat to use expensive method to get accurate info. */
3128 Vw32_get_true_file_attributes
= Qt
;
3129 result
= stat (XSTRING (absname
)->data
, &st
);
3130 Vw32_get_true_file_attributes
= tem
;
3134 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3137 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3139 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3143 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3144 "Return mode bits of file named FILENAME, as an integer.")
3146 Lisp_Object filename
;
3148 Lisp_Object absname
;
3150 Lisp_Object handler
;
3152 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3154 /* If the file name has special constructs in it,
3155 call the corresponding file handler. */
3156 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3157 if (!NILP (handler
))
3158 return call2 (handler
, Qfile_modes
, absname
);
3160 absname
= ENCODE_FILE (absname
);
3162 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3164 #if defined (MSDOS) && __DJGPP__ < 2
3165 if (check_executable (XSTRING (absname
)->data
))
3166 st
.st_mode
|= S_IEXEC
;
3167 #endif /* MSDOS && __DJGPP__ < 2 */
3169 return make_number (st
.st_mode
& 07777);
3172 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3173 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3174 Only the 12 low bits of MODE are used.")
3176 Lisp_Object filename
, mode
;
3178 Lisp_Object absname
, encoded_absname
;
3179 Lisp_Object handler
;
3181 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3182 CHECK_NUMBER (mode
, 1);
3184 /* If the file name has special constructs in it,
3185 call the corresponding file handler. */
3186 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3187 if (!NILP (handler
))
3188 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3190 encoded_absname
= ENCODE_FILE (absname
);
3192 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3193 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3198 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3199 "Set the file permission bits for newly created files.\n\
3200 The argument MODE should be an integer; only the low 9 bits are used.\n\
3201 This setting is inherited by subprocesses.")
3205 CHECK_NUMBER (mode
, 0);
3207 umask ((~ XINT (mode
)) & 0777);
3212 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3213 "Return the default file protection for created files.\n\
3214 The value is an integer.")
3220 realmask
= umask (0);
3223 XSETINT (value
, (~ realmask
) & 0777);
3229 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3230 "Tell Unix to finish all pending disk updates.")
3239 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3240 "Return t if file FILE1 is newer than file FILE2.\n\
3241 If FILE1 does not exist, the answer is nil;\n\
3242 otherwise, if FILE2 does not exist, the answer is t.")
3244 Lisp_Object file1
, file2
;
3246 Lisp_Object absname1
, absname2
;
3249 Lisp_Object handler
;
3250 struct gcpro gcpro1
, gcpro2
;
3252 CHECK_STRING (file1
, 0);
3253 CHECK_STRING (file2
, 0);
3256 GCPRO2 (absname1
, file2
);
3257 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3258 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3261 /* If the file name has special constructs in it,
3262 call the corresponding file handler. */
3263 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3265 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3266 if (!NILP (handler
))
3267 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3269 GCPRO2 (absname1
, absname2
);
3270 absname1
= ENCODE_FILE (absname1
);
3271 absname2
= ENCODE_FILE (absname2
);
3274 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3277 mtime1
= st
.st_mtime
;
3279 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3282 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3286 Lisp_Object Qfind_buffer_file_type
;
3289 #ifndef READ_BUF_SIZE
3290 #define READ_BUF_SIZE (64 << 10)
3293 /* This function is called when a function bound to
3294 Vset_auto_coding_function causes some error. At that time, a text
3295 of a file has already been inserted in the current buffer, but,
3296 markers has not yet been adjusted. Thus we must adjust markers
3297 here. We are sure that the buffer was empty before the text of the
3298 file was inserted. */
3301 set_auto_coding_unwind (multibyte
)
3302 Lisp_Object multibyte
;
3304 int inserted
= Z_BYTE
- BEG_BYTE
;
3306 if (!NILP (multibyte
))
3307 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3308 adjust_after_insert (PT
, PT_BYTE
, Z
, Z_BYTE
, inserted
);
3313 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3315 "Insert contents of file FILENAME after point.\n\
3316 Returns list of absolute file name and number of bytes inserted.\n\
3317 If second argument VISIT is non-nil, the buffer's visited filename\n\
3318 and last save file modtime are set, and it is marked unmodified.\n\
3319 If visiting and the file does not exist, visiting is completed\n\
3320 before the error is signaled.\n\
3321 The optional third and fourth arguments BEG and END\n\
3322 specify what portion of the file to insert.\n\
3323 These arguments count bytes in the file, not characters in the buffer.\n\
3324 If VISIT is non-nil, BEG and END must be nil.\n\
3326 If optional fifth argument REPLACE is non-nil,\n\
3327 it means replace the current buffer contents (in the accessible portion)\n\
3328 with the file contents. This is better than simply deleting and inserting\n\
3329 the whole thing because (1) it preserves some marker positions\n\
3330 and (2) it puts less data in the undo list.\n\
3331 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3332 which is often less than the number of characters to be read.\n\
3334 This does code conversion according to the value of\n\
3335 `coding-system-for-read' or `file-coding-system-alist',\n\
3336 and sets the variable `last-coding-system-used' to the coding system\n\
3338 (filename
, visit
, beg
, end
, replace
)
3339 Lisp_Object filename
, visit
, beg
, end
, replace
;
3344 register int how_much
;
3345 register int unprocessed
;
3346 int count
= specpdl_ptr
- specpdl
;
3347 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3348 Lisp_Object handler
, val
, insval
, orig_filename
;
3351 int not_regular
= 0;
3352 unsigned char read_buf
[READ_BUF_SIZE
];
3353 struct coding_system coding
;
3354 unsigned char buffer
[1 << 14];
3355 int replace_handled
= 0;
3356 int set_coding_system
= 0;
3357 int coding_system_decided
= 0;
3359 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3360 error ("Cannot do file visiting in an indirect buffer");
3362 if (!NILP (current_buffer
->read_only
))
3363 Fbarf_if_buffer_read_only ();
3367 orig_filename
= Qnil
;
3369 GCPRO4 (filename
, val
, p
, orig_filename
);
3371 CHECK_STRING (filename
, 0);
3372 filename
= Fexpand_file_name (filename
, Qnil
);
3374 /* If the file name has special constructs in it,
3375 call the corresponding file handler. */
3376 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3377 if (!NILP (handler
))
3379 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3380 visit
, beg
, end
, replace
);
3381 if (CONSP (val
) && CONSP (XCDR (val
)))
3382 inserted
= XINT (XCAR (XCDR (val
)));
3386 orig_filename
= filename
;
3387 filename
= ENCODE_FILE (filename
);
3393 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3395 /* Tell stat to use expensive method to get accurate info. */
3396 Vw32_get_true_file_attributes
= Qt
;
3397 total
= stat (XSTRING (filename
)->data
, &st
);
3398 Vw32_get_true_file_attributes
= tem
;
3403 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3405 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0
3406 || fstat (fd
, &st
) < 0)
3407 #endif /* not APOLLO */
3408 #endif /* WINDOWSNT */
3410 if (fd
>= 0) emacs_close (fd
);
3413 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3416 if (!NILP (Vcoding_system_for_read
))
3417 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3422 /* This code will need to be changed in order to work on named
3423 pipes, and it's probably just not worth it. So we should at
3424 least signal an error. */
3425 if (!S_ISREG (st
.st_mode
))
3432 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3433 Fsignal (Qfile_error
,
3434 Fcons (build_string ("not a regular file"),
3435 Fcons (orig_filename
, Qnil
)));
3440 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0)
3443 /* Replacement should preserve point as it preserves markers. */
3444 if (!NILP (replace
))
3445 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3447 record_unwind_protect (close_file_unwind
, make_number (fd
));
3449 /* Supposedly happens on VMS. */
3450 if (! not_regular
&& st
.st_size
< 0)
3451 error ("File size is negative");
3453 /* Prevent redisplay optimizations. */
3454 current_buffer
->clip_changed
= 1;
3456 if (!NILP (beg
) || !NILP (end
))
3458 error ("Attempt to visit less than an entire file");
3461 CHECK_NUMBER (beg
, 0);
3463 XSETFASTINT (beg
, 0);
3466 CHECK_NUMBER (end
, 0);
3471 XSETINT (end
, st
.st_size
);
3473 /* Arithmetic overflow can occur if an Emacs integer cannot
3474 represent the file size, or if the calculations below
3475 overflow. The calculations below double the file size
3476 twice, so check that it can be multiplied by 4 safely. */
3477 if (XINT (end
) != st
.st_size
3478 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3479 error ("Maximum buffer size exceeded");
3485 /* Decide the coding system to use for reading the file now
3486 because we can't use an optimized method for handling
3487 `coding:' tag if the current buffer is not empty. */
3491 if (!NILP (Vcoding_system_for_read
))
3492 val
= Vcoding_system_for_read
;
3493 else if (! NILP (replace
))
3494 /* In REPLACE mode, we can use the same coding system
3495 that was used to visit the file. */
3496 val
= current_buffer
->buffer_file_coding_system
;
3499 /* Don't try looking inside a file for a coding system
3500 specification if it is not seekable. */
3501 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3503 /* Find a coding system specified in the heading two
3504 lines or in the tailing several lines of the file.
3505 We assume that the 1K-byte and 3K-byte for heading
3506 and tailing respectively are sufficient for this
3508 int how_many
, nread
;
3510 if (st
.st_size
<= (1024 * 4))
3511 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3514 nread
= emacs_read (fd
, read_buf
, 1024);
3517 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3518 report_file_error ("Setting file position",
3519 Fcons (orig_filename
, Qnil
));
3520 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3525 error ("IO error reading %s: %s",
3526 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3529 int count
= specpdl_ptr
- specpdl
;
3530 struct buffer
*prev
= current_buffer
;
3532 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3533 temp_output_buffer_setup (" *code-converting-work*");
3534 set_buffer_internal (XBUFFER (Vstandard_output
));
3535 current_buffer
->enable_multibyte_characters
= Qnil
;
3536 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3537 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3538 val
= call2 (Vset_auto_coding_function
,
3539 filename
, make_number (nread
));
3540 set_buffer_internal (prev
);
3541 /* Discard the unwind protect for recovering the
3545 /* Rewind the file for the actual read done later. */
3546 if (lseek (fd
, 0, 0) < 0)
3547 report_file_error ("Setting file position",
3548 Fcons (orig_filename
, Qnil
));
3554 /* If we have not yet decided a coding system, check
3555 file-coding-system-alist. */
3556 Lisp_Object args
[6], coding_systems
;
3558 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3559 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3560 coding_systems
= Ffind_operation_coding_system (6, args
);
3561 if (CONSP (coding_systems
))
3562 val
= XCAR (coding_systems
);
3566 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3568 if (NILP (current_buffer
->enable_multibyte_characters
)
3570 /* We must suppress all character code conversion except for
3571 end-of-line conversion. */
3572 setup_raw_text_coding_system (&coding
);
3574 coding_system_decided
= 1;
3577 /* Ensure we always set Vlast_coding_system_used. */
3578 set_coding_system
= 1;
3580 /* If requested, replace the accessible part of the buffer
3581 with the file contents. Avoid replacing text at the
3582 beginning or end of the buffer that matches the file contents;
3583 that preserves markers pointing to the unchanged parts.
3585 Here we implement this feature in an optimized way
3586 for the case where code conversion is NOT needed.
3587 The following if-statement handles the case of conversion
3588 in a less optimal way.
3590 If the code conversion is "automatic" then we try using this
3591 method and hope for the best.
3592 But if we discover the need for conversion, we give up on this method
3593 and let the following if-statement handle the replace job. */
3596 && ! CODING_REQUIRE_DECODING (&coding
)
3597 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3598 || coding
.eol_type
== CODING_EOL_LF
))
3600 /* same_at_start and same_at_end count bytes,
3601 because file access counts bytes
3602 and BEG and END count bytes. */
3603 int same_at_start
= BEGV_BYTE
;
3604 int same_at_end
= ZV_BYTE
;
3606 /* There is still a possibility we will find the need to do code
3607 conversion. If that happens, we set this variable to 1 to
3608 give up on handling REPLACE in the optimized way. */
3609 int giveup_match_end
= 0;
3611 if (XINT (beg
) != 0)
3613 if (lseek (fd
, XINT (beg
), 0) < 0)
3614 report_file_error ("Setting file position",
3615 Fcons (orig_filename
, Qnil
));
3620 /* Count how many chars at the start of the file
3621 match the text at the beginning of the buffer. */
3626 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3628 error ("IO error reading %s: %s",
3629 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3630 else if (nread
== 0)
3633 if (coding
.type
== coding_type_undecided
)
3634 detect_coding (&coding
, buffer
, nread
);
3635 if (CODING_REQUIRE_DECODING (&coding
))
3636 /* We found that the file should be decoded somehow.
3637 Let's give up here. */
3639 giveup_match_end
= 1;
3643 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3644 detect_eol (&coding
, buffer
, nread
);
3645 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3646 && coding
.eol_type
!= CODING_EOL_LF
)
3647 /* We found that the format of eol should be decoded.
3648 Let's give up here. */
3650 giveup_match_end
= 1;
3655 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3656 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3657 same_at_start
++, bufpos
++;
3658 /* If we found a discrepancy, stop the scan.
3659 Otherwise loop around and scan the next bufferful. */
3660 if (bufpos
!= nread
)
3664 /* If the file matches the buffer completely,
3665 there's no need to replace anything. */
3666 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3670 /* Truncate the buffer to the size of the file. */
3671 del_range_1 (same_at_start
, same_at_end
, 0);
3676 /* Count how many chars at the end of the file
3677 match the text at the end of the buffer. But, if we have
3678 already found that decoding is necessary, don't waste time. */
3679 while (!giveup_match_end
)
3681 int total_read
, nread
, bufpos
, curpos
, trial
;
3683 /* At what file position are we now scanning? */
3684 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3685 /* If the entire file matches the buffer tail, stop the scan. */
3688 /* How much can we scan in the next step? */
3689 trial
= min (curpos
, sizeof buffer
);
3690 if (lseek (fd
, curpos
- trial
, 0) < 0)
3691 report_file_error ("Setting file position",
3692 Fcons (orig_filename
, Qnil
));
3695 while (total_read
< trial
)
3697 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3699 error ("IO error reading %s: %s",
3700 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3701 total_read
+= nread
;
3703 /* Scan this bufferful from the end, comparing with
3704 the Emacs buffer. */
3705 bufpos
= total_read
;
3706 /* Compare with same_at_start to avoid counting some buffer text
3707 as matching both at the file's beginning and at the end. */
3708 while (bufpos
> 0 && same_at_end
> same_at_start
3709 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3710 same_at_end
--, bufpos
--;
3712 /* If we found a discrepancy, stop the scan.
3713 Otherwise loop around and scan the preceding bufferful. */
3716 /* If this discrepancy is because of code conversion,
3717 we cannot use this method; giveup and try the other. */
3718 if (same_at_end
> same_at_start
3719 && FETCH_BYTE (same_at_end
- 1) >= 0200
3720 && ! NILP (current_buffer
->enable_multibyte_characters
)
3721 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3722 giveup_match_end
= 1;
3728 if (! giveup_match_end
)
3732 /* We win! We can handle REPLACE the optimized way. */
3734 /* Extend the start of non-matching text area to multibyte
3735 character boundary. */
3736 if (! NILP (current_buffer
->enable_multibyte_characters
))
3737 while (same_at_start
> BEGV_BYTE
3738 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3741 /* Extend the end of non-matching text area to multibyte
3742 character boundary. */
3743 if (! NILP (current_buffer
->enable_multibyte_characters
))
3744 while (same_at_end
< ZV_BYTE
3745 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3748 /* Don't try to reuse the same piece of text twice. */
3749 overlap
= (same_at_start
- BEGV_BYTE
3750 - (same_at_end
+ st
.st_size
- ZV
));
3752 same_at_end
+= overlap
;
3754 /* Arrange to read only the nonmatching middle part of the file. */
3755 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3756 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3758 del_range_byte (same_at_start
, same_at_end
, 0);
3759 /* Insert from the file at the proper position. */
3760 temp
= BYTE_TO_CHAR (same_at_start
);
3761 SET_PT_BOTH (temp
, same_at_start
);
3763 /* If display currently starts at beginning of line,
3764 keep it that way. */
3765 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3766 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3768 replace_handled
= 1;
3772 /* If requested, replace the accessible part of the buffer
3773 with the file contents. Avoid replacing text at the
3774 beginning or end of the buffer that matches the file contents;
3775 that preserves markers pointing to the unchanged parts.
3777 Here we implement this feature for the case where code conversion
3778 is needed, in a simple way that needs a lot of memory.
3779 The preceding if-statement handles the case of no conversion
3780 in a more optimized way. */
3781 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3783 int same_at_start
= BEGV_BYTE
;
3784 int same_at_end
= ZV_BYTE
;
3787 /* Make sure that the gap is large enough. */
3788 int bufsize
= 2 * st
.st_size
;
3789 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3792 /* First read the whole file, performing code conversion into
3793 CONVERSION_BUFFER. */
3795 if (lseek (fd
, XINT (beg
), 0) < 0)
3797 xfree (conversion_buffer
);
3798 report_file_error ("Setting file position",
3799 Fcons (orig_filename
, Qnil
));
3802 total
= st
.st_size
; /* Total bytes in the file. */
3803 how_much
= 0; /* Bytes read from file so far. */
3804 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3805 unprocessed
= 0; /* Bytes not processed in previous loop. */
3807 while (how_much
< total
)
3809 /* try is reserved in some compilers (Microsoft C) */
3810 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3811 unsigned char *destination
= read_buf
+ unprocessed
;
3814 /* Allow quitting out of the actual I/O. */
3817 this = emacs_read (fd
, destination
, trytry
);
3820 if (this < 0 || this + unprocessed
== 0)
3828 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3830 int require
, result
;
3832 this += unprocessed
;
3834 /* If we are using more space than estimated,
3835 make CONVERSION_BUFFER bigger. */
3836 require
= decoding_buffer_size (&coding
, this);
3837 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3839 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3840 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3843 /* Convert this batch with results in CONVERSION_BUFFER. */
3844 if (how_much
>= total
) /* This is the last block. */
3845 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3846 result
= decode_coding (&coding
, read_buf
,
3847 conversion_buffer
+ inserted
,
3848 this, bufsize
- inserted
);
3850 /* Save for next iteration whatever we didn't convert. */
3851 unprocessed
= this - coding
.consumed
;
3852 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3853 this = coding
.produced
;
3859 /* At this point, INSERTED is how many characters (i.e. bytes)
3860 are present in CONVERSION_BUFFER.
3861 HOW_MUCH should equal TOTAL,
3862 or should be <= 0 if we couldn't read the file. */
3866 xfree (conversion_buffer
);
3869 error ("IO error reading %s: %s",
3870 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3871 else if (how_much
== -2)
3872 error ("maximum buffer size exceeded");
3875 /* Compare the beginning of the converted file
3876 with the buffer text. */
3879 while (bufpos
< inserted
&& same_at_start
< same_at_end
3880 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3881 same_at_start
++, bufpos
++;
3883 /* If the file matches the buffer completely,
3884 there's no need to replace anything. */
3886 if (bufpos
== inserted
)
3888 xfree (conversion_buffer
);
3891 /* Truncate the buffer to the size of the file. */
3892 del_range_byte (same_at_start
, same_at_end
, 0);
3897 /* Extend the start of non-matching text area to multibyte
3898 character boundary. */
3899 if (! NILP (current_buffer
->enable_multibyte_characters
))
3900 while (same_at_start
> BEGV_BYTE
3901 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3904 /* Scan this bufferful from the end, comparing with
3905 the Emacs buffer. */
3908 /* Compare with same_at_start to avoid counting some buffer text
3909 as matching both at the file's beginning and at the end. */
3910 while (bufpos
> 0 && same_at_end
> same_at_start
3911 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3912 same_at_end
--, bufpos
--;
3914 /* Extend the end of non-matching text area to multibyte
3915 character boundary. */
3916 if (! NILP (current_buffer
->enable_multibyte_characters
))
3917 while (same_at_end
< ZV_BYTE
3918 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3921 /* Don't try to reuse the same piece of text twice. */
3922 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3924 same_at_end
+= overlap
;
3926 /* If display currently starts at beginning of line,
3927 keep it that way. */
3928 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3929 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3931 /* Replace the chars that we need to replace,
3932 and update INSERTED to equal the number of bytes
3933 we are taking from the file. */
3934 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3936 if (same_at_end
!= same_at_start
)
3938 del_range_byte (same_at_start
, same_at_end
, 0);
3940 same_at_start
= GPT_BYTE
;
3944 temp
= BYTE_TO_CHAR (same_at_start
);
3946 /* Insert from the file at the proper position. */
3947 SET_PT_BOTH (temp
, same_at_start
);
3948 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3950 /* Set `inserted' to the number of inserted characters. */
3951 inserted
= PT
- temp
;
3953 free (conversion_buffer
);
3962 register Lisp_Object temp
;
3964 total
= XINT (end
) - XINT (beg
);
3966 /* Make sure point-max won't overflow after this insertion. */
3967 XSETINT (temp
, total
);
3968 if (total
!= XINT (temp
))
3969 error ("Maximum buffer size exceeded");
3972 /* For a special file, all we can do is guess. */
3973 total
= READ_BUF_SIZE
;
3975 if (NILP (visit
) && total
> 0)
3976 prepare_to_modify_buffer (PT
, PT
, NULL
);
3979 if (GAP_SIZE
< total
)
3980 make_gap (total
- GAP_SIZE
);
3982 if (XINT (beg
) != 0 || !NILP (replace
))
3984 if (lseek (fd
, XINT (beg
), 0) < 0)
3985 report_file_error ("Setting file position",
3986 Fcons (orig_filename
, Qnil
));
3989 /* In the following loop, HOW_MUCH contains the total bytes read so
3990 far for a regular file, and not changed for a special file. But,
3991 before exiting the loop, it is set to a negative value if I/O
3994 /* Total bytes inserted. */
3996 /* Here, we don't do code conversion in the loop. It is done by
3997 code_convert_region after all data are read into the buffer. */
3998 while (how_much
< total
)
4000 /* try is reserved in some compilers (Microsoft C) */
4001 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4004 /* For a special file, GAP_SIZE should be checked every time. */
4005 if (not_regular
&& GAP_SIZE
< trytry
)
4006 make_gap (total
- GAP_SIZE
);
4008 /* Allow quitting out of the actual I/O. */
4011 this = emacs_read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1,
4029 /* For a regular file, where TOTAL is the real size,
4030 count HOW_MUCH to compare with it.
4031 For a special file, where TOTAL is just a buffer size,
4032 so don't bother counting in HOW_MUCH.
4033 (INSERTED is where we count the number of characters inserted.) */
4040 /* Put an anchor to ensure multi-byte form ends at gap. */
4045 /* Discard the unwind protect for closing the file. */
4049 error ("IO error reading %s: %s",
4050 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4052 if (! coding_system_decided
)
4054 /* The coding system is not yet decided. Decide it by an
4055 optimized method for handling `coding:' tag. */
4059 if (!NILP (Vcoding_system_for_read
))
4060 val
= Vcoding_system_for_read
;
4063 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4065 /* Since we are sure that the current buffer was
4066 empty before the insertion, we can toggle
4067 enable-multibyte-characters directly here without
4068 taking care of marker adjustment and byte
4069 combining problem. */
4070 Lisp_Object prev_multibyte
;
4071 int count
= specpdl_ptr
- specpdl
;
4073 prev_multibyte
= current_buffer
->enable_multibyte_characters
;
4074 current_buffer
->enable_multibyte_characters
= Qnil
;
4075 record_unwind_protect (set_auto_coding_unwind
,
4077 val
= call2 (Vset_auto_coding_function
,
4078 filename
, make_number (inserted
));
4079 /* Discard the unwind protect for recovering the
4080 error of Vset_auto_coding_function. */
4082 current_buffer
->enable_multibyte_characters
= prev_multibyte
;
4083 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
4088 /* If the coding system is not yet decided, check
4089 file-coding-system-alist. */
4090 Lisp_Object args
[6], coding_systems
;
4092 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4093 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4094 coding_systems
= Ffind_operation_coding_system (6, args
);
4095 if (CONSP (coding_systems
))
4096 val
= XCAR (coding_systems
);
4100 /* The following kludgy code is to avoid some compiler bug.
4102 setup_coding_system (val, &coding);
4105 struct coding_system temp_coding
;
4106 setup_coding_system (val
, &temp_coding
);
4107 bcopy (&temp_coding
, &coding
, sizeof coding
);
4110 if (NILP (current_buffer
->enable_multibyte_characters
)
4112 /* We must suppress all character code conversion except for
4113 end-of-line conversion. */
4114 setup_raw_text_coding_system (&coding
);
4117 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4119 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4121 /* Here, we don't have to consider byte combining (see the
4122 comment below) because code_convert_region takes care of
4124 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4126 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
4127 ? coding
.produced
: coding
.produced_char
);
4129 else if (!NILP (current_buffer
->enable_multibyte_characters
))
4131 int inserted_byte
= inserted
;
4133 /* There's a possibility that we must combine bytes at the
4134 head (resp. the tail) of the just inserted text with the
4135 bytes before (resp. after) the gap to form a single
4137 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
4138 adjust_after_insert (PT
, PT_BYTE
,
4139 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4143 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4148 /* Use the conversion type to determine buffer-file-type
4149 (find-buffer-file-type is now used to help determine the
4151 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4152 || coding
.eol_type
== CODING_EOL_LF
)
4153 && ! CODING_REQUIRE_DECODING (&coding
))
4154 current_buffer
->buffer_file_type
= Qt
;
4156 current_buffer
->buffer_file_type
= Qnil
;
4164 if (!EQ (current_buffer
->undo_list
, Qt
))
4165 current_buffer
->undo_list
= Qnil
;
4167 stat (XSTRING (filename
)->data
, &st
);
4172 current_buffer
->modtime
= st
.st_mtime
;
4173 current_buffer
->filename
= orig_filename
;
4176 SAVE_MODIFF
= MODIFF
;
4177 current_buffer
->auto_save_modified
= MODIFF
;
4178 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4179 #ifdef CLASH_DETECTION
4182 if (!NILP (current_buffer
->file_truename
))
4183 unlock_file (current_buffer
->file_truename
);
4184 unlock_file (filename
);
4186 #endif /* CLASH_DETECTION */
4188 Fsignal (Qfile_error
,
4189 Fcons (build_string ("not a regular file"),
4190 Fcons (orig_filename
, Qnil
)));
4192 /* If visiting nonexistent file, return nil. */
4193 if (current_buffer
->modtime
== -1)
4194 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4197 /* Decode file format */
4200 insval
= call3 (Qformat_decode
,
4201 Qnil
, make_number (inserted
), visit
);
4202 CHECK_NUMBER (insval
, 0);
4203 inserted
= XFASTINT (insval
);
4206 /* Call after-change hooks for the inserted text, aside from the case
4207 of normal visiting (not with REPLACE), which is done in a new buffer
4208 "before" the buffer is changed. */
4209 if (inserted
> 0 && total
> 0
4210 && (NILP (visit
) || !NILP (replace
)))
4211 signal_after_change (PT
, 0, inserted
);
4213 if (set_coding_system
)
4214 Vlast_coding_system_used
= coding
.symbol
;
4218 p
= Vafter_insert_file_functions
;
4221 insval
= call1 (Fcar (p
), make_number (inserted
));
4224 CHECK_NUMBER (insval
, 0);
4225 inserted
= XFASTINT (insval
);
4232 /* ??? Retval needs to be dealt with in all cases consistently. */
4234 val
= Fcons (orig_filename
,
4235 Fcons (make_number (inserted
),
4238 RETURN_UNGCPRO (unbind_to (count
, val
));
4241 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4244 /* If build_annotations switched buffers, switch back to BUF.
4245 Kill the temporary buffer that was selected in the meantime.
4247 Since this kill only the last temporary buffer, some buffers remain
4248 not killed if build_annotations switched buffers more than once.
4252 build_annotations_unwind (buf
)
4257 if (XBUFFER (buf
) == current_buffer
)
4259 tembuf
= Fcurrent_buffer ();
4261 Fkill_buffer (tembuf
);
4265 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4266 "r\nFWrite region to file: \ni\ni\ni\np",
4267 "Write current region into specified file.\n\
4268 When called from a program, takes three arguments:\n\
4269 START, END and FILENAME. START and END are buffer positions.\n\
4270 Optional fourth argument APPEND if non-nil means\n\
4271 append to existing file contents (if any).\n\
4272 Optional fifth argument VISIT if t means\n\
4273 set the last-save-file-modtime of buffer to this file's modtime\n\
4274 and mark buffer not modified.\n\
4275 If VISIT is a string, it is a second file name;\n\
4276 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4277 VISIT is also the file name to lock and unlock for clash detection.\n\
4278 If VISIT is neither t nor nil nor a string,\n\
4279 that means do not print the \"Wrote file\" message.\n\
4280 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4281 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4282 The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
4283 for an existing file with the same name. If MUSTBENEW is `excl',\n\
4284 that means to get an error if the file already exists; never overwrite.\n\
4285 If MUSTBENEW is neither nil nor `excl', that means ask for\n\
4286 confirmation before overwriting, but do go ahead and overwrite the file\n\
4287 if the user confirms.\n\
4288 Kludgy feature: if START is a string, then that string is written\n\
4289 to the file, instead of any buffer contents, and END is ignored.\n\
4291 This does code conversion according to the value of\n\
4292 `coding-system-for-write', `buffer-file-coding-system', or\n\
4293 `file-coding-system-alist', and sets the variable\n\
4294 `last-coding-system-used' to the coding system actually used.")
4296 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4297 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4305 int count
= specpdl_ptr
- specpdl
;
4308 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4310 Lisp_Object handler
;
4311 Lisp_Object visit_file
;
4312 Lisp_Object annotations
;
4313 Lisp_Object encoded_filename
;
4314 int visiting
, quietly
;
4315 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4316 struct buffer
*given_buffer
;
4318 int buffer_file_type
= O_BINARY
;
4320 struct coding_system coding
;
4322 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4323 error ("Cannot do file visiting in an indirect buffer");
4325 if (!NILP (start
) && !STRINGP (start
))
4326 validate_region (&start
, &end
);
4328 GCPRO4 (start
, filename
, visit
, lockname
);
4330 /* Decide the coding-system to encode the data with. */
4336 else if (!NILP (Vcoding_system_for_write
))
4337 val
= Vcoding_system_for_write
;
4340 /* If the variable `buffer-file-coding-system' is set locally,
4341 it means that the file was read with some kind of code
4342 conversion or the varialbe is explicitely set by users. We
4343 had better write it out with the same coding system even if
4344 `enable-multibyte-characters' is nil.
4346 If it is not set locally, we anyway have to convert EOL
4347 format if the default value of `buffer-file-coding-system'
4348 tells that it is not Unix-like (LF only) format. */
4349 int using_default_coding
= 0;
4350 int force_raw_text
= 0;
4352 val
= current_buffer
->buffer_file_coding_system
;
4354 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4357 if (NILP (current_buffer
->enable_multibyte_characters
))
4363 /* Check file-coding-system-alist. */
4364 Lisp_Object args
[7], coding_systems
;
4366 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4367 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4369 coding_systems
= Ffind_operation_coding_system (7, args
);
4370 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4371 val
= XCDR (coding_systems
);
4375 && !NILP (current_buffer
->buffer_file_coding_system
))
4377 /* If we still have not decided a coding system, use the
4378 default value of buffer-file-coding-system. */
4379 val
= current_buffer
->buffer_file_coding_system
;
4380 using_default_coding
= 1;
4384 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4385 /* Confirm that VAL can surely encode the current region. */
4386 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4388 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4389 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4390 && !using_default_coding
)
4392 if (! EQ (default_buffer_file_coding
.symbol
,
4393 buffer_defaults
.buffer_file_coding_system
))
4394 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4395 &default_buffer_file_coding
);
4396 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4398 Lisp_Object subsidiaries
;
4400 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4401 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4402 if (VECTORP (subsidiaries
)
4403 && XVECTOR (subsidiaries
)->size
== 3)
4405 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4410 setup_raw_text_coding_system (&coding
);
4411 goto done_setup_coding
;
4414 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4417 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4418 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4421 Vlast_coding_system_used
= coding
.symbol
;
4423 filename
= Fexpand_file_name (filename
, Qnil
);
4425 if (! NILP (mustbenew
) && mustbenew
!= Qexcl
)
4426 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4428 if (STRINGP (visit
))
4429 visit_file
= Fexpand_file_name (visit
, Qnil
);
4431 visit_file
= filename
;
4434 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4435 quietly
= !NILP (visit
);
4439 if (NILP (lockname
))
4440 lockname
= visit_file
;
4442 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4444 /* If the file name has special constructs in it,
4445 call the corresponding file handler. */
4446 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4447 /* If FILENAME has no handler, see if VISIT has one. */
4448 if (NILP (handler
) && STRINGP (visit
))
4449 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4451 if (!NILP (handler
))
4454 val
= call6 (handler
, Qwrite_region
, start
, end
,
4455 filename
, append
, visit
);
4459 SAVE_MODIFF
= MODIFF
;
4460 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4461 current_buffer
->filename
= visit_file
;
4467 /* Special kludge to simplify auto-saving. */
4470 XSETFASTINT (start
, BEG
);
4471 XSETFASTINT (end
, Z
);
4474 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4475 count1
= specpdl_ptr
- specpdl
;
4477 given_buffer
= current_buffer
;
4478 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4479 if (current_buffer
!= given_buffer
)
4481 XSETFASTINT (start
, BEGV
);
4482 XSETFASTINT (end
, ZV
);
4485 #ifdef CLASH_DETECTION
4488 #if 0 /* This causes trouble for GNUS. */
4489 /* If we've locked this file for some other buffer,
4490 query before proceeding. */
4491 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4492 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4495 lock_file (lockname
);
4497 #endif /* CLASH_DETECTION */
4499 encoded_filename
= ENCODE_FILE (filename
);
4501 fn
= XSTRING (encoded_filename
)->data
;
4505 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4506 #else /* not DOS_NT */
4507 desc
= emacs_open (fn
, O_WRONLY
, 0);
4508 #endif /* not DOS_NT */
4510 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4512 if (auto_saving
) /* Overwrite any previous version of autosave file */
4514 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4515 desc
= emacs_open (fn
, O_RDWR
, 0);
4517 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4518 ? XSTRING (current_buffer
->filename
)->data
: 0,
4521 else /* Write to temporary name and rename if no errors */
4523 Lisp_Object temp_name
;
4524 temp_name
= Ffile_name_directory (filename
);
4526 if (!NILP (temp_name
))
4528 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4529 build_string ("$$SAVE$$")));
4530 fname
= XSTRING (filename
)->data
;
4531 fn
= XSTRING (temp_name
)->data
;
4532 desc
= creat_copy_attrs (fname
, fn
);
4535 /* If we can't open the temporary file, try creating a new
4536 version of the original file. VMS "creat" creates a
4537 new version rather than truncating an existing file. */
4540 desc
= creat (fn
, 0666);
4541 #if 0 /* This can clobber an existing file and fail to replace it,
4542 if the user runs out of space. */
4545 /* We can't make a new version;
4546 try to truncate and rewrite existing version if any. */
4548 desc
= emacs_open (fn
, O_RDWR
, 0);
4554 desc
= creat (fn
, 0666);
4558 desc
= emacs_open (fn
,
4559 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
4560 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4561 S_IREAD
| S_IWRITE
);
4562 #else /* not DOS_NT */
4563 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4564 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4565 auto_saving
? auto_save_mode_bits
: 0666);
4566 #endif /* not DOS_NT */
4567 #endif /* not VMS */
4573 #ifdef CLASH_DETECTION
4575 if (!auto_saving
) unlock_file (lockname
);
4577 #endif /* CLASH_DETECTION */
4578 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4581 record_unwind_protect (close_file_unwind
, make_number (desc
));
4583 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4584 if (lseek (desc
, 0, 2) < 0)
4586 #ifdef CLASH_DETECTION
4587 if (!auto_saving
) unlock_file (lockname
);
4588 #endif /* CLASH_DETECTION */
4589 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4594 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4595 * if we do writes that don't end with a carriage return. Furthermore
4596 * it cannot handle writes of more then 16K. The modified
4597 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4598 * this EXCEPT for the last record (iff it doesn't end with a carriage
4599 * return). This implies that if your buffer doesn't end with a carriage
4600 * return, you get one free... tough. However it also means that if
4601 * we make two calls to sys_write (a la the following code) you can
4602 * get one at the gap as well. The easiest way to fix this (honest)
4603 * is to move the gap to the next newline (or the end of the buffer).
4608 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4609 move_gap (find_next_newline (GPT
, 1));
4611 /* Whether VMS or not, we must move the gap to the next of newline
4612 when we must put designation sequences at beginning of line. */
4613 if (INTEGERP (start
)
4614 && coding
.type
== coding_type_iso2022
4615 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4616 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4618 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4619 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4620 move_gap_both (PT
, PT_BYTE
);
4621 SET_PT_BOTH (opoint
, opoint_byte
);
4628 if (STRINGP (start
))
4630 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4631 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4635 else if (XINT (start
) != XINT (end
))
4637 register int end1
= CHAR_TO_BYTE (XINT (end
));
4639 tem
= CHAR_TO_BYTE (XINT (start
));
4641 if (XINT (start
) < GPT
)
4643 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4644 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4649 if (XINT (end
) > GPT
&& !failure
)
4651 tem
= max (tem
, GPT_BYTE
);
4652 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4653 tem
, &annotations
, &coding
);
4659 /* If file was empty, still need to write the annotations */
4660 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4661 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4665 if (CODING_REQUIRE_FLUSHING (&coding
)
4666 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4669 /* We have to flush out a data. */
4670 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4671 failure
= 0 > e_write (desc
, "", 0, &coding
);
4678 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4679 Disk full in NFS may be reported here. */
4680 /* mib says that closing the file will try to write as fast as NFS can do
4681 it, and that means the fsync here is not crucial for autosave files. */
4682 if (!auto_saving
&& fsync (desc
) < 0)
4684 /* If fsync fails with EINTR, don't treat that as serious. */
4686 failure
= 1, save_errno
= errno
;
4690 /* Spurious "file has changed on disk" warnings have been
4691 observed on Suns as well.
4692 It seems that `close' can change the modtime, under nfs.
4694 (This has supposedly been fixed in Sunos 4,
4695 but who knows about all the other machines with NFS?) */
4698 /* On VMS and APOLLO, must do the stat after the close
4699 since closing changes the modtime. */
4702 /* Recall that #if defined does not work on VMS. */
4709 /* NFS can report a write failure now. */
4710 if (emacs_close (desc
) < 0)
4711 failure
= 1, save_errno
= errno
;
4714 /* If we wrote to a temporary name and had no errors, rename to real name. */
4718 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4726 /* Discard the unwind protect for close_file_unwind. */
4727 specpdl_ptr
= specpdl
+ count1
;
4728 /* Restore the original current buffer. */
4729 visit_file
= unbind_to (count
, visit_file
);
4731 #ifdef CLASH_DETECTION
4733 unlock_file (lockname
);
4734 #endif /* CLASH_DETECTION */
4736 /* Do this before reporting IO error
4737 to avoid a "file has changed on disk" warning on
4738 next attempt to save. */
4740 current_buffer
->modtime
= st
.st_mtime
;
4743 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4744 emacs_strerror (save_errno
));
4748 SAVE_MODIFF
= MODIFF
;
4749 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4750 current_buffer
->filename
= visit_file
;
4751 update_mode_lines
++;
4757 message_with_string ("Wrote %s", visit_file
, 1);
4762 Lisp_Object
merge ();
4764 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4765 "Return t if (car A) is numerically less than (car B).")
4769 return Flss (Fcar (a
), Fcar (b
));
4772 /* Build the complete list of annotations appropriate for writing out
4773 the text between START and END, by calling all the functions in
4774 write-region-annotate-functions and merging the lists they return.
4775 If one of these functions switches to a different buffer, we assume
4776 that buffer contains altered text. Therefore, the caller must
4777 make sure to restore the current buffer in all cases,
4778 as save-excursion would do. */
4781 build_annotations (start
, end
, pre_write_conversion
)
4782 Lisp_Object start
, end
, pre_write_conversion
;
4784 Lisp_Object annotations
;
4786 struct gcpro gcpro1
, gcpro2
;
4787 Lisp_Object original_buffer
;
4789 XSETBUFFER (original_buffer
, current_buffer
);
4792 p
= Vwrite_region_annotate_functions
;
4793 GCPRO2 (annotations
, p
);
4796 struct buffer
*given_buffer
= current_buffer
;
4797 Vwrite_region_annotations_so_far
= annotations
;
4798 res
= call2 (Fcar (p
), start
, end
);
4799 /* If the function makes a different buffer current,
4800 assume that means this buffer contains altered text to be output.
4801 Reset START and END from the buffer bounds
4802 and discard all previous annotations because they should have
4803 been dealt with by this function. */
4804 if (current_buffer
!= given_buffer
)
4806 XSETFASTINT (start
, BEGV
);
4807 XSETFASTINT (end
, ZV
);
4810 Flength (res
); /* Check basic validity of return value */
4811 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4815 /* Now do the same for annotation functions implied by the file-format */
4816 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4817 p
= Vauto_save_file_format
;
4819 p
= current_buffer
->file_format
;
4822 struct buffer
*given_buffer
= current_buffer
;
4823 Vwrite_region_annotations_so_far
= annotations
;
4824 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4826 if (current_buffer
!= given_buffer
)
4828 XSETFASTINT (start
, BEGV
);
4829 XSETFASTINT (end
, ZV
);
4833 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4837 /* At last, do the same for the function PRE_WRITE_CONVERSION
4838 implied by the current coding-system. */
4839 if (!NILP (pre_write_conversion
))
4841 struct buffer
*given_buffer
= current_buffer
;
4842 Vwrite_region_annotations_so_far
= annotations
;
4843 res
= call2 (pre_write_conversion
, start
, end
);
4845 annotations
= (current_buffer
!= given_buffer
4847 : merge (annotations
, res
, Qcar_less_than_car
));
4854 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4855 assuming they start at byte position BYTEPOS in the buffer.
4856 Intersperse with them the annotations from *ANNOT
4857 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4858 each at its appropriate position.
4860 We modify *ANNOT by discarding elements as we use them up.
4862 The return value is negative in case of system call failure. */
4865 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4867 register char *addr
;
4868 register int nbytes
;
4871 struct coding_system
*coding
;
4875 int lastpos
= bytepos
+ nbytes
;
4877 while (NILP (*annot
) || CONSP (*annot
))
4879 tem
= Fcar_safe (Fcar (*annot
));
4880 nextpos
= bytepos
- 1;
4882 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4884 /* If there are no more annotations in this range,
4885 output the rest of the range all at once. */
4886 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4887 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4889 /* Output buffer text up to the next annotation's position. */
4890 if (nextpos
> bytepos
)
4892 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4894 addr
+= nextpos
- bytepos
;
4897 /* Output the annotation. */
4898 tem
= Fcdr (Fcar (*annot
));
4901 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4905 *annot
= Fcdr (*annot
);
4910 #ifndef WRITE_BUF_SIZE
4911 #define WRITE_BUF_SIZE (16 * 1024)
4914 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4915 encoding them with coding system CODING. */
4918 e_write (desc
, addr
, nbytes
, coding
)
4920 register char *addr
;
4921 register int nbytes
;
4922 struct coding_system
*coding
;
4924 char buf
[WRITE_BUF_SIZE
];
4926 /* We used to have a code for handling selective display here. But,
4927 now it is handled within encode_coding. */
4932 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4933 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4934 if (coding
->produced
> 0)
4936 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
4937 if (coding
->produced
) return -1;
4939 if (result
== CODING_FINISH_INSUFFICIENT_SRC
)
4941 /* The source text ends by an incomplete multibyte form.
4942 There's no way other than write it out as is. */
4943 nbytes
-= emacs_write (desc
, addr
, nbytes
);
4944 if (nbytes
) return -1;
4952 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4953 Sverify_visited_file_modtime
, 1, 1, 0,
4954 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4955 This means that the file has not been changed since it was visited or saved.")
4961 Lisp_Object handler
;
4962 Lisp_Object filename
;
4964 CHECK_BUFFER (buf
, 0);
4967 if (!STRINGP (b
->filename
)) return Qt
;
4968 if (b
->modtime
== 0) return Qt
;
4970 /* If the file name has special constructs in it,
4971 call the corresponding file handler. */
4972 handler
= Ffind_file_name_handler (b
->filename
,
4973 Qverify_visited_file_modtime
);
4974 if (!NILP (handler
))
4975 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4977 filename
= ENCODE_FILE (b
->filename
);
4979 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4981 /* If the file doesn't exist now and didn't exist before,
4982 we say that it isn't modified, provided the error is a tame one. */
4983 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4988 if (st
.st_mtime
== b
->modtime
4989 /* If both are positive, accept them if they are off by one second. */
4990 || (st
.st_mtime
> 0 && b
->modtime
> 0
4991 && (st
.st_mtime
== b
->modtime
+ 1
4992 || st
.st_mtime
== b
->modtime
- 1)))
4997 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4998 Sclear_visited_file_modtime
, 0, 0, 0,
4999 "Clear out records of last mod time of visited file.\n\
5000 Next attempt to save will certainly not complain of a discrepancy.")
5003 current_buffer
->modtime
= 0;
5007 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5008 Svisited_file_modtime
, 0, 0, 0,
5009 "Return the current buffer's recorded visited file modification time.\n\
5010 The value is a list of the form (HIGH . LOW), like the time values\n\
5011 that `file-attributes' returns.")
5014 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5017 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5018 Sset_visited_file_modtime
, 0, 1, 0,
5019 "Update buffer's recorded modification time from the visited file's time.\n\
5020 Useful if the buffer was not read from the file normally\n\
5021 or if the file itself has been changed for some known benign reason.\n\
5022 An argument specifies the modification time value to use\n\
5023 \(instead of that of the visited file), in the form of a list\n\
5024 \(HIGH . LOW) or (HIGH LOW).")
5026 Lisp_Object time_list
;
5028 if (!NILP (time_list
))
5029 current_buffer
->modtime
= cons_to_long (time_list
);
5032 register Lisp_Object filename
;
5034 Lisp_Object handler
;
5036 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5038 /* If the file name has special constructs in it,
5039 call the corresponding file handler. */
5040 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5041 if (!NILP (handler
))
5042 /* The handler can find the file name the same way we did. */
5043 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5045 filename
= ENCODE_FILE (filename
);
5047 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5048 current_buffer
->modtime
= st
.st_mtime
;
5058 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5059 Fsleep_for (make_number (1), Qnil
);
5060 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5061 Fsleep_for (make_number (1), Qnil
);
5062 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5063 Fsleep_for (make_number (1), Qnil
);
5073 /* Get visited file's mode to become the auto save file's mode. */
5074 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5075 /* But make sure we can overwrite it later! */
5076 auto_save_mode_bits
= st
.st_mode
| 0600;
5078 auto_save_mode_bits
= 0666;
5081 Fwrite_region (Qnil
, Qnil
,
5082 current_buffer
->auto_save_file_name
,
5083 Qnil
, Qlambda
, Qnil
, Qnil
);
5087 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5092 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5093 | XFASTINT (XCDR (stream
))));
5098 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5101 minibuffer_auto_raise
= XINT (value
);
5105 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5106 "Auto-save all buffers that need it.\n\
5107 This is all buffers that have auto-saving enabled\n\
5108 and are changed since last auto-saved.\n\
5109 Auto-saving writes the buffer into a file\n\
5110 so that your editing is not lost if the system crashes.\n\
5111 This file is not the file you visited; that changes only when you save.\n\
5112 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5113 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5114 A non-nil CURRENT-ONLY argument means save only current buffer.")
5115 (no_message
, current_only
)
5116 Lisp_Object no_message
, current_only
;
5118 struct buffer
*old
= current_buffer
, *b
;
5119 Lisp_Object tail
, buf
;
5121 int do_handled_files
;
5124 Lisp_Object lispstream
;
5125 int count
= specpdl_ptr
- specpdl
;
5127 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5128 int message_p
= push_message ();
5130 /* Ordinarily don't quit within this function,
5131 but don't make it impossible to quit (in case we get hung in I/O). */
5135 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5136 point to non-strings reached from Vbuffer_alist. */
5141 if (!NILP (Vrun_hooks
))
5142 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5144 if (STRINGP (Vauto_save_list_file_name
))
5146 Lisp_Object listfile
;
5147 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5148 stream
= fopen (XSTRING (listfile
)->data
, "w");
5151 /* Arrange to close that file whether or not we get an error.
5152 Also reset auto_saving to 0. */
5153 lispstream
= Fcons (Qnil
, Qnil
);
5154 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
5155 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
5166 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5167 record_unwind_protect (do_auto_save_unwind_1
,
5168 make_number (minibuffer_auto_raise
));
5169 minibuffer_auto_raise
= 0;
5172 /* First, save all files which don't have handlers. If Emacs is
5173 crashing, the handlers may tweak what is causing Emacs to crash
5174 in the first place, and it would be a shame if Emacs failed to
5175 autosave perfectly ordinary files because it couldn't handle some
5177 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5178 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5180 buf
= XCDR (XCAR (tail
));
5183 /* Record all the buffers that have auto save mode
5184 in the special file that lists them. For each of these buffers,
5185 Record visited name (if any) and auto save name. */
5186 if (STRINGP (b
->auto_save_file_name
)
5187 && stream
!= NULL
&& do_handled_files
== 0)
5189 if (!NILP (b
->filename
))
5191 fwrite (XSTRING (b
->filename
)->data
, 1,
5192 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5194 putc ('\n', stream
);
5195 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5196 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5197 putc ('\n', stream
);
5200 if (!NILP (current_only
)
5201 && b
!= current_buffer
)
5204 /* Don't auto-save indirect buffers.
5205 The base buffer takes care of it. */
5209 /* Check for auto save enabled
5210 and file changed since last auto save
5211 and file changed since last real save. */
5212 if (STRINGP (b
->auto_save_file_name
)
5213 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5214 && b
->auto_save_modified
< BUF_MODIFF (b
)
5215 /* -1 means we've turned off autosaving for a while--see below. */
5216 && XINT (b
->save_length
) >= 0
5217 && (do_handled_files
5218 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5221 EMACS_TIME before_time
, after_time
;
5223 EMACS_GET_TIME (before_time
);
5225 /* If we had a failure, don't try again for 20 minutes. */
5226 if (b
->auto_save_failure_time
>= 0
5227 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5230 if ((XFASTINT (b
->save_length
) * 10
5231 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5232 /* A short file is likely to change a large fraction;
5233 spare the user annoying messages. */
5234 && XFASTINT (b
->save_length
) > 5000
5235 /* These messages are frequent and annoying for `*mail*'. */
5236 && !EQ (b
->filename
, Qnil
)
5237 && NILP (no_message
))
5239 /* It has shrunk too much; turn off auto-saving here. */
5240 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5241 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5243 minibuffer_auto_raise
= 0;
5244 /* Turn off auto-saving until there's a real save,
5245 and prevent any more warnings. */
5246 XSETINT (b
->save_length
, -1);
5247 Fsleep_for (make_number (1), Qnil
);
5250 set_buffer_internal (b
);
5251 if (!auto_saved
&& NILP (no_message
))
5252 message1 ("Auto-saving...");
5253 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5255 b
->auto_save_modified
= BUF_MODIFF (b
);
5256 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5257 set_buffer_internal (old
);
5259 EMACS_GET_TIME (after_time
);
5261 /* If auto-save took more than 60 seconds,
5262 assume it was an NFS failure that got a timeout. */
5263 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5264 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5268 /* Prevent another auto save till enough input events come in. */
5269 record_auto_save ();
5271 if (auto_saved
&& NILP (no_message
))
5275 sit_for (1, 0, 0, 0, 0);
5279 message1 ("Auto-saving...done");
5285 unbind_to (count
, Qnil
);
5289 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5290 Sset_buffer_auto_saved
, 0, 0, 0,
5291 "Mark current buffer as auto-saved with its current text.\n\
5292 No auto-save file will be written until the buffer changes again.")
5295 current_buffer
->auto_save_modified
= MODIFF
;
5296 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5297 current_buffer
->auto_save_failure_time
= -1;
5301 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5302 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5303 "Clear any record of a recent auto-save failure in the current buffer.")
5306 current_buffer
->auto_save_failure_time
= -1;
5310 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5312 "Return t if buffer has been auto-saved since last read in or saved.")
5315 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5318 /* Reading and completing file names */
5319 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5321 /* In the string VAL, change each $ to $$ and return the result. */
5324 double_dollars (val
)
5327 register unsigned char *old
, *new;
5331 osize
= STRING_BYTES (XSTRING (val
));
5333 /* Count the number of $ characters. */
5334 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5335 if (*old
++ == '$') count
++;
5338 old
= XSTRING (val
)->data
;
5339 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5341 new = XSTRING (val
)->data
;
5342 for (n
= osize
; n
> 0; n
--)
5355 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5357 "Internal subroutine for read-file-name. Do not call this.")
5358 (string
, dir
, action
)
5359 Lisp_Object string
, dir
, action
;
5360 /* action is nil for complete, t for return list of completions,
5361 lambda for verify final value */
5363 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5365 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5367 CHECK_STRING (string
, 0);
5374 /* No need to protect ACTION--we only compare it with t and nil. */
5375 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5377 if (XSTRING (string
)->size
== 0)
5379 if (EQ (action
, Qlambda
))
5387 orig_string
= string
;
5388 string
= Fsubstitute_in_file_name (string
);
5389 changed
= NILP (Fstring_equal (string
, orig_string
));
5390 name
= Ffile_name_nondirectory (string
);
5391 val
= Ffile_name_directory (string
);
5393 realdir
= Fexpand_file_name (val
, realdir
);
5398 specdir
= Ffile_name_directory (string
);
5399 val
= Ffile_name_completion (name
, realdir
);
5404 return double_dollars (string
);
5408 if (!NILP (specdir
))
5409 val
= concat2 (specdir
, val
);
5411 return double_dollars (val
);
5414 #endif /* not VMS */
5418 if (EQ (action
, Qt
))
5419 return Ffile_name_all_completions (name
, realdir
);
5420 /* Only other case actually used is ACTION = lambda */
5422 /* Supposedly this helps commands such as `cd' that read directory names,
5423 but can someone explain how it helps them? -- RMS */
5424 if (XSTRING (name
)->size
== 0)
5427 return Ffile_exists_p (string
);
5430 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5431 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5432 Value is not expanded---you must call `expand-file-name' yourself.\n\
5433 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5434 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5435 except that if INITIAL is specified, that combined with DIR is used.)\n\
5436 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5437 Non-nil and non-t means also require confirmation after completion.\n\
5438 Fifth arg INITIAL specifies text to start with.\n\
5439 DIR defaults to current buffer's directory default.")
5440 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5441 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5443 Lisp_Object val
, insdef
, tem
;
5444 struct gcpro gcpro1
, gcpro2
;
5445 register char *homedir
;
5446 int replace_in_history
= 0;
5447 int add_to_history
= 0;
5451 dir
= current_buffer
->directory
;
5452 if (NILP (default_filename
))
5454 if (! NILP (initial
))
5455 default_filename
= Fexpand_file_name (initial
, dir
);
5457 default_filename
= current_buffer
->filename
;
5460 /* If dir starts with user's homedir, change that to ~. */
5461 homedir
= (char *) egetenv ("HOME");
5463 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5464 CORRECT_DIR_SEPS (homedir
);
5468 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5469 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5471 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5472 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5473 XSTRING (dir
)->data
[0] = '~';
5475 /* Likewise for default_filename. */
5477 && STRINGP (default_filename
)
5478 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5479 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5482 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5483 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5484 XSTRING (default_filename
)->data
[0] = '~';
5486 if (!NILP (default_filename
))
5488 CHECK_STRING (default_filename
, 3);
5489 default_filename
= double_dollars (default_filename
);
5492 if (insert_default_directory
&& STRINGP (dir
))
5495 if (!NILP (initial
))
5497 Lisp_Object args
[2], pos
;
5501 insdef
= Fconcat (2, args
);
5502 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5503 insdef
= Fcons (double_dollars (insdef
), pos
);
5506 insdef
= double_dollars (insdef
);
5508 else if (STRINGP (initial
))
5509 insdef
= Fcons (double_dollars (initial
), make_number (0));
5513 count
= specpdl_ptr
- specpdl
;
5515 specbind (intern ("completion-ignore-case"), Qt
);
5518 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5520 GCPRO2 (insdef
, default_filename
);
5523 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5527 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5532 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5533 dir
, mustmatch
, insdef
,
5534 Qfile_name_history
, default_filename
, Qnil
);
5536 tem
= Fsymbol_value (Qfile_name_history
);
5537 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
5538 replace_in_history
= 1;
5540 /* If Fcompleting_read returned the inserted default string itself
5541 (rather than a new string with the same contents),
5542 it has to mean that the user typed RET with the minibuffer empty.
5543 In that case, we really want to return ""
5544 so that commands such as set-visited-file-name can distinguish. */
5545 if (EQ (val
, default_filename
))
5547 /* In this case, Fcompleting_read has not added an element
5548 to the history. Maybe we should. */
5549 if (! replace_in_history
)
5552 val
= build_string ("");
5555 unbind_to (count
, Qnil
);
5558 error ("No file name specified");
5560 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5562 if (!NILP (tem
) && !NILP (default_filename
))
5563 val
= default_filename
;
5564 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5566 if (!NILP (default_filename
))
5567 val
= default_filename
;
5569 error ("No default file name");
5571 val
= Fsubstitute_in_file_name (val
);
5573 if (replace_in_history
)
5574 /* Replace what Fcompleting_read added to the history
5575 with what we will actually return. */
5576 XCAR (Fsymbol_value (Qfile_name_history
)) = double_dollars (val
);
5577 else if (add_to_history
)
5579 /* Add the value to the history--but not if it matches
5580 the last value already there. */
5581 Lisp_Object val1
= double_dollars (val
);
5582 tem
= Fsymbol_value (Qfile_name_history
);
5583 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
5584 Fset (Qfile_name_history
,
5595 /* Must be set before any path manipulation is performed. */
5596 XSETFASTINT (Vdirectory_sep_char
, '/');
5603 Qexpand_file_name
= intern ("expand-file-name");
5604 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5605 Qdirectory_file_name
= intern ("directory-file-name");
5606 Qfile_name_directory
= intern ("file-name-directory");
5607 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5608 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5609 Qfile_name_as_directory
= intern ("file-name-as-directory");
5610 Qcopy_file
= intern ("copy-file");
5611 Qmake_directory_internal
= intern ("make-directory-internal");
5612 Qdelete_directory
= intern ("delete-directory");
5613 Qdelete_file
= intern ("delete-file");
5614 Qrename_file
= intern ("rename-file");
5615 Qadd_name_to_file
= intern ("add-name-to-file");
5616 Qmake_symbolic_link
= intern ("make-symbolic-link");
5617 Qfile_exists_p
= intern ("file-exists-p");
5618 Qfile_executable_p
= intern ("file-executable-p");
5619 Qfile_readable_p
= intern ("file-readable-p");
5620 Qfile_writable_p
= intern ("file-writable-p");
5621 Qfile_symlink_p
= intern ("file-symlink-p");
5622 Qaccess_file
= intern ("access-file");
5623 Qfile_directory_p
= intern ("file-directory-p");
5624 Qfile_regular_p
= intern ("file-regular-p");
5625 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5626 Qfile_modes
= intern ("file-modes");
5627 Qset_file_modes
= intern ("set-file-modes");
5628 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5629 Qinsert_file_contents
= intern ("insert-file-contents");
5630 Qwrite_region
= intern ("write-region");
5631 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5632 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5634 staticpro (&Qexpand_file_name
);
5635 staticpro (&Qsubstitute_in_file_name
);
5636 staticpro (&Qdirectory_file_name
);
5637 staticpro (&Qfile_name_directory
);
5638 staticpro (&Qfile_name_nondirectory
);
5639 staticpro (&Qunhandled_file_name_directory
);
5640 staticpro (&Qfile_name_as_directory
);
5641 staticpro (&Qcopy_file
);
5642 staticpro (&Qmake_directory_internal
);
5643 staticpro (&Qdelete_directory
);
5644 staticpro (&Qdelete_file
);
5645 staticpro (&Qrename_file
);
5646 staticpro (&Qadd_name_to_file
);
5647 staticpro (&Qmake_symbolic_link
);
5648 staticpro (&Qfile_exists_p
);
5649 staticpro (&Qfile_executable_p
);
5650 staticpro (&Qfile_readable_p
);
5651 staticpro (&Qfile_writable_p
);
5652 staticpro (&Qaccess_file
);
5653 staticpro (&Qfile_symlink_p
);
5654 staticpro (&Qfile_directory_p
);
5655 staticpro (&Qfile_regular_p
);
5656 staticpro (&Qfile_accessible_directory_p
);
5657 staticpro (&Qfile_modes
);
5658 staticpro (&Qset_file_modes
);
5659 staticpro (&Qfile_newer_than_file_p
);
5660 staticpro (&Qinsert_file_contents
);
5661 staticpro (&Qwrite_region
);
5662 staticpro (&Qverify_visited_file_modtime
);
5663 staticpro (&Qset_visited_file_modtime
);
5665 Qfile_name_history
= intern ("file-name-history");
5666 Fset (Qfile_name_history
, Qnil
);
5667 staticpro (&Qfile_name_history
);
5669 Qfile_error
= intern ("file-error");
5670 staticpro (&Qfile_error
);
5671 Qfile_already_exists
= intern ("file-already-exists");
5672 staticpro (&Qfile_already_exists
);
5673 Qfile_date_error
= intern ("file-date-error");
5674 staticpro (&Qfile_date_error
);
5675 Qexcl
= intern ("excl");
5679 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5680 staticpro (&Qfind_buffer_file_type
);
5683 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5684 "*Coding system for encoding file names.\n\
5685 If it is nil, default-file-name-coding-system (which see) is used.");
5686 Vfile_name_coding_system
= Qnil
;
5688 DEFVAR_LISP ("default-file-name-coding-system",
5689 &Vdefault_file_name_coding_system
,
5690 "Default coding system for encoding file names.\n\
5691 This variable is used only when file-name-coding-system is nil.\n\
5693 This variable is set/changed by the command set-language-environment.\n\
5694 User should not set this variable manually,\n\
5695 instead use file-name-coding-system to get a constant encoding\n\
5696 of file names regardless of the current language environment.");
5697 Vdefault_file_name_coding_system
= Qnil
;
5699 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5700 "*Format in which to write auto-save files.\n\
5701 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5702 If it is t, which is the default, auto-save files are written in the\n\
5703 same format as a regular save would use.");
5704 Vauto_save_file_format
= Qt
;
5706 Qformat_decode
= intern ("format-decode");
5707 staticpro (&Qformat_decode
);
5708 Qformat_annotate_function
= intern ("format-annotate-function");
5709 staticpro (&Qformat_annotate_function
);
5711 Qcar_less_than_car
= intern ("car-less-than-car");
5712 staticpro (&Qcar_less_than_car
);
5714 Fput (Qfile_error
, Qerror_conditions
,
5715 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5716 Fput (Qfile_error
, Qerror_message
,
5717 build_string ("File error"));
5719 Fput (Qfile_already_exists
, Qerror_conditions
,
5720 Fcons (Qfile_already_exists
,
5721 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5722 Fput (Qfile_already_exists
, Qerror_message
,
5723 build_string ("File already exists"));
5725 Fput (Qfile_date_error
, Qerror_conditions
,
5726 Fcons (Qfile_date_error
,
5727 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5728 Fput (Qfile_date_error
, Qerror_message
,
5729 build_string ("Cannot set file date"));
5731 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5732 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5733 insert_default_directory
= 1;
5735 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5736 "*Non-nil means write new files with record format `stmlf'.\n\
5737 nil means use format `var'. This variable is meaningful only on VMS.");
5738 vms_stmlf_recfm
= 0;
5740 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5741 "Directory separator character for built-in functions that return file names.\n\
5742 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5743 This variable affects the built-in functions only on Windows,\n\
5744 on other platforms, it is initialized so that Lisp code can find out\n\
5745 what the normal separator is.");
5747 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5748 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5749 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5752 The first argument given to HANDLER is the name of the I/O primitive\n\
5753 to be handled; the remaining arguments are the arguments that were\n\
5754 passed to that primitive. For example, if you do\n\
5755 (file-exists-p FILENAME)\n\
5756 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5757 (funcall HANDLER 'file-exists-p FILENAME)\n\
5758 The function `find-file-name-handler' checks this list for a handler\n\
5759 for its argument.");
5760 Vfile_name_handler_alist
= Qnil
;
5762 DEFVAR_LISP ("set-auto-coding-function",
5763 &Vset_auto_coding_function
,
5764 "If non-nil, a function to call to decide a coding system of file.\n\
5765 Two arguments are passed to this function: the file name\n\
5766 and the length of a file contents following the point.\n\
5767 This function should return a coding system to decode the file contents.\n\
5768 It should check the file name against `auto-coding-alist'.\n\
5769 If no coding system is decided, it should check a coding system\n\
5770 specified in the heading lines with the format:\n\
5771 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5772 or local variable spec of the tailing lines with `coding:' tag.");
5773 Vset_auto_coding_function
= Qnil
;
5775 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5776 "A list of functions to be called at the end of `insert-file-contents'.\n\
5777 Each is passed one argument, the number of bytes inserted. It should return\n\
5778 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5779 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5780 responsible for calling the after-insert-file-functions if appropriate.");
5781 Vafter_insert_file_functions
= Qnil
;
5783 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5784 "A list of functions to be called at the start of `write-region'.\n\
5785 Each is passed two arguments, START and END as for `write-region'.\n\
5786 These are usually two numbers but not always; see the documentation\n\
5787 for `write-region'. The function should return a list of pairs\n\
5788 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5789 inserted at the specified positions of the file being written (1 means to\n\
5790 insert before the first byte written). The POSITIONs must be sorted into\n\
5791 increasing order. If there are several functions in the list, the several\n\
5792 lists are merged destructively.");
5793 Vwrite_region_annotate_functions
= Qnil
;
5795 DEFVAR_LISP ("write-region-annotations-so-far",
5796 &Vwrite_region_annotations_so_far
,
5797 "When an annotation function is called, this holds the previous annotations.\n\
5798 These are the annotations made by other annotation functions\n\
5799 that were already called. See also `write-region-annotate-functions'.");
5800 Vwrite_region_annotations_so_far
= Qnil
;
5802 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5803 "A list of file name handlers that temporarily should not be used.\n\
5804 This applies only to the operation `inhibit-file-name-operation'.");
5805 Vinhibit_file_name_handlers
= Qnil
;
5807 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5808 "The operation for which `inhibit-file-name-handlers' is applicable.");
5809 Vinhibit_file_name_operation
= Qnil
;
5811 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5812 "File name in which we write a list of all auto save file names.\n\
5813 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5814 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5816 Vauto_save_list_file_name
= Qnil
;
5818 defsubr (&Sfind_file_name_handler
);
5819 defsubr (&Sfile_name_directory
);
5820 defsubr (&Sfile_name_nondirectory
);
5821 defsubr (&Sunhandled_file_name_directory
);
5822 defsubr (&Sfile_name_as_directory
);
5823 defsubr (&Sdirectory_file_name
);
5824 defsubr (&Smake_temp_name
);
5825 defsubr (&Sexpand_file_name
);
5826 defsubr (&Ssubstitute_in_file_name
);
5827 defsubr (&Scopy_file
);
5828 defsubr (&Smake_directory_internal
);
5829 defsubr (&Sdelete_directory
);
5830 defsubr (&Sdelete_file
);
5831 defsubr (&Srename_file
);
5832 defsubr (&Sadd_name_to_file
);
5834 defsubr (&Smake_symbolic_link
);
5835 #endif /* S_IFLNK */
5837 defsubr (&Sdefine_logical_name
);
5840 defsubr (&Ssysnetunam
);
5841 #endif /* HPUX_NET */
5842 defsubr (&Sfile_name_absolute_p
);
5843 defsubr (&Sfile_exists_p
);
5844 defsubr (&Sfile_executable_p
);
5845 defsubr (&Sfile_readable_p
);
5846 defsubr (&Sfile_writable_p
);
5847 defsubr (&Saccess_file
);
5848 defsubr (&Sfile_symlink_p
);
5849 defsubr (&Sfile_directory_p
);
5850 defsubr (&Sfile_accessible_directory_p
);
5851 defsubr (&Sfile_regular_p
);
5852 defsubr (&Sfile_modes
);
5853 defsubr (&Sset_file_modes
);
5854 defsubr (&Sset_default_file_modes
);
5855 defsubr (&Sdefault_file_modes
);
5856 defsubr (&Sfile_newer_than_file_p
);
5857 defsubr (&Sinsert_file_contents
);
5858 defsubr (&Swrite_region
);
5859 defsubr (&Scar_less_than_car
);
5860 defsubr (&Sverify_visited_file_modtime
);
5861 defsubr (&Sclear_visited_file_modtime
);
5862 defsubr (&Svisited_file_modtime
);
5863 defsubr (&Sset_visited_file_modtime
);
5864 defsubr (&Sdo_auto_save
);
5865 defsubr (&Sset_buffer_auto_saved
);
5866 defsubr (&Sclear_buffer_auto_save_failure
);
5867 defsubr (&Srecent_auto_save_p
);
5869 defsubr (&Sread_file_name_internal
);
5870 defsubr (&Sread_file_name
);
5873 defsubr (&Sunix_sync
);