1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
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 (GNU_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)
88 #include "intervals.h"
99 #endif /* not WINDOWSNT */
103 #include <sys/param.h>
111 #define CORRECT_DIR_SEPS(s) \
112 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
113 else unixtodos_filename (s); \
115 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
116 redirector allows the six letters between 'Z' and 'a' as well. */
118 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
121 #define IS_DRIVE(x) isalpha (x)
123 /* Need to lower-case the drive letter, or else expanded
124 filenames will sometimes compare inequal, because
125 `expand-file-name' doesn't always down-case the drive letter. */
126 #define DRIVE_LETTER(x) (tolower (x))
147 #include "commands.h"
148 extern int use_dialog_box
;
162 /* Nonzero during writing of auto-save files */
165 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
166 a new file with the same mode as the original */
167 int auto_save_mode_bits
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Format for auto-save files */
181 Lisp_Object Vauto_save_file_format
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Nonzero means, when reading a filename in the minibuffer,
203 start out by inserting the default directory into the minibuffer. */
204 int insert_default_directory
;
206 /* On VMS, nonzero means write new files with record format stmlf.
207 Zero means use var format. */
210 /* On NT, specifies the directory separator character, used (eg.) when
211 expanding file names. This can be bound to / or \. */
212 Lisp_Object Vdirectory_sep_char
;
214 extern Lisp_Object Vuser_login_name
;
217 extern Lisp_Object Vw32_get_true_file_attributes
;
220 extern int minibuf_level
;
222 extern int minibuffer_auto_raise
;
224 /* These variables describe handlers that have "already" had a chance
225 to handle the current operation.
227 Vinhibit_file_name_handlers is a list of file name handlers.
228 Vinhibit_file_name_operation is the operation being handled.
229 If we try to handle that operation, we ignore those handlers. */
231 static Lisp_Object Vinhibit_file_name_handlers
;
232 static Lisp_Object Vinhibit_file_name_operation
;
234 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
236 Lisp_Object Qfile_name_history
;
238 Lisp_Object Qcar_less_than_car
;
240 static int a_write
P_ ((int, Lisp_Object
, int, int,
241 Lisp_Object
*, struct coding_system
*));
242 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
246 report_file_error (string
, data
)
250 Lisp_Object errstring
;
253 synchronize_system_messages_locale ();
254 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
255 Vlocale_coding_system
, 0);
261 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
264 /* System error messages are capitalized. Downcase the initial
265 unless it is followed by a slash. */
266 if (XSTRING (errstring
)->data
[1] != '/')
267 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
269 Fsignal (Qfile_error
,
270 Fcons (build_string (string
), Fcons (errstring
, data
)));
275 close_file_unwind (fd
)
278 emacs_close (XFASTINT (fd
));
282 /* Restore point, having saved it as a marker. */
285 restore_point_unwind (location
)
286 Lisp_Object location
;
288 Fgoto_char (location
);
289 Fset_marker (location
, Qnil
, Qnil
);
293 Lisp_Object Qexpand_file_name
;
294 Lisp_Object Qsubstitute_in_file_name
;
295 Lisp_Object Qdirectory_file_name
;
296 Lisp_Object Qfile_name_directory
;
297 Lisp_Object Qfile_name_nondirectory
;
298 Lisp_Object Qunhandled_file_name_directory
;
299 Lisp_Object Qfile_name_as_directory
;
300 Lisp_Object Qcopy_file
;
301 Lisp_Object Qmake_directory_internal
;
302 Lisp_Object Qmake_directory
;
303 Lisp_Object Qdelete_directory
;
304 Lisp_Object Qdelete_file
;
305 Lisp_Object Qrename_file
;
306 Lisp_Object Qadd_name_to_file
;
307 Lisp_Object Qmake_symbolic_link
;
308 Lisp_Object Qfile_exists_p
;
309 Lisp_Object Qfile_executable_p
;
310 Lisp_Object Qfile_readable_p
;
311 Lisp_Object Qfile_writable_p
;
312 Lisp_Object Qfile_symlink_p
;
313 Lisp_Object Qaccess_file
;
314 Lisp_Object Qfile_directory_p
;
315 Lisp_Object Qfile_regular_p
;
316 Lisp_Object Qfile_accessible_directory_p
;
317 Lisp_Object Qfile_modes
;
318 Lisp_Object Qset_file_modes
;
319 Lisp_Object Qfile_newer_than_file_p
;
320 Lisp_Object Qinsert_file_contents
;
321 Lisp_Object Qwrite_region
;
322 Lisp_Object Qverify_visited_file_modtime
;
323 Lisp_Object Qset_visited_file_modtime
;
325 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
326 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
327 Otherwise, return nil.
328 A file name is handled if one of the regular expressions in
329 `file-name-handler-alist' matches it.
331 If OPERATION equals `inhibit-file-name-operation', then we ignore
332 any handlers that are members of `inhibit-file-name-handlers',
333 but we still do run any other handlers. This lets handlers
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
, result
;
343 CHECK_STRING (filename
);
345 if (EQ (operation
, Vinhibit_file_name_operation
))
346 inhibited_handlers
= Vinhibit_file_name_handlers
;
348 inhibited_handlers
= Qnil
;
350 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
351 chain
= XCDR (chain
))
361 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
363 Lisp_Object handler
, tem
;
365 handler
= XCDR (elt
);
366 tem
= Fmemq (handler
, inhibited_handlers
);
380 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
382 doc
: /* Return the directory component in file name FILENAME.
383 Return nil if FILENAME does not include a directory.
384 Otherwise return a directory spec.
385 Given a Unix syntax file name, returns a string ending in slash;
386 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
388 Lisp_Object filename
;
390 register unsigned char *beg
;
391 register unsigned char *p
;
394 CHECK_STRING (filename
);
396 /* If the file name has special constructs in it,
397 call the corresponding file handler. */
398 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
400 return call2 (handler
, Qfile_name_directory
, filename
);
402 #ifdef FILE_SYSTEM_CASE
403 filename
= FILE_SYSTEM_CASE (filename
);
405 beg
= XSTRING (filename
)->data
;
407 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
409 p
= beg
+ STRING_BYTES (XSTRING (filename
));
411 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
413 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
416 /* only recognise drive specifier at the beginning */
418 /* handle the "/:d:foo" and "/:foo" cases correctly */
419 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
420 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
427 /* Expansion of "c:" to drive and default directory. */
430 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
431 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
432 unsigned char *r
= res
;
434 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
436 strncpy (res
, beg
, 2);
441 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
443 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
446 p
= beg
+ strlen (beg
);
449 CORRECT_DIR_SEPS (beg
);
452 if (STRING_MULTIBYTE (filename
))
453 return make_string (beg
, p
- beg
);
454 return make_unibyte_string (beg
, p
- beg
);
457 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
458 Sfile_name_nondirectory
, 1, 1, 0,
459 doc
: /* Return file name FILENAME sans its directory.
460 For example, in a Unix-syntax file name,
461 this is everything after the last slash,
462 or the entire name if it contains no slash. */)
464 Lisp_Object filename
;
466 register unsigned char *beg
, *p
, *end
;
469 CHECK_STRING (filename
);
471 /* If the file name has special constructs in it,
472 call the corresponding file handler. */
473 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
475 return call2 (handler
, Qfile_name_nondirectory
, filename
);
477 beg
= XSTRING (filename
)->data
;
478 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
480 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
482 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
485 /* only recognise drive specifier at beginning */
487 /* handle the "/:d:foo" case correctly */
488 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
493 if (STRING_MULTIBYTE (filename
))
494 return make_string (p
, end
- p
);
495 return make_unibyte_string (p
, end
- p
);
498 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
499 Sunhandled_file_name_directory
, 1, 1, 0,
500 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
501 A `directly usable' directory name is one that may be used without the
502 intervention of any file handler.
503 If FILENAME is a directly usable file itself, return
504 \(file-name-directory FILENAME).
505 The `call-process' and `start-process' functions use this function to
506 get a current directory to run processes in. */)
508 Lisp_Object filename
;
512 /* If the file name has special constructs in it,
513 call the corresponding file handler. */
514 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
516 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
518 return Ffile_name_directory (filename
);
523 file_name_as_directory (out
, in
)
526 int size
= strlen (in
) - 1;
539 /* Is it already a directory string? */
540 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
542 /* Is it a VMS directory file name? If so, hack VMS syntax. */
543 else if (! index (in
, '/')
544 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
545 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
546 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
547 || ! strncmp (&in
[size
- 5], ".dir", 4))
548 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
549 && in
[size
] == '1')))
551 register char *p
, *dot
;
555 dir:x.dir --> dir:[x]
556 dir:[x]y.dir --> dir:[x.y] */
558 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
561 strncpy (out
, in
, p
- in
);
580 dot
= index (p
, '.');
583 /* blindly remove any extension */
584 size
= strlen (out
) + (dot
- p
);
585 strncat (out
, p
, dot
- p
);
596 /* For Unix syntax, Append a slash if necessary */
597 if (!IS_DIRECTORY_SEP (out
[size
]))
599 out
[size
+ 1] = DIRECTORY_SEP
;
600 out
[size
+ 2] = '\0';
603 CORRECT_DIR_SEPS (out
);
609 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
610 Sfile_name_as_directory
, 1, 1, 0,
611 doc
: /* Return a string representing file FILENAME interpreted as a directory.
612 This operation exists because a directory is also a file, but its name as
613 a directory is different from its name as a file.
614 The result can be used as the value of `default-directory'
615 or passed as second argument to `expand-file-name'.
616 For a Unix-syntax file name, just appends a slash.
617 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
628 /* If the file name has special constructs in it,
629 call the corresponding file handler. */
630 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
632 return call2 (handler
, Qfile_name_as_directory
, file
);
634 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
635 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
639 * Convert from directory name to filename.
641 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
642 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
643 * On UNIX, it's simple: just make sure there isn't a terminating /
645 * Value is nonzero if the string output is different from the input.
649 directory_file_name (src
, dst
)
657 struct FAB fab
= cc$rms_fab
;
658 struct NAM nam
= cc$rms_nam
;
659 char esa
[NAM$C_MAXRSS
];
664 if (! index (src
, '/')
665 && (src
[slen
- 1] == ']'
666 || src
[slen
- 1] == ':'
667 || src
[slen
- 1] == '>'))
669 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
671 fab
.fab$b_fns
= slen
;
672 fab
.fab$l_nam
= &nam
;
673 fab
.fab$l_fop
= FAB$M_NAM
;
676 nam
.nam$b_ess
= sizeof esa
;
677 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
679 /* We call SYS$PARSE to handle such things as [--] for us. */
680 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
682 slen
= nam
.nam$b_esl
;
683 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
688 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
690 /* what about when we have logical_name:???? */
691 if (src
[slen
- 1] == ':')
692 { /* Xlate logical name and see what we get */
693 ptr
= strcpy (dst
, src
); /* upper case for getenv */
696 if ('a' <= *ptr
&& *ptr
<= 'z')
700 dst
[slen
- 1] = 0; /* remove colon */
701 if (!(src
= egetenv (dst
)))
703 /* should we jump to the beginning of this procedure?
704 Good points: allows us to use logical names that xlate
706 Bad points: can be a problem if we just translated to a device
708 For now, I'll punt and always expect VMS names, and hope for
711 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
712 { /* no recursion here! */
718 { /* not a directory spec */
723 bracket
= src
[slen
- 1];
725 /* If bracket is ']' or '>', bracket - 2 is the corresponding
727 ptr
= index (src
, bracket
- 2);
729 { /* no opening bracket */
733 if (!(rptr
= rindex (src
, '.')))
736 strncpy (dst
, src
, slen
);
740 dst
[slen
++] = bracket
;
745 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
746 then translate the device and recurse. */
747 if (dst
[slen
- 1] == ':'
748 && dst
[slen
- 2] != ':' /* skip decnet nodes */
749 && strcmp (src
+ slen
, "[000000]") == 0)
751 dst
[slen
- 1] = '\0';
752 if ((ptr
= egetenv (dst
))
753 && (rlen
= strlen (ptr
) - 1) > 0
754 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
755 && ptr
[rlen
- 1] == '.')
757 char * buf
= (char *) alloca (strlen (ptr
) + 1);
761 return directory_file_name (buf
, dst
);
766 strcat (dst
, "[000000]");
770 rlen
= strlen (rptr
) - 1;
771 strncat (dst
, rptr
, rlen
);
772 dst
[slen
+ rlen
] = '\0';
773 strcat (dst
, ".DIR.1");
777 /* Process as Unix format: just remove any final slash.
778 But leave "/" unchanged; do not change it to "". */
781 /* Handle // as root for apollo's. */
782 if ((slen
> 2 && dst
[slen
- 1] == '/')
783 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
787 && IS_DIRECTORY_SEP (dst
[slen
- 1])
789 && !IS_ANY_SEP (dst
[slen
- 2])
795 CORRECT_DIR_SEPS (dst
);
800 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
802 doc
: /* Returns the file name of the directory named DIRECTORY.
803 This is the name of the file that holds the data for the directory DIRECTORY.
804 This operation exists because a directory is also a file, but its name as
805 a directory is different from its name as a file.
806 In Unix-syntax, this function just removes the final slash.
807 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
808 it returns a file name such as \"[X]Y.DIR.1\". */)
810 Lisp_Object directory
;
815 CHECK_STRING (directory
);
817 if (NILP (directory
))
820 /* If the file name has special constructs in it,
821 call the corresponding file handler. */
822 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
824 return call2 (handler
, Qdirectory_file_name
, directory
);
827 /* 20 extra chars is insufficient for VMS, since we might perform a
828 logical name translation. an equivalence string can be up to 255
829 chars long, so grab that much extra space... - sss */
830 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
832 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
834 directory_file_name (XSTRING (directory
)->data
, buf
);
835 return build_string (buf
);
838 static char make_temp_name_tbl
[64] =
840 'A','B','C','D','E','F','G','H',
841 'I','J','K','L','M','N','O','P',
842 'Q','R','S','T','U','V','W','X',
843 'Y','Z','a','b','c','d','e','f',
844 'g','h','i','j','k','l','m','n',
845 'o','p','q','r','s','t','u','v',
846 'w','x','y','z','0','1','2','3',
847 '4','5','6','7','8','9','-','_'
850 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
852 /* Value is a temporary file name starting with PREFIX, a string.
854 The Emacs process number forms part of the result, so there is
855 no danger of generating a name being used by another process.
856 In addition, this function makes an attempt to choose a name
857 which has no existing file. To make this work, PREFIX should be
858 an absolute file name.
860 BASE64_P non-zero means add the pid as 3 characters in base64
861 encoding. In this case, 6 characters will be added to PREFIX to
862 form the file name. Otherwise, if Emacs is running on a system
863 with long file names, add the pid as a decimal number.
865 This function signals an error if no unique file name could be
869 make_temp_name (prefix
, base64_p
)
876 unsigned char *p
, *data
;
880 CHECK_STRING (prefix
);
882 /* VAL is created by adding 6 characters to PREFIX. The first
883 three are the PID of this process, in base 64, and the second
884 three are incremented if the file already exists. This ensures
885 262144 unique file names per PID per PREFIX. */
887 pid
= (int) getpid ();
891 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
892 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
893 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
898 #ifdef HAVE_LONG_FILE_NAMES
899 sprintf (pidbuf
, "%d", pid
);
900 pidlen
= strlen (pidbuf
);
902 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
903 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
904 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
909 len
= XSTRING (prefix
)->size
;
910 val
= make_uninit_string (len
+ 3 + pidlen
);
911 data
= XSTRING (val
)->data
;
912 bcopy(XSTRING (prefix
)->data
, data
, len
);
915 bcopy (pidbuf
, p
, pidlen
);
918 /* Here we try to minimize useless stat'ing when this function is
919 invoked many times successively with the same PREFIX. We achieve
920 this by initializing count to a random value, and incrementing it
923 We don't want make-temp-name to be called while dumping,
924 because then make_temp_name_count_initialized_p would get set
925 and then make_temp_name_count would not be set when Emacs starts. */
927 if (!make_temp_name_count_initialized_p
)
929 make_temp_name_count
= (unsigned) time (NULL
);
930 make_temp_name_count_initialized_p
= 1;
936 unsigned num
= make_temp_name_count
;
938 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
939 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
940 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
942 /* Poor man's congruential RN generator. Replace with
943 ++make_temp_name_count for debugging. */
944 make_temp_name_count
+= 25229;
945 make_temp_name_count
%= 225307;
947 if (stat (data
, &ignored
) < 0)
949 /* We want to return only if errno is ENOENT. */
953 /* The error here is dubious, but there is little else we
954 can do. The alternatives are to return nil, which is
955 as bad as (and in many cases worse than) throwing the
956 error, or to ignore the error, which will likely result
957 in looping through 225307 stat's, which is not only
958 dog-slow, but also useless since it will fallback to
959 the errow below, anyway. */
960 report_file_error ("Cannot create temporary name for prefix",
961 Fcons (prefix
, Qnil
));
966 error ("Cannot create temporary name for prefix `%s'",
967 XSTRING (prefix
)->data
);
972 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
973 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
974 The Emacs process number forms part of the result,
975 so there is no danger of generating a name being used by another process.
977 In addition, this function makes an attempt to choose a name
978 which has no existing file. To make this work,
979 PREFIX should be an absolute file name.
981 There is a race condition between calling `make-temp-name' and creating the
982 file which opens all kinds of security holes. For that reason, you should
983 probably use `make-temp-file' instead. */)
987 return make_temp_name (prefix
, 0);
992 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
993 doc
: /* Convert filename NAME to absolute, and canonicalize it.
994 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
995 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
996 the current buffer's value of default-directory is used.
997 File name components that are `.' are removed, and
998 so are file name components followed by `..', along with the `..' itself;
999 note that these simplifications are done without checking the resulting
1000 file names in the file system.
1001 An initial `~/' expands to your home directory.
1002 An initial `~USER/' expands to USER's home directory.
1003 See also the function `substitute-in-file-name'. */)
1004 (name
, default_directory
)
1005 Lisp_Object name
, default_directory
;
1009 register unsigned char *newdir
, *p
, *o
;
1011 unsigned char *target
;
1014 unsigned char * colon
= 0;
1015 unsigned char * close
= 0;
1016 unsigned char * slash
= 0;
1017 unsigned char * brack
= 0;
1018 int lbrack
= 0, rbrack
= 0;
1023 int collapse_newdir
= 1;
1027 Lisp_Object handler
;
1029 CHECK_STRING (name
);
1031 /* If the file name has special constructs in it,
1032 call the corresponding file handler. */
1033 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1034 if (!NILP (handler
))
1035 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1037 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1038 if (NILP (default_directory
))
1039 default_directory
= current_buffer
->directory
;
1040 if (! STRINGP (default_directory
))
1043 /* "/" is not considered a root directory on DOS_NT, so using "/"
1044 here causes an infinite recursion in, e.g., the following:
1046 (let (default-directory)
1047 (expand-file-name "a"))
1049 To avoid this, we set default_directory to the root of the
1051 extern char *emacs_root_dir (void);
1053 default_directory
= build_string (emacs_root_dir ());
1055 default_directory
= build_string ("/");
1059 if (!NILP (default_directory
))
1061 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1062 if (!NILP (handler
))
1063 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1066 o
= XSTRING (default_directory
)->data
;
1068 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1069 It would be better to do this down below where we actually use
1070 default_directory. Unfortunately, calling Fexpand_file_name recursively
1071 could invoke GC, and the strings might be relocated. This would
1072 be annoying because we have pointers into strings lying around
1073 that would need adjusting, and people would add new pointers to
1074 the code and forget to adjust them, resulting in intermittent bugs.
1075 Putting this call here avoids all that crud.
1077 The EQ test avoids infinite recursion. */
1078 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1079 /* Save time in some common cases - as long as default_directory
1080 is not relative, it can be canonicalized with name below (if it
1081 is needed at all) without requiring it to be expanded now. */
1083 /* Detect MSDOS file names with drive specifiers. */
1084 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1086 /* Detect Windows file names in UNC format. */
1087 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1089 #else /* not DOS_NT */
1090 /* Detect Unix absolute file names (/... alone is not absolute on
1092 && ! (IS_DIRECTORY_SEP (o
[0]))
1093 #endif /* not DOS_NT */
1096 struct gcpro gcpro1
;
1099 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1104 /* Filenames on VMS are always upper case. */
1105 name
= Fupcase (name
);
1107 #ifdef FILE_SYSTEM_CASE
1108 name
= FILE_SYSTEM_CASE (name
);
1111 nm
= XSTRING (name
)->data
;
1114 /* We will force directory separators to be either all \ or /, so make
1115 a local copy to modify, even if there ends up being no change. */
1116 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1118 /* Note if special escape prefix is present, but remove for now. */
1119 if (nm
[0] == '/' && nm
[1] == ':')
1125 /* Find and remove drive specifier if present; this makes nm absolute
1126 even if the rest of the name appears to be relative. Only look for
1127 drive specifier at the beginning. */
1128 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1135 /* If we see "c://somedir", we want to strip the first slash after the
1136 colon when stripping the drive letter. Otherwise, this expands to
1138 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1140 #endif /* WINDOWSNT */
1144 /* Discard any previous drive specifier if nm is now in UNC format. */
1145 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1151 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1152 none are found, we can probably return right away. We will avoid
1153 allocating a new string if name is already fully expanded. */
1155 IS_DIRECTORY_SEP (nm
[0])
1157 && drive
&& !is_escaped
1160 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1167 /* If it turns out that the filename we want to return is just a
1168 suffix of FILENAME, we don't need to go through and edit
1169 things; we just need to construct a new string using data
1170 starting at the middle of FILENAME. If we set lose to a
1171 non-zero value, that means we've discovered that we can't do
1178 /* Since we know the name is absolute, we can assume that each
1179 element starts with a "/". */
1181 /* "." and ".." are hairy. */
1182 if (IS_DIRECTORY_SEP (p
[0])
1184 && (IS_DIRECTORY_SEP (p
[2])
1186 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1189 /* We want to replace multiple `/' in a row with a single
1192 && IS_DIRECTORY_SEP (p
[0])
1193 && IS_DIRECTORY_SEP (p
[1]))
1200 /* if dev:[dir]/, move nm to / */
1201 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1202 nm
= (brack
? brack
+ 1 : colon
+ 1);
1203 lbrack
= rbrack
= 0;
1211 /* VMS pre V4.4,convert '-'s in filenames. */
1212 if (lbrack
== rbrack
)
1214 if (dots
< 2) /* this is to allow negative version numbers */
1219 if (lbrack
> rbrack
&&
1220 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1221 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1227 /* count open brackets, reset close bracket pointer */
1228 if (p
[0] == '[' || p
[0] == '<')
1229 lbrack
++, brack
= 0;
1230 /* count close brackets, set close bracket pointer */
1231 if (p
[0] == ']' || p
[0] == '>')
1232 rbrack
++, brack
= p
;
1233 /* detect ][ or >< */
1234 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1236 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1237 nm
= p
+ 1, lose
= 1;
1238 if (p
[0] == ':' && (colon
|| slash
))
1239 /* if dev1:[dir]dev2:, move nm to dev2: */
1245 /* if /name/dev:, move nm to dev: */
1248 /* if node::dev:, move colon following dev */
1249 else if (colon
&& colon
[-1] == ':')
1251 /* if dev1:dev2:, move nm to dev2: */
1252 else if (colon
&& colon
[-1] != ':')
1257 if (p
[0] == ':' && !colon
)
1263 if (lbrack
== rbrack
)
1266 else if (p
[0] == '.')
1274 if (index (nm
, '/'))
1275 return build_string (sys_translate_unix (nm
));
1278 /* Make sure directories are all separated with / or \ as
1279 desired, but avoid allocation of a new string when not
1281 CORRECT_DIR_SEPS (nm
);
1283 if (IS_DIRECTORY_SEP (nm
[1]))
1285 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1286 name
= build_string (nm
);
1290 /* drive must be set, so this is okay */
1291 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1293 name
= make_string (nm
- 2, p
- nm
+ 2);
1294 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1295 XSTRING (name
)->data
[1] = ':';
1298 #else /* not DOS_NT */
1299 if (nm
== XSTRING (name
)->data
)
1301 return build_string (nm
);
1302 #endif /* not DOS_NT */
1306 /* At this point, nm might or might not be an absolute file name. We
1307 need to expand ~ or ~user if present, otherwise prefix nm with
1308 default_directory if nm is not absolute, and finally collapse /./
1309 and /foo/../ sequences.
1311 We set newdir to be the appropriate prefix if one is needed:
1312 - the relevant user directory if nm starts with ~ or ~user
1313 - the specified drive's working dir (DOS/NT only) if nm does not
1315 - the value of default_directory.
1317 Note that these prefixes are not guaranteed to be absolute (except
1318 for the working dir of a drive). Therefore, to ensure we always
1319 return an absolute name, if the final prefix is not absolute we
1320 append it to the current working directory. */
1324 if (nm
[0] == '~') /* prefix ~ */
1326 if (IS_DIRECTORY_SEP (nm
[1])
1330 || nm
[1] == 0) /* ~ by itself */
1332 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1333 newdir
= (unsigned char *) "";
1336 collapse_newdir
= 0;
1339 nm
++; /* Don't leave the slash in nm. */
1342 else /* ~user/filename */
1344 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1349 o
= (unsigned char *) alloca (p
- nm
+ 1);
1350 bcopy ((char *) nm
, o
, p
- nm
);
1353 pw
= (struct passwd
*) getpwnam (o
+ 1);
1356 newdir
= (unsigned char *) pw
-> pw_dir
;
1358 nm
= p
+ 1; /* skip the terminator */
1362 collapse_newdir
= 0;
1367 /* If we don't find a user of that name, leave the name
1368 unchanged; don't move nm forward to p. */
1373 /* On DOS and Windows, nm is absolute if a drive name was specified;
1374 use the drive's current directory as the prefix if needed. */
1375 if (!newdir
&& drive
)
1377 /* Get default directory if needed to make nm absolute. */
1378 if (!IS_DIRECTORY_SEP (nm
[0]))
1380 newdir
= alloca (MAXPATHLEN
+ 1);
1381 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1386 /* Either nm starts with /, or drive isn't mounted. */
1387 newdir
= alloca (4);
1388 newdir
[0] = DRIVE_LETTER (drive
);
1396 /* Finally, if no prefix has been specified and nm is not absolute,
1397 then it must be expanded relative to default_directory. */
1401 /* /... alone is not absolute on DOS and Windows. */
1402 && !IS_DIRECTORY_SEP (nm
[0])
1405 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1412 newdir
= XSTRING (default_directory
)->data
;
1414 /* Note if special escape prefix is present, but remove for now. */
1415 if (newdir
[0] == '/' && newdir
[1] == ':')
1426 /* First ensure newdir is an absolute name. */
1428 /* Detect MSDOS file names with drive specifiers. */
1429 ! (IS_DRIVE (newdir
[0])
1430 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1432 /* Detect Windows file names in UNC format. */
1433 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1437 /* Effectively, let newdir be (expand-file-name newdir cwd).
1438 Because of the admonition against calling expand-file-name
1439 when we have pointers into lisp strings, we accomplish this
1440 indirectly by prepending newdir to nm if necessary, and using
1441 cwd (or the wd of newdir's drive) as the new newdir. */
1443 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1448 if (!IS_DIRECTORY_SEP (nm
[0]))
1450 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1451 file_name_as_directory (tmp
, newdir
);
1455 newdir
= alloca (MAXPATHLEN
+ 1);
1458 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1465 /* Strip off drive name from prefix, if present. */
1466 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1472 /* Keep only a prefix from newdir if nm starts with slash
1473 (//server/share for UNC, nothing otherwise). */
1474 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1477 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1479 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1481 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1483 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1495 /* Get rid of any slash at the end of newdir, unless newdir is
1496 just / or // (an incomplete UNC name). */
1497 length
= strlen (newdir
);
1498 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1500 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1504 unsigned char *temp
= (unsigned char *) alloca (length
);
1505 bcopy (newdir
, temp
, length
- 1);
1506 temp
[length
- 1] = 0;
1514 /* Now concatenate the directory and name to new space in the stack frame */
1515 tlen
+= strlen (nm
) + 1;
1517 /* Reserve space for drive specifier and escape prefix, since either
1518 or both may need to be inserted. (The Microsoft x86 compiler
1519 produces incorrect code if the following two lines are combined.) */
1520 target
= (unsigned char *) alloca (tlen
+ 4);
1522 #else /* not DOS_NT */
1523 target
= (unsigned char *) alloca (tlen
);
1524 #endif /* not DOS_NT */
1530 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1533 /* If newdir is effectively "C:/", then the drive letter will have
1534 been stripped and newdir will be "/". Concatenating with an
1535 absolute directory in nm produces "//", which will then be
1536 incorrectly treated as a network share. Ignore newdir in
1537 this case (keeping the drive letter). */
1538 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1539 && newdir
[1] == '\0'))
1541 strcpy (target
, newdir
);
1545 file_name_as_directory (target
, newdir
);
1548 strcat (target
, nm
);
1550 if (index (target
, '/'))
1551 strcpy (target
, sys_translate_unix (target
));
1554 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1556 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1565 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1571 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1572 /* brackets are offset from each other by 2 */
1575 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1576 /* convert [foo][bar] to [bar] */
1577 while (o
[-1] != '[' && o
[-1] != '<')
1579 else if (*p
== '-' && *o
!= '.')
1582 else if (p
[0] == '-' && o
[-1] == '.' &&
1583 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1584 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1588 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1589 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1591 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1593 /* else [foo.-] ==> [-] */
1599 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1600 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1606 if (!IS_DIRECTORY_SEP (*p
))
1610 else if (IS_DIRECTORY_SEP (p
[0])
1612 && (IS_DIRECTORY_SEP (p
[2])
1615 /* If "/." is the entire filename, keep the "/". Otherwise,
1616 just delete the whole "/.". */
1617 if (o
== target
&& p
[2] == '\0')
1621 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1622 /* `/../' is the "superroot" on certain file systems. */
1624 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1626 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1628 /* Keep initial / only if this is the whole name. */
1629 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1634 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1636 /* Collapse multiple `/' in a row. */
1638 while (IS_DIRECTORY_SEP (*p
))
1645 #endif /* not VMS */
1649 /* At last, set drive name. */
1651 /* Except for network file name. */
1652 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1653 #endif /* WINDOWSNT */
1655 if (!drive
) abort ();
1657 target
[0] = DRIVE_LETTER (drive
);
1660 /* Reinsert the escape prefix if required. */
1667 CORRECT_DIR_SEPS (target
);
1670 return make_string (target
, o
- target
);
1674 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1675 This is the old version of expand-file-name, before it was thoroughly
1676 rewritten for Emacs 10.31. We leave this version here commented-out,
1677 because the code is very complex and likely to have subtle bugs. If
1678 bugs _are_ found, it might be of interest to look at the old code and
1679 see what did it do in the relevant situation.
1681 Don't remove this code: it's true that it will be accessible via CVS,
1682 but a few years from deletion, people will forget it is there. */
1684 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1685 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1686 "Convert FILENAME to absolute, and canonicalize it.\n\
1687 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1688 (does not start with slash); if DEFAULT is nil or missing,\n\
1689 the current buffer's value of default-directory is used.\n\
1690 Filenames containing `.' or `..' as components are simplified;\n\
1691 initial `~/' expands to your home directory.\n\
1692 See also the function `substitute-in-file-name'.")
1694 Lisp_Object name
, defalt
;
1698 register unsigned char *newdir
, *p
, *o
;
1700 unsigned char *target
;
1704 unsigned char * colon
= 0;
1705 unsigned char * close
= 0;
1706 unsigned char * slash
= 0;
1707 unsigned char * brack
= 0;
1708 int lbrack
= 0, rbrack
= 0;
1712 CHECK_STRING (name
);
1715 /* Filenames on VMS are always upper case. */
1716 name
= Fupcase (name
);
1719 nm
= XSTRING (name
)->data
;
1721 /* If nm is absolute, flush ...// and detect /./ and /../.
1722 If no /./ or /../ we can return right away. */
1734 if (p
[0] == '/' && p
[1] == '/'
1736 /* // at start of filename is meaningful on Apollo system. */
1741 if (p
[0] == '/' && p
[1] == '~')
1742 nm
= p
+ 1, lose
= 1;
1743 if (p
[0] == '/' && p
[1] == '.'
1744 && (p
[2] == '/' || p
[2] == 0
1745 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1751 /* if dev:[dir]/, move nm to / */
1752 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1753 nm
= (brack
? brack
+ 1 : colon
+ 1);
1754 lbrack
= rbrack
= 0;
1762 /* VMS pre V4.4,convert '-'s in filenames. */
1763 if (lbrack
== rbrack
)
1765 if (dots
< 2) /* this is to allow negative version numbers */
1770 if (lbrack
> rbrack
&&
1771 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1772 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1778 /* count open brackets, reset close bracket pointer */
1779 if (p
[0] == '[' || p
[0] == '<')
1780 lbrack
++, brack
= 0;
1781 /* count close brackets, set close bracket pointer */
1782 if (p
[0] == ']' || p
[0] == '>')
1783 rbrack
++, brack
= p
;
1784 /* detect ][ or >< */
1785 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1787 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1788 nm
= p
+ 1, lose
= 1;
1789 if (p
[0] == ':' && (colon
|| slash
))
1790 /* if dev1:[dir]dev2:, move nm to dev2: */
1796 /* If /name/dev:, move nm to dev: */
1799 /* If node::dev:, move colon following dev */
1800 else if (colon
&& colon
[-1] == ':')
1802 /* If dev1:dev2:, move nm to dev2: */
1803 else if (colon
&& colon
[-1] != ':')
1808 if (p
[0] == ':' && !colon
)
1814 if (lbrack
== rbrack
)
1817 else if (p
[0] == '.')
1825 if (index (nm
, '/'))
1826 return build_string (sys_translate_unix (nm
));
1828 if (nm
== XSTRING (name
)->data
)
1830 return build_string (nm
);
1834 /* Now determine directory to start with and put it in NEWDIR */
1838 if (nm
[0] == '~') /* prefix ~ */
1843 || nm
[1] == 0)/* ~/filename */
1845 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1846 newdir
= (unsigned char *) "";
1849 nm
++; /* Don't leave the slash in nm. */
1852 else /* ~user/filename */
1854 /* Get past ~ to user */
1855 unsigned char *user
= nm
+ 1;
1856 /* Find end of name. */
1857 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1858 int len
= ptr
? ptr
- user
: strlen (user
);
1860 unsigned char *ptr1
= index (user
, ':');
1861 if (ptr1
!= 0 && ptr1
- user
< len
)
1864 /* Copy the user name into temp storage. */
1865 o
= (unsigned char *) alloca (len
+ 1);
1866 bcopy ((char *) user
, o
, len
);
1869 /* Look up the user name. */
1870 pw
= (struct passwd
*) getpwnam (o
+ 1);
1872 error ("\"%s\" isn't a registered user", o
+ 1);
1874 newdir
= (unsigned char *) pw
->pw_dir
;
1876 /* Discard the user name from NM. */
1883 #endif /* not VMS */
1887 defalt
= current_buffer
->directory
;
1888 CHECK_STRING (defalt
);
1889 newdir
= XSTRING (defalt
)->data
;
1892 /* Now concatenate the directory and name to new space in the stack frame */
1894 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1895 target
= (unsigned char *) alloca (tlen
);
1901 if (nm
[0] == 0 || nm
[0] == '/')
1902 strcpy (target
, newdir
);
1905 file_name_as_directory (target
, newdir
);
1908 strcat (target
, nm
);
1910 if (index (target
, '/'))
1911 strcpy (target
, sys_translate_unix (target
));
1914 /* Now canonicalize by removing /. and /foo/.. if they appear */
1922 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1928 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1929 /* brackets are offset from each other by 2 */
1932 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1933 /* convert [foo][bar] to [bar] */
1934 while (o
[-1] != '[' && o
[-1] != '<')
1936 else if (*p
== '-' && *o
!= '.')
1939 else if (p
[0] == '-' && o
[-1] == '.' &&
1940 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1941 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1945 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1946 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1948 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1950 /* else [foo.-] ==> [-] */
1956 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1957 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1967 else if (!strncmp (p
, "//", 2)
1969 /* // at start of filename is meaningful in Apollo system. */
1977 else if (p
[0] == '/' && p
[1] == '.' &&
1978 (p
[2] == '/' || p
[2] == 0))
1980 else if (!strncmp (p
, "/..", 3)
1981 /* `/../' is the "superroot" on certain file systems. */
1983 && (p
[3] == '/' || p
[3] == 0))
1985 while (o
!= target
&& *--o
!= '/')
1988 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1992 if (o
== target
&& *o
== '/')
2000 #endif /* not VMS */
2003 return make_string (target
, o
- target
);
2007 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2008 Ssubstitute_in_file_name
, 1, 1, 0,
2009 doc
: /* Substitute environment variables referred to in FILENAME.
2010 `$FOO' where FOO is an environment variable name means to substitute
2011 the value of that variable. The variable name should be terminated
2012 with a character not a letter, digit or underscore; otherwise, enclose
2013 the entire variable name in braces.
2014 If `/~' appears, all of FILENAME through that `/' is discarded.
2016 On VMS, `$' substitution is not done; this function does little and only
2017 duplicates what `expand-file-name' does. */)
2019 Lisp_Object filename
;
2023 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2024 unsigned char *target
= NULL
;
2026 int substituted
= 0;
2028 Lisp_Object handler
;
2030 CHECK_STRING (filename
);
2032 /* If the file name has special constructs in it,
2033 call the corresponding file handler. */
2034 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2035 if (!NILP (handler
))
2036 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2038 nm
= XSTRING (filename
)->data
;
2040 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2041 CORRECT_DIR_SEPS (nm
);
2042 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
2044 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
2046 /* If /~ or // appears, discard everything through first slash. */
2048 for (p
= nm
; p
!= endp
; p
++)
2051 #if defined (APOLLO) || defined (WINDOWSNT)
2052 /* // at start of file name is meaningful in Apollo and
2053 WindowsNT systems. */
2054 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2055 #else /* not (APOLLO || WINDOWSNT) */
2056 || IS_DIRECTORY_SEP (p
[0])
2057 #endif /* not (APOLLO || WINDOWSNT) */
2062 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2064 || IS_DIRECTORY_SEP (p
[-1])))
2070 /* see comment in expand-file-name about drive specifiers */
2071 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2072 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2081 return build_string (nm
);
2084 /* See if any variables are substituted into the string
2085 and find the total length of their values in `total' */
2087 for (p
= nm
; p
!= endp
;)
2097 /* "$$" means a single "$" */
2106 while (p
!= endp
&& *p
!= '}') p
++;
2107 if (*p
!= '}') goto missingclose
;
2113 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2117 /* Copy out the variable name */
2118 target
= (unsigned char *) alloca (s
- o
+ 1);
2119 strncpy (target
, o
, s
- o
);
2122 strupr (target
); /* $home == $HOME etc. */
2125 /* Get variable value */
2126 o
= (unsigned char *) egetenv (target
);
2129 total
+= strlen (o
);
2139 /* If substitution required, recopy the string and do it */
2140 /* Make space in stack frame for the new copy */
2141 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2144 /* Copy the rest of the name through, replacing $ constructs with values */
2161 while (p
!= endp
&& *p
!= '}') p
++;
2162 if (*p
!= '}') goto missingclose
;
2168 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2172 /* Copy out the variable name */
2173 target
= (unsigned char *) alloca (s
- o
+ 1);
2174 strncpy (target
, o
, s
- o
);
2177 strupr (target
); /* $home == $HOME etc. */
2180 /* Get variable value */
2181 o
= (unsigned char *) egetenv (target
);
2185 strcpy (x
, target
); x
+= strlen (target
);
2187 else if (STRING_MULTIBYTE (filename
))
2189 /* If the original string is multibyte,
2190 convert what we substitute into multibyte. */
2193 int c
= unibyte_char_to_multibyte (*o
++);
2194 x
+= CHAR_STRING (c
, x
);
2206 /* If /~ or // appears, discard everything through first slash. */
2208 for (p
= xnm
; p
!= x
; p
++)
2210 #if defined (APOLLO) || defined (WINDOWSNT)
2211 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2212 #else /* not (APOLLO || WINDOWSNT) */
2213 || IS_DIRECTORY_SEP (p
[0])
2214 #endif /* not (APOLLO || WINDOWSNT) */
2216 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2219 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2220 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2224 if (STRING_MULTIBYTE (filename
))
2225 return make_string (xnm
, x
- xnm
);
2226 return make_unibyte_string (xnm
, x
- xnm
);
2229 error ("Bad format environment-variable substitution");
2231 error ("Missing \"}\" in environment-variable substitution");
2233 error ("Substituting nonexistent environment variable \"%s\"", target
);
2236 #endif /* not VMS */
2240 /* A slightly faster and more convenient way to get
2241 (directory-file-name (expand-file-name FOO)). */
2244 expand_and_dir_to_file (filename
, defdir
)
2245 Lisp_Object filename
, defdir
;
2247 register Lisp_Object absname
;
2249 absname
= Fexpand_file_name (filename
, defdir
);
2252 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2253 if (c
== ':' || c
== ']' || c
== '>')
2254 absname
= Fdirectory_file_name (absname
);
2257 /* Remove final slash, if any (unless this is the root dir).
2258 stat behaves differently depending! */
2259 if (XSTRING (absname
)->size
> 1
2260 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2261 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2262 /* We cannot take shortcuts; they might be wrong for magic file names. */
2263 absname
= Fdirectory_file_name (absname
);
2268 /* Signal an error if the file ABSNAME already exists.
2269 If INTERACTIVE is nonzero, ask the user whether to proceed,
2270 and bypass the error if the user says to go ahead.
2271 QUERYSTRING is a name for the action that is being considered
2274 *STATPTR is used to store the stat information if the file exists.
2275 If the file does not exist, STATPTR->st_mode is set to 0.
2276 If STATPTR is null, we don't store into it.
2278 If QUICK is nonzero, we ask for y or n, not yes or no. */
2281 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2282 Lisp_Object absname
;
2283 unsigned char *querystring
;
2285 struct stat
*statptr
;
2288 register Lisp_Object tem
, encoded_filename
;
2289 struct stat statbuf
;
2290 struct gcpro gcpro1
;
2292 encoded_filename
= ENCODE_FILE (absname
);
2294 /* stat is a good way to tell whether the file exists,
2295 regardless of what access permissions it has. */
2296 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2299 Fsignal (Qfile_already_exists
,
2300 Fcons (build_string ("File already exists"),
2301 Fcons (absname
, Qnil
)));
2303 tem
= format1 ("File %s already exists; %s anyway? ",
2304 XSTRING (absname
)->data
, querystring
);
2306 tem
= Fy_or_n_p (tem
);
2308 tem
= do_yes_or_no_p (tem
);
2311 Fsignal (Qfile_already_exists
,
2312 Fcons (build_string ("File already exists"),
2313 Fcons (absname
, Qnil
)));
2320 statptr
->st_mode
= 0;
2325 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2326 "fCopy file: \nFCopy %s to file: \np\nP",
2327 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2328 If NEWNAME names a directory, copy FILE there.
2329 Signals a `file-already-exists' error if file NEWNAME already exists,
2330 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2331 A number as third arg means request confirmation if NEWNAME already exists.
2332 This is what happens in interactive use with M-x.
2333 Fourth arg KEEP-TIME non-nil means give the new file the same
2334 last-modified time as the old one. (This works on only some systems.)
2335 A prefix arg makes KEEP-TIME non-nil. */)
2336 (file
, newname
, ok_if_already_exists
, keep_time
)
2337 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2340 char buf
[16 * 1024];
2341 struct stat st
, out_st
;
2342 Lisp_Object handler
;
2343 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2344 int count
= specpdl_ptr
- specpdl
;
2345 int input_file_statable_p
;
2346 Lisp_Object encoded_file
, encoded_newname
;
2348 encoded_file
= encoded_newname
= Qnil
;
2349 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2350 CHECK_STRING (file
);
2351 CHECK_STRING (newname
);
2353 if (!NILP (Ffile_directory_p (newname
)))
2354 newname
= Fexpand_file_name (file
, newname
);
2356 newname
= Fexpand_file_name (newname
, Qnil
);
2358 file
= Fexpand_file_name (file
, Qnil
);
2360 /* If the input file name has special constructs in it,
2361 call the corresponding file handler. */
2362 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2363 /* Likewise for output file name. */
2365 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2366 if (!NILP (handler
))
2367 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2368 ok_if_already_exists
, keep_time
));
2370 encoded_file
= ENCODE_FILE (file
);
2371 encoded_newname
= ENCODE_FILE (newname
);
2373 if (NILP (ok_if_already_exists
)
2374 || INTEGERP (ok_if_already_exists
))
2375 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2376 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2377 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2381 if (!CopyFile (XSTRING (encoded_file
)->data
,
2382 XSTRING (encoded_newname
)->data
,
2384 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2385 else if (NILP (keep_time
))
2388 EMACS_GET_TIME (now
);
2389 if (set_file_times (XSTRING (encoded_newname
)->data
,
2391 Fsignal (Qfile_date_error
,
2392 Fcons (build_string ("Cannot set file date"),
2393 Fcons (newname
, Qnil
)));
2395 #else /* not WINDOWSNT */
2396 ifd
= emacs_open (XSTRING (encoded_file
)->data
, O_RDONLY
, 0);
2398 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2400 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2402 /* We can only copy regular files and symbolic links. Other files are not
2404 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2406 #if !defined (DOS_NT) || __DJGPP__ > 1
2407 if (out_st
.st_mode
!= 0
2408 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2411 report_file_error ("Input and output files are the same",
2412 Fcons (file
, Fcons (newname
, Qnil
)));
2416 #if defined (S_ISREG) && defined (S_ISLNK)
2417 if (input_file_statable_p
)
2419 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2421 #if defined (EISDIR)
2422 /* Get a better looking error message. */
2425 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2428 #endif /* S_ISREG && S_ISLNK */
2431 /* Create the copy file with the same record format as the input file */
2432 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2435 /* System's default file type was set to binary by _fmode in emacs.c. */
2436 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2437 #else /* not MSDOS */
2438 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2439 #endif /* not MSDOS */
2442 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2444 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2448 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2449 if (emacs_write (ofd
, buf
, n
) != n
)
2450 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2453 /* Closing the output clobbers the file times on some systems. */
2454 if (emacs_close (ofd
) < 0)
2455 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2457 if (input_file_statable_p
)
2459 if (!NILP (keep_time
))
2461 EMACS_TIME atime
, mtime
;
2462 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2463 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2464 if (set_file_times (XSTRING (encoded_newname
)->data
,
2466 Fsignal (Qfile_date_error
,
2467 Fcons (build_string ("Cannot set file date"),
2468 Fcons (newname
, Qnil
)));
2471 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2473 #if defined (__DJGPP__) && __DJGPP__ > 1
2474 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2475 and if it can't, it tells so. Otherwise, under MSDOS we usually
2476 get only the READ bit, which will make the copied file read-only,
2477 so it's better not to chmod at all. */
2478 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2479 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2480 #endif /* DJGPP version 2 or newer */
2485 #endif /* WINDOWSNT */
2487 /* Discard the unwind protects. */
2488 specpdl_ptr
= specpdl
+ count
;
2494 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2495 Smake_directory_internal
, 1, 1, 0,
2496 doc
: /* Create a new directory named DIRECTORY. */)
2498 Lisp_Object directory
;
2501 Lisp_Object handler
;
2502 Lisp_Object encoded_dir
;
2504 CHECK_STRING (directory
);
2505 directory
= Fexpand_file_name (directory
, Qnil
);
2507 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2508 if (!NILP (handler
))
2509 return call2 (handler
, Qmake_directory_internal
, directory
);
2511 encoded_dir
= ENCODE_FILE (directory
);
2513 dir
= XSTRING (encoded_dir
)->data
;
2516 if (mkdir (dir
) != 0)
2518 if (mkdir (dir
, 0777) != 0)
2520 report_file_error ("Creating directory", Flist (1, &directory
));
2525 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2526 doc
: /* Delete the directory named DIRECTORY. */)
2528 Lisp_Object directory
;
2531 Lisp_Object handler
;
2532 Lisp_Object encoded_dir
;
2534 CHECK_STRING (directory
);
2535 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2537 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2538 if (!NILP (handler
))
2539 return call2 (handler
, Qdelete_directory
, directory
);
2541 encoded_dir
= ENCODE_FILE (directory
);
2543 dir
= XSTRING (encoded_dir
)->data
;
2545 if (rmdir (dir
) != 0)
2546 report_file_error ("Removing directory", Flist (1, &directory
));
2551 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2552 doc
: /* Delete file named FILENAME.
2553 If file has multiple names, it continues to exist with the other names. */)
2555 Lisp_Object filename
;
2557 Lisp_Object handler
;
2558 Lisp_Object encoded_file
;
2560 CHECK_STRING (filename
);
2561 filename
= Fexpand_file_name (filename
, Qnil
);
2563 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2564 if (!NILP (handler
))
2565 return call2 (handler
, Qdelete_file
, filename
);
2567 encoded_file
= ENCODE_FILE (filename
);
2569 if (0 > unlink (XSTRING (encoded_file
)->data
))
2570 report_file_error ("Removing old name", Flist (1, &filename
));
2575 internal_delete_file_1 (ignore
)
2581 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2584 internal_delete_file (filename
)
2585 Lisp_Object filename
;
2587 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2588 Qt
, internal_delete_file_1
));
2591 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2592 "fRename file: \nFRename %s to file: \np",
2593 doc
: /* Rename FILE as NEWNAME. Both args strings.
2594 If file has names other than FILE, it continues to have those names.
2595 Signals a `file-already-exists' error if a file NEWNAME already exists
2596 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2597 A number as third arg means request confirmation if NEWNAME already exists.
2598 This is what happens in interactive use with M-x. */)
2599 (file
, newname
, ok_if_already_exists
)
2600 Lisp_Object file
, newname
, ok_if_already_exists
;
2603 Lisp_Object args
[2];
2605 Lisp_Object handler
;
2606 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2607 Lisp_Object encoded_file
, encoded_newname
;
2609 encoded_file
= encoded_newname
= Qnil
;
2610 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2611 CHECK_STRING (file
);
2612 CHECK_STRING (newname
);
2613 file
= Fexpand_file_name (file
, Qnil
);
2614 newname
= Fexpand_file_name (newname
, Qnil
);
2616 /* If the file name has special constructs in it,
2617 call the corresponding file handler. */
2618 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2620 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2621 if (!NILP (handler
))
2622 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2623 file
, newname
, ok_if_already_exists
));
2625 encoded_file
= ENCODE_FILE (file
);
2626 encoded_newname
= ENCODE_FILE (newname
);
2629 /* If the file names are identical but for the case, don't ask for
2630 confirmation: they simply want to change the letter-case of the
2632 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2634 if (NILP (ok_if_already_exists
)
2635 || INTEGERP (ok_if_already_exists
))
2636 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2637 INTEGERP (ok_if_already_exists
), 0, 0);
2639 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2641 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2642 || 0 > unlink (XSTRING (encoded_file
)->data
))
2647 Fcopy_file (file
, newname
,
2648 /* We have already prompted if it was an integer,
2649 so don't have copy-file prompt again. */
2650 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2651 Fdelete_file (file
);
2658 report_file_error ("Renaming", Flist (2, args
));
2661 report_file_error ("Renaming", Flist (2, &file
));
2668 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2669 "fAdd name to file: \nFName to add to %s: \np",
2670 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2671 Signals a `file-already-exists' error if a file NEWNAME already exists
2672 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2673 A number as third arg means request confirmation if NEWNAME already exists.
2674 This is what happens in interactive use with M-x. */)
2675 (file
, newname
, ok_if_already_exists
)
2676 Lisp_Object file
, newname
, ok_if_already_exists
;
2679 Lisp_Object args
[2];
2681 Lisp_Object handler
;
2682 Lisp_Object encoded_file
, encoded_newname
;
2683 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2685 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2686 encoded_file
= encoded_newname
= Qnil
;
2687 CHECK_STRING (file
);
2688 CHECK_STRING (newname
);
2689 file
= Fexpand_file_name (file
, Qnil
);
2690 newname
= Fexpand_file_name (newname
, Qnil
);
2692 /* If the file name has special constructs in it,
2693 call the corresponding file handler. */
2694 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2695 if (!NILP (handler
))
2696 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2697 newname
, ok_if_already_exists
));
2699 /* If the new name has special constructs in it,
2700 call the corresponding file handler. */
2701 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2702 if (!NILP (handler
))
2703 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2704 newname
, ok_if_already_exists
));
2706 encoded_file
= ENCODE_FILE (file
);
2707 encoded_newname
= ENCODE_FILE (newname
);
2709 if (NILP (ok_if_already_exists
)
2710 || INTEGERP (ok_if_already_exists
))
2711 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2712 INTEGERP (ok_if_already_exists
), 0, 0);
2714 unlink (XSTRING (newname
)->data
);
2715 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2720 report_file_error ("Adding new name", Flist (2, args
));
2722 report_file_error ("Adding new name", Flist (2, &file
));
2731 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2732 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2733 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2734 Signals a `file-already-exists' error if a file LINKNAME already exists
2735 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2736 A number as third arg means request confirmation if LINKNAME already exists.
2737 This happens for interactive use with M-x. */)
2738 (filename
, linkname
, ok_if_already_exists
)
2739 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2742 Lisp_Object args
[2];
2744 Lisp_Object handler
;
2745 Lisp_Object encoded_filename
, encoded_linkname
;
2746 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2748 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2749 encoded_filename
= encoded_linkname
= Qnil
;
2750 CHECK_STRING (filename
);
2751 CHECK_STRING (linkname
);
2752 /* If the link target has a ~, we must expand it to get
2753 a truly valid file name. Otherwise, do not expand;
2754 we want to permit links to relative file names. */
2755 if (XSTRING (filename
)->data
[0] == '~')
2756 filename
= Fexpand_file_name (filename
, Qnil
);
2757 linkname
= Fexpand_file_name (linkname
, Qnil
);
2759 /* If the file name has special constructs in it,
2760 call the corresponding file handler. */
2761 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2762 if (!NILP (handler
))
2763 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2764 linkname
, ok_if_already_exists
));
2766 /* If the new link name has special constructs in it,
2767 call the corresponding file handler. */
2768 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2769 if (!NILP (handler
))
2770 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2771 linkname
, ok_if_already_exists
));
2773 encoded_filename
= ENCODE_FILE (filename
);
2774 encoded_linkname
= ENCODE_FILE (linkname
);
2776 if (NILP (ok_if_already_exists
)
2777 || INTEGERP (ok_if_already_exists
))
2778 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2779 INTEGERP (ok_if_already_exists
), 0, 0);
2780 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2781 XSTRING (encoded_linkname
)->data
))
2783 /* If we didn't complain already, silently delete existing file. */
2784 if (errno
== EEXIST
)
2786 unlink (XSTRING (encoded_linkname
)->data
);
2787 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2788 XSTRING (encoded_linkname
)->data
))
2798 report_file_error ("Making symbolic link", Flist (2, args
));
2800 report_file_error ("Making symbolic link", Flist (2, &filename
));
2806 #endif /* S_IFLNK */
2810 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2811 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2812 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2813 If STRING is nil or a null string, the logical name NAME is deleted. */)
2818 CHECK_STRING (name
);
2820 delete_logical_name (XSTRING (name
)->data
);
2823 CHECK_STRING (string
);
2825 if (XSTRING (string
)->size
== 0)
2826 delete_logical_name (XSTRING (name
)->data
);
2828 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2837 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2838 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2840 Lisp_Object path
, login
;
2844 CHECK_STRING (path
);
2845 CHECK_STRING (login
);
2847 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2849 if (netresult
== -1)
2854 #endif /* HPUX_NET */
2856 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2858 doc
: /* Return t if file FILENAME specifies an absolute file name.
2859 On Unix, this is a name starting with a `/' or a `~'. */)
2861 Lisp_Object filename
;
2865 CHECK_STRING (filename
);
2866 ptr
= XSTRING (filename
)->data
;
2867 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2869 /* ??? This criterion is probably wrong for '<'. */
2870 || index (ptr
, ':') || index (ptr
, '<')
2871 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2875 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2883 /* Return nonzero if file FILENAME exists and can be executed. */
2886 check_executable (filename
)
2890 int len
= strlen (filename
);
2893 if (stat (filename
, &st
) < 0)
2895 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2896 return ((st
.st_mode
& S_IEXEC
) != 0);
2898 return (S_ISREG (st
.st_mode
)
2900 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2901 || stricmp (suffix
, ".exe") == 0
2902 || stricmp (suffix
, ".bat") == 0)
2903 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2904 #endif /* not WINDOWSNT */
2905 #else /* not DOS_NT */
2906 #ifdef HAVE_EUIDACCESS
2907 return (euidaccess (filename
, 1) >= 0);
2909 /* Access isn't quite right because it uses the real uid
2910 and we really want to test with the effective uid.
2911 But Unix doesn't give us a right way to do it. */
2912 return (access (filename
, 1) >= 0);
2914 #endif /* not DOS_NT */
2917 /* Return nonzero if file FILENAME exists and can be written. */
2920 check_writable (filename
)
2925 if (stat (filename
, &st
) < 0)
2927 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2928 #else /* not MSDOS */
2929 #ifdef HAVE_EUIDACCESS
2930 return (euidaccess (filename
, 2) >= 0);
2932 /* Access isn't quite right because it uses the real uid
2933 and we really want to test with the effective uid.
2934 But Unix doesn't give us a right way to do it.
2935 Opening with O_WRONLY could work for an ordinary file,
2936 but would lose for directories. */
2937 return (access (filename
, 2) >= 0);
2939 #endif /* not MSDOS */
2942 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2943 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
2944 See also `file-readable-p' and `file-attributes'. */)
2946 Lisp_Object filename
;
2948 Lisp_Object absname
;
2949 Lisp_Object handler
;
2950 struct stat statbuf
;
2952 CHECK_STRING (filename
);
2953 absname
= Fexpand_file_name (filename
, Qnil
);
2955 /* If the file name has special constructs in it,
2956 call the corresponding file handler. */
2957 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2958 if (!NILP (handler
))
2959 return call2 (handler
, Qfile_exists_p
, absname
);
2961 absname
= ENCODE_FILE (absname
);
2963 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2966 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2967 doc
: /* Return t if FILENAME can be executed by you.
2968 For a directory, this means you can access files in that directory. */)
2970 Lisp_Object filename
;
2972 Lisp_Object absname
;
2973 Lisp_Object handler
;
2975 CHECK_STRING (filename
);
2976 absname
= Fexpand_file_name (filename
, Qnil
);
2978 /* If the file name has special constructs in it,
2979 call the corresponding file handler. */
2980 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2981 if (!NILP (handler
))
2982 return call2 (handler
, Qfile_executable_p
, absname
);
2984 absname
= ENCODE_FILE (absname
);
2986 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2989 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2990 doc
: /* Return t if file FILENAME exists and you can read it.
2991 See also `file-exists-p' and `file-attributes'. */)
2993 Lisp_Object filename
;
2995 Lisp_Object absname
;
2996 Lisp_Object handler
;
2999 struct stat statbuf
;
3001 CHECK_STRING (filename
);
3002 absname
= Fexpand_file_name (filename
, Qnil
);
3004 /* If the file name has special constructs in it,
3005 call the corresponding file handler. */
3006 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3007 if (!NILP (handler
))
3008 return call2 (handler
, Qfile_readable_p
, absname
);
3010 absname
= ENCODE_FILE (absname
);
3012 #if defined(DOS_NT) || defined(macintosh)
3013 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3015 if (access (XSTRING (absname
)->data
, 0) == 0)
3018 #else /* not DOS_NT and not macintosh */
3020 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3021 /* Opening a fifo without O_NONBLOCK can wait.
3022 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3023 except in the case of a fifo, on a system which handles it. */
3024 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
3027 if (S_ISFIFO (statbuf
.st_mode
))
3028 flags
|= O_NONBLOCK
;
3030 desc
= emacs_open (XSTRING (absname
)->data
, flags
, 0);
3035 #endif /* not DOS_NT and not macintosh */
3038 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3040 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3041 doc
: /* Return t if file FILENAME can be written or created by you. */)
3043 Lisp_Object filename
;
3045 Lisp_Object absname
, dir
, encoded
;
3046 Lisp_Object handler
;
3047 struct stat statbuf
;
3049 CHECK_STRING (filename
);
3050 absname
= Fexpand_file_name (filename
, Qnil
);
3052 /* If the file name has special constructs in it,
3053 call the corresponding file handler. */
3054 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3055 if (!NILP (handler
))
3056 return call2 (handler
, Qfile_writable_p
, absname
);
3058 encoded
= ENCODE_FILE (absname
);
3059 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
3060 return (check_writable (XSTRING (encoded
)->data
)
3063 dir
= Ffile_name_directory (absname
);
3066 dir
= Fdirectory_file_name (dir
);
3070 dir
= Fdirectory_file_name (dir
);
3073 dir
= ENCODE_FILE (dir
);
3075 /* The read-only attribute of the parent directory doesn't affect
3076 whether a file or directory can be created within it. Some day we
3077 should check ACLs though, which do affect this. */
3078 if (stat (XSTRING (dir
)->data
, &statbuf
) < 0)
3080 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3082 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
3087 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3088 doc
: /* Access file FILENAME, and get an error if that does not work.
3089 The second argument STRING is used in the error message.
3090 If there is no error, we return nil. */)
3092 Lisp_Object filename
, string
;
3094 Lisp_Object handler
, encoded_filename
, absname
;
3097 CHECK_STRING (filename
);
3098 absname
= Fexpand_file_name (filename
, Qnil
);
3100 CHECK_STRING (string
);
3102 /* If the file name has special constructs in it,
3103 call the corresponding file handler. */
3104 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3105 if (!NILP (handler
))
3106 return call3 (handler
, Qaccess_file
, absname
, string
);
3108 encoded_filename
= ENCODE_FILE (absname
);
3110 fd
= emacs_open (XSTRING (encoded_filename
)->data
, O_RDONLY
, 0);
3112 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
3118 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3119 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3120 The value is the name of the file to which it is linked.
3121 Otherwise returns nil. */)
3123 Lisp_Object filename
;
3130 Lisp_Object handler
;
3132 CHECK_STRING (filename
);
3133 filename
= Fexpand_file_name (filename
, Qnil
);
3135 /* If the file name has special constructs in it,
3136 call the corresponding file handler. */
3137 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3138 if (!NILP (handler
))
3139 return call2 (handler
, Qfile_symlink_p
, filename
);
3141 filename
= ENCODE_FILE (filename
);
3148 buf
= (char *) xrealloc (buf
, bufsize
);
3149 bzero (buf
, bufsize
);
3152 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3156 /* HP-UX reports ERANGE if buffer is too small. */
3157 if (errno
== ERANGE
)
3167 while (valsize
>= bufsize
);
3169 val
= make_string (buf
, valsize
);
3170 if (buf
[0] == '/' && index (buf
, ':'))
3171 val
= concat2 (build_string ("/:"), val
);
3173 val
= DECODE_FILE (val
);
3175 #else /* not S_IFLNK */
3177 #endif /* not S_IFLNK */
3180 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3181 doc
: /* Return t if FILENAME names an existing directory.
3182 Symbolic links to directories count as directories.
3183 See `file-symlink-p' to distinguish symlinks. */)
3185 Lisp_Object filename
;
3187 register Lisp_Object absname
;
3189 Lisp_Object handler
;
3191 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3193 /* If the file name has special constructs in it,
3194 call the corresponding file handler. */
3195 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3196 if (!NILP (handler
))
3197 return call2 (handler
, Qfile_directory_p
, absname
);
3199 absname
= ENCODE_FILE (absname
);
3201 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3203 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3206 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3207 doc
: /* Return t if file FILENAME names a directory you can open.
3208 For the value to be t, FILENAME must specify the name of a directory as a file,
3209 and the directory must allow you to open files in it. In order to use a
3210 directory as a buffer's current directory, this predicate must return true.
3211 A directory name spec may be given instead; then the value is t
3212 if the directory so specified exists and really is a readable and
3213 searchable directory. */)
3215 Lisp_Object filename
;
3217 Lisp_Object handler
;
3219 struct gcpro gcpro1
;
3221 /* If the file name has special constructs in it,
3222 call the corresponding file handler. */
3223 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3224 if (!NILP (handler
))
3225 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3227 /* It's an unlikely combination, but yes we really do need to gcpro:
3228 Suppose that file-accessible-directory-p has no handler, but
3229 file-directory-p does have a handler; this handler causes a GC which
3230 relocates the string in `filename'; and finally file-directory-p
3231 returns non-nil. Then we would end up passing a garbaged string
3232 to file-executable-p. */
3234 tem
= (NILP (Ffile_directory_p (filename
))
3235 || NILP (Ffile_executable_p (filename
)));
3237 return tem
? Qnil
: Qt
;
3240 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3241 doc
: /* Return t if file FILENAME is the name of a regular file.
3242 This is the sort of file that holds an ordinary stream of data bytes. */)
3244 Lisp_Object filename
;
3246 register Lisp_Object absname
;
3248 Lisp_Object handler
;
3250 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3252 /* If the file name has special constructs in it,
3253 call the corresponding file handler. */
3254 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3255 if (!NILP (handler
))
3256 return call2 (handler
, Qfile_regular_p
, absname
);
3258 absname
= ENCODE_FILE (absname
);
3263 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3265 /* Tell stat to use expensive method to get accurate info. */
3266 Vw32_get_true_file_attributes
= Qt
;
3267 result
= stat (XSTRING (absname
)->data
, &st
);
3268 Vw32_get_true_file_attributes
= tem
;
3272 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3275 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3277 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3281 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3282 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3284 Lisp_Object filename
;
3286 Lisp_Object absname
;
3288 Lisp_Object handler
;
3290 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3292 /* If the file name has special constructs in it,
3293 call the corresponding file handler. */
3294 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3295 if (!NILP (handler
))
3296 return call2 (handler
, Qfile_modes
, absname
);
3298 absname
= ENCODE_FILE (absname
);
3300 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3302 #if defined (MSDOS) && __DJGPP__ < 2
3303 if (check_executable (XSTRING (absname
)->data
))
3304 st
.st_mode
|= S_IEXEC
;
3305 #endif /* MSDOS && __DJGPP__ < 2 */
3307 return make_number (st
.st_mode
& 07777);
3310 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3311 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3312 Only the 12 low bits of MODE are used. */)
3314 Lisp_Object filename
, mode
;
3316 Lisp_Object absname
, encoded_absname
;
3317 Lisp_Object handler
;
3319 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3320 CHECK_NUMBER (mode
);
3322 /* If the file name has special constructs in it,
3323 call the corresponding file handler. */
3324 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3325 if (!NILP (handler
))
3326 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3328 encoded_absname
= ENCODE_FILE (absname
);
3330 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3331 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3336 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3337 doc
: /* Set the file permission bits for newly created files.
3338 The argument MODE should be an integer; only the low 9 bits are used.
3339 This setting is inherited by subprocesses. */)
3343 CHECK_NUMBER (mode
);
3345 umask ((~ XINT (mode
)) & 0777);
3350 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3351 doc
: /* Return the default file protection for created files.
3352 The value is an integer. */)
3358 realmask
= umask (0);
3361 XSETINT (value
, (~ realmask
) & 0777);
3371 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3372 doc
: /* Tell Unix to finish all pending disk updates. */)
3381 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3382 doc
: /* Return t if file FILE1 is newer than file FILE2.
3383 If FILE1 does not exist, the answer is nil;
3384 otherwise, if FILE2 does not exist, the answer is t. */)
3386 Lisp_Object file1
, file2
;
3388 Lisp_Object absname1
, absname2
;
3391 Lisp_Object handler
;
3392 struct gcpro gcpro1
, gcpro2
;
3394 CHECK_STRING (file1
);
3395 CHECK_STRING (file2
);
3398 GCPRO2 (absname1
, file2
);
3399 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3400 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3403 /* If the file name has special constructs in it,
3404 call the corresponding file handler. */
3405 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3407 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3408 if (!NILP (handler
))
3409 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3411 GCPRO2 (absname1
, absname2
);
3412 absname1
= ENCODE_FILE (absname1
);
3413 absname2
= ENCODE_FILE (absname2
);
3416 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3419 mtime1
= st
.st_mtime
;
3421 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3424 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3428 Lisp_Object Qfind_buffer_file_type
;
3431 #ifndef READ_BUF_SIZE
3432 #define READ_BUF_SIZE (64 << 10)
3435 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3437 /* This function is called after Lisp functions to decide a coding
3438 system are called, or when they cause an error. Before they are
3439 called, the current buffer is set unibyte and it contains only a
3440 newly inserted text (thus the buffer was empty before the
3443 The functions may set markers, overlays, text properties, or even
3444 alter the buffer contents, change the current buffer.
3446 Here, we reset all those changes by:
3447 o set back the current buffer.
3448 o move all markers and overlays to BEG.
3449 o remove all text properties.
3450 o set back the buffer multibyteness. */
3453 decide_coding_unwind (unwind_data
)
3454 Lisp_Object unwind_data
;
3456 Lisp_Object multibyte
, undo_list
, buffer
;
3458 multibyte
= XCAR (unwind_data
);
3459 unwind_data
= XCDR (unwind_data
);
3460 undo_list
= XCAR (unwind_data
);
3461 buffer
= XCDR (unwind_data
);
3463 if (current_buffer
!= XBUFFER (buffer
))
3464 set_buffer_internal (XBUFFER (buffer
));
3465 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3466 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3467 BUF_INTERVALS (current_buffer
) = 0;
3468 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3470 /* Now we are safe to change the buffer's multibyteness directly. */
3471 current_buffer
->enable_multibyte_characters
= multibyte
;
3472 current_buffer
->undo_list
= undo_list
;
3478 /* Used to pass values from insert-file-contents to read_non_regular. */
3480 static int non_regular_fd
;
3481 static int non_regular_inserted
;
3482 static int non_regular_nbytes
;
3485 /* Read from a non-regular file.
3486 Read non_regular_trytry bytes max from non_regular_fd.
3487 Non_regular_inserted specifies where to put the read bytes.
3488 Value is the number of bytes read. */
3497 nbytes
= emacs_read (non_regular_fd
,
3498 BEG_ADDR
+ PT_BYTE
- 1 + non_regular_inserted
,
3499 non_regular_nbytes
);
3501 return make_number (nbytes
);
3505 /* Condition-case handler used when reading from non-regular files
3506 in insert-file-contents. */
3509 read_non_regular_quit ()
3515 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3517 doc
: /* Insert contents of file FILENAME after point.
3518 Returns list of absolute file name and number of bytes inserted.
3519 If second argument VISIT is non-nil, the buffer's visited filename
3520 and last save file modtime are set, and it is marked unmodified.
3521 If visiting and the file does not exist, visiting is completed
3522 before the error is signaled.
3523 The optional third and fourth arguments BEG and END
3524 specify what portion of the file to insert.
3525 These arguments count bytes in the file, not characters in the buffer.
3526 If VISIT is non-nil, BEG and END must be nil.
3528 If optional fifth argument REPLACE is non-nil,
3529 it means replace the current buffer contents (in the accessible portion)
3530 with the file contents. This is better than simply deleting and inserting
3531 the whole thing because (1) it preserves some marker positions
3532 and (2) it puts less data in the undo list.
3533 When REPLACE is non-nil, the value is the number of characters actually read,
3534 which is often less than the number of characters to be read.
3536 This does code conversion according to the value of
3537 `coding-system-for-read' or `file-coding-system-alist',
3538 and sets the variable `last-coding-system-used' to the coding system
3540 (filename
, visit
, beg
, end
, replace
)
3541 Lisp_Object filename
, visit
, beg
, end
, replace
;
3546 register int how_much
;
3547 register int unprocessed
;
3548 int count
= BINDING_STACK_SIZE ();
3549 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3550 Lisp_Object handler
, val
, insval
, orig_filename
;
3553 int not_regular
= 0;
3554 unsigned char read_buf
[READ_BUF_SIZE
];
3555 struct coding_system coding
;
3556 unsigned char buffer
[1 << 14];
3557 int replace_handled
= 0;
3558 int set_coding_system
= 0;
3559 int coding_system_decided
= 0;
3562 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3563 error ("Cannot do file visiting in an indirect buffer");
3565 if (!NILP (current_buffer
->read_only
))
3566 Fbarf_if_buffer_read_only ();
3570 orig_filename
= Qnil
;
3572 GCPRO4 (filename
, val
, p
, orig_filename
);
3574 CHECK_STRING (filename
);
3575 filename
= Fexpand_file_name (filename
, Qnil
);
3577 /* If the file name has special constructs in it,
3578 call the corresponding file handler. */
3579 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3580 if (!NILP (handler
))
3582 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3583 visit
, beg
, end
, replace
);
3584 if (CONSP (val
) && CONSP (XCDR (val
)))
3585 inserted
= XINT (XCAR (XCDR (val
)));
3589 orig_filename
= filename
;
3590 filename
= ENCODE_FILE (filename
);
3596 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3598 /* Tell stat to use expensive method to get accurate info. */
3599 Vw32_get_true_file_attributes
= Qt
;
3600 total
= stat (XSTRING (filename
)->data
, &st
);
3601 Vw32_get_true_file_attributes
= tem
;
3606 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3608 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0
3609 || fstat (fd
, &st
) < 0)
3610 #endif /* not APOLLO */
3611 #endif /* WINDOWSNT */
3613 if (fd
>= 0) emacs_close (fd
);
3616 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3619 if (!NILP (Vcoding_system_for_read
))
3620 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3625 /* This code will need to be changed in order to work on named
3626 pipes, and it's probably just not worth it. So we should at
3627 least signal an error. */
3628 if (!S_ISREG (st
.st_mode
))
3635 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3636 Fsignal (Qfile_error
,
3637 Fcons (build_string ("not a regular file"),
3638 Fcons (orig_filename
, Qnil
)));
3643 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0)
3646 /* Replacement should preserve point as it preserves markers. */
3647 if (!NILP (replace
))
3648 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3650 record_unwind_protect (close_file_unwind
, make_number (fd
));
3652 /* Supposedly happens on VMS. */
3653 if (! not_regular
&& st
.st_size
< 0)
3654 error ("File size is negative");
3656 /* Prevent redisplay optimizations. */
3657 current_buffer
->clip_changed
= 1;
3661 if (!NILP (beg
) || !NILP (end
))
3662 error ("Attempt to visit less than an entire file");
3663 if (BEG
< Z
&& NILP (replace
))
3664 error ("Cannot do file visiting in a non-empty buffer");
3670 XSETFASTINT (beg
, 0);
3678 XSETINT (end
, st
.st_size
);
3680 /* Arithmetic overflow can occur if an Emacs integer cannot
3681 represent the file size, or if the calculations below
3682 overflow. The calculations below double the file size
3683 twice, so check that it can be multiplied by 4 safely. */
3684 if (XINT (end
) != st
.st_size
3685 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3686 error ("Maximum buffer size exceeded");
3688 /* The file size returned from stat may be zero, but data
3689 may be readable nonetheless, for example when this is a
3690 file in the /proc filesystem. */
3691 if (st
.st_size
== 0)
3692 XSETINT (end
, READ_BUF_SIZE
);
3698 /* Decide the coding system to use for reading the file now
3699 because we can't use an optimized method for handling
3700 `coding:' tag if the current buffer is not empty. */
3704 if (!NILP (Vcoding_system_for_read
))
3705 val
= Vcoding_system_for_read
;
3706 else if (! NILP (replace
))
3707 /* In REPLACE mode, we can use the same coding system
3708 that was used to visit the file. */
3709 val
= current_buffer
->buffer_file_coding_system
;
3712 /* Don't try looking inside a file for a coding system
3713 specification if it is not seekable. */
3714 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3716 /* Find a coding system specified in the heading two
3717 lines or in the tailing several lines of the file.
3718 We assume that the 1K-byte and 3K-byte for heading
3719 and tailing respectively are sufficient for this
3723 if (st
.st_size
<= (1024 * 4))
3724 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3727 nread
= emacs_read (fd
, read_buf
, 1024);
3730 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3731 report_file_error ("Setting file position",
3732 Fcons (orig_filename
, Qnil
));
3733 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3738 error ("IO error reading %s: %s",
3739 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3742 struct buffer
*prev
= current_buffer
;
3745 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3747 /* The call to temp_output_buffer_setup binds
3749 count1
= specpdl_ptr
- specpdl
;
3750 temp_output_buffer_setup (" *code-converting-work*");
3752 set_buffer_internal (XBUFFER (Vstandard_output
));
3753 current_buffer
->enable_multibyte_characters
= Qnil
;
3754 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3755 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3756 val
= call2 (Vset_auto_coding_function
,
3757 filename
, make_number (nread
));
3758 set_buffer_internal (prev
);
3760 /* Remove the binding for standard-output. */
3761 unbind_to (count1
, Qnil
);
3763 /* Discard the unwind protect for recovering the
3767 /* Rewind the file for the actual read done later. */
3768 if (lseek (fd
, 0, 0) < 0)
3769 report_file_error ("Setting file position",
3770 Fcons (orig_filename
, Qnil
));
3776 /* If we have not yet decided a coding system, check
3777 file-coding-system-alist. */
3778 Lisp_Object args
[6], coding_systems
;
3780 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3781 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3782 coding_systems
= Ffind_operation_coding_system (6, args
);
3783 if (CONSP (coding_systems
))
3784 val
= XCAR (coding_systems
);
3788 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3789 /* Ensure we set Vlast_coding_system_used. */
3790 set_coding_system
= 1;
3792 if (NILP (current_buffer
->enable_multibyte_characters
)
3794 /* We must suppress all character code conversion except for
3795 end-of-line conversion. */
3796 setup_raw_text_coding_system (&coding
);
3798 coding
.src_multibyte
= 0;
3799 coding
.dst_multibyte
3800 = !NILP (current_buffer
->enable_multibyte_characters
);
3801 coding_system_decided
= 1;
3804 /* If requested, replace the accessible part of the buffer
3805 with the file contents. Avoid replacing text at the
3806 beginning or end of the buffer that matches the file contents;
3807 that preserves markers pointing to the unchanged parts.
3809 Here we implement this feature in an optimized way
3810 for the case where code conversion is NOT needed.
3811 The following if-statement handles the case of conversion
3812 in a less optimal way.
3814 If the code conversion is "automatic" then we try using this
3815 method and hope for the best.
3816 But if we discover the need for conversion, we give up on this method
3817 and let the following if-statement handle the replace job. */
3820 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3822 /* same_at_start and same_at_end count bytes,
3823 because file access counts bytes
3824 and BEG and END count bytes. */
3825 int same_at_start
= BEGV_BYTE
;
3826 int same_at_end
= ZV_BYTE
;
3828 /* There is still a possibility we will find the need to do code
3829 conversion. If that happens, we set this variable to 1 to
3830 give up on handling REPLACE in the optimized way. */
3831 int giveup_match_end
= 0;
3833 if (XINT (beg
) != 0)
3835 if (lseek (fd
, XINT (beg
), 0) < 0)
3836 report_file_error ("Setting file position",
3837 Fcons (orig_filename
, Qnil
));
3842 /* Count how many chars at the start of the file
3843 match the text at the beginning of the buffer. */
3848 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3850 error ("IO error reading %s: %s",
3851 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3852 else if (nread
== 0)
3855 if (coding
.type
== coding_type_undecided
)
3856 detect_coding (&coding
, buffer
, nread
);
3857 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3858 /* We found that the file should be decoded somehow.
3859 Let's give up here. */
3861 giveup_match_end
= 1;
3865 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3866 detect_eol (&coding
, buffer
, nread
);
3867 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3868 && coding
.eol_type
!= CODING_EOL_LF
)
3869 /* We found that the format of eol should be decoded.
3870 Let's give up here. */
3872 giveup_match_end
= 1;
3877 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3878 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3879 same_at_start
++, bufpos
++;
3880 /* If we found a discrepancy, stop the scan.
3881 Otherwise loop around and scan the next bufferful. */
3882 if (bufpos
!= nread
)
3886 /* If the file matches the buffer completely,
3887 there's no need to replace anything. */
3888 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3892 /* Truncate the buffer to the size of the file. */
3893 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3898 /* Count how many chars at the end of the file
3899 match the text at the end of the buffer. But, if we have
3900 already found that decoding is necessary, don't waste time. */
3901 while (!giveup_match_end
)
3903 int total_read
, nread
, bufpos
, curpos
, trial
;
3905 /* At what file position are we now scanning? */
3906 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3907 /* If the entire file matches the buffer tail, stop the scan. */
3910 /* How much can we scan in the next step? */
3911 trial
= min (curpos
, sizeof buffer
);
3912 if (lseek (fd
, curpos
- trial
, 0) < 0)
3913 report_file_error ("Setting file position",
3914 Fcons (orig_filename
, Qnil
));
3916 total_read
= nread
= 0;
3917 while (total_read
< trial
)
3919 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3921 error ("IO error reading %s: %s",
3922 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3923 else if (nread
== 0)
3925 total_read
+= nread
;
3928 /* Scan this bufferful from the end, comparing with
3929 the Emacs buffer. */
3930 bufpos
= total_read
;
3932 /* Compare with same_at_start to avoid counting some buffer text
3933 as matching both at the file's beginning and at the end. */
3934 while (bufpos
> 0 && same_at_end
> same_at_start
3935 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3936 same_at_end
--, bufpos
--;
3938 /* If we found a discrepancy, stop the scan.
3939 Otherwise loop around and scan the preceding bufferful. */
3942 /* If this discrepancy is because of code conversion,
3943 we cannot use this method; giveup and try the other. */
3944 if (same_at_end
> same_at_start
3945 && FETCH_BYTE (same_at_end
- 1) >= 0200
3946 && ! NILP (current_buffer
->enable_multibyte_characters
)
3947 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3948 giveup_match_end
= 1;
3957 if (! giveup_match_end
)
3961 /* We win! We can handle REPLACE the optimized way. */
3963 /* Extend the start of non-matching text area to multibyte
3964 character boundary. */
3965 if (! NILP (current_buffer
->enable_multibyte_characters
))
3966 while (same_at_start
> BEGV_BYTE
3967 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3970 /* Extend the end of non-matching text area to multibyte
3971 character boundary. */
3972 if (! NILP (current_buffer
->enable_multibyte_characters
))
3973 while (same_at_end
< ZV_BYTE
3974 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3977 /* Don't try to reuse the same piece of text twice. */
3978 overlap
= (same_at_start
- BEGV_BYTE
3979 - (same_at_end
+ st
.st_size
- ZV
));
3981 same_at_end
+= overlap
;
3983 /* Arrange to read only the nonmatching middle part of the file. */
3984 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3985 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3987 del_range_byte (same_at_start
, same_at_end
, 0);
3988 /* Insert from the file at the proper position. */
3989 temp
= BYTE_TO_CHAR (same_at_start
);
3990 SET_PT_BOTH (temp
, same_at_start
);
3992 /* If display currently starts at beginning of line,
3993 keep it that way. */
3994 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3995 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3997 replace_handled
= 1;
4001 /* If requested, replace the accessible part of the buffer
4002 with the file contents. Avoid replacing text at the
4003 beginning or end of the buffer that matches the file contents;
4004 that preserves markers pointing to the unchanged parts.
4006 Here we implement this feature for the case where code conversion
4007 is needed, in a simple way that needs a lot of memory.
4008 The preceding if-statement handles the case of no conversion
4009 in a more optimized way. */
4010 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4012 int same_at_start
= BEGV_BYTE
;
4013 int same_at_end
= ZV_BYTE
;
4016 /* Make sure that the gap is large enough. */
4017 int bufsize
= 2 * st
.st_size
;
4018 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4021 /* First read the whole file, performing code conversion into
4022 CONVERSION_BUFFER. */
4024 if (lseek (fd
, XINT (beg
), 0) < 0)
4026 xfree (conversion_buffer
);
4027 report_file_error ("Setting file position",
4028 Fcons (orig_filename
, Qnil
));
4031 total
= st
.st_size
; /* Total bytes in the file. */
4032 how_much
= 0; /* Bytes read from file so far. */
4033 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4034 unprocessed
= 0; /* Bytes not processed in previous loop. */
4036 while (how_much
< total
)
4038 /* try is reserved in some compilers (Microsoft C) */
4039 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4040 unsigned char *destination
= read_buf
+ unprocessed
;
4043 /* Allow quitting out of the actual I/O. */
4046 this = emacs_read (fd
, destination
, trytry
);
4049 if (this < 0 || this + unprocessed
== 0)
4057 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4059 int require
, result
;
4061 this += unprocessed
;
4063 /* If we are using more space than estimated,
4064 make CONVERSION_BUFFER bigger. */
4065 require
= decoding_buffer_size (&coding
, this);
4066 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4068 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4069 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4072 /* Convert this batch with results in CONVERSION_BUFFER. */
4073 if (how_much
>= total
) /* This is the last block. */
4074 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4075 if (coding
.composing
!= COMPOSITION_DISABLED
)
4076 coding_allocate_composition_data (&coding
, BEGV
);
4077 result
= decode_coding (&coding
, read_buf
,
4078 conversion_buffer
+ inserted
,
4079 this, bufsize
- inserted
);
4081 /* Save for next iteration whatever we didn't convert. */
4082 unprocessed
= this - coding
.consumed
;
4083 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4084 if (!NILP (current_buffer
->enable_multibyte_characters
))
4085 this = coding
.produced
;
4087 this = str_as_unibyte (conversion_buffer
+ inserted
,
4094 /* At this point, INSERTED is how many characters (i.e. bytes)
4095 are present in CONVERSION_BUFFER.
4096 HOW_MUCH should equal TOTAL,
4097 or should be <= 0 if we couldn't read the file. */
4101 xfree (conversion_buffer
);
4104 error ("IO error reading %s: %s",
4105 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4106 else if (how_much
== -2)
4107 error ("maximum buffer size exceeded");
4110 /* Compare the beginning of the converted file
4111 with the buffer text. */
4114 while (bufpos
< inserted
&& same_at_start
< same_at_end
4115 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4116 same_at_start
++, bufpos
++;
4118 /* If the file matches the buffer completely,
4119 there's no need to replace anything. */
4121 if (bufpos
== inserted
)
4123 xfree (conversion_buffer
);
4126 /* Truncate the buffer to the size of the file. */
4127 del_range_byte (same_at_start
, same_at_end
, 0);
4132 /* Extend the start of non-matching text area to multibyte
4133 character boundary. */
4134 if (! NILP (current_buffer
->enable_multibyte_characters
))
4135 while (same_at_start
> BEGV_BYTE
4136 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4139 /* Scan this bufferful from the end, comparing with
4140 the Emacs buffer. */
4143 /* Compare with same_at_start to avoid counting some buffer text
4144 as matching both at the file's beginning and at the end. */
4145 while (bufpos
> 0 && same_at_end
> same_at_start
4146 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4147 same_at_end
--, bufpos
--;
4149 /* Extend the end of non-matching text area to multibyte
4150 character boundary. */
4151 if (! NILP (current_buffer
->enable_multibyte_characters
))
4152 while (same_at_end
< ZV_BYTE
4153 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4156 /* Don't try to reuse the same piece of text twice. */
4157 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4159 same_at_end
+= overlap
;
4161 /* If display currently starts at beginning of line,
4162 keep it that way. */
4163 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4164 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4166 /* Replace the chars that we need to replace,
4167 and update INSERTED to equal the number of bytes
4168 we are taking from the file. */
4169 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4171 if (same_at_end
!= same_at_start
)
4173 del_range_byte (same_at_start
, same_at_end
, 0);
4175 same_at_start
= GPT_BYTE
;
4179 temp
= BYTE_TO_CHAR (same_at_start
);
4181 /* Insert from the file at the proper position. */
4182 SET_PT_BOTH (temp
, same_at_start
);
4183 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4185 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4186 coding_restore_composition (&coding
, Fcurrent_buffer ());
4187 coding_free_composition_data (&coding
);
4189 /* Set `inserted' to the number of inserted characters. */
4190 inserted
= PT
- temp
;
4192 xfree (conversion_buffer
);
4201 register Lisp_Object temp
;
4203 total
= XINT (end
) - XINT (beg
);
4205 /* Make sure point-max won't overflow after this insertion. */
4206 XSETINT (temp
, total
);
4207 if (total
!= XINT (temp
))
4208 error ("Maximum buffer size exceeded");
4211 /* For a special file, all we can do is guess. */
4212 total
= READ_BUF_SIZE
;
4214 if (NILP (visit
) && total
> 0)
4215 prepare_to_modify_buffer (PT
, PT
, NULL
);
4218 if (GAP_SIZE
< total
)
4219 make_gap (total
- GAP_SIZE
);
4221 if (XINT (beg
) != 0 || !NILP (replace
))
4223 if (lseek (fd
, XINT (beg
), 0) < 0)
4224 report_file_error ("Setting file position",
4225 Fcons (orig_filename
, Qnil
));
4228 /* In the following loop, HOW_MUCH contains the total bytes read so
4229 far for a regular file, and not changed for a special file. But,
4230 before exiting the loop, it is set to a negative value if I/O
4234 /* Total bytes inserted. */
4237 /* Here, we don't do code conversion in the loop. It is done by
4238 code_convert_region after all data are read into the buffer. */
4240 int gap_size
= GAP_SIZE
;
4242 while (how_much
< total
)
4244 /* try is reserved in some compilers (Microsoft C) */
4245 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4252 /* Maybe make more room. */
4253 if (gap_size
< trytry
)
4255 make_gap (total
- gap_size
);
4256 gap_size
= GAP_SIZE
;
4259 /* Read from the file, capturing `quit'. When an
4260 error occurs, end the loop, and arrange for a quit
4261 to be signaled after decoding the text we read. */
4262 non_regular_fd
= fd
;
4263 non_regular_inserted
= inserted
;
4264 non_regular_nbytes
= trytry
;
4265 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4266 read_non_regular_quit
);
4277 /* Allow quitting out of the actual I/O. We don't make text
4278 part of the buffer until all the reading is done, so a C-g
4279 here doesn't do any harm. */
4282 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- 1 + inserted
, trytry
);
4294 /* For a regular file, where TOTAL is the real size,
4295 count HOW_MUCH to compare with it.
4296 For a special file, where TOTAL is just a buffer size,
4297 so don't bother counting in HOW_MUCH.
4298 (INSERTED is where we count the number of characters inserted.) */
4305 /* Make the text read part of the buffer. */
4306 GAP_SIZE
-= inserted
;
4308 GPT_BYTE
+= inserted
;
4310 ZV_BYTE
+= inserted
;
4315 /* Put an anchor to ensure multi-byte form ends at gap. */
4320 /* Discard the unwind protect for closing the file. */
4324 error ("IO error reading %s: %s",
4325 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4329 if (! coding_system_decided
)
4331 /* The coding system is not yet decided. Decide it by an
4332 optimized method for handling `coding:' tag.
4334 Note that we can get here only if the buffer was empty
4335 before the insertion. */
4339 if (!NILP (Vcoding_system_for_read
))
4340 val
= Vcoding_system_for_read
;
4343 /* Since we are sure that the current buffer was empty
4344 before the insertion, we can toggle
4345 enable-multibyte-characters directly here without taking
4346 care of marker adjustment and byte combining problem. By
4347 this way, we can run Lisp program safely before decoding
4348 the inserted text. */
4349 Lisp_Object unwind_data
;
4350 int count
= specpdl_ptr
- specpdl
;
4352 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4353 Fcons (current_buffer
->undo_list
,
4354 Fcurrent_buffer ()));
4355 current_buffer
->enable_multibyte_characters
= Qnil
;
4356 current_buffer
->undo_list
= Qt
;
4357 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4359 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4361 val
= call2 (Vset_auto_coding_function
,
4362 filename
, make_number (inserted
));
4367 /* If the coding system is not yet decided, check
4368 file-coding-system-alist. */
4369 Lisp_Object args
[6], coding_systems
;
4371 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4372 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4373 coding_systems
= Ffind_operation_coding_system (6, args
);
4374 if (CONSP (coding_systems
))
4375 val
= XCAR (coding_systems
);
4378 unbind_to (count
, Qnil
);
4379 inserted
= Z_BYTE
- BEG_BYTE
;
4382 /* The following kludgy code is to avoid some compiler bug.
4384 setup_coding_system (val, &coding);
4387 struct coding_system temp_coding
;
4388 setup_coding_system (val
, &temp_coding
);
4389 bcopy (&temp_coding
, &coding
, sizeof coding
);
4391 /* Ensure we set Vlast_coding_system_used. */
4392 set_coding_system
= 1;
4394 if (NILP (current_buffer
->enable_multibyte_characters
)
4396 /* We must suppress all character code conversion except for
4397 end-of-line conversion. */
4398 setup_raw_text_coding_system (&coding
);
4399 coding
.src_multibyte
= 0;
4400 coding
.dst_multibyte
4401 = !NILP (current_buffer
->enable_multibyte_characters
);
4405 /* Can't do this if part of the buffer might be preserved. */
4407 && (coding
.type
== coding_type_no_conversion
4408 || coding
.type
== coding_type_raw_text
))
4410 /* Visiting a file with these coding system makes the buffer
4412 current_buffer
->enable_multibyte_characters
= Qnil
;
4413 coding
.dst_multibyte
= 0;
4416 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4418 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4420 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4422 inserted
= coding
.produced_char
;
4425 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4430 /* Use the conversion type to determine buffer-file-type
4431 (find-buffer-file-type is now used to help determine the
4433 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4434 || coding
.eol_type
== CODING_EOL_LF
)
4435 && ! CODING_REQUIRE_DECODING (&coding
))
4436 current_buffer
->buffer_file_type
= Qt
;
4438 current_buffer
->buffer_file_type
= Qnil
;
4445 if (!EQ (current_buffer
->undo_list
, Qt
))
4446 current_buffer
->undo_list
= Qnil
;
4448 stat (XSTRING (filename
)->data
, &st
);
4453 current_buffer
->modtime
= st
.st_mtime
;
4454 current_buffer
->filename
= orig_filename
;
4457 SAVE_MODIFF
= MODIFF
;
4458 current_buffer
->auto_save_modified
= MODIFF
;
4459 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4460 #ifdef CLASH_DETECTION
4463 if (!NILP (current_buffer
->file_truename
))
4464 unlock_file (current_buffer
->file_truename
);
4465 unlock_file (filename
);
4467 #endif /* CLASH_DETECTION */
4469 Fsignal (Qfile_error
,
4470 Fcons (build_string ("not a regular file"),
4471 Fcons (orig_filename
, Qnil
)));
4474 /* Decode file format */
4477 int empty_undo_list_p
= 0;
4479 /* If we're anyway going to discard undo information, don't
4480 record it in the first place. The buffer's undo list at this
4481 point is either nil or t when visiting a file. */
4484 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4485 current_buffer
->undo_list
= Qt
;
4488 insval
= call3 (Qformat_decode
,
4489 Qnil
, make_number (inserted
), visit
);
4490 CHECK_NUMBER (insval
);
4491 inserted
= XFASTINT (insval
);
4494 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4497 if (set_coding_system
)
4498 Vlast_coding_system_used
= coding
.symbol
;
4500 /* Call after-change hooks for the inserted text, aside from the case
4501 of normal visiting (not with REPLACE), which is done in a new buffer
4502 "before" the buffer is changed. */
4503 if (inserted
> 0 && total
> 0
4504 && (NILP (visit
) || !NILP (replace
)))
4506 signal_after_change (PT
, 0, inserted
);
4507 update_compositions (PT
, PT
, CHECK_BORDER
);
4510 p
= Vafter_insert_file_functions
;
4513 insval
= call1 (Fcar (p
), make_number (inserted
));
4516 CHECK_NUMBER (insval
);
4517 inserted
= XFASTINT (insval
);
4524 && current_buffer
->modtime
== -1)
4526 /* If visiting nonexistent file, return nil. */
4527 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4531 Fsignal (Qquit
, Qnil
);
4533 /* ??? Retval needs to be dealt with in all cases consistently. */
4535 val
= Fcons (orig_filename
,
4536 Fcons (make_number (inserted
),
4539 RETURN_UNGCPRO (unbind_to (count
, val
));
4542 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4543 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4544 Lisp_Object
, Lisp_Object
));
4546 /* If build_annotations switched buffers, switch back to BUF.
4547 Kill the temporary buffer that was selected in the meantime.
4549 Since this kill only the last temporary buffer, some buffers remain
4550 not killed if build_annotations switched buffers more than once.
4554 build_annotations_unwind (buf
)
4559 if (XBUFFER (buf
) == current_buffer
)
4561 tembuf
= Fcurrent_buffer ();
4563 Fkill_buffer (tembuf
);
4567 /* Decide the coding-system to encode the data with. */
4570 choose_write_coding_system (start
, end
, filename
,
4571 append
, visit
, lockname
, coding
)
4572 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4573 struct coding_system
*coding
;
4579 else if (!NILP (Vcoding_system_for_write
))
4580 val
= Vcoding_system_for_write
;
4583 /* If the variable `buffer-file-coding-system' is set locally,
4584 it means that the file was read with some kind of code
4585 conversion or the variable is explicitly set by users. We
4586 had better write it out with the same coding system even if
4587 `enable-multibyte-characters' is nil.
4589 If it is not set locally, we anyway have to convert EOL
4590 format if the default value of `buffer-file-coding-system'
4591 tells that it is not Unix-like (LF only) format. */
4592 int using_default_coding
= 0;
4593 int force_raw_text
= 0;
4595 val
= current_buffer
->buffer_file_coding_system
;
4597 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4600 if (NILP (current_buffer
->enable_multibyte_characters
))
4606 /* Check file-coding-system-alist. */
4607 Lisp_Object args
[7], coding_systems
;
4609 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4610 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4612 coding_systems
= Ffind_operation_coding_system (7, args
);
4613 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4614 val
= XCDR (coding_systems
);
4618 && !NILP (current_buffer
->buffer_file_coding_system
))
4620 /* If we still have not decided a coding system, use the
4621 default value of buffer-file-coding-system. */
4622 val
= current_buffer
->buffer_file_coding_system
;
4623 using_default_coding
= 1;
4627 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4628 /* Confirm that VAL can surely encode the current region. */
4629 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4631 setup_coding_system (Fcheck_coding_system (val
), coding
);
4632 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4633 && !using_default_coding
)
4635 if (! EQ (default_buffer_file_coding
.symbol
,
4636 buffer_defaults
.buffer_file_coding_system
))
4637 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4638 &default_buffer_file_coding
);
4639 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4641 Lisp_Object subsidiaries
;
4643 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4644 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4645 if (VECTORP (subsidiaries
)
4646 && XVECTOR (subsidiaries
)->size
== 3)
4648 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4653 setup_raw_text_coding_system (coding
);
4654 goto done_setup_coding
;
4657 setup_coding_system (Fcheck_coding_system (val
), coding
);
4660 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4661 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4664 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4665 "r\nFWrite region to file: \ni\ni\ni\np",
4666 doc
: /* Write current region into specified file.
4667 When called from a program, requires three arguments:
4668 START, END and FILENAME. START and END are normally buffer positions
4669 specifying the part of the buffer to write.
4670 If START is nil, that means to use the entire buffer contents.
4671 If START is a string, then output that string to the file
4672 instead of any buffer contents; END is ignored.
4674 Optional fourth argument APPEND if non-nil means
4675 append to existing file contents (if any). If it is an integer,
4676 seek to that offset in the file before writing.
4677 Optional fifth argument VISIT if t means
4678 set the last-save-file-modtime of buffer to this file's modtime
4679 and mark buffer not modified.
4680 If VISIT is a string, it is a second file name;
4681 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4682 VISIT is also the file name to lock and unlock for clash detection.
4683 If VISIT is neither t nor nil nor a string,
4684 that means do not print the \"Wrote file\" message.
4685 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4686 use for locking and unlocking, overriding FILENAME and VISIT.
4687 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4688 for an existing file with the same name. If MUSTBENEW is `excl',
4689 that means to get an error if the file already exists; never overwrite.
4690 If MUSTBENEW is neither nil nor `excl', that means ask for
4691 confirmation before overwriting, but do go ahead and overwrite the file
4692 if the user confirms.
4694 This does code conversion according to the value of
4695 `coding-system-for-write', `buffer-file-coding-system', or
4696 `file-coding-system-alist', and sets the variable
4697 `last-coding-system-used' to the coding system actually used. */)
4698 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4699 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4707 int count
= specpdl_ptr
- specpdl
;
4710 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4712 Lisp_Object handler
;
4713 Lisp_Object visit_file
;
4714 Lisp_Object annotations
;
4715 Lisp_Object encoded_filename
;
4716 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4717 int quietly
= !NILP (visit
);
4718 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4719 struct buffer
*given_buffer
;
4721 int buffer_file_type
= O_BINARY
;
4723 struct coding_system coding
;
4725 if (current_buffer
->base_buffer
&& visiting
)
4726 error ("Cannot do file visiting in an indirect buffer");
4728 if (!NILP (start
) && !STRINGP (start
))
4729 validate_region (&start
, &end
);
4731 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4733 filename
= Fexpand_file_name (filename
, Qnil
);
4735 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4736 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4738 if (STRINGP (visit
))
4739 visit_file
= Fexpand_file_name (visit
, Qnil
);
4741 visit_file
= filename
;
4743 if (NILP (lockname
))
4744 lockname
= visit_file
;
4748 /* If the file name has special constructs in it,
4749 call the corresponding file handler. */
4750 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4751 /* If FILENAME has no handler, see if VISIT has one. */
4752 if (NILP (handler
) && STRINGP (visit
))
4753 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4755 if (!NILP (handler
))
4758 val
= call6 (handler
, Qwrite_region
, start
, end
,
4759 filename
, append
, visit
);
4763 SAVE_MODIFF
= MODIFF
;
4764 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4765 current_buffer
->filename
= visit_file
;
4771 /* Special kludge to simplify auto-saving. */
4774 XSETFASTINT (start
, BEG
);
4775 XSETFASTINT (end
, Z
);
4778 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4779 count1
= specpdl_ptr
- specpdl
;
4781 given_buffer
= current_buffer
;
4782 annotations
= build_annotations (start
, end
);
4783 if (current_buffer
!= given_buffer
)
4785 XSETFASTINT (start
, BEGV
);
4786 XSETFASTINT (end
, ZV
);
4791 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4793 /* Decide the coding-system to encode the data with.
4794 We used to make this choice before calling build_annotations, but that
4795 leads to problems when a write-annotate-function takes care of
4796 unsavable chars (as was the case with X-Symbol). */
4797 choose_write_coding_system (start
, end
, filename
,
4798 append
, visit
, lockname
, &coding
);
4799 Vlast_coding_system_used
= coding
.symbol
;
4801 given_buffer
= current_buffer
;
4802 annotations
= build_annotations_2 (start
, end
,
4803 coding
.pre_write_conversion
, annotations
);
4804 if (current_buffer
!= given_buffer
)
4806 XSETFASTINT (start
, BEGV
);
4807 XSETFASTINT (end
, ZV
);
4810 #ifdef CLASH_DETECTION
4813 #if 0 /* This causes trouble for GNUS. */
4814 /* If we've locked this file for some other buffer,
4815 query before proceeding. */
4816 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4817 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4820 lock_file (lockname
);
4822 #endif /* CLASH_DETECTION */
4824 encoded_filename
= ENCODE_FILE (filename
);
4826 fn
= XSTRING (encoded_filename
)->data
;
4830 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4831 #else /* not DOS_NT */
4832 desc
= emacs_open (fn
, O_WRONLY
, 0);
4833 #endif /* not DOS_NT */
4835 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4837 if (auto_saving
) /* Overwrite any previous version of autosave file */
4839 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4840 desc
= emacs_open (fn
, O_RDWR
, 0);
4842 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4843 ? XSTRING (current_buffer
->filename
)->data
: 0,
4846 else /* Write to temporary name and rename if no errors */
4848 Lisp_Object temp_name
;
4849 temp_name
= Ffile_name_directory (filename
);
4851 if (!NILP (temp_name
))
4853 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4854 build_string ("$$SAVE$$")));
4855 fname
= XSTRING (filename
)->data
;
4856 fn
= XSTRING (temp_name
)->data
;
4857 desc
= creat_copy_attrs (fname
, fn
);
4860 /* If we can't open the temporary file, try creating a new
4861 version of the original file. VMS "creat" creates a
4862 new version rather than truncating an existing file. */
4865 desc
= creat (fn
, 0666);
4866 #if 0 /* This can clobber an existing file and fail to replace it,
4867 if the user runs out of space. */
4870 /* We can't make a new version;
4871 try to truncate and rewrite existing version if any. */
4873 desc
= emacs_open (fn
, O_RDWR
, 0);
4879 desc
= creat (fn
, 0666);
4883 desc
= emacs_open (fn
,
4884 O_WRONLY
| O_CREAT
| buffer_file_type
4885 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4886 S_IREAD
| S_IWRITE
);
4887 #else /* not DOS_NT */
4888 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4889 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4890 auto_saving
? auto_save_mode_bits
: 0666);
4891 #endif /* not DOS_NT */
4892 #endif /* not VMS */
4896 #ifdef CLASH_DETECTION
4898 if (!auto_saving
) unlock_file (lockname
);
4900 #endif /* CLASH_DETECTION */
4902 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4905 record_unwind_protect (close_file_unwind
, make_number (desc
));
4907 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4911 if (NUMBERP (append
))
4912 ret
= lseek (desc
, XINT (append
), 1);
4914 ret
= lseek (desc
, 0, 2);
4917 #ifdef CLASH_DETECTION
4918 if (!auto_saving
) unlock_file (lockname
);
4919 #endif /* CLASH_DETECTION */
4921 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4929 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4930 * if we do writes that don't end with a carriage return. Furthermore
4931 * it cannot handle writes of more then 16K. The modified
4932 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4933 * this EXCEPT for the last record (iff it doesn't end with a carriage
4934 * return). This implies that if your buffer doesn't end with a carriage
4935 * return, you get one free... tough. However it also means that if
4936 * we make two calls to sys_write (a la the following code) you can
4937 * get one at the gap as well. The easiest way to fix this (honest)
4938 * is to move the gap to the next newline (or the end of the buffer).
4943 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4944 move_gap (find_next_newline (GPT
, 1));
4946 /* Whether VMS or not, we must move the gap to the next of newline
4947 when we must put designation sequences at beginning of line. */
4948 if (INTEGERP (start
)
4949 && coding
.type
== coding_type_iso2022
4950 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4951 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4953 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4954 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4955 move_gap_both (PT
, PT_BYTE
);
4956 SET_PT_BOTH (opoint
, opoint_byte
);
4963 if (STRINGP (start
))
4965 failure
= 0 > a_write (desc
, start
, 0, XSTRING (start
)->size
,
4966 &annotations
, &coding
);
4969 else if (XINT (start
) != XINT (end
))
4971 tem
= CHAR_TO_BYTE (XINT (start
));
4973 if (XINT (start
) < GPT
)
4975 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
4976 min (GPT
, XINT (end
)) - XINT (start
),
4977 &annotations
, &coding
);
4981 if (XINT (end
) > GPT
&& !failure
)
4983 tem
= max (XINT (start
), GPT
);
4984 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
4985 &annotations
, &coding
);
4991 /* If file was empty, still need to write the annotations */
4992 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4993 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4997 if (CODING_REQUIRE_FLUSHING (&coding
)
4998 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5001 /* We have to flush out a data. */
5002 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5003 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5010 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5011 Disk full in NFS may be reported here. */
5012 /* mib says that closing the file will try to write as fast as NFS can do
5013 it, and that means the fsync here is not crucial for autosave files. */
5014 if (!auto_saving
&& fsync (desc
) < 0)
5016 /* If fsync fails with EINTR, don't treat that as serious. */
5018 failure
= 1, save_errno
= errno
;
5022 /* Spurious "file has changed on disk" warnings have been
5023 observed on Suns as well.
5024 It seems that `close' can change the modtime, under nfs.
5026 (This has supposedly been fixed in Sunos 4,
5027 but who knows about all the other machines with NFS?) */
5030 /* On VMS and APOLLO, must do the stat after the close
5031 since closing changes the modtime. */
5034 /* Recall that #if defined does not work on VMS. */
5041 /* NFS can report a write failure now. */
5042 if (emacs_close (desc
) < 0)
5043 failure
= 1, save_errno
= errno
;
5046 /* If we wrote to a temporary name and had no errors, rename to real name. */
5050 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5058 /* Discard the unwind protect for close_file_unwind. */
5059 specpdl_ptr
= specpdl
+ count1
;
5060 /* Restore the original current buffer. */
5061 visit_file
= unbind_to (count
, visit_file
);
5063 #ifdef CLASH_DETECTION
5065 unlock_file (lockname
);
5066 #endif /* CLASH_DETECTION */
5068 /* Do this before reporting IO error
5069 to avoid a "file has changed on disk" warning on
5070 next attempt to save. */
5072 current_buffer
->modtime
= st
.st_mtime
;
5075 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
5076 emacs_strerror (save_errno
));
5080 SAVE_MODIFF
= MODIFF
;
5081 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5082 current_buffer
->filename
= visit_file
;
5083 update_mode_lines
++;
5089 message_with_string ("Wrote %s", visit_file
, 1);
5094 Lisp_Object
merge ();
5096 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5097 doc
: /* Return t if (car A) is numerically less than (car B). */)
5101 return Flss (Fcar (a
), Fcar (b
));
5104 /* Build the complete list of annotations appropriate for writing out
5105 the text between START and END, by calling all the functions in
5106 write-region-annotate-functions and merging the lists they return.
5107 If one of these functions switches to a different buffer, we assume
5108 that buffer contains altered text. Therefore, the caller must
5109 make sure to restore the current buffer in all cases,
5110 as save-excursion would do. */
5113 build_annotations (start
, end
)
5114 Lisp_Object start
, end
;
5116 Lisp_Object annotations
;
5118 struct gcpro gcpro1
, gcpro2
;
5119 Lisp_Object original_buffer
;
5122 XSETBUFFER (original_buffer
, current_buffer
);
5125 p
= Vwrite_region_annotate_functions
;
5126 GCPRO2 (annotations
, p
);
5129 struct buffer
*given_buffer
= current_buffer
;
5130 Vwrite_region_annotations_so_far
= annotations
;
5131 res
= call2 (Fcar (p
), start
, end
);
5132 /* If the function makes a different buffer current,
5133 assume that means this buffer contains altered text to be output.
5134 Reset START and END from the buffer bounds
5135 and discard all previous annotations because they should have
5136 been dealt with by this function. */
5137 if (current_buffer
!= given_buffer
)
5139 XSETFASTINT (start
, BEGV
);
5140 XSETFASTINT (end
, ZV
);
5143 Flength (res
); /* Check basic validity of return value */
5144 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5148 /* Now do the same for annotation functions implied by the file-format */
5149 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5150 p
= Vauto_save_file_format
;
5152 p
= current_buffer
->file_format
;
5153 for (i
= 0; !NILP (p
); p
= Fcdr (p
), ++i
)
5155 struct buffer
*given_buffer
= current_buffer
;
5157 Vwrite_region_annotations_so_far
= annotations
;
5159 /* Value is either a list of annotations or nil if the function
5160 has written annotations to a temporary buffer, which is now
5162 res
= call5 (Qformat_annotate_function
, Fcar (p
), start
, end
,
5163 original_buffer
, make_number (i
));
5164 if (current_buffer
!= given_buffer
)
5166 XSETFASTINT (start
, BEGV
);
5167 XSETFASTINT (end
, ZV
);
5172 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5180 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5181 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5183 struct gcpro gcpro1
;
5186 GCPRO1 (annotations
);
5187 /* At last, do the same for the function PRE_WRITE_CONVERSION
5188 implied by the current coding-system. */
5189 if (!NILP (pre_write_conversion
))
5191 struct buffer
*given_buffer
= current_buffer
;
5192 Vwrite_region_annotations_so_far
= annotations
;
5193 res
= call2 (pre_write_conversion
, start
, end
);
5195 annotations
= (current_buffer
!= given_buffer
5197 : merge (annotations
, res
, Qcar_less_than_car
));
5204 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5205 If STRING is nil, POS is the character position in the current buffer.
5206 Intersperse with them the annotations from *ANNOT
5207 which fall within the range of POS to POS + NCHARS,
5208 each at its appropriate position.
5210 We modify *ANNOT by discarding elements as we use them up.
5212 The return value is negative in case of system call failure. */
5215 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5218 register int nchars
;
5221 struct coding_system
*coding
;
5225 int lastpos
= pos
+ nchars
;
5227 while (NILP (*annot
) || CONSP (*annot
))
5229 tem
= Fcar_safe (Fcar (*annot
));
5232 nextpos
= XFASTINT (tem
);
5234 /* If there are no more annotations in this range,
5235 output the rest of the range all at once. */
5236 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5237 return e_write (desc
, string
, pos
, lastpos
, coding
);
5239 /* Output buffer text up to the next annotation's position. */
5242 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5246 /* Output the annotation. */
5247 tem
= Fcdr (Fcar (*annot
));
5250 if (0 > e_write (desc
, tem
, 0, XSTRING (tem
)->size
, coding
))
5253 *annot
= Fcdr (*annot
);
5258 #ifndef WRITE_BUF_SIZE
5259 #define WRITE_BUF_SIZE (16 * 1024)
5262 /* Write text in the range START and END into descriptor DESC,
5263 encoding them with coding system CODING. If STRING is nil, START
5264 and END are character positions of the current buffer, else they
5265 are indexes to the string STRING. */
5268 e_write (desc
, string
, start
, end
, coding
)
5272 struct coding_system
*coding
;
5274 register char *addr
;
5275 register int nbytes
;
5276 char buf
[WRITE_BUF_SIZE
];
5280 coding
->composing
= COMPOSITION_DISABLED
;
5281 if (coding
->composing
!= COMPOSITION_DISABLED
)
5282 coding_save_composition (coding
, start
, end
, string
);
5284 if (STRINGP (string
))
5286 addr
= XSTRING (string
)->data
;
5287 nbytes
= STRING_BYTES (XSTRING (string
));
5288 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5290 else if (start
< end
)
5292 /* It is assured that the gap is not in the range START and END-1. */
5293 addr
= CHAR_POS_ADDR (start
);
5294 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5295 coding
->src_multibyte
5296 = !NILP (current_buffer
->enable_multibyte_characters
);
5302 coding
->src_multibyte
= 1;
5305 /* We used to have a code for handling selective display here. But,
5306 now it is handled within encode_coding. */
5311 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5312 if (coding
->produced
> 0)
5314 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5315 if (coding
->produced
)
5321 nbytes
-= coding
->consumed
;
5322 addr
+= coding
->consumed
;
5323 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5326 /* The source text ends by an incomplete multibyte form.
5327 There's no way other than write it out as is. */
5328 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5337 start
+= coding
->consumed_char
;
5338 if (coding
->cmp_data
)
5339 coding_adjust_composition_offset (coding
, start
);
5342 if (coding
->cmp_data
)
5343 coding_free_composition_data (coding
);
5348 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5349 Sverify_visited_file_modtime
, 1, 1, 0,
5350 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5351 This means that the file has not been changed since it was visited or saved. */)
5357 Lisp_Object handler
;
5358 Lisp_Object filename
;
5363 if (!STRINGP (b
->filename
)) return Qt
;
5364 if (b
->modtime
== 0) return Qt
;
5366 /* If the file name has special constructs in it,
5367 call the corresponding file handler. */
5368 handler
= Ffind_file_name_handler (b
->filename
,
5369 Qverify_visited_file_modtime
);
5370 if (!NILP (handler
))
5371 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5373 filename
= ENCODE_FILE (b
->filename
);
5375 if (stat (XSTRING (filename
)->data
, &st
) < 0)
5377 /* If the file doesn't exist now and didn't exist before,
5378 we say that it isn't modified, provided the error is a tame one. */
5379 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5384 if (st
.st_mtime
== b
->modtime
5385 /* If both are positive, accept them if they are off by one second. */
5386 || (st
.st_mtime
> 0 && b
->modtime
> 0
5387 && (st
.st_mtime
== b
->modtime
+ 1
5388 || st
.st_mtime
== b
->modtime
- 1)))
5393 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5394 Sclear_visited_file_modtime
, 0, 0, 0,
5395 doc
: /* Clear out records of last mod time of visited file.
5396 Next attempt to save will certainly not complain of a discrepancy. */)
5399 current_buffer
->modtime
= 0;
5403 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5404 Svisited_file_modtime
, 0, 0, 0,
5405 doc
: /* Return the current buffer's recorded visited file modification time.
5406 The value is a list of the form (HIGH . LOW), like the time values
5407 that `file-attributes' returns. */)
5410 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5413 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5414 Sset_visited_file_modtime
, 0, 1, 0,
5415 doc
: /* Update buffer's recorded modification time from the visited file's time.
5416 Useful if the buffer was not read from the file normally
5417 or if the file itself has been changed for some known benign reason.
5418 An argument specifies the modification time value to use
5419 \(instead of that of the visited file), in the form of a list
5420 \(HIGH . LOW) or (HIGH LOW). */)
5422 Lisp_Object time_list
;
5424 if (!NILP (time_list
))
5425 current_buffer
->modtime
= cons_to_long (time_list
);
5428 register Lisp_Object filename
;
5430 Lisp_Object handler
;
5432 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5434 /* If the file name has special constructs in it,
5435 call the corresponding file handler. */
5436 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5437 if (!NILP (handler
))
5438 /* The handler can find the file name the same way we did. */
5439 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5441 filename
= ENCODE_FILE (filename
);
5443 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5444 current_buffer
->modtime
= st
.st_mtime
;
5451 auto_save_error (error
)
5454 Lisp_Object args
[3], msg
;
5456 struct gcpro gcpro1
;
5460 args
[0] = build_string ("Auto-saving %s: %s");
5461 args
[1] = current_buffer
->name
;
5462 args
[2] = Ferror_message_string (error
);
5463 msg
= Fformat (3, args
);
5465 nbytes
= STRING_BYTES (XSTRING (msg
));
5467 for (i
= 0; i
< 3; ++i
)
5470 message2 (XSTRING (msg
)->data
, nbytes
, STRING_MULTIBYTE (msg
));
5472 message2_nolog (XSTRING (msg
)->data
, nbytes
, STRING_MULTIBYTE (msg
));
5473 Fsleep_for (make_number (1), Qnil
);
5485 /* Get visited file's mode to become the auto save file's mode. */
5486 if (! NILP (current_buffer
->filename
)
5487 && stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5488 /* But make sure we can overwrite it later! */
5489 auto_save_mode_bits
= st
.st_mode
| 0600;
5491 auto_save_mode_bits
= 0666;
5494 Fwrite_region (Qnil
, Qnil
,
5495 current_buffer
->auto_save_file_name
,
5496 Qnil
, Qlambda
, Qnil
, Qnil
);
5500 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5505 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5506 | XFASTINT (XCDR (stream
))));
5512 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5515 minibuffer_auto_raise
= XINT (value
);
5519 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5520 doc
: /* Auto-save all buffers that need it.
5521 This is all buffers that have auto-saving enabled
5522 and are changed since last auto-saved.
5523 Auto-saving writes the buffer into a file
5524 so that your editing is not lost if the system crashes.
5525 This file is not the file you visited; that changes only when you save.
5526 Normally we run the normal hook `auto-save-hook' before saving.
5528 A non-nil NO-MESSAGE argument means do not print any message if successful.
5529 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5530 (no_message
, current_only
)
5531 Lisp_Object no_message
, current_only
;
5533 struct buffer
*old
= current_buffer
, *b
;
5534 Lisp_Object tail
, buf
;
5536 int do_handled_files
;
5539 Lisp_Object lispstream
;
5540 int count
= specpdl_ptr
- specpdl
;
5541 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5544 if (max_specpdl_size
< specpdl_size
+ 40)
5545 max_specpdl_size
= specpdl_size
+ 40;
5550 if (NILP (no_message
));
5551 message_p
= push_message ();
5553 /* Ordinarily don't quit within this function,
5554 but don't make it impossible to quit (in case we get hung in I/O). */
5558 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5559 point to non-strings reached from Vbuffer_alist. */
5561 if (!NILP (Vrun_hooks
))
5562 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5564 if (STRINGP (Vauto_save_list_file_name
))
5566 Lisp_Object listfile
;
5568 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5570 /* Don't try to create the directory when shutting down Emacs,
5571 because creating the directory might signal an error, and
5572 that would leave Emacs in a strange state. */
5573 if (!NILP (Vrun_hooks
))
5576 dir
= Ffile_name_directory (listfile
);
5577 if (NILP (Ffile_directory_p (dir
)))
5578 call2 (Qmake_directory
, dir
, Qt
);
5581 stream
= fopen (XSTRING (listfile
)->data
, "w");
5584 /* Arrange to close that file whether or not we get an error.
5585 Also reset auto_saving to 0. */
5586 lispstream
= Fcons (Qnil
, Qnil
);
5587 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5588 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5599 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5600 record_unwind_protect (do_auto_save_unwind_1
,
5601 make_number (minibuffer_auto_raise
));
5602 minibuffer_auto_raise
= 0;
5605 /* First, save all files which don't have handlers. If Emacs is
5606 crashing, the handlers may tweak what is causing Emacs to crash
5607 in the first place, and it would be a shame if Emacs failed to
5608 autosave perfectly ordinary files because it couldn't handle some
5610 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5611 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5613 buf
= XCDR (XCAR (tail
));
5616 /* Record all the buffers that have auto save mode
5617 in the special file that lists them. For each of these buffers,
5618 Record visited name (if any) and auto save name. */
5619 if (STRINGP (b
->auto_save_file_name
)
5620 && stream
!= NULL
&& do_handled_files
== 0)
5622 if (!NILP (b
->filename
))
5624 fwrite (XSTRING (b
->filename
)->data
, 1,
5625 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5627 putc ('\n', stream
);
5628 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5629 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5630 putc ('\n', stream
);
5633 if (!NILP (current_only
)
5634 && b
!= current_buffer
)
5637 /* Don't auto-save indirect buffers.
5638 The base buffer takes care of it. */
5642 /* Check for auto save enabled
5643 and file changed since last auto save
5644 and file changed since last real save. */
5645 if (STRINGP (b
->auto_save_file_name
)
5646 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5647 && b
->auto_save_modified
< BUF_MODIFF (b
)
5648 /* -1 means we've turned off autosaving for a while--see below. */
5649 && XINT (b
->save_length
) >= 0
5650 && (do_handled_files
5651 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5654 EMACS_TIME before_time
, after_time
;
5656 EMACS_GET_TIME (before_time
);
5658 /* If we had a failure, don't try again for 20 minutes. */
5659 if (b
->auto_save_failure_time
>= 0
5660 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5663 if ((XFASTINT (b
->save_length
) * 10
5664 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5665 /* A short file is likely to change a large fraction;
5666 spare the user annoying messages. */
5667 && XFASTINT (b
->save_length
) > 5000
5668 /* These messages are frequent and annoying for `*mail*'. */
5669 && !EQ (b
->filename
, Qnil
)
5670 && NILP (no_message
))
5672 /* It has shrunk too much; turn off auto-saving here. */
5673 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5674 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5676 minibuffer_auto_raise
= 0;
5677 /* Turn off auto-saving until there's a real save,
5678 and prevent any more warnings. */
5679 XSETINT (b
->save_length
, -1);
5680 Fsleep_for (make_number (1), Qnil
);
5683 set_buffer_internal (b
);
5684 if (!auto_saved
&& NILP (no_message
))
5685 message1 ("Auto-saving...");
5686 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5688 b
->auto_save_modified
= BUF_MODIFF (b
);
5689 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5690 set_buffer_internal (old
);
5692 EMACS_GET_TIME (after_time
);
5694 /* If auto-save took more than 60 seconds,
5695 assume it was an NFS failure that got a timeout. */
5696 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5697 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5701 /* Prevent another auto save till enough input events come in. */
5702 record_auto_save ();
5704 if (auto_saved
&& NILP (no_message
))
5708 sit_for (1, 0, 0, 0, 0);
5712 message1 ("Auto-saving...done");
5717 unbind_to (count
, Qnil
);
5721 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5722 Sset_buffer_auto_saved
, 0, 0, 0,
5723 doc
: /* Mark current buffer as auto-saved with its current text.
5724 No auto-save file will be written until the buffer changes again. */)
5727 current_buffer
->auto_save_modified
= MODIFF
;
5728 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5729 current_buffer
->auto_save_failure_time
= -1;
5733 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5734 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5735 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5738 current_buffer
->auto_save_failure_time
= -1;
5742 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5744 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5747 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5750 /* Reading and completing file names */
5751 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5753 /* In the string VAL, change each $ to $$ and return the result. */
5756 double_dollars (val
)
5759 register unsigned char *old
, *new;
5763 osize
= STRING_BYTES (XSTRING (val
));
5765 /* Count the number of $ characters. */
5766 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5767 if (*old
++ == '$') count
++;
5770 old
= XSTRING (val
)->data
;
5771 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5773 new = XSTRING (val
)->data
;
5774 for (n
= osize
; n
> 0; n
--)
5787 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5789 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5790 (string
, dir
, action
)
5791 Lisp_Object string
, dir
, action
;
5792 /* action is nil for complete, t for return list of completions,
5793 lambda for verify final value */
5795 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5797 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5799 CHECK_STRING (string
);
5806 /* No need to protect ACTION--we only compare it with t and nil. */
5807 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5809 if (XSTRING (string
)->size
== 0)
5811 if (EQ (action
, Qlambda
))
5819 orig_string
= string
;
5820 string
= Fsubstitute_in_file_name (string
);
5821 changed
= NILP (Fstring_equal (string
, orig_string
));
5822 name
= Ffile_name_nondirectory (string
);
5823 val
= Ffile_name_directory (string
);
5825 realdir
= Fexpand_file_name (val
, realdir
);
5830 specdir
= Ffile_name_directory (string
);
5831 val
= Ffile_name_completion (name
, realdir
);
5836 return double_dollars (string
);
5840 if (!NILP (specdir
))
5841 val
= concat2 (specdir
, val
);
5843 return double_dollars (val
);
5846 #endif /* not VMS */
5850 if (EQ (action
, Qt
))
5851 return Ffile_name_all_completions (name
, realdir
);
5852 /* Only other case actually used is ACTION = lambda */
5854 /* Supposedly this helps commands such as `cd' that read directory names,
5855 but can someone explain how it helps them? -- RMS */
5856 if (XSTRING (name
)->size
== 0)
5859 return Ffile_exists_p (string
);
5862 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5863 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
5864 Value is not expanded---you must call `expand-file-name' yourself.
5865 Default name to DEFAULT-FILENAME if user enters a null string.
5866 (If DEFAULT-FILENAME is omitted, the visited file name is used,
5867 except that if INITIAL is specified, that combined with DIR is used.)
5868 Fourth arg MUSTMATCH non-nil means require existing file's name.
5869 Non-nil and non-t means also require confirmation after completion.
5870 Fifth arg INITIAL specifies text to start with.
5871 DIR defaults to current buffer's directory default.
5873 If this command was invoked with the mouse, use a file dialog box if
5874 `use-dialog-box' is non-nil, and the window system or X toolkit in use
5875 provides a file dialog box. */)
5876 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5877 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5879 Lisp_Object val
, insdef
, tem
;
5880 struct gcpro gcpro1
, gcpro2
;
5881 register char *homedir
;
5882 int replace_in_history
= 0;
5883 int add_to_history
= 0;
5887 dir
= current_buffer
->directory
;
5888 if (NILP (default_filename
))
5890 if (! NILP (initial
))
5891 default_filename
= Fexpand_file_name (initial
, dir
);
5893 default_filename
= current_buffer
->filename
;
5896 /* If dir starts with user's homedir, change that to ~. */
5897 homedir
= (char *) egetenv ("HOME");
5899 /* homedir can be NULL in temacs, since Vprocess_environment is not
5900 yet set up. We shouldn't crash in that case. */
5903 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5904 CORRECT_DIR_SEPS (homedir
);
5909 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5910 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5912 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5913 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5914 XSTRING (dir
)->data
[0] = '~';
5916 /* Likewise for default_filename. */
5918 && STRINGP (default_filename
)
5919 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5920 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5923 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5924 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5925 XSTRING (default_filename
)->data
[0] = '~';
5927 if (!NILP (default_filename
))
5929 CHECK_STRING (default_filename
);
5930 default_filename
= double_dollars (default_filename
);
5933 if (insert_default_directory
&& STRINGP (dir
))
5936 if (!NILP (initial
))
5938 Lisp_Object args
[2], pos
;
5942 insdef
= Fconcat (2, args
);
5943 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5944 insdef
= Fcons (double_dollars (insdef
), pos
);
5947 insdef
= double_dollars (insdef
);
5949 else if (STRINGP (initial
))
5950 insdef
= Fcons (double_dollars (initial
), make_number (0));
5954 count
= specpdl_ptr
- specpdl
;
5956 specbind (intern ("completion-ignore-case"), Qt
);
5959 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5961 GCPRO2 (insdef
, default_filename
);
5963 #if defined (USE_MOTIF) || defined (HAVE_NTGUI)
5964 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5968 /* If DIR contains a file name, split it. */
5970 file
= Ffile_name_nondirectory (dir
);
5971 if (XSTRING (file
)->size
&& NILP (default_filename
))
5973 default_filename
= file
;
5974 dir
= Ffile_name_directory (dir
);
5976 if (!NILP(default_filename
))
5977 default_filename
= Fexpand_file_name (default_filename
, dir
);
5978 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5983 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5984 dir
, mustmatch
, insdef
,
5985 Qfile_name_history
, default_filename
, Qnil
);
5987 tem
= Fsymbol_value (Qfile_name_history
);
5988 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
5989 replace_in_history
= 1;
5991 /* If Fcompleting_read returned the inserted default string itself
5992 (rather than a new string with the same contents),
5993 it has to mean that the user typed RET with the minibuffer empty.
5994 In that case, we really want to return ""
5995 so that commands such as set-visited-file-name can distinguish. */
5996 if (EQ (val
, default_filename
))
5998 /* In this case, Fcompleting_read has not added an element
5999 to the history. Maybe we should. */
6000 if (! replace_in_history
)
6003 val
= build_string ("");
6006 unbind_to (count
, Qnil
);
6009 error ("No file name specified");
6011 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6013 if (!NILP (tem
) && !NILP (default_filename
))
6014 val
= default_filename
;
6015 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
6017 if (!NILP (default_filename
))
6018 val
= default_filename
;
6020 error ("No default file name");
6022 val
= Fsubstitute_in_file_name (val
);
6024 if (replace_in_history
)
6025 /* Replace what Fcompleting_read added to the history
6026 with what we will actually return. */
6027 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6028 else if (add_to_history
)
6030 /* Add the value to the history--but not if it matches
6031 the last value already there. */
6032 Lisp_Object val1
= double_dollars (val
);
6033 tem
= Fsymbol_value (Qfile_name_history
);
6034 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6035 Fset (Qfile_name_history
,
6046 /* Must be set before any path manipulation is performed. */
6047 XSETFASTINT (Vdirectory_sep_char
, '/');
6054 Qexpand_file_name
= intern ("expand-file-name");
6055 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6056 Qdirectory_file_name
= intern ("directory-file-name");
6057 Qfile_name_directory
= intern ("file-name-directory");
6058 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6059 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6060 Qfile_name_as_directory
= intern ("file-name-as-directory");
6061 Qcopy_file
= intern ("copy-file");
6062 Qmake_directory_internal
= intern ("make-directory-internal");
6063 Qmake_directory
= intern ("make-directory");
6064 Qdelete_directory
= intern ("delete-directory");
6065 Qdelete_file
= intern ("delete-file");
6066 Qrename_file
= intern ("rename-file");
6067 Qadd_name_to_file
= intern ("add-name-to-file");
6068 Qmake_symbolic_link
= intern ("make-symbolic-link");
6069 Qfile_exists_p
= intern ("file-exists-p");
6070 Qfile_executable_p
= intern ("file-executable-p");
6071 Qfile_readable_p
= intern ("file-readable-p");
6072 Qfile_writable_p
= intern ("file-writable-p");
6073 Qfile_symlink_p
= intern ("file-symlink-p");
6074 Qaccess_file
= intern ("access-file");
6075 Qfile_directory_p
= intern ("file-directory-p");
6076 Qfile_regular_p
= intern ("file-regular-p");
6077 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6078 Qfile_modes
= intern ("file-modes");
6079 Qset_file_modes
= intern ("set-file-modes");
6080 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6081 Qinsert_file_contents
= intern ("insert-file-contents");
6082 Qwrite_region
= intern ("write-region");
6083 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6084 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6086 staticpro (&Qexpand_file_name
);
6087 staticpro (&Qsubstitute_in_file_name
);
6088 staticpro (&Qdirectory_file_name
);
6089 staticpro (&Qfile_name_directory
);
6090 staticpro (&Qfile_name_nondirectory
);
6091 staticpro (&Qunhandled_file_name_directory
);
6092 staticpro (&Qfile_name_as_directory
);
6093 staticpro (&Qcopy_file
);
6094 staticpro (&Qmake_directory_internal
);
6095 staticpro (&Qmake_directory
);
6096 staticpro (&Qdelete_directory
);
6097 staticpro (&Qdelete_file
);
6098 staticpro (&Qrename_file
);
6099 staticpro (&Qadd_name_to_file
);
6100 staticpro (&Qmake_symbolic_link
);
6101 staticpro (&Qfile_exists_p
);
6102 staticpro (&Qfile_executable_p
);
6103 staticpro (&Qfile_readable_p
);
6104 staticpro (&Qfile_writable_p
);
6105 staticpro (&Qaccess_file
);
6106 staticpro (&Qfile_symlink_p
);
6107 staticpro (&Qfile_directory_p
);
6108 staticpro (&Qfile_regular_p
);
6109 staticpro (&Qfile_accessible_directory_p
);
6110 staticpro (&Qfile_modes
);
6111 staticpro (&Qset_file_modes
);
6112 staticpro (&Qfile_newer_than_file_p
);
6113 staticpro (&Qinsert_file_contents
);
6114 staticpro (&Qwrite_region
);
6115 staticpro (&Qverify_visited_file_modtime
);
6116 staticpro (&Qset_visited_file_modtime
);
6118 Qfile_name_history
= intern ("file-name-history");
6119 Fset (Qfile_name_history
, Qnil
);
6120 staticpro (&Qfile_name_history
);
6122 Qfile_error
= intern ("file-error");
6123 staticpro (&Qfile_error
);
6124 Qfile_already_exists
= intern ("file-already-exists");
6125 staticpro (&Qfile_already_exists
);
6126 Qfile_date_error
= intern ("file-date-error");
6127 staticpro (&Qfile_date_error
);
6128 Qexcl
= intern ("excl");
6132 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6133 staticpro (&Qfind_buffer_file_type
);
6136 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6137 doc
: /* *Coding system for encoding file names.
6138 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6139 Vfile_name_coding_system
= Qnil
;
6141 DEFVAR_LISP ("default-file-name-coding-system",
6142 &Vdefault_file_name_coding_system
,
6143 doc
: /* Default coding system for encoding file names.
6144 This variable is used only when `file-name-coding-system' is nil.
6146 This variable is set/changed by the command `set-language-environment'.
6147 User should not set this variable manually,
6148 instead use `file-name-coding-system' to get a constant encoding
6149 of file names regardless of the current language environment. */);
6150 Vdefault_file_name_coding_system
= Qnil
;
6152 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6153 doc
: /* *Format in which to write auto-save files.
6154 Should be a list of symbols naming formats that are defined in `format-alist'.
6155 If it is t, which is the default, auto-save files are written in the
6156 same format as a regular save would use. */);
6157 Vauto_save_file_format
= Qt
;
6159 Qformat_decode
= intern ("format-decode");
6160 staticpro (&Qformat_decode
);
6161 Qformat_annotate_function
= intern ("format-annotate-function");
6162 staticpro (&Qformat_annotate_function
);
6164 Qcar_less_than_car
= intern ("car-less-than-car");
6165 staticpro (&Qcar_less_than_car
);
6167 Fput (Qfile_error
, Qerror_conditions
,
6168 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6169 Fput (Qfile_error
, Qerror_message
,
6170 build_string ("File error"));
6172 Fput (Qfile_already_exists
, Qerror_conditions
,
6173 Fcons (Qfile_already_exists
,
6174 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6175 Fput (Qfile_already_exists
, Qerror_message
,
6176 build_string ("File already exists"));
6178 Fput (Qfile_date_error
, Qerror_conditions
,
6179 Fcons (Qfile_date_error
,
6180 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6181 Fput (Qfile_date_error
, Qerror_message
,
6182 build_string ("Cannot set file date"));
6184 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6185 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6186 insert_default_directory
= 1;
6188 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6189 doc
: /* *Non-nil means write new files with record format `stmlf'.
6190 nil means use format `var'. This variable is meaningful only on VMS. */);
6191 vms_stmlf_recfm
= 0;
6193 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6194 doc
: /* Directory separator character for built-in functions that return file names.
6195 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
6196 This variable affects the built-in functions only on Windows,
6197 on other platforms, it is initialized so that Lisp code can find out
6198 what the normal separator is.
6200 WARNING: This variable is deprecated and will be removed in the near
6201 future. DO NOT USE IT. */);
6203 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6204 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6205 If a file name matches REGEXP, then all I/O on that file is done by calling
6208 The first argument given to HANDLER is the name of the I/O primitive
6209 to be handled; the remaining arguments are the arguments that were
6210 passed to that primitive. For example, if you do
6211 (file-exists-p FILENAME)
6212 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6213 (funcall HANDLER 'file-exists-p FILENAME)
6214 The function `find-file-name-handler' checks this list for a handler
6215 for its argument. */);
6216 Vfile_name_handler_alist
= Qnil
;
6218 DEFVAR_LISP ("set-auto-coding-function",
6219 &Vset_auto_coding_function
,
6220 doc
: /* If non-nil, a function to call to decide a coding system of file.
6221 Two arguments are passed to this function: the file name
6222 and the length of a file contents following the point.
6223 This function should return a coding system to decode the file contents.
6224 It should check the file name against `auto-coding-alist'.
6225 If no coding system is decided, it should check a coding system
6226 specified in the heading lines with the format:
6227 -*- ... coding: CODING-SYSTEM; ... -*-
6228 or local variable spec of the tailing lines with `coding:' tag. */);
6229 Vset_auto_coding_function
= Qnil
;
6231 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6232 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6233 Each is passed one argument, the number of bytes inserted. It should return
6234 the new byte count, and leave point the same. If `insert-file-contents' is
6235 intercepted by a handler from `file-name-handler-alist', that handler is
6236 responsible for calling the after-insert-file-functions if appropriate. */);
6237 Vafter_insert_file_functions
= Qnil
;
6239 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6240 doc
: /* A list of functions to be called at the start of `write-region'.
6241 Each is passed two arguments, START and END as for `write-region'.
6242 These are usually two numbers but not always; see the documentation
6243 for `write-region'. The function should return a list of pairs
6244 of the form (POSITION . STRING), consisting of strings to be effectively
6245 inserted at the specified positions of the file being written (1 means to
6246 insert before the first byte written). The POSITIONs must be sorted into
6247 increasing order. If there are several functions in the list, the several
6248 lists are merged destructively. */);
6249 Vwrite_region_annotate_functions
= Qnil
;
6251 DEFVAR_LISP ("write-region-annotations-so-far",
6252 &Vwrite_region_annotations_so_far
,
6253 doc
: /* When an annotation function is called, this holds the previous annotations.
6254 These are the annotations made by other annotation functions
6255 that were already called. See also `write-region-annotate-functions'. */);
6256 Vwrite_region_annotations_so_far
= Qnil
;
6258 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6259 doc
: /* A list of file name handlers that temporarily should not be used.
6260 This applies only to the operation `inhibit-file-name-operation'. */);
6261 Vinhibit_file_name_handlers
= Qnil
;
6263 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6264 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6265 Vinhibit_file_name_operation
= Qnil
;
6267 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6268 doc
: /* File name in which we write a list of all auto save file names.
6269 This variable is initialized automatically from `auto-save-list-file-prefix'
6270 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6271 a non-nil value. */);
6272 Vauto_save_list_file_name
= Qnil
;
6274 defsubr (&Sfind_file_name_handler
);
6275 defsubr (&Sfile_name_directory
);
6276 defsubr (&Sfile_name_nondirectory
);
6277 defsubr (&Sunhandled_file_name_directory
);
6278 defsubr (&Sfile_name_as_directory
);
6279 defsubr (&Sdirectory_file_name
);
6280 defsubr (&Smake_temp_name
);
6281 defsubr (&Sexpand_file_name
);
6282 defsubr (&Ssubstitute_in_file_name
);
6283 defsubr (&Scopy_file
);
6284 defsubr (&Smake_directory_internal
);
6285 defsubr (&Sdelete_directory
);
6286 defsubr (&Sdelete_file
);
6287 defsubr (&Srename_file
);
6288 defsubr (&Sadd_name_to_file
);
6290 defsubr (&Smake_symbolic_link
);
6291 #endif /* S_IFLNK */
6293 defsubr (&Sdefine_logical_name
);
6296 defsubr (&Ssysnetunam
);
6297 #endif /* HPUX_NET */
6298 defsubr (&Sfile_name_absolute_p
);
6299 defsubr (&Sfile_exists_p
);
6300 defsubr (&Sfile_executable_p
);
6301 defsubr (&Sfile_readable_p
);
6302 defsubr (&Sfile_writable_p
);
6303 defsubr (&Saccess_file
);
6304 defsubr (&Sfile_symlink_p
);
6305 defsubr (&Sfile_directory_p
);
6306 defsubr (&Sfile_accessible_directory_p
);
6307 defsubr (&Sfile_regular_p
);
6308 defsubr (&Sfile_modes
);
6309 defsubr (&Sset_file_modes
);
6310 defsubr (&Sset_default_file_modes
);
6311 defsubr (&Sdefault_file_modes
);
6312 defsubr (&Sfile_newer_than_file_p
);
6313 defsubr (&Sinsert_file_contents
);
6314 defsubr (&Swrite_region
);
6315 defsubr (&Scar_less_than_car
);
6316 defsubr (&Sverify_visited_file_modtime
);
6317 defsubr (&Sclear_visited_file_modtime
);
6318 defsubr (&Svisited_file_modtime
);
6319 defsubr (&Sset_visited_file_modtime
);
6320 defsubr (&Sdo_auto_save
);
6321 defsubr (&Sset_buffer_auto_saved
);
6322 defsubr (&Sclear_buffer_auto_save_failure
);
6323 defsubr (&Srecent_auto_save_p
);
6325 defsubr (&Sread_file_name_internal
);
6326 defsubr (&Sread_file_name
);
6329 defsubr (&Sunix_sync
);