1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 #define _GNU_SOURCE /* for euidaccess */
26 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
31 #include <sys/types.h>
38 #if !defined (S_ISLNK) && defined (S_IFLNK)
39 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
42 #if !defined (S_ISFIFO) && defined (S_IFIFO)
43 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
46 #if !defined (S_ISREG) && defined (S_IFREG)
47 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
86 #include "intervals.h"
97 #endif /* not WINDOWSNT */
101 #include <sys/param.h>
109 #define CORRECT_DIR_SEPS(s) \
110 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
111 else unixtodos_filename (s); \
113 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
114 redirector allows the six letters between 'Z' and 'a' as well. */
116 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
119 #define IS_DRIVE(x) isalpha (x)
121 /* Need to lower-case the drive letter, or else expanded
122 filenames will sometimes compare inequal, because
123 `expand-file-name' doesn't always down-case the drive letter. */
124 #define DRIVE_LETTER(x) (tolower (x))
145 #include "commands.h"
146 extern int use_dialog_box
;
160 #define min(a, b) ((a) < (b) ? (a) : (b))
161 #define max(a, b) ((a) > (b) ? (a) : (b))
163 /* Nonzero during writing of auto-save files */
166 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
167 a new file with the same mode as the original */
168 int auto_save_mode_bits
;
170 /* Coding system for file names, or nil if none. */
171 Lisp_Object Vfile_name_coding_system
;
173 /* Coding system for file names used only when
174 Vfile_name_coding_system is nil. */
175 Lisp_Object Vdefault_file_name_coding_system
;
177 /* Alist of elements (REGEXP . HANDLER) for file names
178 whose I/O is done with a special handler. */
179 Lisp_Object Vfile_name_handler_alist
;
181 /* Format for auto-save files */
182 Lisp_Object Vauto_save_file_format
;
184 /* Lisp functions for translating file formats */
185 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
187 /* Function to be called to decide a coding system of a reading file. */
188 Lisp_Object Vset_auto_coding_function
;
190 /* Functions to be called to process text properties in inserted file. */
191 Lisp_Object Vafter_insert_file_functions
;
193 /* Functions to be called to create text property annotations for file. */
194 Lisp_Object Vwrite_region_annotate_functions
;
196 /* During build_annotations, each time an annotation function is called,
197 this holds the annotations made by the previous functions. */
198 Lisp_Object Vwrite_region_annotations_so_far
;
200 /* File name in which we write a list of all our auto save files. */
201 Lisp_Object Vauto_save_list_file_name
;
203 /* Nonzero means, when reading a filename in the minibuffer,
204 start out by inserting the default directory into the minibuffer. */
205 int insert_default_directory
;
207 /* On VMS, nonzero means write new files with record format stmlf.
208 Zero means use var format. */
211 /* On NT, specifies the directory separator character, used (eg.) when
212 expanding file names. This can be bound to / or \. */
213 Lisp_Object Vdirectory_sep_char
;
215 extern Lisp_Object Vuser_login_name
;
218 extern Lisp_Object Vw32_get_true_file_attributes
;
221 extern int minibuf_level
;
223 extern int minibuffer_auto_raise
;
225 /* These variables describe handlers that have "already" had a chance
226 to handle the current operation.
228 Vinhibit_file_name_handlers is a list of file name handlers.
229 Vinhibit_file_name_operation is the operation being handled.
230 If we try to handle that operation, we ignore those handlers. */
232 static Lisp_Object Vinhibit_file_name_handlers
;
233 static Lisp_Object Vinhibit_file_name_operation
;
235 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
237 Lisp_Object Qfile_name_history
;
239 Lisp_Object Qcar_less_than_car
;
241 static int a_write
P_ ((int, Lisp_Object
, int, int,
242 Lisp_Object
*, struct coding_system
*));
243 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
247 report_file_error (string
, data
)
251 Lisp_Object errstring
;
254 synchronize_system_messages_locale ();
255 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
256 Vlocale_coding_system
, 0);
262 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
265 /* System error messages are capitalized. Downcase the initial
266 unless it is followed by a slash. */
267 if (XSTRING (errstring
)->data
[1] != '/')
268 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
270 Fsignal (Qfile_error
,
271 Fcons (build_string (string
), Fcons (errstring
, data
)));
276 close_file_unwind (fd
)
279 emacs_close (XFASTINT (fd
));
283 /* Restore point, having saved it as a marker. */
286 restore_point_unwind (location
)
287 Lisp_Object location
;
289 Fgoto_char (location
);
290 Fset_marker (location
, Qnil
, Qnil
);
294 Lisp_Object Qexpand_file_name
;
295 Lisp_Object Qsubstitute_in_file_name
;
296 Lisp_Object Qdirectory_file_name
;
297 Lisp_Object Qfile_name_directory
;
298 Lisp_Object Qfile_name_nondirectory
;
299 Lisp_Object Qunhandled_file_name_directory
;
300 Lisp_Object Qfile_name_as_directory
;
301 Lisp_Object Qcopy_file
;
302 Lisp_Object Qmake_directory_internal
;
303 Lisp_Object Qmake_directory
;
304 Lisp_Object Qdelete_directory
;
305 Lisp_Object Qdelete_file
;
306 Lisp_Object Qrename_file
;
307 Lisp_Object Qadd_name_to_file
;
308 Lisp_Object Qmake_symbolic_link
;
309 Lisp_Object Qfile_exists_p
;
310 Lisp_Object Qfile_executable_p
;
311 Lisp_Object Qfile_readable_p
;
312 Lisp_Object Qfile_writable_p
;
313 Lisp_Object Qfile_symlink_p
;
314 Lisp_Object Qaccess_file
;
315 Lisp_Object Qfile_directory_p
;
316 Lisp_Object Qfile_regular_p
;
317 Lisp_Object Qfile_accessible_directory_p
;
318 Lisp_Object Qfile_modes
;
319 Lisp_Object Qset_file_modes
;
320 Lisp_Object Qfile_newer_than_file_p
;
321 Lisp_Object Qinsert_file_contents
;
322 Lisp_Object Qwrite_region
;
323 Lisp_Object Qverify_visited_file_modtime
;
324 Lisp_Object Qset_visited_file_modtime
;
326 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
327 "Return FILENAME's handler function for OPERATION, if it has one.\n\
328 Otherwise, return nil.\n\
329 A file name is handled if one of the regular expressions in\n\
330 `file-name-handler-alist' matches it.\n\n\
331 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
332 any handlers that are members of `inhibit-file-name-handlers',\n\
333 but we still do run any other handlers. This lets handlers\n\
334 use the standard functions without calling themselves recursively.")
335 (filename
, operation
)
336 Lisp_Object filename
, operation
;
338 /* This function must not munge the match data. */
339 Lisp_Object chain
, inhibited_handlers
;
341 CHECK_STRING (filename
, 0);
343 if (EQ (operation
, Vinhibit_file_name_operation
))
344 inhibited_handlers
= Vinhibit_file_name_handlers
;
346 inhibited_handlers
= Qnil
;
348 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
349 chain
= XCDR (chain
))
357 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
359 Lisp_Object handler
, tem
;
361 handler
= XCDR (elt
);
362 tem
= Fmemq (handler
, inhibited_handlers
);
373 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
375 "Return the directory component in file name FILENAME.\n\
376 Return nil if FILENAME does not include a directory.\n\
377 Otherwise return a directory spec.\n\
378 Given a Unix syntax file name, returns a string ending in slash;\n\
379 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
381 Lisp_Object filename
;
383 register unsigned char *beg
;
384 register unsigned char *p
;
387 CHECK_STRING (filename
, 0);
389 /* If the file name has special constructs in it,
390 call the corresponding file handler. */
391 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
393 return call2 (handler
, Qfile_name_directory
, filename
);
395 #ifdef FILE_SYSTEM_CASE
396 filename
= FILE_SYSTEM_CASE (filename
);
398 beg
= XSTRING (filename
)->data
;
400 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
402 p
= beg
+ STRING_BYTES (XSTRING (filename
));
404 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
406 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
409 /* only recognise drive specifier at the beginning */
411 /* handle the "/:d:foo" and "/:foo" cases correctly */
412 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
413 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
420 /* Expansion of "c:" to drive and default directory. */
423 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
424 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
425 unsigned char *r
= res
;
427 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
429 strncpy (res
, beg
, 2);
434 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
436 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
439 p
= beg
+ strlen (beg
);
442 CORRECT_DIR_SEPS (beg
);
445 if (STRING_MULTIBYTE (filename
))
446 return make_string (beg
, p
- beg
);
447 return make_unibyte_string (beg
, p
- beg
);
450 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
451 Sfile_name_nondirectory
, 1, 1, 0,
452 "Return file name FILENAME sans its directory.\n\
453 For example, in a Unix-syntax file name,\n\
454 this is everything after the last slash,\n\
455 or the entire name if it contains no slash.")
457 Lisp_Object filename
;
459 register unsigned char *beg
, *p
, *end
;
462 CHECK_STRING (filename
, 0);
464 /* If the file name has special constructs in it,
465 call the corresponding file handler. */
466 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
468 return call2 (handler
, Qfile_name_nondirectory
, filename
);
470 beg
= XSTRING (filename
)->data
;
471 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
473 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
475 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
478 /* only recognise drive specifier at beginning */
480 /* handle the "/:d:foo" case correctly */
481 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
486 if (STRING_MULTIBYTE (filename
))
487 return make_string (p
, end
- p
);
488 return make_unibyte_string (p
, end
- p
);
491 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
492 Sunhandled_file_name_directory
, 1, 1, 0,
493 "Return a directly usable directory name somehow associated with FILENAME.\n\
494 A `directly usable' directory name is one that may be used without the\n\
495 intervention of any file handler.\n\
496 If FILENAME is a directly usable file itself, return\n\
497 \(file-name-directory FILENAME).\n\
498 The `call-process' and `start-process' functions use this function to\n\
499 get a current directory to run processes in.")
501 Lisp_Object filename
;
505 /* If the file name has special constructs in it,
506 call the corresponding file handler. */
507 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
509 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
511 return Ffile_name_directory (filename
);
516 file_name_as_directory (out
, in
)
519 int size
= strlen (in
) - 1;
532 /* Is it already a directory string? */
533 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
535 /* Is it a VMS directory file name? If so, hack VMS syntax. */
536 else if (! index (in
, '/')
537 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
538 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
539 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
540 || ! strncmp (&in
[size
- 5], ".dir", 4))
541 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
542 && in
[size
] == '1')))
544 register char *p
, *dot
;
548 dir:x.dir --> dir:[x]
549 dir:[x]y.dir --> dir:[x.y] */
551 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
554 strncpy (out
, in
, p
- in
);
573 dot
= index (p
, '.');
576 /* blindly remove any extension */
577 size
= strlen (out
) + (dot
- p
);
578 strncat (out
, p
, dot
- p
);
589 /* For Unix syntax, Append a slash if necessary */
590 if (!IS_DIRECTORY_SEP (out
[size
]))
592 out
[size
+ 1] = DIRECTORY_SEP
;
593 out
[size
+ 2] = '\0';
596 CORRECT_DIR_SEPS (out
);
602 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
603 Sfile_name_as_directory
, 1, 1, 0,
604 "Return a string representing file FILENAME interpreted as a directory.\n\
605 This operation exists because a directory is also a file, but its name as\n\
606 a directory is different from its name as a file.\n\
607 The result can be used as the value of `default-directory'\n\
608 or passed as second argument to `expand-file-name'.\n\
609 For a Unix-syntax file name, just appends a slash.\n\
610 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
617 CHECK_STRING (file
, 0);
621 /* If the file name has special constructs in it,
622 call the corresponding file handler. */
623 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
625 return call2 (handler
, Qfile_name_as_directory
, file
);
627 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
628 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
632 * Convert from directory name to filename.
634 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
635 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
636 * On UNIX, it's simple: just make sure there isn't a terminating /
638 * Value is nonzero if the string output is different from the input.
642 directory_file_name (src
, dst
)
650 struct FAB fab
= cc$rms_fab
;
651 struct NAM nam
= cc$rms_nam
;
652 char esa
[NAM$C_MAXRSS
];
657 if (! index (src
, '/')
658 && (src
[slen
- 1] == ']'
659 || src
[slen
- 1] == ':'
660 || src
[slen
- 1] == '>'))
662 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
664 fab
.fab$b_fns
= slen
;
665 fab
.fab$l_nam
= &nam
;
666 fab
.fab$l_fop
= FAB$M_NAM
;
669 nam
.nam$b_ess
= sizeof esa
;
670 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
672 /* We call SYS$PARSE to handle such things as [--] for us. */
673 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
675 slen
= nam
.nam$b_esl
;
676 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
681 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
683 /* what about when we have logical_name:???? */
684 if (src
[slen
- 1] == ':')
685 { /* Xlate logical name and see what we get */
686 ptr
= strcpy (dst
, src
); /* upper case for getenv */
689 if ('a' <= *ptr
&& *ptr
<= 'z')
693 dst
[slen
- 1] = 0; /* remove colon */
694 if (!(src
= egetenv (dst
)))
696 /* should we jump to the beginning of this procedure?
697 Good points: allows us to use logical names that xlate
699 Bad points: can be a problem if we just translated to a device
701 For now, I'll punt and always expect VMS names, and hope for
704 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
705 { /* no recursion here! */
711 { /* not a directory spec */
716 bracket
= src
[slen
- 1];
718 /* If bracket is ']' or '>', bracket - 2 is the corresponding
720 ptr
= index (src
, bracket
- 2);
722 { /* no opening bracket */
726 if (!(rptr
= rindex (src
, '.')))
729 strncpy (dst
, src
, slen
);
733 dst
[slen
++] = bracket
;
738 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
739 then translate the device and recurse. */
740 if (dst
[slen
- 1] == ':'
741 && dst
[slen
- 2] != ':' /* skip decnet nodes */
742 && strcmp (src
+ slen
, "[000000]") == 0)
744 dst
[slen
- 1] = '\0';
745 if ((ptr
= egetenv (dst
))
746 && (rlen
= strlen (ptr
) - 1) > 0
747 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
748 && ptr
[rlen
- 1] == '.')
750 char * buf
= (char *) alloca (strlen (ptr
) + 1);
754 return directory_file_name (buf
, dst
);
759 strcat (dst
, "[000000]");
763 rlen
= strlen (rptr
) - 1;
764 strncat (dst
, rptr
, rlen
);
765 dst
[slen
+ rlen
] = '\0';
766 strcat (dst
, ".DIR.1");
770 /* Process as Unix format: just remove any final slash.
771 But leave "/" unchanged; do not change it to "". */
774 /* Handle // as root for apollo's. */
775 if ((slen
> 2 && dst
[slen
- 1] == '/')
776 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
780 && IS_DIRECTORY_SEP (dst
[slen
- 1])
782 && !IS_ANY_SEP (dst
[slen
- 2])
788 CORRECT_DIR_SEPS (dst
);
793 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
795 "Returns the file name of the directory named DIRECTORY.\n\
796 This is the name of the file that holds the data for the directory DIRECTORY.\n\
797 This operation exists because a directory is also a file, but its name as\n\
798 a directory is different from its name as a file.\n\
799 In Unix-syntax, this function just removes the final slash.\n\
800 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
801 it returns a file name such as \"[X]Y.DIR.1\".")
803 Lisp_Object directory
;
808 CHECK_STRING (directory
, 0);
810 if (NILP (directory
))
813 /* If the file name has special constructs in it,
814 call the corresponding file handler. */
815 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
817 return call2 (handler
, Qdirectory_file_name
, directory
);
820 /* 20 extra chars is insufficient for VMS, since we might perform a
821 logical name translation. an equivalence string can be up to 255
822 chars long, so grab that much extra space... - sss */
823 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
825 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
827 directory_file_name (XSTRING (directory
)->data
, buf
);
828 return build_string (buf
);
831 static char make_temp_name_tbl
[64] =
833 'A','B','C','D','E','F','G','H',
834 'I','J','K','L','M','N','O','P',
835 'Q','R','S','T','U','V','W','X',
836 'Y','Z','a','b','c','d','e','f',
837 'g','h','i','j','k','l','m','n',
838 'o','p','q','r','s','t','u','v',
839 'w','x','y','z','0','1','2','3',
840 '4','5','6','7','8','9','-','_'
843 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
845 /* Value is a temporary file name starting with PREFIX, a string.
847 The Emacs process number forms part of the result, so there is
848 no danger of generating a name being used by another process.
849 In addition, this function makes an attempt to choose a name
850 which has no existing file. To make this work, PREFIX should be
851 an absolute file name.
853 BASE64_P non-zero means add the pid as 3 characters in base64
854 encoding. In this case, 6 characters will be added to PREFIX to
855 form the file name. Otherwise, if Emacs is running on a system
856 with long file names, add the pid as a decimal number.
858 This function signals an error if no unique file name could be
862 make_temp_name (prefix
, base64_p
)
869 unsigned char *p
, *data
;
873 CHECK_STRING (prefix
, 0);
875 /* VAL is created by adding 6 characters to PREFIX. The first
876 three are the PID of this process, in base 64, and the second
877 three are incremented if the file already exists. This ensures
878 262144 unique file names per PID per PREFIX. */
880 pid
= (int) getpid ();
884 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
885 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
886 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
891 #ifdef HAVE_LONG_FILE_NAMES
892 sprintf (pidbuf
, "%d", pid
);
893 pidlen
= strlen (pidbuf
);
895 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
896 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
897 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
902 len
= XSTRING (prefix
)->size
;
903 val
= make_uninit_string (len
+ 3 + pidlen
);
904 data
= XSTRING (val
)->data
;
905 bcopy(XSTRING (prefix
)->data
, data
, len
);
908 bcopy (pidbuf
, p
, pidlen
);
911 /* Here we try to minimize useless stat'ing when this function is
912 invoked many times successively with the same PREFIX. We achieve
913 this by initializing count to a random value, and incrementing it
916 We don't want make-temp-name to be called while dumping,
917 because then make_temp_name_count_initialized_p would get set
918 and then make_temp_name_count would not be set when Emacs starts. */
920 if (!make_temp_name_count_initialized_p
)
922 make_temp_name_count
= (unsigned) time (NULL
);
923 make_temp_name_count_initialized_p
= 1;
929 unsigned num
= make_temp_name_count
;
931 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
932 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
933 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
935 /* Poor man's congruential RN generator. Replace with
936 ++make_temp_name_count for debugging. */
937 make_temp_name_count
+= 25229;
938 make_temp_name_count
%= 225307;
940 if (stat (data
, &ignored
) < 0)
942 /* We want to return only if errno is ENOENT. */
946 /* The error here is dubious, but there is little else we
947 can do. The alternatives are to return nil, which is
948 as bad as (and in many cases worse than) throwing the
949 error, or to ignore the error, which will likely result
950 in looping through 225307 stat's, which is not only
951 dog-slow, but also useless since it will fallback to
952 the errow below, anyway. */
953 report_file_error ("Cannot create temporary name for prefix",
954 Fcons (prefix
, Qnil
));
959 error ("Cannot create temporary name for prefix `%s'",
960 XSTRING (prefix
)->data
);
965 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
966 "Generate temporary file name (string) starting with PREFIX (a string).\n\
967 The Emacs process number forms part of the result,\n\
968 so there is no danger of generating a name being used by another process.\n\
970 In addition, this function makes an attempt to choose a name\n\
971 which has no existing file. To make this work,\n\
972 PREFIX should be an absolute file name.\n\
974 There is a race condition between calling `make-temp-name' and creating the\n\
975 file which opens all kinds of security holes. For that reason, you should\n\
976 probably use `make-temp-file' instead.")
980 return make_temp_name (prefix
, 0);
985 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
986 "Convert filename NAME to absolute, and canonicalize it.\n\
987 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
988 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
989 the current buffer's value of default-directory is used.\n\
990 File name components that are `.' are removed, and \n\
991 so are file name components followed by `..', along with the `..' itself;\n\
992 note that these simplifications are done without checking the resulting\n\
993 file names in the file system.\n\
994 An initial `~/' expands to your home directory.\n\
995 An initial `~USER/' expands to USER's home directory.\n\
996 See also the function `substitute-in-file-name'.")
997 (name
, default_directory
)
998 Lisp_Object name
, default_directory
;
1002 register unsigned char *newdir
, *p
, *o
;
1004 unsigned char *target
;
1007 unsigned char * colon
= 0;
1008 unsigned char * close
= 0;
1009 unsigned char * slash
= 0;
1010 unsigned char * brack
= 0;
1011 int lbrack
= 0, rbrack
= 0;
1016 int collapse_newdir
= 1;
1020 Lisp_Object handler
;
1022 CHECK_STRING (name
, 0);
1024 /* If the file name has special constructs in it,
1025 call the corresponding file handler. */
1026 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1027 if (!NILP (handler
))
1028 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1030 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1031 if (NILP (default_directory
))
1032 default_directory
= current_buffer
->directory
;
1033 if (! STRINGP (default_directory
))
1034 default_directory
= build_string ("/");
1036 if (!NILP (default_directory
))
1038 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1039 if (!NILP (handler
))
1040 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1043 o
= XSTRING (default_directory
)->data
;
1045 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1046 It would be better to do this down below where we actually use
1047 default_directory. Unfortunately, calling Fexpand_file_name recursively
1048 could invoke GC, and the strings might be relocated. This would
1049 be annoying because we have pointers into strings lying around
1050 that would need adjusting, and people would add new pointers to
1051 the code and forget to adjust them, resulting in intermittent bugs.
1052 Putting this call here avoids all that crud.
1054 The EQ test avoids infinite recursion. */
1055 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1056 /* Save time in some common cases - as long as default_directory
1057 is not relative, it can be canonicalized with name below (if it
1058 is needed at all) without requiring it to be expanded now. */
1060 /* Detect MSDOS file names with drive specifiers. */
1061 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1063 /* Detect Windows file names in UNC format. */
1064 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1066 #else /* not DOS_NT */
1067 /* Detect Unix absolute file names (/... alone is not absolute on
1069 && ! (IS_DIRECTORY_SEP (o
[0]))
1070 #endif /* not DOS_NT */
1073 struct gcpro gcpro1
;
1076 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1081 /* Filenames on VMS are always upper case. */
1082 name
= Fupcase (name
);
1084 #ifdef FILE_SYSTEM_CASE
1085 name
= FILE_SYSTEM_CASE (name
);
1088 nm
= XSTRING (name
)->data
;
1091 /* We will force directory separators to be either all \ or /, so make
1092 a local copy to modify, even if there ends up being no change. */
1093 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1095 /* Note if special escape prefix is present, but remove for now. */
1096 if (nm
[0] == '/' && nm
[1] == ':')
1102 /* Find and remove drive specifier if present; this makes nm absolute
1103 even if the rest of the name appears to be relative. Only look for
1104 drive specifier at the beginning. */
1105 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1112 /* If we see "c://somedir", we want to strip the first slash after the
1113 colon when stripping the drive letter. Otherwise, this expands to
1115 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1117 #endif /* WINDOWSNT */
1121 /* Discard any previous drive specifier if nm is now in UNC format. */
1122 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1128 /* If nm is absolute, look for /./ or /../ sequences; if none are
1129 found, we can probably return right away. We will avoid allocating
1130 a new string if name is already fully expanded. */
1132 IS_DIRECTORY_SEP (nm
[0])
1134 && drive
&& !is_escaped
1137 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1144 /* If it turns out that the filename we want to return is just a
1145 suffix of FILENAME, we don't need to go through and edit
1146 things; we just need to construct a new string using data
1147 starting at the middle of FILENAME. If we set lose to a
1148 non-zero value, that means we've discovered that we can't do
1155 /* Since we know the name is absolute, we can assume that each
1156 element starts with a "/". */
1158 /* "." and ".." are hairy. */
1159 if (IS_DIRECTORY_SEP (p
[0])
1161 && (IS_DIRECTORY_SEP (p
[2])
1163 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1170 /* if dev:[dir]/, move nm to / */
1171 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1172 nm
= (brack
? brack
+ 1 : colon
+ 1);
1173 lbrack
= rbrack
= 0;
1181 /* VMS pre V4.4,convert '-'s in filenames. */
1182 if (lbrack
== rbrack
)
1184 if (dots
< 2) /* this is to allow negative version numbers */
1189 if (lbrack
> rbrack
&&
1190 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1191 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1197 /* count open brackets, reset close bracket pointer */
1198 if (p
[0] == '[' || p
[0] == '<')
1199 lbrack
++, brack
= 0;
1200 /* count close brackets, set close bracket pointer */
1201 if (p
[0] == ']' || p
[0] == '>')
1202 rbrack
++, brack
= p
;
1203 /* detect ][ or >< */
1204 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1206 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1207 nm
= p
+ 1, lose
= 1;
1208 if (p
[0] == ':' && (colon
|| slash
))
1209 /* if dev1:[dir]dev2:, move nm to dev2: */
1215 /* if /name/dev:, move nm to dev: */
1218 /* if node::dev:, move colon following dev */
1219 else if (colon
&& colon
[-1] == ':')
1221 /* if dev1:dev2:, move nm to dev2: */
1222 else if (colon
&& colon
[-1] != ':')
1227 if (p
[0] == ':' && !colon
)
1233 if (lbrack
== rbrack
)
1236 else if (p
[0] == '.')
1244 if (index (nm
, '/'))
1245 return build_string (sys_translate_unix (nm
));
1248 /* Make sure directories are all separated with / or \ as
1249 desired, but avoid allocation of a new string when not
1251 CORRECT_DIR_SEPS (nm
);
1253 if (IS_DIRECTORY_SEP (nm
[1]))
1255 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1256 name
= build_string (nm
);
1260 /* drive must be set, so this is okay */
1261 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1263 name
= make_string (nm
- 2, p
- nm
+ 2);
1264 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1265 XSTRING (name
)->data
[1] = ':';
1268 #else /* not DOS_NT */
1269 if (nm
== XSTRING (name
)->data
)
1271 return build_string (nm
);
1272 #endif /* not DOS_NT */
1276 /* At this point, nm might or might not be an absolute file name. We
1277 need to expand ~ or ~user if present, otherwise prefix nm with
1278 default_directory if nm is not absolute, and finally collapse /./
1279 and /foo/../ sequences.
1281 We set newdir to be the appropriate prefix if one is needed:
1282 - the relevant user directory if nm starts with ~ or ~user
1283 - the specified drive's working dir (DOS/NT only) if nm does not
1285 - the value of default_directory.
1287 Note that these prefixes are not guaranteed to be absolute (except
1288 for the working dir of a drive). Therefore, to ensure we always
1289 return an absolute name, if the final prefix is not absolute we
1290 append it to the current working directory. */
1294 if (nm
[0] == '~') /* prefix ~ */
1296 if (IS_DIRECTORY_SEP (nm
[1])
1300 || nm
[1] == 0) /* ~ by itself */
1302 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1303 newdir
= (unsigned char *) "";
1306 collapse_newdir
= 0;
1309 nm
++; /* Don't leave the slash in nm. */
1312 else /* ~user/filename */
1314 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1319 o
= (unsigned char *) alloca (p
- nm
+ 1);
1320 bcopy ((char *) nm
, o
, p
- nm
);
1323 pw
= (struct passwd
*) getpwnam (o
+ 1);
1326 newdir
= (unsigned char *) pw
-> pw_dir
;
1328 nm
= p
+ 1; /* skip the terminator */
1332 collapse_newdir
= 0;
1337 /* If we don't find a user of that name, leave the name
1338 unchanged; don't move nm forward to p. */
1343 /* On DOS and Windows, nm is absolute if a drive name was specified;
1344 use the drive's current directory as the prefix if needed. */
1345 if (!newdir
&& drive
)
1347 /* Get default directory if needed to make nm absolute. */
1348 if (!IS_DIRECTORY_SEP (nm
[0]))
1350 newdir
= alloca (MAXPATHLEN
+ 1);
1351 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1356 /* Either nm starts with /, or drive isn't mounted. */
1357 newdir
= alloca (4);
1358 newdir
[0] = DRIVE_LETTER (drive
);
1366 /* Finally, if no prefix has been specified and nm is not absolute,
1367 then it must be expanded relative to default_directory. */
1371 /* /... alone is not absolute on DOS and Windows. */
1372 && !IS_DIRECTORY_SEP (nm
[0])
1375 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1382 newdir
= XSTRING (default_directory
)->data
;
1384 /* Note if special escape prefix is present, but remove for now. */
1385 if (newdir
[0] == '/' && newdir
[1] == ':')
1396 /* First ensure newdir is an absolute name. */
1398 /* Detect MSDOS file names with drive specifiers. */
1399 ! (IS_DRIVE (newdir
[0])
1400 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1402 /* Detect Windows file names in UNC format. */
1403 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1407 /* Effectively, let newdir be (expand-file-name newdir cwd).
1408 Because of the admonition against calling expand-file-name
1409 when we have pointers into lisp strings, we accomplish this
1410 indirectly by prepending newdir to nm if necessary, and using
1411 cwd (or the wd of newdir's drive) as the new newdir. */
1413 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1418 if (!IS_DIRECTORY_SEP (nm
[0]))
1420 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1421 file_name_as_directory (tmp
, newdir
);
1425 newdir
= alloca (MAXPATHLEN
+ 1);
1428 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1435 /* Strip off drive name from prefix, if present. */
1436 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1442 /* Keep only a prefix from newdir if nm starts with slash
1443 (//server/share for UNC, nothing otherwise). */
1444 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1447 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1449 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1451 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1453 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1465 /* Get rid of any slash at the end of newdir, unless newdir is
1466 just / or // (an incomplete UNC name). */
1467 length
= strlen (newdir
);
1468 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1470 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1474 unsigned char *temp
= (unsigned char *) alloca (length
);
1475 bcopy (newdir
, temp
, length
- 1);
1476 temp
[length
- 1] = 0;
1484 /* Now concatenate the directory and name to new space in the stack frame */
1485 tlen
+= strlen (nm
) + 1;
1487 /* Reserve space for drive specifier and escape prefix, since either
1488 or both may need to be inserted. (The Microsoft x86 compiler
1489 produces incorrect code if the following two lines are combined.) */
1490 target
= (unsigned char *) alloca (tlen
+ 4);
1492 #else /* not DOS_NT */
1493 target
= (unsigned char *) alloca (tlen
);
1494 #endif /* not DOS_NT */
1500 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1503 /* If newdir is effectively "C:/", then the drive letter will have
1504 been stripped and newdir will be "/". Concatenating with an
1505 absolute directory in nm produces "//", which will then be
1506 incorrectly treated as a network share. Ignore newdir in
1507 this case (keeping the drive letter). */
1508 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1509 && newdir
[1] == '\0'))
1511 strcpy (target
, newdir
);
1515 file_name_as_directory (target
, newdir
);
1518 strcat (target
, nm
);
1520 if (index (target
, '/'))
1521 strcpy (target
, sys_translate_unix (target
));
1524 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1526 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1534 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1540 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1541 /* brackets are offset from each other by 2 */
1544 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1545 /* convert [foo][bar] to [bar] */
1546 while (o
[-1] != '[' && o
[-1] != '<')
1548 else if (*p
== '-' && *o
!= '.')
1551 else if (p
[0] == '-' && o
[-1] == '.' &&
1552 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1553 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1557 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1558 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1560 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1562 /* else [foo.-] ==> [-] */
1568 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1569 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1575 if (!IS_DIRECTORY_SEP (*p
))
1579 else if (IS_DIRECTORY_SEP (p
[0])
1581 && (IS_DIRECTORY_SEP (p
[2])
1584 /* If "/." is the entire filename, keep the "/". Otherwise,
1585 just delete the whole "/.". */
1586 if (o
== target
&& p
[2] == '\0')
1590 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1591 /* `/../' is the "superroot" on certain file systems. */
1593 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1595 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1597 /* Keep initial / only if this is the whole name. */
1598 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1606 #endif /* not VMS */
1610 /* At last, set drive name. */
1612 /* Except for network file name. */
1613 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1614 #endif /* WINDOWSNT */
1616 if (!drive
) abort ();
1618 target
[0] = DRIVE_LETTER (drive
);
1621 /* Reinsert the escape prefix if required. */
1628 CORRECT_DIR_SEPS (target
);
1631 return make_string (target
, o
- target
);
1635 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1636 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1637 "Convert FILENAME to absolute, and canonicalize it.\n\
1638 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1639 (does not start with slash); if DEFAULT is nil or missing,\n\
1640 the current buffer's value of default-directory is used.\n\
1641 Filenames containing `.' or `..' as components are simplified;\n\
1642 initial `~/' expands to your home directory.\n\
1643 See also the function `substitute-in-file-name'.")
1645 Lisp_Object name
, defalt
;
1649 register unsigned char *newdir
, *p
, *o
;
1651 unsigned char *target
;
1655 unsigned char * colon
= 0;
1656 unsigned char * close
= 0;
1657 unsigned char * slash
= 0;
1658 unsigned char * brack
= 0;
1659 int lbrack
= 0, rbrack
= 0;
1663 CHECK_STRING (name
, 0);
1666 /* Filenames on VMS are always upper case. */
1667 name
= Fupcase (name
);
1670 nm
= XSTRING (name
)->data
;
1672 /* If nm is absolute, flush ...// and detect /./ and /../.
1673 If no /./ or /../ we can return right away. */
1685 if (p
[0] == '/' && p
[1] == '/'
1687 /* // at start of filename is meaningful on Apollo system. */
1692 if (p
[0] == '/' && p
[1] == '~')
1693 nm
= p
+ 1, lose
= 1;
1694 if (p
[0] == '/' && p
[1] == '.'
1695 && (p
[2] == '/' || p
[2] == 0
1696 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1702 /* if dev:[dir]/, move nm to / */
1703 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1704 nm
= (brack
? brack
+ 1 : colon
+ 1);
1705 lbrack
= rbrack
= 0;
1713 /* VMS pre V4.4,convert '-'s in filenames. */
1714 if (lbrack
== rbrack
)
1716 if (dots
< 2) /* this is to allow negative version numbers */
1721 if (lbrack
> rbrack
&&
1722 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1723 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1729 /* count open brackets, reset close bracket pointer */
1730 if (p
[0] == '[' || p
[0] == '<')
1731 lbrack
++, brack
= 0;
1732 /* count close brackets, set close bracket pointer */
1733 if (p
[0] == ']' || p
[0] == '>')
1734 rbrack
++, brack
= p
;
1735 /* detect ][ or >< */
1736 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1738 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1739 nm
= p
+ 1, lose
= 1;
1740 if (p
[0] == ':' && (colon
|| slash
))
1741 /* if dev1:[dir]dev2:, move nm to dev2: */
1747 /* If /name/dev:, move nm to dev: */
1750 /* If node::dev:, move colon following dev */
1751 else if (colon
&& colon
[-1] == ':')
1753 /* If dev1:dev2:, move nm to dev2: */
1754 else if (colon
&& colon
[-1] != ':')
1759 if (p
[0] == ':' && !colon
)
1765 if (lbrack
== rbrack
)
1768 else if (p
[0] == '.')
1776 if (index (nm
, '/'))
1777 return build_string (sys_translate_unix (nm
));
1779 if (nm
== XSTRING (name
)->data
)
1781 return build_string (nm
);
1785 /* Now determine directory to start with and put it in NEWDIR */
1789 if (nm
[0] == '~') /* prefix ~ */
1794 || nm
[1] == 0)/* ~/filename */
1796 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1797 newdir
= (unsigned char *) "";
1800 nm
++; /* Don't leave the slash in nm. */
1803 else /* ~user/filename */
1805 /* Get past ~ to user */
1806 unsigned char *user
= nm
+ 1;
1807 /* Find end of name. */
1808 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1809 int len
= ptr
? ptr
- user
: strlen (user
);
1811 unsigned char *ptr1
= index (user
, ':');
1812 if (ptr1
!= 0 && ptr1
- user
< len
)
1815 /* Copy the user name into temp storage. */
1816 o
= (unsigned char *) alloca (len
+ 1);
1817 bcopy ((char *) user
, o
, len
);
1820 /* Look up the user name. */
1821 pw
= (struct passwd
*) getpwnam (o
+ 1);
1823 error ("\"%s\" isn't a registered user", o
+ 1);
1825 newdir
= (unsigned char *) pw
->pw_dir
;
1827 /* Discard the user name from NM. */
1834 #endif /* not VMS */
1838 defalt
= current_buffer
->directory
;
1839 CHECK_STRING (defalt
, 1);
1840 newdir
= XSTRING (defalt
)->data
;
1843 /* Now concatenate the directory and name to new space in the stack frame */
1845 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1846 target
= (unsigned char *) alloca (tlen
);
1852 if (nm
[0] == 0 || nm
[0] == '/')
1853 strcpy (target
, newdir
);
1856 file_name_as_directory (target
, newdir
);
1859 strcat (target
, nm
);
1861 if (index (target
, '/'))
1862 strcpy (target
, sys_translate_unix (target
));
1865 /* Now canonicalize by removing /. and /foo/.. if they appear */
1873 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1879 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1880 /* brackets are offset from each other by 2 */
1883 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1884 /* convert [foo][bar] to [bar] */
1885 while (o
[-1] != '[' && o
[-1] != '<')
1887 else if (*p
== '-' && *o
!= '.')
1890 else if (p
[0] == '-' && o
[-1] == '.' &&
1891 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1892 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1896 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1897 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1899 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1901 /* else [foo.-] ==> [-] */
1907 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1908 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1918 else if (!strncmp (p
, "//", 2)
1920 /* // at start of filename is meaningful in Apollo system. */
1928 else if (p
[0] == '/' && p
[1] == '.' &&
1929 (p
[2] == '/' || p
[2] == 0))
1931 else if (!strncmp (p
, "/..", 3)
1932 /* `/../' is the "superroot" on certain file systems. */
1934 && (p
[3] == '/' || p
[3] == 0))
1936 while (o
!= target
&& *--o
!= '/')
1939 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1943 if (o
== target
&& *o
== '/')
1951 #endif /* not VMS */
1954 return make_string (target
, o
- target
);
1958 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1959 Ssubstitute_in_file_name
, 1, 1, 0,
1960 "Substitute environment variables referred to in FILENAME.\n\
1961 `$FOO' where FOO is an environment variable name means to substitute\n\
1962 the value of that variable. The variable name should be terminated\n\
1963 with a character not a letter, digit or underscore; otherwise, enclose\n\
1964 the entire variable name in braces.\n\
1965 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1966 On VMS, `$' substitution is not done; this function does little and only\n\
1967 duplicates what `expand-file-name' does.")
1969 Lisp_Object filename
;
1973 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1974 unsigned char *target
;
1976 int substituted
= 0;
1978 Lisp_Object handler
;
1980 CHECK_STRING (filename
, 0);
1982 /* If the file name has special constructs in it,
1983 call the corresponding file handler. */
1984 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1985 if (!NILP (handler
))
1986 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1988 nm
= XSTRING (filename
)->data
;
1990 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1991 CORRECT_DIR_SEPS (nm
);
1992 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1994 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1996 /* If /~ or // appears, discard everything through first slash. */
1998 for (p
= nm
; p
!= endp
; p
++)
2001 #if defined (APOLLO) || defined (WINDOWSNT)
2002 /* // at start of file name is meaningful in Apollo and
2003 WindowsNT systems. */
2004 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2005 #else /* not (APOLLO || WINDOWSNT) */
2006 || IS_DIRECTORY_SEP (p
[0])
2007 #endif /* not (APOLLO || WINDOWSNT) */
2012 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2014 || IS_DIRECTORY_SEP (p
[-1])))
2020 /* see comment in expand-file-name about drive specifiers */
2021 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2022 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2031 return build_string (nm
);
2034 /* See if any variables are substituted into the string
2035 and find the total length of their values in `total' */
2037 for (p
= nm
; p
!= endp
;)
2047 /* "$$" means a single "$" */
2056 while (p
!= endp
&& *p
!= '}') p
++;
2057 if (*p
!= '}') goto missingclose
;
2063 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2067 /* Copy out the variable name */
2068 target
= (unsigned char *) alloca (s
- o
+ 1);
2069 strncpy (target
, o
, s
- o
);
2072 strupr (target
); /* $home == $HOME etc. */
2075 /* Get variable value */
2076 o
= (unsigned char *) egetenv (target
);
2077 if (!o
) goto badvar
;
2078 total
+= strlen (o
);
2085 /* If substitution required, recopy the string and do it */
2086 /* Make space in stack frame for the new copy */
2087 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2090 /* Copy the rest of the name through, replacing $ constructs with values */
2107 while (p
!= endp
&& *p
!= '}') p
++;
2108 if (*p
!= '}') goto missingclose
;
2114 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2118 /* Copy out the variable name */
2119 target
= (unsigned char *) alloca (s
- o
+ 1);
2120 strncpy (target
, o
, s
- o
);
2123 strupr (target
); /* $home == $HOME etc. */
2126 /* Get variable value */
2127 o
= (unsigned char *) egetenv (target
);
2131 if (STRING_MULTIBYTE (filename
))
2133 /* If the original string is multibyte,
2134 convert what we substitute into multibyte. */
2137 int c
= unibyte_char_to_multibyte (*o
++);
2138 x
+= CHAR_STRING (c
, x
);
2150 /* If /~ or // appears, discard everything through first slash. */
2152 for (p
= xnm
; p
!= x
; p
++)
2154 #if defined (APOLLO) || defined (WINDOWSNT)
2155 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2156 #else /* not (APOLLO || WINDOWSNT) */
2157 || IS_DIRECTORY_SEP (p
[0])
2158 #endif /* not (APOLLO || WINDOWSNT) */
2160 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2163 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2164 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2168 if (STRING_MULTIBYTE (filename
))
2169 return make_string (xnm
, x
- xnm
);
2170 return make_unibyte_string (xnm
, x
- xnm
);
2173 error ("Bad format environment-variable substitution");
2175 error ("Missing \"}\" in environment-variable substitution");
2177 error ("Substituting nonexistent environment variable \"%s\"", target
);
2180 #endif /* not VMS */
2183 /* A slightly faster and more convenient way to get
2184 (directory-file-name (expand-file-name FOO)). */
2187 expand_and_dir_to_file (filename
, defdir
)
2188 Lisp_Object filename
, defdir
;
2190 register Lisp_Object absname
;
2192 absname
= Fexpand_file_name (filename
, defdir
);
2195 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2196 if (c
== ':' || c
== ']' || c
== '>')
2197 absname
= Fdirectory_file_name (absname
);
2200 /* Remove final slash, if any (unless this is the root dir).
2201 stat behaves differently depending! */
2202 if (XSTRING (absname
)->size
> 1
2203 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2204 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2205 /* We cannot take shortcuts; they might be wrong for magic file names. */
2206 absname
= Fdirectory_file_name (absname
);
2211 /* Signal an error if the file ABSNAME already exists.
2212 If INTERACTIVE is nonzero, ask the user whether to proceed,
2213 and bypass the error if the user says to go ahead.
2214 QUERYSTRING is a name for the action that is being considered
2217 *STATPTR is used to store the stat information if the file exists.
2218 If the file does not exist, STATPTR->st_mode is set to 0.
2219 If STATPTR is null, we don't store into it.
2221 If QUICK is nonzero, we ask for y or n, not yes or no. */
2224 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2225 Lisp_Object absname
;
2226 unsigned char *querystring
;
2228 struct stat
*statptr
;
2231 register Lisp_Object tem
, encoded_filename
;
2232 struct stat statbuf
;
2233 struct gcpro gcpro1
;
2235 encoded_filename
= ENCODE_FILE (absname
);
2237 /* stat is a good way to tell whether the file exists,
2238 regardless of what access permissions it has. */
2239 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2242 Fsignal (Qfile_already_exists
,
2243 Fcons (build_string ("File already exists"),
2244 Fcons (absname
, Qnil
)));
2246 tem
= format1 ("File %s already exists; %s anyway? ",
2247 XSTRING (absname
)->data
, querystring
);
2249 tem
= Fy_or_n_p (tem
);
2251 tem
= do_yes_or_no_p (tem
);
2254 Fsignal (Qfile_already_exists
,
2255 Fcons (build_string ("File already exists"),
2256 Fcons (absname
, Qnil
)));
2263 statptr
->st_mode
= 0;
2268 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2269 "fCopy file: \nFCopy %s to file: \np\nP",
2270 "Copy FILE to NEWNAME. Both args must be strings.\n\
2271 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2272 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2273 A number as third arg means request confirmation if NEWNAME already exists.\n\
2274 This is what happens in interactive use with M-x.\n\
2275 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2276 last-modified time as the old one. (This works on only some systems.)\n\
2277 A prefix arg makes KEEP-TIME non-nil.")
2278 (file
, newname
, ok_if_already_exists
, keep_date
)
2279 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2282 char buf
[16 * 1024];
2283 struct stat st
, out_st
;
2284 Lisp_Object handler
;
2285 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2286 int count
= specpdl_ptr
- specpdl
;
2287 int input_file_statable_p
;
2288 Lisp_Object encoded_file
, encoded_newname
;
2290 encoded_file
= encoded_newname
= Qnil
;
2291 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2292 CHECK_STRING (file
, 0);
2293 CHECK_STRING (newname
, 1);
2295 file
= Fexpand_file_name (file
, Qnil
);
2296 newname
= Fexpand_file_name (newname
, Qnil
);
2298 /* If the input file name has special constructs in it,
2299 call the corresponding file handler. */
2300 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2301 /* Likewise for output file name. */
2303 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2304 if (!NILP (handler
))
2305 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2306 ok_if_already_exists
, keep_date
));
2308 encoded_file
= ENCODE_FILE (file
);
2309 encoded_newname
= ENCODE_FILE (newname
);
2311 if (NILP (ok_if_already_exists
)
2312 || INTEGERP (ok_if_already_exists
))
2313 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2314 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2315 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2318 ifd
= emacs_open (XSTRING (encoded_file
)->data
, O_RDONLY
, 0);
2320 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2322 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2324 /* We can only copy regular files and symbolic links. Other files are not
2326 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2328 #if !defined (DOS_NT) || __DJGPP__ > 1
2329 if (out_st
.st_mode
!= 0
2330 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2333 report_file_error ("Input and output files are the same",
2334 Fcons (file
, Fcons (newname
, Qnil
)));
2338 #if defined (S_ISREG) && defined (S_ISLNK)
2339 if (input_file_statable_p
)
2341 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2343 #if defined (EISDIR)
2344 /* Get a better looking error message. */
2347 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2350 #endif /* S_ISREG && S_ISLNK */
2353 /* Create the copy file with the same record format as the input file */
2354 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2357 /* System's default file type was set to binary by _fmode in emacs.c. */
2358 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2359 #else /* not MSDOS */
2360 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2361 #endif /* not MSDOS */
2364 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2366 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2370 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2371 if (emacs_write (ofd
, buf
, n
) != n
)
2372 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2375 /* Closing the output clobbers the file times on some systems. */
2376 if (emacs_close (ofd
) < 0)
2377 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2379 if (input_file_statable_p
)
2381 if (!NILP (keep_date
))
2383 EMACS_TIME atime
, mtime
;
2384 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2385 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2386 if (set_file_times (XSTRING (encoded_newname
)->data
,
2388 Fsignal (Qfile_date_error
,
2389 Fcons (build_string ("Cannot set file date"),
2390 Fcons (newname
, Qnil
)));
2393 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2395 #if defined (__DJGPP__) && __DJGPP__ > 1
2396 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2397 and if it can't, it tells so. Otherwise, under MSDOS we usually
2398 get only the READ bit, which will make the copied file read-only,
2399 so it's better not to chmod at all. */
2400 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2401 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2402 #endif /* DJGPP version 2 or newer */
2408 /* Discard the unwind protects. */
2409 specpdl_ptr
= specpdl
+ count
;
2415 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2416 Smake_directory_internal
, 1, 1, 0,
2417 "Create a new directory named DIRECTORY.")
2419 Lisp_Object directory
;
2422 Lisp_Object handler
;
2423 Lisp_Object encoded_dir
;
2425 CHECK_STRING (directory
, 0);
2426 directory
= Fexpand_file_name (directory
, Qnil
);
2428 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2429 if (!NILP (handler
))
2430 return call2 (handler
, Qmake_directory_internal
, directory
);
2432 encoded_dir
= ENCODE_FILE (directory
);
2434 dir
= XSTRING (encoded_dir
)->data
;
2437 if (mkdir (dir
) != 0)
2439 if (mkdir (dir
, 0777) != 0)
2441 report_file_error ("Creating directory", Flist (1, &directory
));
2446 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2447 "Delete the directory named DIRECTORY.")
2449 Lisp_Object directory
;
2452 Lisp_Object handler
;
2453 Lisp_Object encoded_dir
;
2455 CHECK_STRING (directory
, 0);
2456 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2458 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2459 if (!NILP (handler
))
2460 return call2 (handler
, Qdelete_directory
, directory
);
2462 encoded_dir
= ENCODE_FILE (directory
);
2464 dir
= XSTRING (encoded_dir
)->data
;
2466 if (rmdir (dir
) != 0)
2467 report_file_error ("Removing directory", Flist (1, &directory
));
2472 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2473 "Delete file named FILENAME.\n\
2474 If file has multiple names, it continues to exist with the other names.")
2476 Lisp_Object filename
;
2478 Lisp_Object handler
;
2479 Lisp_Object encoded_file
;
2481 CHECK_STRING (filename
, 0);
2482 filename
= Fexpand_file_name (filename
, Qnil
);
2484 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2485 if (!NILP (handler
))
2486 return call2 (handler
, Qdelete_file
, filename
);
2488 encoded_file
= ENCODE_FILE (filename
);
2490 if (0 > unlink (XSTRING (encoded_file
)->data
))
2491 report_file_error ("Removing old name", Flist (1, &filename
));
2496 internal_delete_file_1 (ignore
)
2502 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2505 internal_delete_file (filename
)
2506 Lisp_Object filename
;
2508 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2509 Qt
, internal_delete_file_1
));
2512 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2513 "fRename file: \nFRename %s to file: \np",
2514 "Rename FILE as NEWNAME. Both args strings.\n\
2515 If file has names other than FILE, it continues to have those names.\n\
2516 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2517 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2518 A number as third arg means request confirmation if NEWNAME already exists.\n\
2519 This is what happens in interactive use with M-x.")
2520 (file
, newname
, ok_if_already_exists
)
2521 Lisp_Object file
, newname
, ok_if_already_exists
;
2524 Lisp_Object args
[2];
2526 Lisp_Object handler
;
2527 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2528 Lisp_Object encoded_file
, encoded_newname
;
2530 encoded_file
= encoded_newname
= Qnil
;
2531 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2532 CHECK_STRING (file
, 0);
2533 CHECK_STRING (newname
, 1);
2534 file
= Fexpand_file_name (file
, Qnil
);
2535 newname
= Fexpand_file_name (newname
, Qnil
);
2537 /* If the file name has special constructs in it,
2538 call the corresponding file handler. */
2539 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2541 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2542 if (!NILP (handler
))
2543 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2544 file
, newname
, ok_if_already_exists
));
2546 encoded_file
= ENCODE_FILE (file
);
2547 encoded_newname
= ENCODE_FILE (newname
);
2550 /* If the file names are identical but for the case, don't ask for
2551 confirmation: they simply want to change the letter-case of the
2553 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2555 if (NILP (ok_if_already_exists
)
2556 || INTEGERP (ok_if_already_exists
))
2557 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2558 INTEGERP (ok_if_already_exists
), 0, 0);
2560 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2562 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2563 || 0 > unlink (XSTRING (encoded_file
)->data
))
2568 Fcopy_file (file
, newname
,
2569 /* We have already prompted if it was an integer,
2570 so don't have copy-file prompt again. */
2571 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2572 Fdelete_file (file
);
2579 report_file_error ("Renaming", Flist (2, args
));
2582 report_file_error ("Renaming", Flist (2, &file
));
2589 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2590 "fAdd name to file: \nFName to add to %s: \np",
2591 "Give FILE additional name NEWNAME. Both args strings.\n\
2592 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2593 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2594 A number as third arg means request confirmation if NEWNAME already exists.\n\
2595 This is what happens in interactive use with M-x.")
2596 (file
, newname
, ok_if_already_exists
)
2597 Lisp_Object file
, newname
, ok_if_already_exists
;
2600 Lisp_Object args
[2];
2602 Lisp_Object handler
;
2603 Lisp_Object encoded_file
, encoded_newname
;
2604 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2606 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2607 encoded_file
= encoded_newname
= Qnil
;
2608 CHECK_STRING (file
, 0);
2609 CHECK_STRING (newname
, 1);
2610 file
= Fexpand_file_name (file
, Qnil
);
2611 newname
= Fexpand_file_name (newname
, Qnil
);
2613 /* If the file name has special constructs in it,
2614 call the corresponding file handler. */
2615 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2616 if (!NILP (handler
))
2617 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2618 newname
, ok_if_already_exists
));
2620 /* If the new name has special constructs in it,
2621 call the corresponding file handler. */
2622 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2623 if (!NILP (handler
))
2624 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2625 newname
, ok_if_already_exists
));
2627 encoded_file
= ENCODE_FILE (file
);
2628 encoded_newname
= ENCODE_FILE (newname
);
2630 if (NILP (ok_if_already_exists
)
2631 || INTEGERP (ok_if_already_exists
))
2632 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2633 INTEGERP (ok_if_already_exists
), 0, 0);
2635 unlink (XSTRING (newname
)->data
);
2636 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2641 report_file_error ("Adding new name", Flist (2, args
));
2643 report_file_error ("Adding new name", Flist (2, &file
));
2652 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2653 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2654 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2655 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2656 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2657 A number as third arg means request confirmation if LINKNAME already exists.\n\
2658 This happens for interactive use with M-x.")
2659 (filename
, linkname
, ok_if_already_exists
)
2660 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2663 Lisp_Object args
[2];
2665 Lisp_Object handler
;
2666 Lisp_Object encoded_filename
, encoded_linkname
;
2667 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2669 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2670 encoded_filename
= encoded_linkname
= Qnil
;
2671 CHECK_STRING (filename
, 0);
2672 CHECK_STRING (linkname
, 1);
2673 /* If the link target has a ~, we must expand it to get
2674 a truly valid file name. Otherwise, do not expand;
2675 we want to permit links to relative file names. */
2676 if (XSTRING (filename
)->data
[0] == '~')
2677 filename
= Fexpand_file_name (filename
, Qnil
);
2678 linkname
= Fexpand_file_name (linkname
, Qnil
);
2680 /* If the file name has special constructs in it,
2681 call the corresponding file handler. */
2682 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2683 if (!NILP (handler
))
2684 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2685 linkname
, ok_if_already_exists
));
2687 /* If the new link name has special constructs in it,
2688 call the corresponding file handler. */
2689 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2690 if (!NILP (handler
))
2691 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2692 linkname
, ok_if_already_exists
));
2694 encoded_filename
= ENCODE_FILE (filename
);
2695 encoded_linkname
= ENCODE_FILE (linkname
);
2697 if (NILP (ok_if_already_exists
)
2698 || INTEGERP (ok_if_already_exists
))
2699 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2700 INTEGERP (ok_if_already_exists
), 0, 0);
2701 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2702 XSTRING (encoded_linkname
)->data
))
2704 /* If we didn't complain already, silently delete existing file. */
2705 if (errno
== EEXIST
)
2707 unlink (XSTRING (encoded_linkname
)->data
);
2708 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2709 XSTRING (encoded_linkname
)->data
))
2719 report_file_error ("Making symbolic link", Flist (2, args
));
2721 report_file_error ("Making symbolic link", Flist (2, &filename
));
2727 #endif /* S_IFLNK */
2731 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2732 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2733 "Define the job-wide logical name NAME to have the value STRING.\n\
2734 If STRING is nil or a null string, the logical name NAME is deleted.")
2739 CHECK_STRING (name
, 0);
2741 delete_logical_name (XSTRING (name
)->data
);
2744 CHECK_STRING (string
, 1);
2746 if (XSTRING (string
)->size
== 0)
2747 delete_logical_name (XSTRING (name
)->data
);
2749 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2758 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2759 "Open a network connection to PATH using LOGIN as the login string.")
2761 Lisp_Object path
, login
;
2765 CHECK_STRING (path
, 0);
2766 CHECK_STRING (login
, 0);
2768 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2770 if (netresult
== -1)
2775 #endif /* HPUX_NET */
2777 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2779 "Return t if file FILENAME specifies an absolute file name.\n\
2780 On Unix, this is a name starting with a `/' or a `~'.")
2782 Lisp_Object filename
;
2786 CHECK_STRING (filename
, 0);
2787 ptr
= XSTRING (filename
)->data
;
2788 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2790 /* ??? This criterion is probably wrong for '<'. */
2791 || index (ptr
, ':') || index (ptr
, '<')
2792 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2796 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2804 /* Return nonzero if file FILENAME exists and can be executed. */
2807 check_executable (filename
)
2811 int len
= strlen (filename
);
2814 if (stat (filename
, &st
) < 0)
2816 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2817 return ((st
.st_mode
& S_IEXEC
) != 0);
2819 return (S_ISREG (st
.st_mode
)
2821 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2822 || stricmp (suffix
, ".exe") == 0
2823 || stricmp (suffix
, ".bat") == 0)
2824 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2825 #endif /* not WINDOWSNT */
2826 #else /* not DOS_NT */
2827 #ifdef HAVE_EUIDACCESS
2828 return (euidaccess (filename
, 1) >= 0);
2830 /* Access isn't quite right because it uses the real uid
2831 and we really want to test with the effective uid.
2832 But Unix doesn't give us a right way to do it. */
2833 return (access (filename
, 1) >= 0);
2835 #endif /* not DOS_NT */
2838 /* Return nonzero if file FILENAME exists and can be written. */
2841 check_writable (filename
)
2846 if (stat (filename
, &st
) < 0)
2848 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2849 #else /* not MSDOS */
2850 #ifdef HAVE_EUIDACCESS
2851 return (euidaccess (filename
, 2) >= 0);
2853 /* Access isn't quite right because it uses the real uid
2854 and we really want to test with the effective uid.
2855 But Unix doesn't give us a right way to do it.
2856 Opening with O_WRONLY could work for an ordinary file,
2857 but would lose for directories. */
2858 return (access (filename
, 2) >= 0);
2860 #endif /* not MSDOS */
2863 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2864 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2865 See also `file-readable-p' and `file-attributes'.")
2867 Lisp_Object filename
;
2869 Lisp_Object absname
;
2870 Lisp_Object handler
;
2871 struct stat statbuf
;
2873 CHECK_STRING (filename
, 0);
2874 absname
= Fexpand_file_name (filename
, Qnil
);
2876 /* If the file name has special constructs in it,
2877 call the corresponding file handler. */
2878 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2879 if (!NILP (handler
))
2880 return call2 (handler
, Qfile_exists_p
, absname
);
2882 absname
= ENCODE_FILE (absname
);
2884 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2887 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2888 "Return t if FILENAME can be executed by you.\n\
2889 For a directory, this means you can access files in that directory.")
2891 Lisp_Object filename
;
2894 Lisp_Object absname
;
2895 Lisp_Object handler
;
2897 CHECK_STRING (filename
, 0);
2898 absname
= Fexpand_file_name (filename
, Qnil
);
2900 /* If the file name has special constructs in it,
2901 call the corresponding file handler. */
2902 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2903 if (!NILP (handler
))
2904 return call2 (handler
, Qfile_executable_p
, absname
);
2906 absname
= ENCODE_FILE (absname
);
2908 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2911 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2912 "Return t if file FILENAME exists and you can read it.\n\
2913 See also `file-exists-p' and `file-attributes'.")
2915 Lisp_Object filename
;
2917 Lisp_Object absname
;
2918 Lisp_Object handler
;
2921 struct stat statbuf
;
2923 CHECK_STRING (filename
, 0);
2924 absname
= Fexpand_file_name (filename
, Qnil
);
2926 /* If the file name has special constructs in it,
2927 call the corresponding file handler. */
2928 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2929 if (!NILP (handler
))
2930 return call2 (handler
, Qfile_readable_p
, absname
);
2932 absname
= ENCODE_FILE (absname
);
2935 /* Under MS-DOS and Windows, open does not work for directories. */
2936 if (access (XSTRING (absname
)->data
, 0) == 0)
2939 #else /* not DOS_NT */
2941 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2942 /* Opening a fifo without O_NONBLOCK can wait.
2943 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2944 except in the case of a fifo, on a system which handles it. */
2945 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2948 if (S_ISFIFO (statbuf
.st_mode
))
2949 flags
|= O_NONBLOCK
;
2951 desc
= emacs_open (XSTRING (absname
)->data
, flags
, 0);
2956 #endif /* not DOS_NT */
2959 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2961 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2962 "Return t if file FILENAME can be written or created by you.")
2964 Lisp_Object filename
;
2966 Lisp_Object absname
, dir
, encoded
;
2967 Lisp_Object handler
;
2968 struct stat statbuf
;
2970 CHECK_STRING (filename
, 0);
2971 absname
= Fexpand_file_name (filename
, Qnil
);
2973 /* If the file name has special constructs in it,
2974 call the corresponding file handler. */
2975 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2976 if (!NILP (handler
))
2977 return call2 (handler
, Qfile_writable_p
, absname
);
2979 encoded
= ENCODE_FILE (absname
);
2980 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2981 return (check_writable (XSTRING (encoded
)->data
)
2984 dir
= Ffile_name_directory (absname
);
2987 dir
= Fdirectory_file_name (dir
);
2991 dir
= Fdirectory_file_name (dir
);
2994 dir
= ENCODE_FILE (dir
);
2996 /* The read-only attribute of the parent directory doesn't affect
2997 whether a file or directory can be created within it. Some day we
2998 should check ACLs though, which do affect this. */
2999 if (stat (XSTRING (dir
)->data
, &statbuf
) < 0)
3001 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3003 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
3008 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3009 "Access file FILENAME, and get an error if that does not work.\n\
3010 The second argument STRING is used in the error message.\n\
3011 If there is no error, we return nil.")
3013 Lisp_Object filename
, string
;
3015 Lisp_Object handler
, encoded_filename
;
3018 CHECK_STRING (filename
, 0);
3019 CHECK_STRING (string
, 1);
3021 /* If the file name has special constructs in it,
3022 call the corresponding file handler. */
3023 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
3024 if (!NILP (handler
))
3025 return call3 (handler
, Qaccess_file
, filename
, string
);
3027 encoded_filename
= ENCODE_FILE (filename
);
3029 fd
= emacs_open (XSTRING (encoded_filename
)->data
, O_RDONLY
, 0);
3031 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
3037 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3038 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
3039 The value is the name of the file to which it is linked.\n\
3040 Otherwise returns nil.")
3042 Lisp_Object filename
;
3049 Lisp_Object handler
;
3051 CHECK_STRING (filename
, 0);
3052 filename
= Fexpand_file_name (filename
, Qnil
);
3054 /* If the file name has special constructs in it,
3055 call the corresponding file handler. */
3056 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3057 if (!NILP (handler
))
3058 return call2 (handler
, Qfile_symlink_p
, filename
);
3060 filename
= ENCODE_FILE (filename
);
3065 buf
= (char *) xmalloc (bufsize
);
3066 bzero (buf
, bufsize
);
3067 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3068 if (valsize
< bufsize
) break;
3069 /* Buffer was not long enough */
3078 val
= make_string (buf
, valsize
);
3079 if (buf
[0] == '/' && index (buf
, ':'))
3080 val
= concat2 (build_string ("/:"), val
);
3082 val
= DECODE_FILE (val
);
3084 #else /* not S_IFLNK */
3086 #endif /* not S_IFLNK */
3089 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3090 "Return t if FILENAME names an existing directory.\n\
3091 Symbolic links to directories count as directories.\n\
3092 See `file-symlink-p' to distinguish symlinks.")
3094 Lisp_Object filename
;
3096 register Lisp_Object absname
;
3098 Lisp_Object handler
;
3100 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3102 /* If the file name has special constructs in it,
3103 call the corresponding file handler. */
3104 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3105 if (!NILP (handler
))
3106 return call2 (handler
, Qfile_directory_p
, absname
);
3108 absname
= ENCODE_FILE (absname
);
3110 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3112 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3115 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3116 "Return t if file FILENAME is the name of a directory as a file,\n\
3117 and files in that directory can be opened by you. In order to use a\n\
3118 directory as a buffer's current directory, this predicate must return true.\n\
3119 A directory name spec may be given instead; then the value is t\n\
3120 if the directory so specified exists and really is a readable and\n\
3121 searchable directory.")
3123 Lisp_Object filename
;
3125 Lisp_Object handler
;
3127 struct gcpro gcpro1
;
3129 /* If the file name has special constructs in it,
3130 call the corresponding file handler. */
3131 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3132 if (!NILP (handler
))
3133 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3135 /* It's an unlikely combination, but yes we really do need to gcpro:
3136 Suppose that file-accessible-directory-p has no handler, but
3137 file-directory-p does have a handler; this handler causes a GC which
3138 relocates the string in `filename'; and finally file-directory-p
3139 returns non-nil. Then we would end up passing a garbaged string
3140 to file-executable-p. */
3142 tem
= (NILP (Ffile_directory_p (filename
))
3143 || NILP (Ffile_executable_p (filename
)));
3145 return tem
? Qnil
: Qt
;
3148 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3149 "Return t if file FILENAME is the name of a regular file.\n\
3150 This is the sort of file that holds an ordinary stream of data bytes.")
3152 Lisp_Object filename
;
3154 register Lisp_Object absname
;
3156 Lisp_Object handler
;
3158 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3160 /* If the file name has special constructs in it,
3161 call the corresponding file handler. */
3162 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3163 if (!NILP (handler
))
3164 return call2 (handler
, Qfile_regular_p
, absname
);
3166 absname
= ENCODE_FILE (absname
);
3171 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3173 /* Tell stat to use expensive method to get accurate info. */
3174 Vw32_get_true_file_attributes
= Qt
;
3175 result
= stat (XSTRING (absname
)->data
, &st
);
3176 Vw32_get_true_file_attributes
= tem
;
3180 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3183 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3185 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3189 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3190 "Return mode bits of file named FILENAME, as an integer.")
3192 Lisp_Object filename
;
3194 Lisp_Object absname
;
3196 Lisp_Object handler
;
3198 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3200 /* If the file name has special constructs in it,
3201 call the corresponding file handler. */
3202 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3203 if (!NILP (handler
))
3204 return call2 (handler
, Qfile_modes
, absname
);
3206 absname
= ENCODE_FILE (absname
);
3208 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3210 #if defined (MSDOS) && __DJGPP__ < 2
3211 if (check_executable (XSTRING (absname
)->data
))
3212 st
.st_mode
|= S_IEXEC
;
3213 #endif /* MSDOS && __DJGPP__ < 2 */
3215 return make_number (st
.st_mode
& 07777);
3218 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3219 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3220 Only the 12 low bits of MODE are used.")
3222 Lisp_Object filename
, mode
;
3224 Lisp_Object absname
, encoded_absname
;
3225 Lisp_Object handler
;
3227 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3228 CHECK_NUMBER (mode
, 1);
3230 /* If the file name has special constructs in it,
3231 call the corresponding file handler. */
3232 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3233 if (!NILP (handler
))
3234 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3236 encoded_absname
= ENCODE_FILE (absname
);
3238 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3239 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3244 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3245 "Set the file permission bits for newly created files.\n\
3246 The argument MODE should be an integer; only the low 9 bits are used.\n\
3247 This setting is inherited by subprocesses.")
3251 CHECK_NUMBER (mode
, 0);
3253 umask ((~ XINT (mode
)) & 0777);
3258 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3259 "Return the default file protection for created files.\n\
3260 The value is an integer.")
3266 realmask
= umask (0);
3269 XSETINT (value
, (~ realmask
) & 0777);
3279 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3280 "Tell Unix to finish all pending disk updates.")
3289 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3290 "Return t if file FILE1 is newer than file FILE2.\n\
3291 If FILE1 does not exist, the answer is nil;\n\
3292 otherwise, if FILE2 does not exist, the answer is t.")
3294 Lisp_Object file1
, file2
;
3296 Lisp_Object absname1
, absname2
;
3299 Lisp_Object handler
;
3300 struct gcpro gcpro1
, gcpro2
;
3302 CHECK_STRING (file1
, 0);
3303 CHECK_STRING (file2
, 0);
3306 GCPRO2 (absname1
, file2
);
3307 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3308 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3311 /* If the file name has special constructs in it,
3312 call the corresponding file handler. */
3313 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3315 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3316 if (!NILP (handler
))
3317 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3319 GCPRO2 (absname1
, absname2
);
3320 absname1
= ENCODE_FILE (absname1
);
3321 absname2
= ENCODE_FILE (absname2
);
3324 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3327 mtime1
= st
.st_mtime
;
3329 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3332 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3336 Lisp_Object Qfind_buffer_file_type
;
3339 #ifndef READ_BUF_SIZE
3340 #define READ_BUF_SIZE (64 << 10)
3343 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3345 /* This function is called after Lisp functions to decide a coding
3346 system are called, or when they cause an error. Before they are
3347 called, the current buffer is set unibyte and it contains only a
3348 newly inserted text (thus the buffer was empty before the
3351 The functions may set markers, overlays, text properties, or even
3352 alter the buffer contents, change the current buffer.
3354 Here, we reset all those changes by:
3355 o set back the current buffer.
3356 o move all markers and overlays to BEG.
3357 o remove all text properties.
3358 o set back the buffer multibyteness. */
3361 decide_coding_unwind (unwind_data
)
3362 Lisp_Object unwind_data
;
3364 Lisp_Object multibyte
, undo_list
, buffer
;
3366 multibyte
= XCAR (unwind_data
);
3367 unwind_data
= XCDR (unwind_data
);
3368 undo_list
= XCAR (unwind_data
);
3369 buffer
= XCDR (unwind_data
);
3371 if (current_buffer
!= XBUFFER (buffer
))
3372 set_buffer_internal (XBUFFER (buffer
));
3373 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3374 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3375 BUF_INTERVALS (current_buffer
) = 0;
3376 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3378 /* Now we are safe to change the buffer's multibyteness directly. */
3379 current_buffer
->enable_multibyte_characters
= multibyte
;
3380 current_buffer
->undo_list
= undo_list
;
3385 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3387 "Insert contents of file FILENAME after point.\n\
3388 Returns list of absolute file name and number of bytes inserted.\n\
3389 If second argument VISIT is non-nil, the buffer's visited filename\n\
3390 and last save file modtime are set, and it is marked unmodified.\n\
3391 If visiting and the file does not exist, visiting is completed\n\
3392 before the error is signaled.\n\
3393 The optional third and fourth arguments BEG and END\n\
3394 specify what portion of the file to insert.\n\
3395 These arguments count bytes in the file, not characters in the buffer.\n\
3396 If VISIT is non-nil, BEG and END must be nil.\n\
3398 If optional fifth argument REPLACE is non-nil,\n\
3399 it means replace the current buffer contents (in the accessible portion)\n\
3400 with the file contents. This is better than simply deleting and inserting\n\
3401 the whole thing because (1) it preserves some marker positions\n\
3402 and (2) it puts less data in the undo list.\n\
3403 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3404 which is often less than the number of characters to be read.\n\
3406 This does code conversion according to the value of\n\
3407 `coding-system-for-read' or `file-coding-system-alist',\n\
3408 and sets the variable `last-coding-system-used' to the coding system\n\
3410 (filename
, visit
, beg
, end
, replace
)
3411 Lisp_Object filename
, visit
, beg
, end
, replace
;
3416 register int how_much
;
3417 register int unprocessed
;
3418 int count
= specpdl_ptr
- specpdl
;
3419 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3420 Lisp_Object handler
, val
, insval
, orig_filename
;
3423 int not_regular
= 0;
3424 unsigned char read_buf
[READ_BUF_SIZE
];
3425 struct coding_system coding
;
3426 unsigned char buffer
[1 << 14];
3427 int replace_handled
= 0;
3428 int set_coding_system
= 0;
3429 int coding_system_decided
= 0;
3431 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3432 error ("Cannot do file visiting in an indirect buffer");
3434 if (!NILP (current_buffer
->read_only
))
3435 Fbarf_if_buffer_read_only ();
3439 orig_filename
= Qnil
;
3441 GCPRO4 (filename
, val
, p
, orig_filename
);
3443 CHECK_STRING (filename
, 0);
3444 filename
= Fexpand_file_name (filename
, Qnil
);
3446 /* If the file name has special constructs in it,
3447 call the corresponding file handler. */
3448 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3449 if (!NILP (handler
))
3451 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3452 visit
, beg
, end
, replace
);
3453 if (CONSP (val
) && CONSP (XCDR (val
)))
3454 inserted
= XINT (XCAR (XCDR (val
)));
3458 orig_filename
= filename
;
3459 filename
= ENCODE_FILE (filename
);
3465 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3467 /* Tell stat to use expensive method to get accurate info. */
3468 Vw32_get_true_file_attributes
= Qt
;
3469 total
= stat (XSTRING (filename
)->data
, &st
);
3470 Vw32_get_true_file_attributes
= tem
;
3475 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3477 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0
3478 || fstat (fd
, &st
) < 0)
3479 #endif /* not APOLLO */
3480 #endif /* WINDOWSNT */
3482 if (fd
>= 0) emacs_close (fd
);
3485 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3488 if (!NILP (Vcoding_system_for_read
))
3489 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3494 /* This code will need to be changed in order to work on named
3495 pipes, and it's probably just not worth it. So we should at
3496 least signal an error. */
3497 if (!S_ISREG (st
.st_mode
))
3504 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3505 Fsignal (Qfile_error
,
3506 Fcons (build_string ("not a regular file"),
3507 Fcons (orig_filename
, Qnil
)));
3512 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0)
3515 /* Replacement should preserve point as it preserves markers. */
3516 if (!NILP (replace
))
3517 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3519 record_unwind_protect (close_file_unwind
, make_number (fd
));
3521 /* Supposedly happens on VMS. */
3522 if (! not_regular
&& st
.st_size
< 0)
3523 error ("File size is negative");
3525 /* Prevent redisplay optimizations. */
3526 current_buffer
->clip_changed
= 1;
3530 if (!NILP (beg
) || !NILP (end
))
3531 error ("Attempt to visit less than an entire file");
3532 if (BEG
< Z
&& NILP (replace
))
3533 error ("Cannot do file visiting in a non-empty buffer");
3537 CHECK_NUMBER (beg
, 0);
3539 XSETFASTINT (beg
, 0);
3542 CHECK_NUMBER (end
, 0);
3547 XSETINT (end
, st
.st_size
);
3549 /* Arithmetic overflow can occur if an Emacs integer cannot
3550 represent the file size, or if the calculations below
3551 overflow. The calculations below double the file size
3552 twice, so check that it can be multiplied by 4 safely. */
3553 if (XINT (end
) != st
.st_size
3554 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3555 error ("Maximum buffer size exceeded");
3561 /* Decide the coding system to use for reading the file now
3562 because we can't use an optimized method for handling
3563 `coding:' tag if the current buffer is not empty. */
3567 if (!NILP (Vcoding_system_for_read
))
3568 val
= Vcoding_system_for_read
;
3569 else if (! NILP (replace
))
3570 /* In REPLACE mode, we can use the same coding system
3571 that was used to visit the file. */
3572 val
= current_buffer
->buffer_file_coding_system
;
3575 /* Don't try looking inside a file for a coding system
3576 specification if it is not seekable. */
3577 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3579 /* Find a coding system specified in the heading two
3580 lines or in the tailing several lines of the file.
3581 We assume that the 1K-byte and 3K-byte for heading
3582 and tailing respectively are sufficient for this
3586 if (st
.st_size
<= (1024 * 4))
3587 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3590 nread
= emacs_read (fd
, read_buf
, 1024);
3593 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3594 report_file_error ("Setting file position",
3595 Fcons (orig_filename
, Qnil
));
3596 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3601 error ("IO error reading %s: %s",
3602 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3605 struct buffer
*prev
= current_buffer
;
3608 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3610 /* The call to temp_output_buffer_setup binds
3612 count1
= specpdl_ptr
- specpdl
;
3613 temp_output_buffer_setup (" *code-converting-work*");
3615 set_buffer_internal (XBUFFER (Vstandard_output
));
3616 current_buffer
->enable_multibyte_characters
= Qnil
;
3617 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3618 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3619 val
= call2 (Vset_auto_coding_function
,
3620 filename
, make_number (nread
));
3621 set_buffer_internal (prev
);
3623 /* Remove the binding for standard-output. */
3624 unbind_to (count1
, Qnil
);
3626 /* Discard the unwind protect for recovering the
3630 /* Rewind the file for the actual read done later. */
3631 if (lseek (fd
, 0, 0) < 0)
3632 report_file_error ("Setting file position",
3633 Fcons (orig_filename
, Qnil
));
3639 /* If we have not yet decided a coding system, check
3640 file-coding-system-alist. */
3641 Lisp_Object args
[6], coding_systems
;
3643 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3644 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3645 coding_systems
= Ffind_operation_coding_system (6, args
);
3646 if (CONSP (coding_systems
))
3647 val
= XCAR (coding_systems
);
3651 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3652 /* Ensure we set Vlast_coding_system_used. */
3653 set_coding_system
= 1;
3655 if (NILP (current_buffer
->enable_multibyte_characters
)
3657 /* We must suppress all character code conversion except for
3658 end-of-line conversion. */
3659 setup_raw_text_coding_system (&coding
);
3661 coding
.src_multibyte
= 0;
3662 coding
.dst_multibyte
3663 = !NILP (current_buffer
->enable_multibyte_characters
);
3664 coding_system_decided
= 1;
3667 /* If requested, replace the accessible part of the buffer
3668 with the file contents. Avoid replacing text at the
3669 beginning or end of the buffer that matches the file contents;
3670 that preserves markers pointing to the unchanged parts.
3672 Here we implement this feature in an optimized way
3673 for the case where code conversion is NOT needed.
3674 The following if-statement handles the case of conversion
3675 in a less optimal way.
3677 If the code conversion is "automatic" then we try using this
3678 method and hope for the best.
3679 But if we discover the need for conversion, we give up on this method
3680 and let the following if-statement handle the replace job. */
3683 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3685 /* same_at_start and same_at_end count bytes,
3686 because file access counts bytes
3687 and BEG and END count bytes. */
3688 int same_at_start
= BEGV_BYTE
;
3689 int same_at_end
= ZV_BYTE
;
3691 /* There is still a possibility we will find the need to do code
3692 conversion. If that happens, we set this variable to 1 to
3693 give up on handling REPLACE in the optimized way. */
3694 int giveup_match_end
= 0;
3696 if (XINT (beg
) != 0)
3698 if (lseek (fd
, XINT (beg
), 0) < 0)
3699 report_file_error ("Setting file position",
3700 Fcons (orig_filename
, Qnil
));
3705 /* Count how many chars at the start of the file
3706 match the text at the beginning of the buffer. */
3711 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3713 error ("IO error reading %s: %s",
3714 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3715 else if (nread
== 0)
3718 if (coding
.type
== coding_type_undecided
)
3719 detect_coding (&coding
, buffer
, nread
);
3720 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3721 /* We found that the file should be decoded somehow.
3722 Let's give up here. */
3724 giveup_match_end
= 1;
3728 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3729 detect_eol (&coding
, buffer
, nread
);
3730 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3731 && coding
.eol_type
!= CODING_EOL_LF
)
3732 /* We found that the format of eol should be decoded.
3733 Let's give up here. */
3735 giveup_match_end
= 1;
3740 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3741 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3742 same_at_start
++, bufpos
++;
3743 /* If we found a discrepancy, stop the scan.
3744 Otherwise loop around and scan the next bufferful. */
3745 if (bufpos
!= nread
)
3749 /* If the file matches the buffer completely,
3750 there's no need to replace anything. */
3751 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3755 /* Truncate the buffer to the size of the file. */
3756 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3761 /* Count how many chars at the end of the file
3762 match the text at the end of the buffer. But, if we have
3763 already found that decoding is necessary, don't waste time. */
3764 while (!giveup_match_end
)
3766 int total_read
, nread
, bufpos
, curpos
, trial
;
3768 /* At what file position are we now scanning? */
3769 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3770 /* If the entire file matches the buffer tail, stop the scan. */
3773 /* How much can we scan in the next step? */
3774 trial
= min (curpos
, sizeof buffer
);
3775 if (lseek (fd
, curpos
- trial
, 0) < 0)
3776 report_file_error ("Setting file position",
3777 Fcons (orig_filename
, Qnil
));
3780 while (total_read
< trial
)
3782 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3784 error ("IO error reading %s: %s",
3785 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3786 total_read
+= nread
;
3788 /* Scan this bufferful from the end, comparing with
3789 the Emacs buffer. */
3790 bufpos
= total_read
;
3791 /* Compare with same_at_start to avoid counting some buffer text
3792 as matching both at the file's beginning and at the end. */
3793 while (bufpos
> 0 && same_at_end
> same_at_start
3794 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3795 same_at_end
--, bufpos
--;
3797 /* If we found a discrepancy, stop the scan.
3798 Otherwise loop around and scan the preceding bufferful. */
3801 /* If this discrepancy is because of code conversion,
3802 we cannot use this method; giveup and try the other. */
3803 if (same_at_end
> same_at_start
3804 && FETCH_BYTE (same_at_end
- 1) >= 0200
3805 && ! NILP (current_buffer
->enable_multibyte_characters
)
3806 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3807 giveup_match_end
= 1;
3813 if (! giveup_match_end
)
3817 /* We win! We can handle REPLACE the optimized way. */
3819 /* Extend the start of non-matching text area to multibyte
3820 character boundary. */
3821 if (! NILP (current_buffer
->enable_multibyte_characters
))
3822 while (same_at_start
> BEGV_BYTE
3823 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3826 /* Extend the end of non-matching text area to multibyte
3827 character boundary. */
3828 if (! NILP (current_buffer
->enable_multibyte_characters
))
3829 while (same_at_end
< ZV_BYTE
3830 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3833 /* Don't try to reuse the same piece of text twice. */
3834 overlap
= (same_at_start
- BEGV_BYTE
3835 - (same_at_end
+ st
.st_size
- ZV
));
3837 same_at_end
+= overlap
;
3839 /* Arrange to read only the nonmatching middle part of the file. */
3840 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3841 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3843 del_range_byte (same_at_start
, same_at_end
, 0);
3844 /* Insert from the file at the proper position. */
3845 temp
= BYTE_TO_CHAR (same_at_start
);
3846 SET_PT_BOTH (temp
, same_at_start
);
3848 /* If display currently starts at beginning of line,
3849 keep it that way. */
3850 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3851 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3853 replace_handled
= 1;
3857 /* If requested, replace the accessible part of the buffer
3858 with the file contents. Avoid replacing text at the
3859 beginning or end of the buffer that matches the file contents;
3860 that preserves markers pointing to the unchanged parts.
3862 Here we implement this feature for the case where code conversion
3863 is needed, in a simple way that needs a lot of memory.
3864 The preceding if-statement handles the case of no conversion
3865 in a more optimized way. */
3866 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3868 int same_at_start
= BEGV_BYTE
;
3869 int same_at_end
= ZV_BYTE
;
3872 /* Make sure that the gap is large enough. */
3873 int bufsize
= 2 * st
.st_size
;
3874 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3877 /* First read the whole file, performing code conversion into
3878 CONVERSION_BUFFER. */
3880 if (lseek (fd
, XINT (beg
), 0) < 0)
3882 xfree (conversion_buffer
);
3883 report_file_error ("Setting file position",
3884 Fcons (orig_filename
, Qnil
));
3887 total
= st
.st_size
; /* Total bytes in the file. */
3888 how_much
= 0; /* Bytes read from file so far. */
3889 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3890 unprocessed
= 0; /* Bytes not processed in previous loop. */
3892 while (how_much
< total
)
3894 /* try is reserved in some compilers (Microsoft C) */
3895 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3896 unsigned char *destination
= read_buf
+ unprocessed
;
3899 /* Allow quitting out of the actual I/O. */
3902 this = emacs_read (fd
, destination
, trytry
);
3905 if (this < 0 || this + unprocessed
== 0)
3913 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3915 int require
, result
;
3917 this += unprocessed
;
3919 /* If we are using more space than estimated,
3920 make CONVERSION_BUFFER bigger. */
3921 require
= decoding_buffer_size (&coding
, this);
3922 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3924 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3925 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3928 /* Convert this batch with results in CONVERSION_BUFFER. */
3929 if (how_much
>= total
) /* This is the last block. */
3930 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3931 result
= decode_coding (&coding
, read_buf
,
3932 conversion_buffer
+ inserted
,
3933 this, bufsize
- inserted
);
3935 /* Save for next iteration whatever we didn't convert. */
3936 unprocessed
= this - coding
.consumed
;
3937 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3938 if (!NILP (current_buffer
->enable_multibyte_characters
))
3939 this = coding
.produced
;
3941 this = str_as_unibyte (conversion_buffer
+ inserted
,
3948 /* At this point, INSERTED is how many characters (i.e. bytes)
3949 are present in CONVERSION_BUFFER.
3950 HOW_MUCH should equal TOTAL,
3951 or should be <= 0 if we couldn't read the file. */
3955 xfree (conversion_buffer
);
3958 error ("IO error reading %s: %s",
3959 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3960 else if (how_much
== -2)
3961 error ("maximum buffer size exceeded");
3964 /* Compare the beginning of the converted file
3965 with the buffer text. */
3968 while (bufpos
< inserted
&& same_at_start
< same_at_end
3969 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3970 same_at_start
++, bufpos
++;
3972 /* If the file matches the buffer completely,
3973 there's no need to replace anything. */
3975 if (bufpos
== inserted
)
3977 xfree (conversion_buffer
);
3980 /* Truncate the buffer to the size of the file. */
3981 del_range_byte (same_at_start
, same_at_end
, 0);
3986 /* Extend the start of non-matching text area to multibyte
3987 character boundary. */
3988 if (! NILP (current_buffer
->enable_multibyte_characters
))
3989 while (same_at_start
> BEGV_BYTE
3990 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3993 /* Scan this bufferful from the end, comparing with
3994 the Emacs buffer. */
3997 /* Compare with same_at_start to avoid counting some buffer text
3998 as matching both at the file's beginning and at the end. */
3999 while (bufpos
> 0 && same_at_end
> same_at_start
4000 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4001 same_at_end
--, bufpos
--;
4003 /* Extend the end of non-matching text area to multibyte
4004 character boundary. */
4005 if (! NILP (current_buffer
->enable_multibyte_characters
))
4006 while (same_at_end
< ZV_BYTE
4007 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4010 /* Don't try to reuse the same piece of text twice. */
4011 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4013 same_at_end
+= overlap
;
4015 /* If display currently starts at beginning of line,
4016 keep it that way. */
4017 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4018 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4020 /* Replace the chars that we need to replace,
4021 and update INSERTED to equal the number of bytes
4022 we are taking from the file. */
4023 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4025 if (same_at_end
!= same_at_start
)
4027 del_range_byte (same_at_start
, same_at_end
, 0);
4029 same_at_start
= GPT_BYTE
;
4033 temp
= BYTE_TO_CHAR (same_at_start
);
4035 /* Insert from the file at the proper position. */
4036 SET_PT_BOTH (temp
, same_at_start
);
4037 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4039 /* Set `inserted' to the number of inserted characters. */
4040 inserted
= PT
- temp
;
4042 xfree (conversion_buffer
);
4051 register Lisp_Object temp
;
4053 total
= XINT (end
) - XINT (beg
);
4055 /* Make sure point-max won't overflow after this insertion. */
4056 XSETINT (temp
, total
);
4057 if (total
!= XINT (temp
))
4058 error ("Maximum buffer size exceeded");
4061 /* For a special file, all we can do is guess. */
4062 total
= READ_BUF_SIZE
;
4064 if (NILP (visit
) && total
> 0)
4065 prepare_to_modify_buffer (PT
, PT
, NULL
);
4068 if (GAP_SIZE
< total
)
4069 make_gap (total
- GAP_SIZE
);
4071 if (XINT (beg
) != 0 || !NILP (replace
))
4073 if (lseek (fd
, XINT (beg
), 0) < 0)
4074 report_file_error ("Setting file position",
4075 Fcons (orig_filename
, Qnil
));
4078 /* In the following loop, HOW_MUCH contains the total bytes read so
4079 far for a regular file, and not changed for a special file. But,
4080 before exiting the loop, it is set to a negative value if I/O
4083 /* Total bytes inserted. */
4085 /* Here, we don't do code conversion in the loop. It is done by
4086 code_convert_region after all data are read into the buffer. */
4087 while (how_much
< total
)
4089 /* try is reserved in some compilers (Microsoft C) */
4090 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4093 /* For a special file, GAP_SIZE should be checked every time. */
4094 if (not_regular
&& GAP_SIZE
< trytry
)
4095 make_gap (total
- GAP_SIZE
);
4097 /* Allow quitting out of the actual I/O. */
4100 this = emacs_read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1,
4118 /* For a regular file, where TOTAL is the real size,
4119 count HOW_MUCH to compare with it.
4120 For a special file, where TOTAL is just a buffer size,
4121 so don't bother counting in HOW_MUCH.
4122 (INSERTED is where we count the number of characters inserted.) */
4129 /* Put an anchor to ensure multi-byte form ends at gap. */
4134 /* Discard the unwind protect for closing the file. */
4138 error ("IO error reading %s: %s",
4139 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4143 if (! coding_system_decided
)
4145 /* The coding system is not yet decided. Decide it by an
4146 optimized method for handling `coding:' tag.
4148 Note that we can get here only if the buffer was empty
4149 before the insertion. */
4153 if (!NILP (Vcoding_system_for_read
))
4154 val
= Vcoding_system_for_read
;
4157 /* Since we are sure that the current buffer was empty
4158 before the insertion, we can toggle
4159 enable-multibyte-characters directly here without taking
4160 care of marker adjustment and byte combining problem. By
4161 this way, we can run Lisp program safely before decoding
4162 the inserted text. */
4163 Lisp_Object unwind_data
;
4164 int count
= specpdl_ptr
- specpdl
;
4166 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4167 Fcons (current_buffer
->undo_list
,
4168 Fcurrent_buffer ()));
4169 current_buffer
->enable_multibyte_characters
= Qnil
;
4170 current_buffer
->undo_list
= Qt
;
4171 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4173 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4175 val
= call2 (Vset_auto_coding_function
,
4176 filename
, make_number (inserted
));
4181 /* If the coding system is not yet decided, check
4182 file-coding-system-alist. */
4183 Lisp_Object args
[6], coding_systems
;
4185 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4186 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4187 coding_systems
= Ffind_operation_coding_system (6, args
);
4188 if (CONSP (coding_systems
))
4189 val
= XCAR (coding_systems
);
4192 unbind_to (count
, Qnil
);
4193 inserted
= Z_BYTE
- BEG_BYTE
;
4196 /* The following kludgy code is to avoid some compiler bug.
4198 setup_coding_system (val, &coding);
4201 struct coding_system temp_coding
;
4202 setup_coding_system (val
, &temp_coding
);
4203 bcopy (&temp_coding
, &coding
, sizeof coding
);
4205 /* Ensure we set Vlast_coding_system_used. */
4206 set_coding_system
= 1;
4208 if (NILP (current_buffer
->enable_multibyte_characters
)
4210 /* We must suppress all character code conversion except for
4211 end-of-line conversion. */
4212 setup_raw_text_coding_system (&coding
);
4213 coding
.src_multibyte
= 0;
4214 coding
.dst_multibyte
4215 = !NILP (current_buffer
->enable_multibyte_characters
);
4219 && (coding
.type
== coding_type_no_conversion
4220 || coding
.type
== coding_type_raw_text
))
4222 /* Visiting a file with these coding system always make the buffer
4224 current_buffer
->enable_multibyte_characters
= Qnil
;
4225 coding
.dst_multibyte
= 0;
4228 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4230 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4232 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4234 inserted
= coding
.produced_char
;
4237 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4242 /* Use the conversion type to determine buffer-file-type
4243 (find-buffer-file-type is now used to help determine the
4245 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4246 || coding
.eol_type
== CODING_EOL_LF
)
4247 && ! CODING_REQUIRE_DECODING (&coding
))
4248 current_buffer
->buffer_file_type
= Qt
;
4250 current_buffer
->buffer_file_type
= Qnil
;
4257 if (!EQ (current_buffer
->undo_list
, Qt
))
4258 current_buffer
->undo_list
= Qnil
;
4260 stat (XSTRING (filename
)->data
, &st
);
4265 current_buffer
->modtime
= st
.st_mtime
;
4266 current_buffer
->filename
= orig_filename
;
4269 SAVE_MODIFF
= MODIFF
;
4270 current_buffer
->auto_save_modified
= MODIFF
;
4271 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4272 #ifdef CLASH_DETECTION
4275 if (!NILP (current_buffer
->file_truename
))
4276 unlock_file (current_buffer
->file_truename
);
4277 unlock_file (filename
);
4279 #endif /* CLASH_DETECTION */
4281 Fsignal (Qfile_error
,
4282 Fcons (build_string ("not a regular file"),
4283 Fcons (orig_filename
, Qnil
)));
4286 /* Decode file format */
4289 insval
= call3 (Qformat_decode
,
4290 Qnil
, make_number (inserted
), visit
);
4291 CHECK_NUMBER (insval
, 0);
4292 inserted
= XFASTINT (insval
);
4295 if (set_coding_system
)
4296 Vlast_coding_system_used
= coding
.symbol
;
4298 /* Call after-change hooks for the inserted text, aside from the case
4299 of normal visiting (not with REPLACE), which is done in a new buffer
4300 "before" the buffer is changed. */
4301 if (inserted
> 0 && total
> 0
4302 && (NILP (visit
) || !NILP (replace
)))
4304 signal_after_change (PT
, 0, inserted
);
4305 update_compositions (PT
, PT
, CHECK_BORDER
);
4308 p
= Vafter_insert_file_functions
;
4311 insval
= call1 (Fcar (p
), make_number (inserted
));
4314 CHECK_NUMBER (insval
, 0);
4315 inserted
= XFASTINT (insval
);
4322 && current_buffer
->modtime
== -1)
4324 /* If visiting nonexistent file, return nil. */
4325 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4328 /* ??? Retval needs to be dealt with in all cases consistently. */
4330 val
= Fcons (orig_filename
,
4331 Fcons (make_number (inserted
),
4334 RETURN_UNGCPRO (unbind_to (count
, val
));
4337 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4340 /* If build_annotations switched buffers, switch back to BUF.
4341 Kill the temporary buffer that was selected in the meantime.
4343 Since this kill only the last temporary buffer, some buffers remain
4344 not killed if build_annotations switched buffers more than once.
4348 build_annotations_unwind (buf
)
4353 if (XBUFFER (buf
) == current_buffer
)
4355 tembuf
= Fcurrent_buffer ();
4357 Fkill_buffer (tembuf
);
4361 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4362 "r\nFWrite region to file: \ni\ni\ni\np",
4363 "Write current region into specified file.\n\
4364 When called from a program, takes three arguments:\n\
4365 START, END and FILENAME. START and END are buffer positions.\n\
4366 Optional fourth argument APPEND if non-nil means\n\
4367 append to existing file contents (if any). If it is an integer,\n\
4368 seek to that offset in the file before writing.\n\
4369 Optional fifth argument VISIT if t means\n\
4370 set the last-save-file-modtime of buffer to this file's modtime\n\
4371 and mark buffer not modified.\n\
4372 If VISIT is a string, it is a second file name;\n\
4373 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4374 VISIT is also the file name to lock and unlock for clash detection.\n\
4375 If VISIT is neither t nor nil nor a string,\n\
4376 that means do not print the \"Wrote file\" message.\n\
4377 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4378 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4379 The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
4380 for an existing file with the same name. If MUSTBENEW is `excl',\n\
4381 that means to get an error if the file already exists; never overwrite.\n\
4382 If MUSTBENEW is neither nil nor `excl', that means ask for\n\
4383 confirmation before overwriting, but do go ahead and overwrite the file\n\
4384 if the user confirms.\n\
4385 Kludgy feature: if START is a string, then that string is written\n\
4386 to the file, instead of any buffer contents, and END is ignored.\n\
4388 This does code conversion according to the value of\n\
4389 `coding-system-for-write', `buffer-file-coding-system', or\n\
4390 `file-coding-system-alist', and sets the variable\n\
4391 `last-coding-system-used' to the coding system actually used.")
4393 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4394 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4402 int count
= specpdl_ptr
- specpdl
;
4405 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4407 Lisp_Object handler
;
4408 Lisp_Object visit_file
;
4409 Lisp_Object annotations
;
4410 Lisp_Object encoded_filename
;
4411 int visiting
, quietly
;
4412 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4413 struct buffer
*given_buffer
;
4415 int buffer_file_type
= O_BINARY
;
4417 struct coding_system coding
;
4419 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4420 error ("Cannot do file visiting in an indirect buffer");
4422 if (!NILP (start
) && !STRINGP (start
))
4423 validate_region (&start
, &end
);
4425 GCPRO4 (start
, filename
, visit
, lockname
);
4427 /* Decide the coding-system to encode the data with. */
4433 else if (!NILP (Vcoding_system_for_write
))
4434 val
= Vcoding_system_for_write
;
4437 /* If the variable `buffer-file-coding-system' is set locally,
4438 it means that the file was read with some kind of code
4439 conversion or the varialbe is explicitely set by users. We
4440 had better write it out with the same coding system even if
4441 `enable-multibyte-characters' is nil.
4443 If it is not set locally, we anyway have to convert EOL
4444 format if the default value of `buffer-file-coding-system'
4445 tells that it is not Unix-like (LF only) format. */
4446 int using_default_coding
= 0;
4447 int force_raw_text
= 0;
4449 val
= current_buffer
->buffer_file_coding_system
;
4451 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4454 if (NILP (current_buffer
->enable_multibyte_characters
))
4460 /* Check file-coding-system-alist. */
4461 Lisp_Object args
[7], coding_systems
;
4463 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4464 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4466 coding_systems
= Ffind_operation_coding_system (7, args
);
4467 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4468 val
= XCDR (coding_systems
);
4472 && !NILP (current_buffer
->buffer_file_coding_system
))
4474 /* If we still have not decided a coding system, use the
4475 default value of buffer-file-coding-system. */
4476 val
= current_buffer
->buffer_file_coding_system
;
4477 using_default_coding
= 1;
4481 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4482 /* Confirm that VAL can surely encode the current region. */
4483 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4485 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4486 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4487 && !using_default_coding
)
4489 if (! EQ (default_buffer_file_coding
.symbol
,
4490 buffer_defaults
.buffer_file_coding_system
))
4491 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4492 &default_buffer_file_coding
);
4493 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4495 Lisp_Object subsidiaries
;
4497 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4498 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4499 if (VECTORP (subsidiaries
)
4500 && XVECTOR (subsidiaries
)->size
== 3)
4502 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4507 setup_raw_text_coding_system (&coding
);
4508 goto done_setup_coding
;
4511 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4514 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4515 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4518 Vlast_coding_system_used
= coding
.symbol
;
4520 filename
= Fexpand_file_name (filename
, Qnil
);
4522 if (! NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4523 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4525 if (STRINGP (visit
))
4526 visit_file
= Fexpand_file_name (visit
, Qnil
);
4528 visit_file
= filename
;
4531 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4532 quietly
= !NILP (visit
);
4536 if (NILP (lockname
))
4537 lockname
= visit_file
;
4539 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4541 /* If the file name has special constructs in it,
4542 call the corresponding file handler. */
4543 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4544 /* If FILENAME has no handler, see if VISIT has one. */
4545 if (NILP (handler
) && STRINGP (visit
))
4546 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4548 if (!NILP (handler
))
4551 val
= call6 (handler
, Qwrite_region
, start
, end
,
4552 filename
, append
, visit
);
4556 SAVE_MODIFF
= MODIFF
;
4557 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4558 current_buffer
->filename
= visit_file
;
4564 /* Special kludge to simplify auto-saving. */
4567 XSETFASTINT (start
, BEG
);
4568 XSETFASTINT (end
, Z
);
4571 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4572 count1
= specpdl_ptr
- specpdl
;
4574 given_buffer
= current_buffer
;
4575 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4576 if (current_buffer
!= given_buffer
)
4578 XSETFASTINT (start
, BEGV
);
4579 XSETFASTINT (end
, ZV
);
4582 #ifdef CLASH_DETECTION
4585 #if 0 /* This causes trouble for GNUS. */
4586 /* If we've locked this file for some other buffer,
4587 query before proceeding. */
4588 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4589 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4592 lock_file (lockname
);
4594 #endif /* CLASH_DETECTION */
4596 encoded_filename
= ENCODE_FILE (filename
);
4598 fn
= XSTRING (encoded_filename
)->data
;
4602 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4603 #else /* not DOS_NT */
4604 desc
= emacs_open (fn
, O_WRONLY
, 0);
4605 #endif /* not DOS_NT */
4607 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4609 if (auto_saving
) /* Overwrite any previous version of autosave file */
4611 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4612 desc
= emacs_open (fn
, O_RDWR
, 0);
4614 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4615 ? XSTRING (current_buffer
->filename
)->data
: 0,
4618 else /* Write to temporary name and rename if no errors */
4620 Lisp_Object temp_name
;
4621 temp_name
= Ffile_name_directory (filename
);
4623 if (!NILP (temp_name
))
4625 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4626 build_string ("$$SAVE$$")));
4627 fname
= XSTRING (filename
)->data
;
4628 fn
= XSTRING (temp_name
)->data
;
4629 desc
= creat_copy_attrs (fname
, fn
);
4632 /* If we can't open the temporary file, try creating a new
4633 version of the original file. VMS "creat" creates a
4634 new version rather than truncating an existing file. */
4637 desc
= creat (fn
, 0666);
4638 #if 0 /* This can clobber an existing file and fail to replace it,
4639 if the user runs out of space. */
4642 /* We can't make a new version;
4643 try to truncate and rewrite existing version if any. */
4645 desc
= emacs_open (fn
, O_RDWR
, 0);
4651 desc
= creat (fn
, 0666);
4655 desc
= emacs_open (fn
,
4656 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
4657 | (mustbenew
== Qexcl
? O_EXCL
: 0),
4658 S_IREAD
| S_IWRITE
);
4659 #else /* not DOS_NT */
4660 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4661 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4662 auto_saving
? auto_save_mode_bits
: 0666);
4663 #endif /* not DOS_NT */
4664 #endif /* not VMS */
4668 #ifdef CLASH_DETECTION
4670 if (!auto_saving
) unlock_file (lockname
);
4672 #endif /* CLASH_DETECTION */
4674 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4677 record_unwind_protect (close_file_unwind
, make_number (desc
));
4679 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4683 if (NUMBERP (append
))
4684 ret
= lseek (desc
, XINT (append
), 1);
4686 ret
= lseek (desc
, 0, 2);
4689 #ifdef CLASH_DETECTION
4690 if (!auto_saving
) unlock_file (lockname
);
4691 #endif /* CLASH_DETECTION */
4693 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4701 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4702 * if we do writes that don't end with a carriage return. Furthermore
4703 * it cannot handle writes of more then 16K. The modified
4704 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4705 * this EXCEPT for the last record (iff it doesn't end with a carriage
4706 * return). This implies that if your buffer doesn't end with a carriage
4707 * return, you get one free... tough. However it also means that if
4708 * we make two calls to sys_write (a la the following code) you can
4709 * get one at the gap as well. The easiest way to fix this (honest)
4710 * is to move the gap to the next newline (or the end of the buffer).
4715 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4716 move_gap (find_next_newline (GPT
, 1));
4718 /* Whether VMS or not, we must move the gap to the next of newline
4719 when we must put designation sequences at beginning of line. */
4720 if (INTEGERP (start
)
4721 && coding
.type
== coding_type_iso2022
4722 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4723 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4725 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4726 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4727 move_gap_both (PT
, PT_BYTE
);
4728 SET_PT_BOTH (opoint
, opoint_byte
);
4735 if (STRINGP (start
))
4737 failure
= 0 > a_write (desc
, start
, 0, XSTRING (start
)->size
,
4738 &annotations
, &coding
);
4741 else if (XINT (start
) != XINT (end
))
4743 tem
= CHAR_TO_BYTE (XINT (start
));
4745 if (XINT (start
) < GPT
)
4747 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
4748 min (GPT
, XINT (end
)) - XINT (start
),
4749 &annotations
, &coding
);
4753 if (XINT (end
) > GPT
&& !failure
)
4755 tem
= max (XINT (start
), GPT
);
4756 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
4757 &annotations
, &coding
);
4763 /* If file was empty, still need to write the annotations */
4764 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4765 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4769 if (CODING_REQUIRE_FLUSHING (&coding
)
4770 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4773 /* We have to flush out a data. */
4774 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4775 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
4782 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4783 Disk full in NFS may be reported here. */
4784 /* mib says that closing the file will try to write as fast as NFS can do
4785 it, and that means the fsync here is not crucial for autosave files. */
4786 if (!auto_saving
&& fsync (desc
) < 0)
4788 /* If fsync fails with EINTR, don't treat that as serious. */
4790 failure
= 1, save_errno
= errno
;
4794 /* Spurious "file has changed on disk" warnings have been
4795 observed on Suns as well.
4796 It seems that `close' can change the modtime, under nfs.
4798 (This has supposedly been fixed in Sunos 4,
4799 but who knows about all the other machines with NFS?) */
4802 /* On VMS and APOLLO, must do the stat after the close
4803 since closing changes the modtime. */
4806 /* Recall that #if defined does not work on VMS. */
4813 /* NFS can report a write failure now. */
4814 if (emacs_close (desc
) < 0)
4815 failure
= 1, save_errno
= errno
;
4818 /* If we wrote to a temporary name and had no errors, rename to real name. */
4822 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4830 /* Discard the unwind protect for close_file_unwind. */
4831 specpdl_ptr
= specpdl
+ count1
;
4832 /* Restore the original current buffer. */
4833 visit_file
= unbind_to (count
, visit_file
);
4835 #ifdef CLASH_DETECTION
4837 unlock_file (lockname
);
4838 #endif /* CLASH_DETECTION */
4840 /* Do this before reporting IO error
4841 to avoid a "file has changed on disk" warning on
4842 next attempt to save. */
4844 current_buffer
->modtime
= st
.st_mtime
;
4847 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4848 emacs_strerror (save_errno
));
4852 SAVE_MODIFF
= MODIFF
;
4853 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4854 current_buffer
->filename
= visit_file
;
4855 update_mode_lines
++;
4861 message_with_string ("Wrote %s", visit_file
, 1);
4866 Lisp_Object
merge ();
4868 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4869 "Return t if (car A) is numerically less than (car B).")
4873 return Flss (Fcar (a
), Fcar (b
));
4876 /* Build the complete list of annotations appropriate for writing out
4877 the text between START and END, by calling all the functions in
4878 write-region-annotate-functions and merging the lists they return.
4879 If one of these functions switches to a different buffer, we assume
4880 that buffer contains altered text. Therefore, the caller must
4881 make sure to restore the current buffer in all cases,
4882 as save-excursion would do. */
4885 build_annotations (start
, end
, pre_write_conversion
)
4886 Lisp_Object start
, end
, pre_write_conversion
;
4888 Lisp_Object annotations
;
4890 struct gcpro gcpro1
, gcpro2
;
4891 Lisp_Object original_buffer
;
4894 XSETBUFFER (original_buffer
, current_buffer
);
4897 p
= Vwrite_region_annotate_functions
;
4898 GCPRO2 (annotations
, p
);
4901 struct buffer
*given_buffer
= current_buffer
;
4902 Vwrite_region_annotations_so_far
= annotations
;
4903 res
= call2 (Fcar (p
), start
, end
);
4904 /* If the function makes a different buffer current,
4905 assume that means this buffer contains altered text to be output.
4906 Reset START and END from the buffer bounds
4907 and discard all previous annotations because they should have
4908 been dealt with by this function. */
4909 if (current_buffer
!= given_buffer
)
4911 XSETFASTINT (start
, BEGV
);
4912 XSETFASTINT (end
, ZV
);
4915 Flength (res
); /* Check basic validity of return value */
4916 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4920 /* Now do the same for annotation functions implied by the file-format */
4921 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4922 p
= Vauto_save_file_format
;
4924 p
= current_buffer
->file_format
;
4925 for (i
= 0; !NILP (p
); p
= Fcdr (p
), ++i
)
4927 struct buffer
*given_buffer
= current_buffer
;
4929 Vwrite_region_annotations_so_far
= annotations
;
4931 /* Value is either a list of annotations or nil if the function
4932 has written annotations to a temporary buffer, which is now
4934 res
= call5 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4935 original_buffer
, make_number (i
));
4936 if (current_buffer
!= given_buffer
)
4938 XSETFASTINT (start
, BEGV
);
4939 XSETFASTINT (end
, ZV
);
4944 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4947 /* At last, do the same for the function PRE_WRITE_CONVERSION
4948 implied by the current coding-system. */
4949 if (!NILP (pre_write_conversion
))
4951 struct buffer
*given_buffer
= current_buffer
;
4952 Vwrite_region_annotations_so_far
= annotations
;
4953 res
= call2 (pre_write_conversion
, start
, end
);
4955 annotations
= (current_buffer
!= given_buffer
4957 : merge (annotations
, res
, Qcar_less_than_car
));
4964 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4965 If STRING is nil, POS is the character position in the current buffer.
4966 Intersperse with them the annotations from *ANNOT
4967 which fall within the range of POS to POS + NCHARS,
4968 each at its appropriate position.
4970 We modify *ANNOT by discarding elements as we use them up.
4972 The return value is negative in case of system call failure. */
4975 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
4978 register int nchars
;
4981 struct coding_system
*coding
;
4985 int lastpos
= pos
+ nchars
;
4987 while (NILP (*annot
) || CONSP (*annot
))
4989 tem
= Fcar_safe (Fcar (*annot
));
4992 nextpos
= XFASTINT (tem
);
4994 /* If there are no more annotations in this range,
4995 output the rest of the range all at once. */
4996 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
4997 return e_write (desc
, string
, pos
, lastpos
, coding
);
4999 /* Output buffer text up to the next annotation's position. */
5002 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5006 /* Output the annotation. */
5007 tem
= Fcdr (Fcar (*annot
));
5010 if (0 > e_write (desc
, tem
, 0, XSTRING (tem
)->size
, coding
))
5013 *annot
= Fcdr (*annot
);
5018 #ifndef WRITE_BUF_SIZE
5019 #define WRITE_BUF_SIZE (16 * 1024)
5022 /* Write text in the range START and END into descriptor DESC,
5023 encoding them with coding system CODING. If STRING is nil, START
5024 and END are character positions of the current buffer, else they
5025 are indexes to the string STRING. */
5028 e_write (desc
, string
, start
, end
, coding
)
5032 struct coding_system
*coding
;
5034 register char *addr
;
5035 register int nbytes
;
5036 char buf
[WRITE_BUF_SIZE
];
5038 int require_encoding_p
;
5041 coding
->composing
= COMPOSITION_DISABLED
;
5042 if (coding
->composing
!= COMPOSITION_DISABLED
)
5043 coding_save_composition (coding
, start
, end
, string
);
5045 if (STRINGP (string
))
5047 addr
= XSTRING (string
)->data
;
5048 nbytes
= STRING_BYTES (XSTRING (string
));
5049 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5051 else if (start
< end
)
5053 /* It is assured that the gap is not in the range START and END-1. */
5054 addr
= CHAR_POS_ADDR (start
);
5055 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5056 coding
->src_multibyte
5057 = !NILP (current_buffer
->enable_multibyte_characters
);
5063 coding
->src_multibyte
= 1;
5066 /* We used to have a code for handling selective display here. But,
5067 now it is handled within encode_coding. */
5072 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5073 if (coding
->produced
> 0)
5075 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5076 if (coding
->produced
)
5082 nbytes
-= coding
->consumed
;
5083 addr
+= coding
->consumed
;
5084 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5087 /* The source text ends by an incomplete multibyte form.
5088 There's no way other than write it out as is. */
5089 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5098 start
+= coding
->consumed_char
;
5099 if (coding
->cmp_data
)
5100 coding_adjust_composition_offset (coding
, start
);
5103 if (coding
->cmp_data
)
5104 coding_free_composition_data (coding
);
5109 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5110 Sverify_visited_file_modtime
, 1, 1, 0,
5111 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
5112 This means that the file has not been changed since it was visited or saved.")
5118 Lisp_Object handler
;
5119 Lisp_Object filename
;
5121 CHECK_BUFFER (buf
, 0);
5124 if (!STRINGP (b
->filename
)) return Qt
;
5125 if (b
->modtime
== 0) return Qt
;
5127 /* If the file name has special constructs in it,
5128 call the corresponding file handler. */
5129 handler
= Ffind_file_name_handler (b
->filename
,
5130 Qverify_visited_file_modtime
);
5131 if (!NILP (handler
))
5132 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5134 filename
= ENCODE_FILE (b
->filename
);
5136 if (stat (XSTRING (filename
)->data
, &st
) < 0)
5138 /* If the file doesn't exist now and didn't exist before,
5139 we say that it isn't modified, provided the error is a tame one. */
5140 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5145 if (st
.st_mtime
== b
->modtime
5146 /* If both are positive, accept them if they are off by one second. */
5147 || (st
.st_mtime
> 0 && b
->modtime
> 0
5148 && (st
.st_mtime
== b
->modtime
+ 1
5149 || st
.st_mtime
== b
->modtime
- 1)))
5154 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5155 Sclear_visited_file_modtime
, 0, 0, 0,
5156 "Clear out records of last mod time of visited file.\n\
5157 Next attempt to save will certainly not complain of a discrepancy.")
5160 current_buffer
->modtime
= 0;
5164 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5165 Svisited_file_modtime
, 0, 0, 0,
5166 "Return the current buffer's recorded visited file modification time.\n\
5167 The value is a list of the form (HIGH . LOW), like the time values\n\
5168 that `file-attributes' returns.")
5171 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5174 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5175 Sset_visited_file_modtime
, 0, 1, 0,
5176 "Update buffer's recorded modification time from the visited file's time.\n\
5177 Useful if the buffer was not read from the file normally\n\
5178 or if the file itself has been changed for some known benign reason.\n\
5179 An argument specifies the modification time value to use\n\
5180 \(instead of that of the visited file), in the form of a list\n\
5181 \(HIGH . LOW) or (HIGH LOW).")
5183 Lisp_Object time_list
;
5185 if (!NILP (time_list
))
5186 current_buffer
->modtime
= cons_to_long (time_list
);
5189 register Lisp_Object filename
;
5191 Lisp_Object handler
;
5193 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5195 /* If the file name has special constructs in it,
5196 call the corresponding file handler. */
5197 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5198 if (!NILP (handler
))
5199 /* The handler can find the file name the same way we did. */
5200 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5202 filename
= ENCODE_FILE (filename
);
5204 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5205 current_buffer
->modtime
= st
.st_mtime
;
5215 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
5216 Fsleep_for (make_number (1), Qnil
);
5217 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5218 Fsleep_for (make_number (1), Qnil
);
5219 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
5220 Fsleep_for (make_number (1), Qnil
);
5229 /* Get visited file's mode to become the auto save file's mode. */
5230 if (! NILP (current_buffer
->filename
)
5231 && stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5232 /* But make sure we can overwrite it later! */
5233 auto_save_mode_bits
= st
.st_mode
| 0600;
5235 auto_save_mode_bits
= 0666;
5238 Fwrite_region (Qnil
, Qnil
,
5239 current_buffer
->auto_save_file_name
,
5240 Qnil
, Qlambda
, Qnil
, Qnil
);
5244 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5249 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5250 | XFASTINT (XCDR (stream
))));
5255 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5258 minibuffer_auto_raise
= XINT (value
);
5262 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5263 "Auto-save all buffers that need it.\n\
5264 This is all buffers that have auto-saving enabled\n\
5265 and are changed since last auto-saved.\n\
5266 Auto-saving writes the buffer into a file\n\
5267 so that your editing is not lost if the system crashes.\n\
5268 This file is not the file you visited; that changes only when you save.\n\
5269 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5270 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5271 A non-nil CURRENT-ONLY argument means save only current buffer.")
5272 (no_message
, current_only
)
5273 Lisp_Object no_message
, current_only
;
5275 struct buffer
*old
= current_buffer
, *b
;
5276 Lisp_Object tail
, buf
;
5278 int do_handled_files
;
5281 Lisp_Object lispstream
;
5282 int count
= specpdl_ptr
- specpdl
;
5283 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5284 int message_p
= push_message ();
5286 /* Ordinarily don't quit within this function,
5287 but don't make it impossible to quit (in case we get hung in I/O). */
5291 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5292 point to non-strings reached from Vbuffer_alist. */
5297 if (!NILP (Vrun_hooks
))
5298 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5300 if (STRINGP (Vauto_save_list_file_name
))
5302 Lisp_Object listfile
, dir
;
5304 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5306 dir
= Ffile_name_directory (listfile
);
5307 if (NILP (Ffile_directory_p (dir
)))
5308 call2 (Qmake_directory
, dir
, Qt
);
5310 stream
= fopen (XSTRING (listfile
)->data
, "w");
5313 /* Arrange to close that file whether or not we get an error.
5314 Also reset auto_saving to 0. */
5315 lispstream
= Fcons (Qnil
, Qnil
);
5316 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
5317 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
5328 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5329 record_unwind_protect (do_auto_save_unwind_1
,
5330 make_number (minibuffer_auto_raise
));
5331 minibuffer_auto_raise
= 0;
5334 /* First, save all files which don't have handlers. If Emacs is
5335 crashing, the handlers may tweak what is causing Emacs to crash
5336 in the first place, and it would be a shame if Emacs failed to
5337 autosave perfectly ordinary files because it couldn't handle some
5339 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5340 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5342 buf
= XCDR (XCAR (tail
));
5345 /* Record all the buffers that have auto save mode
5346 in the special file that lists them. For each of these buffers,
5347 Record visited name (if any) and auto save name. */
5348 if (STRINGP (b
->auto_save_file_name
)
5349 && stream
!= NULL
&& do_handled_files
== 0)
5351 if (!NILP (b
->filename
))
5353 fwrite (XSTRING (b
->filename
)->data
, 1,
5354 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5356 putc ('\n', stream
);
5357 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5358 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5359 putc ('\n', stream
);
5362 if (!NILP (current_only
)
5363 && b
!= current_buffer
)
5366 /* Don't auto-save indirect buffers.
5367 The base buffer takes care of it. */
5371 /* Check for auto save enabled
5372 and file changed since last auto save
5373 and file changed since last real save. */
5374 if (STRINGP (b
->auto_save_file_name
)
5375 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5376 && b
->auto_save_modified
< BUF_MODIFF (b
)
5377 /* -1 means we've turned off autosaving for a while--see below. */
5378 && XINT (b
->save_length
) >= 0
5379 && (do_handled_files
5380 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5383 EMACS_TIME before_time
, after_time
;
5385 EMACS_GET_TIME (before_time
);
5387 /* If we had a failure, don't try again for 20 minutes. */
5388 if (b
->auto_save_failure_time
>= 0
5389 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5392 if ((XFASTINT (b
->save_length
) * 10
5393 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5394 /* A short file is likely to change a large fraction;
5395 spare the user annoying messages. */
5396 && XFASTINT (b
->save_length
) > 5000
5397 /* These messages are frequent and annoying for `*mail*'. */
5398 && !EQ (b
->filename
, Qnil
)
5399 && NILP (no_message
))
5401 /* It has shrunk too much; turn off auto-saving here. */
5402 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5403 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5405 minibuffer_auto_raise
= 0;
5406 /* Turn off auto-saving until there's a real save,
5407 and prevent any more warnings. */
5408 XSETINT (b
->save_length
, -1);
5409 Fsleep_for (make_number (1), Qnil
);
5412 set_buffer_internal (b
);
5413 if (!auto_saved
&& NILP (no_message
))
5414 message1 ("Auto-saving...");
5415 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5417 b
->auto_save_modified
= BUF_MODIFF (b
);
5418 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5419 set_buffer_internal (old
);
5421 EMACS_GET_TIME (after_time
);
5423 /* If auto-save took more than 60 seconds,
5424 assume it was an NFS failure that got a timeout. */
5425 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5426 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5430 /* Prevent another auto save till enough input events come in. */
5431 record_auto_save ();
5433 if (auto_saved
&& NILP (no_message
))
5437 sit_for (1, 0, 0, 0, 0);
5441 message1 ("Auto-saving...done");
5447 unbind_to (count
, Qnil
);
5451 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5452 Sset_buffer_auto_saved
, 0, 0, 0,
5453 "Mark current buffer as auto-saved with its current text.\n\
5454 No auto-save file will be written until the buffer changes again.")
5457 current_buffer
->auto_save_modified
= MODIFF
;
5458 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5459 current_buffer
->auto_save_failure_time
= -1;
5463 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5464 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5465 "Clear any record of a recent auto-save failure in the current buffer.")
5468 current_buffer
->auto_save_failure_time
= -1;
5472 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5474 "Return t if buffer has been auto-saved since last read in or saved.")
5477 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5480 /* Reading and completing file names */
5481 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5483 /* In the string VAL, change each $ to $$ and return the result. */
5486 double_dollars (val
)
5489 register unsigned char *old
, *new;
5493 osize
= STRING_BYTES (XSTRING (val
));
5495 /* Count the number of $ characters. */
5496 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5497 if (*old
++ == '$') count
++;
5500 old
= XSTRING (val
)->data
;
5501 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5503 new = XSTRING (val
)->data
;
5504 for (n
= osize
; n
> 0; n
--)
5517 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5519 "Internal subroutine for read-file-name. Do not call this.")
5520 (string
, dir
, action
)
5521 Lisp_Object string
, dir
, action
;
5522 /* action is nil for complete, t for return list of completions,
5523 lambda for verify final value */
5525 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5527 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5529 CHECK_STRING (string
, 0);
5536 /* No need to protect ACTION--we only compare it with t and nil. */
5537 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5539 if (XSTRING (string
)->size
== 0)
5541 if (EQ (action
, Qlambda
))
5549 orig_string
= string
;
5550 string
= Fsubstitute_in_file_name (string
);
5551 changed
= NILP (Fstring_equal (string
, orig_string
));
5552 name
= Ffile_name_nondirectory (string
);
5553 val
= Ffile_name_directory (string
);
5555 realdir
= Fexpand_file_name (val
, realdir
);
5560 specdir
= Ffile_name_directory (string
);
5561 val
= Ffile_name_completion (name
, realdir
);
5566 return double_dollars (string
);
5570 if (!NILP (specdir
))
5571 val
= concat2 (specdir
, val
);
5573 return double_dollars (val
);
5576 #endif /* not VMS */
5580 if (EQ (action
, Qt
))
5581 return Ffile_name_all_completions (name
, realdir
);
5582 /* Only other case actually used is ACTION = lambda */
5584 /* Supposedly this helps commands such as `cd' that read directory names,
5585 but can someone explain how it helps them? -- RMS */
5586 if (XSTRING (name
)->size
== 0)
5589 return Ffile_exists_p (string
);
5592 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5593 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5594 Value is not expanded---you must call `expand-file-name' yourself.\n\
5595 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5596 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5597 except that if INITIAL is specified, that combined with DIR is used.)\n\
5598 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5599 Non-nil and non-t means also require confirmation after completion.\n\
5600 Fifth arg INITIAL specifies text to start with.\n\
5601 DIR defaults to current buffer's directory default.")
5602 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5603 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5605 Lisp_Object val
, insdef
, tem
;
5606 struct gcpro gcpro1
, gcpro2
;
5607 register char *homedir
;
5608 int replace_in_history
= 0;
5609 int add_to_history
= 0;
5613 dir
= current_buffer
->directory
;
5614 if (NILP (default_filename
))
5616 if (! NILP (initial
))
5617 default_filename
= Fexpand_file_name (initial
, dir
);
5619 default_filename
= current_buffer
->filename
;
5622 /* If dir starts with user's homedir, change that to ~. */
5623 homedir
= (char *) egetenv ("HOME");
5625 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5626 CORRECT_DIR_SEPS (homedir
);
5630 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5631 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5633 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5634 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5635 XSTRING (dir
)->data
[0] = '~';
5637 /* Likewise for default_filename. */
5639 && STRINGP (default_filename
)
5640 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5641 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5644 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5645 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5646 XSTRING (default_filename
)->data
[0] = '~';
5648 if (!NILP (default_filename
))
5650 CHECK_STRING (default_filename
, 3);
5651 default_filename
= double_dollars (default_filename
);
5654 if (insert_default_directory
&& STRINGP (dir
))
5657 if (!NILP (initial
))
5659 Lisp_Object args
[2], pos
;
5663 insdef
= Fconcat (2, args
);
5664 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5665 insdef
= Fcons (double_dollars (insdef
), pos
);
5668 insdef
= double_dollars (insdef
);
5670 else if (STRINGP (initial
))
5671 insdef
= Fcons (double_dollars (initial
), make_number (0));
5675 count
= specpdl_ptr
- specpdl
;
5677 specbind (intern ("completion-ignore-case"), Qt
);
5680 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5682 GCPRO2 (insdef
, default_filename
);
5684 #if defined (USE_MOTIF) || defined (HAVE_NTGUI)
5685 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5689 /* If DIR contains a file name, split it. */
5691 file
= Ffile_name_nondirectory (dir
);
5692 if (XSTRING (file
)->size
&& NILP (default_filename
))
5694 default_filename
= file
;
5695 dir
= Ffile_name_directory (dir
);
5697 if (!NILP(default_filename
))
5698 default_filename
= Fexpand_file_name (default_filename
, dir
);
5699 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5704 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5705 dir
, mustmatch
, insdef
,
5706 Qfile_name_history
, default_filename
, Qnil
);
5708 tem
= Fsymbol_value (Qfile_name_history
);
5709 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
5710 replace_in_history
= 1;
5712 /* If Fcompleting_read returned the inserted default string itself
5713 (rather than a new string with the same contents),
5714 it has to mean that the user typed RET with the minibuffer empty.
5715 In that case, we really want to return ""
5716 so that commands such as set-visited-file-name can distinguish. */
5717 if (EQ (val
, default_filename
))
5719 /* In this case, Fcompleting_read has not added an element
5720 to the history. Maybe we should. */
5721 if (! replace_in_history
)
5724 val
= build_string ("");
5727 unbind_to (count
, Qnil
);
5730 error ("No file name specified");
5732 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5734 if (!NILP (tem
) && !NILP (default_filename
))
5735 val
= default_filename
;
5736 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5738 if (!NILP (default_filename
))
5739 val
= default_filename
;
5741 error ("No default file name");
5743 val
= Fsubstitute_in_file_name (val
);
5745 if (replace_in_history
)
5746 /* Replace what Fcompleting_read added to the history
5747 with what we will actually return. */
5748 XCAR (Fsymbol_value (Qfile_name_history
)) = double_dollars (val
);
5749 else if (add_to_history
)
5751 /* Add the value to the history--but not if it matches
5752 the last value already there. */
5753 Lisp_Object val1
= double_dollars (val
);
5754 tem
= Fsymbol_value (Qfile_name_history
);
5755 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
5756 Fset (Qfile_name_history
,
5767 /* Must be set before any path manipulation is performed. */
5768 XSETFASTINT (Vdirectory_sep_char
, '/');
5775 Qexpand_file_name
= intern ("expand-file-name");
5776 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5777 Qdirectory_file_name
= intern ("directory-file-name");
5778 Qfile_name_directory
= intern ("file-name-directory");
5779 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5780 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5781 Qfile_name_as_directory
= intern ("file-name-as-directory");
5782 Qcopy_file
= intern ("copy-file");
5783 Qmake_directory_internal
= intern ("make-directory-internal");
5784 Qmake_directory
= intern ("make-directory");
5785 Qdelete_directory
= intern ("delete-directory");
5786 Qdelete_file
= intern ("delete-file");
5787 Qrename_file
= intern ("rename-file");
5788 Qadd_name_to_file
= intern ("add-name-to-file");
5789 Qmake_symbolic_link
= intern ("make-symbolic-link");
5790 Qfile_exists_p
= intern ("file-exists-p");
5791 Qfile_executable_p
= intern ("file-executable-p");
5792 Qfile_readable_p
= intern ("file-readable-p");
5793 Qfile_writable_p
= intern ("file-writable-p");
5794 Qfile_symlink_p
= intern ("file-symlink-p");
5795 Qaccess_file
= intern ("access-file");
5796 Qfile_directory_p
= intern ("file-directory-p");
5797 Qfile_regular_p
= intern ("file-regular-p");
5798 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5799 Qfile_modes
= intern ("file-modes");
5800 Qset_file_modes
= intern ("set-file-modes");
5801 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5802 Qinsert_file_contents
= intern ("insert-file-contents");
5803 Qwrite_region
= intern ("write-region");
5804 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5805 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5807 staticpro (&Qexpand_file_name
);
5808 staticpro (&Qsubstitute_in_file_name
);
5809 staticpro (&Qdirectory_file_name
);
5810 staticpro (&Qfile_name_directory
);
5811 staticpro (&Qfile_name_nondirectory
);
5812 staticpro (&Qunhandled_file_name_directory
);
5813 staticpro (&Qfile_name_as_directory
);
5814 staticpro (&Qcopy_file
);
5815 staticpro (&Qmake_directory_internal
);
5816 staticpro (&Qmake_directory
);
5817 staticpro (&Qdelete_directory
);
5818 staticpro (&Qdelete_file
);
5819 staticpro (&Qrename_file
);
5820 staticpro (&Qadd_name_to_file
);
5821 staticpro (&Qmake_symbolic_link
);
5822 staticpro (&Qfile_exists_p
);
5823 staticpro (&Qfile_executable_p
);
5824 staticpro (&Qfile_readable_p
);
5825 staticpro (&Qfile_writable_p
);
5826 staticpro (&Qaccess_file
);
5827 staticpro (&Qfile_symlink_p
);
5828 staticpro (&Qfile_directory_p
);
5829 staticpro (&Qfile_regular_p
);
5830 staticpro (&Qfile_accessible_directory_p
);
5831 staticpro (&Qfile_modes
);
5832 staticpro (&Qset_file_modes
);
5833 staticpro (&Qfile_newer_than_file_p
);
5834 staticpro (&Qinsert_file_contents
);
5835 staticpro (&Qwrite_region
);
5836 staticpro (&Qverify_visited_file_modtime
);
5837 staticpro (&Qset_visited_file_modtime
);
5839 Qfile_name_history
= intern ("file-name-history");
5840 Fset (Qfile_name_history
, Qnil
);
5841 staticpro (&Qfile_name_history
);
5843 Qfile_error
= intern ("file-error");
5844 staticpro (&Qfile_error
);
5845 Qfile_already_exists
= intern ("file-already-exists");
5846 staticpro (&Qfile_already_exists
);
5847 Qfile_date_error
= intern ("file-date-error");
5848 staticpro (&Qfile_date_error
);
5849 Qexcl
= intern ("excl");
5853 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5854 staticpro (&Qfind_buffer_file_type
);
5857 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5858 "*Coding system for encoding file names.\n\
5859 If it is nil, default-file-name-coding-system (which see) is used.");
5860 Vfile_name_coding_system
= Qnil
;
5862 DEFVAR_LISP ("default-file-name-coding-system",
5863 &Vdefault_file_name_coding_system
,
5864 "Default coding system for encoding file names.\n\
5865 This variable is used only when file-name-coding-system is nil.\n\
5867 This variable is set/changed by the command set-language-environment.\n\
5868 User should not set this variable manually,\n\
5869 instead use file-name-coding-system to get a constant encoding\n\
5870 of file names regardless of the current language environment.");
5871 Vdefault_file_name_coding_system
= Qnil
;
5873 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5874 "*Format in which to write auto-save files.\n\
5875 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5876 If it is t, which is the default, auto-save files are written in the\n\
5877 same format as a regular save would use.");
5878 Vauto_save_file_format
= Qt
;
5880 Qformat_decode
= intern ("format-decode");
5881 staticpro (&Qformat_decode
);
5882 Qformat_annotate_function
= intern ("format-annotate-function");
5883 staticpro (&Qformat_annotate_function
);
5885 Qcar_less_than_car
= intern ("car-less-than-car");
5886 staticpro (&Qcar_less_than_car
);
5888 Fput (Qfile_error
, Qerror_conditions
,
5889 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5890 Fput (Qfile_error
, Qerror_message
,
5891 build_string ("File error"));
5893 Fput (Qfile_already_exists
, Qerror_conditions
,
5894 Fcons (Qfile_already_exists
,
5895 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5896 Fput (Qfile_already_exists
, Qerror_message
,
5897 build_string ("File already exists"));
5899 Fput (Qfile_date_error
, Qerror_conditions
,
5900 Fcons (Qfile_date_error
,
5901 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5902 Fput (Qfile_date_error
, Qerror_message
,
5903 build_string ("Cannot set file date"));
5905 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5906 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5907 insert_default_directory
= 1;
5909 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5910 "*Non-nil means write new files with record format `stmlf'.\n\
5911 nil means use format `var'. This variable is meaningful only on VMS.");
5912 vms_stmlf_recfm
= 0;
5914 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5915 "Directory separator character for built-in functions that return file names.\n\
5916 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5917 This variable affects the built-in functions only on Windows,\n\
5918 on other platforms, it is initialized so that Lisp code can find out\n\
5919 what the normal separator is.");
5921 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5922 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5923 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5926 The first argument given to HANDLER is the name of the I/O primitive\n\
5927 to be handled; the remaining arguments are the arguments that were\n\
5928 passed to that primitive. For example, if you do\n\
5929 (file-exists-p FILENAME)\n\
5930 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5931 (funcall HANDLER 'file-exists-p FILENAME)\n\
5932 The function `find-file-name-handler' checks this list for a handler\n\
5933 for its argument.");
5934 Vfile_name_handler_alist
= Qnil
;
5936 DEFVAR_LISP ("set-auto-coding-function",
5937 &Vset_auto_coding_function
,
5938 "If non-nil, a function to call to decide a coding system of file.\n\
5939 Two arguments are passed to this function: the file name\n\
5940 and the length of a file contents following the point.\n\
5941 This function should return a coding system to decode the file contents.\n\
5942 It should check the file name against `auto-coding-alist'.\n\
5943 If no coding system is decided, it should check a coding system\n\
5944 specified in the heading lines with the format:\n\
5945 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5946 or local variable spec of the tailing lines with `coding:' tag.");
5947 Vset_auto_coding_function
= Qnil
;
5949 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5950 "A list of functions to be called at the end of `insert-file-contents'.\n\
5951 Each is passed one argument, the number of bytes inserted. It should return\n\
5952 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5953 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5954 responsible for calling the after-insert-file-functions if appropriate.");
5955 Vafter_insert_file_functions
= Qnil
;
5957 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5958 "A list of functions to be called at the start of `write-region'.\n\
5959 Each is passed two arguments, START and END as for `write-region'.\n\
5960 These are usually two numbers but not always; see the documentation\n\
5961 for `write-region'. The function should return a list of pairs\n\
5962 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5963 inserted at the specified positions of the file being written (1 means to\n\
5964 insert before the first byte written). The POSITIONs must be sorted into\n\
5965 increasing order. If there are several functions in the list, the several\n\
5966 lists are merged destructively.");
5967 Vwrite_region_annotate_functions
= Qnil
;
5969 DEFVAR_LISP ("write-region-annotations-so-far",
5970 &Vwrite_region_annotations_so_far
,
5971 "When an annotation function is called, this holds the previous annotations.\n\
5972 These are the annotations made by other annotation functions\n\
5973 that were already called. See also `write-region-annotate-functions'.");
5974 Vwrite_region_annotations_so_far
= Qnil
;
5976 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5977 "A list of file name handlers that temporarily should not be used.\n\
5978 This applies only to the operation `inhibit-file-name-operation'.");
5979 Vinhibit_file_name_handlers
= Qnil
;
5981 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5982 "The operation for which `inhibit-file-name-handlers' is applicable.");
5983 Vinhibit_file_name_operation
= Qnil
;
5985 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5986 "File name in which we write a list of all auto save file names.\n\
5987 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5988 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5990 Vauto_save_list_file_name
= Qnil
;
5992 defsubr (&Sfind_file_name_handler
);
5993 defsubr (&Sfile_name_directory
);
5994 defsubr (&Sfile_name_nondirectory
);
5995 defsubr (&Sunhandled_file_name_directory
);
5996 defsubr (&Sfile_name_as_directory
);
5997 defsubr (&Sdirectory_file_name
);
5998 defsubr (&Smake_temp_name
);
5999 defsubr (&Sexpand_file_name
);
6000 defsubr (&Ssubstitute_in_file_name
);
6001 defsubr (&Scopy_file
);
6002 defsubr (&Smake_directory_internal
);
6003 defsubr (&Sdelete_directory
);
6004 defsubr (&Sdelete_file
);
6005 defsubr (&Srename_file
);
6006 defsubr (&Sadd_name_to_file
);
6008 defsubr (&Smake_symbolic_link
);
6009 #endif /* S_IFLNK */
6011 defsubr (&Sdefine_logical_name
);
6014 defsubr (&Ssysnetunam
);
6015 #endif /* HPUX_NET */
6016 defsubr (&Sfile_name_absolute_p
);
6017 defsubr (&Sfile_exists_p
);
6018 defsubr (&Sfile_executable_p
);
6019 defsubr (&Sfile_readable_p
);
6020 defsubr (&Sfile_writable_p
);
6021 defsubr (&Saccess_file
);
6022 defsubr (&Sfile_symlink_p
);
6023 defsubr (&Sfile_directory_p
);
6024 defsubr (&Sfile_accessible_directory_p
);
6025 defsubr (&Sfile_regular_p
);
6026 defsubr (&Sfile_modes
);
6027 defsubr (&Sset_file_modes
);
6028 defsubr (&Sset_default_file_modes
);
6029 defsubr (&Sdefault_file_modes
);
6030 defsubr (&Sfile_newer_than_file_p
);
6031 defsubr (&Sinsert_file_contents
);
6032 defsubr (&Swrite_region
);
6033 defsubr (&Scar_less_than_car
);
6034 defsubr (&Sverify_visited_file_modtime
);
6035 defsubr (&Sclear_visited_file_modtime
);
6036 defsubr (&Svisited_file_modtime
);
6037 defsubr (&Sset_visited_file_modtime
);
6038 defsubr (&Sdo_auto_save
);
6039 defsubr (&Sset_buffer_auto_saved
);
6040 defsubr (&Sclear_buffer_auto_save_failure
);
6041 defsubr (&Srecent_auto_save_p
);
6043 defsubr (&Sread_file_name_internal
);
6044 defsubr (&Sread_file_name
);
6047 defsubr (&Sunix_sync
);