1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
80 #include "blockinput.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Set by auto_save_1 if an error occurred during the last auto-save. */
163 int auto_save_error_occurred
;
165 /* The symbol bound to coding-system-for-read when
166 insert-file-contents is called for recovering a file. This is not
167 an actual coding system name, but just an indicator to tell
168 insert-file-contents to use `emacs-mule' with a special flag for
169 auto saving and recovering a file. */
170 Lisp_Object Qauto_save_coding
;
172 /* Coding system for file names, or nil if none. */
173 Lisp_Object Vfile_name_coding_system
;
175 /* Coding system for file names used only when
176 Vfile_name_coding_system is nil. */
177 Lisp_Object Vdefault_file_name_coding_system
;
179 /* Alist of elements (REGEXP . HANDLER) for file names
180 whose I/O is done with a special handler. */
181 Lisp_Object Vfile_name_handler_alist
;
183 /* Property name of a file name handler,
184 which gives a list of operations it handles.. */
185 Lisp_Object Qoperations
;
187 /* Lisp functions for translating file formats */
188 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
190 /* Function to be called to decide a coding system of a reading file. */
191 Lisp_Object Vset_auto_coding_function
;
193 /* Functions to be called to process text properties in inserted file. */
194 Lisp_Object Vafter_insert_file_functions
;
196 /* Lisp function for setting buffer-file-coding-system and the
197 multibyteness of the current buffer after inserting a file. */
198 Lisp_Object Qafter_insert_file_set_coding
;
200 /* Functions to be called to create text property annotations for file. */
201 Lisp_Object Vwrite_region_annotate_functions
;
202 Lisp_Object Qwrite_region_annotate_functions
;
204 /* During build_annotations, each time an annotation function is called,
205 this holds the annotations made by the previous functions. */
206 Lisp_Object Vwrite_region_annotations_so_far
;
208 /* File name in which we write a list of all our auto save files. */
209 Lisp_Object Vauto_save_list_file_name
;
211 /* Function to call to read a file name. */
212 Lisp_Object Vread_file_name_function
;
214 /* Current predicate used by read_file_name_internal. */
215 Lisp_Object Vread_file_name_predicate
;
217 /* Nonzero means completion ignores case when reading file name. */
218 int read_file_name_completion_ignore_case
;
220 /* Nonzero means, when reading a filename in the minibuffer,
221 start out by inserting the default directory into the minibuffer. */
222 int insert_default_directory
;
224 /* On VMS, nonzero means write new files with record format stmlf.
225 Zero means use var format. */
228 /* On NT, specifies the directory separator character, used (eg.) when
229 expanding file names. This can be bound to / or \. */
230 Lisp_Object Vdirectory_sep_char
;
233 /* Nonzero means skip the call to fsync in Fwrite-region. */
234 int write_region_inhibit_fsync
;
237 extern Lisp_Object Vuser_login_name
;
240 extern Lisp_Object Vw32_get_true_file_attributes
;
243 extern int minibuf_level
;
245 extern int minibuffer_auto_raise
;
247 extern int history_delete_duplicates
;
249 /* These variables describe handlers that have "already" had a chance
250 to handle the current operation.
252 Vinhibit_file_name_handlers is a list of file name handlers.
253 Vinhibit_file_name_operation is the operation being handled.
254 If we try to handle that operation, we ignore those handlers. */
256 static Lisp_Object Vinhibit_file_name_handlers
;
257 static Lisp_Object Vinhibit_file_name_operation
;
259 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
261 Lisp_Object Qfile_name_history
;
263 Lisp_Object Qcar_less_than_car
;
265 static int a_write
P_ ((int, Lisp_Object
, int, int,
266 Lisp_Object
*, struct coding_system
*));
267 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
271 report_file_error (string
, data
)
275 Lisp_Object errstring
;
278 synchronize_system_messages_locale ();
279 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
280 Vlocale_coding_system
, 0);
286 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
289 /* System error messages are capitalized. Downcase the initial
290 unless it is followed by a slash. */
291 if (SREF (errstring
, 1) != '/')
292 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
294 xsignal (Qfile_error
,
295 Fcons (build_string (string
), Fcons (errstring
, data
)));
300 close_file_unwind (fd
)
303 emacs_close (XFASTINT (fd
));
307 /* Restore point, having saved it as a marker. */
310 restore_point_unwind (location
)
311 Lisp_Object location
;
313 Fgoto_char (location
);
314 Fset_marker (location
, Qnil
, Qnil
);
318 Lisp_Object Qexpand_file_name
;
319 Lisp_Object Qsubstitute_in_file_name
;
320 Lisp_Object Qdirectory_file_name
;
321 Lisp_Object Qfile_name_directory
;
322 Lisp_Object Qfile_name_nondirectory
;
323 Lisp_Object Qunhandled_file_name_directory
;
324 Lisp_Object Qfile_name_as_directory
;
325 Lisp_Object Qcopy_file
;
326 Lisp_Object Qmake_directory_internal
;
327 Lisp_Object Qmake_directory
;
328 Lisp_Object Qdelete_directory
;
329 Lisp_Object Qdelete_file
;
330 Lisp_Object Qrename_file
;
331 Lisp_Object Qadd_name_to_file
;
332 Lisp_Object Qmake_symbolic_link
;
333 Lisp_Object Qfile_exists_p
;
334 Lisp_Object Qfile_executable_p
;
335 Lisp_Object Qfile_readable_p
;
336 Lisp_Object Qfile_writable_p
;
337 Lisp_Object Qfile_symlink_p
;
338 Lisp_Object Qaccess_file
;
339 Lisp_Object Qfile_directory_p
;
340 Lisp_Object Qfile_regular_p
;
341 Lisp_Object Qfile_accessible_directory_p
;
342 Lisp_Object Qfile_modes
;
343 Lisp_Object Qset_file_modes
;
344 Lisp_Object Qset_file_times
;
345 Lisp_Object Qfile_newer_than_file_p
;
346 Lisp_Object Qinsert_file_contents
;
347 Lisp_Object Qwrite_region
;
348 Lisp_Object Qverify_visited_file_modtime
;
349 Lisp_Object Qset_visited_file_modtime
;
351 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
352 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
353 Otherwise, return nil.
354 A file name is handled if one of the regular expressions in
355 `file-name-handler-alist' matches it.
357 If OPERATION equals `inhibit-file-name-operation', then we ignore
358 any handlers that are members of `inhibit-file-name-handlers',
359 but we still do run any other handlers. This lets handlers
360 use the standard functions without calling themselves recursively. */)
361 (filename
, operation
)
362 Lisp_Object filename
, operation
;
364 /* This function must not munge the match data. */
365 Lisp_Object chain
, inhibited_handlers
, result
;
369 CHECK_STRING (filename
);
371 if (EQ (operation
, Vinhibit_file_name_operation
))
372 inhibited_handlers
= Vinhibit_file_name_handlers
;
374 inhibited_handlers
= Qnil
;
376 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
377 chain
= XCDR (chain
))
383 Lisp_Object string
= XCAR (elt
);
385 Lisp_Object handler
= XCDR (elt
);
386 Lisp_Object operations
= Qnil
;
388 if (SYMBOLP (handler
))
389 operations
= Fget (handler
, Qoperations
);
392 && (match_pos
= fast_string_match (string
, filename
)) > pos
393 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
397 handler
= XCDR (elt
);
398 tem
= Fmemq (handler
, inhibited_handlers
);
412 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
414 doc
: /* Return the directory component in file name FILENAME.
415 Return nil if FILENAME does not include a directory.
416 Otherwise return a directory name.
417 Given a Unix syntax file name, returns a string ending in slash;
418 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
420 Lisp_Object filename
;
423 register const unsigned char *beg
;
425 register unsigned char *beg
;
427 register const unsigned char *p
;
430 CHECK_STRING (filename
);
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
436 return call2 (handler
, Qfile_name_directory
, filename
);
438 filename
= FILE_SYSTEM_CASE (filename
);
439 beg
= SDATA (filename
);
441 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
443 p
= beg
+ SBYTES (filename
);
445 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
447 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
450 /* only recognise drive specifier at the beginning */
452 /* handle the "/:d:foo" and "/:foo" cases correctly */
453 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
454 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
461 /* Expansion of "c:" to drive and default directory. */
464 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
465 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
466 unsigned char *r
= res
;
468 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
470 strncpy (res
, beg
, 2);
475 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
477 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
480 p
= beg
+ strlen (beg
);
483 CORRECT_DIR_SEPS (beg
);
486 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
489 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
490 Sfile_name_nondirectory
, 1, 1, 0,
491 doc
: /* Return file name FILENAME sans its directory.
492 For example, in a Unix-syntax file name,
493 this is everything after the last slash,
494 or the entire name if it contains no slash. */)
496 Lisp_Object filename
;
498 register const unsigned char *beg
, *p
, *end
;
501 CHECK_STRING (filename
);
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
507 return call2 (handler
, Qfile_name_nondirectory
, filename
);
509 beg
= SDATA (filename
);
510 end
= p
= beg
+ SBYTES (filename
);
512 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
514 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
517 /* only recognise drive specifier at beginning */
519 /* handle the "/:d:foo" case correctly */
520 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
525 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
528 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
529 Sunhandled_file_name_directory
, 1, 1, 0,
530 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
531 A `directly usable' directory name is one that may be used without the
532 intervention of any file handler.
533 If FILENAME is a directly usable file itself, return
534 \(file-name-directory FILENAME).
535 The `call-process' and `start-process' functions use this function to
536 get a current directory to run processes in. */)
538 Lisp_Object filename
;
542 /* If the file name has special constructs in it,
543 call the corresponding file handler. */
544 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
546 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
548 return Ffile_name_directory (filename
);
553 file_name_as_directory (out
, in
)
556 int size
= strlen (in
) - 1;
569 /* Is it already a directory string? */
570 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
572 /* Is it a VMS directory file name? If so, hack VMS syntax. */
573 else if (! index (in
, '/')
574 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
575 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
576 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
577 || ! strncmp (&in
[size
- 5], ".dir", 4))
578 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
579 && in
[size
] == '1')))
581 register char *p
, *dot
;
585 dir:x.dir --> dir:[x]
586 dir:[x]y.dir --> dir:[x.y] */
588 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
591 strncpy (out
, in
, p
- in
);
610 dot
= index (p
, '.');
613 /* blindly remove any extension */
614 size
= strlen (out
) + (dot
- p
);
615 strncat (out
, p
, dot
- p
);
626 /* For Unix syntax, Append a slash if necessary */
627 if (!IS_DIRECTORY_SEP (out
[size
]))
629 /* Cannot use DIRECTORY_SEP, which could have any value */
631 out
[size
+ 2] = '\0';
634 CORRECT_DIR_SEPS (out
);
640 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
641 Sfile_name_as_directory
, 1, 1, 0,
642 doc
: /* Return a string representing the file name FILE interpreted as a directory.
643 This operation exists because a directory is also a file, but its name as
644 a directory is different from its name as a file.
645 The result can be used as the value of `default-directory'
646 or passed as second argument to `expand-file-name'.
647 For a Unix-syntax file name, just appends a slash.
648 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
659 /* If the file name has special constructs in it,
660 call the corresponding file handler. */
661 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
663 return call2 (handler
, Qfile_name_as_directory
, file
);
665 buf
= (char *) alloca (SBYTES (file
) + 10);
666 file_name_as_directory (buf
, SDATA (file
));
667 return make_specified_string (buf
, -1, strlen (buf
),
668 STRING_MULTIBYTE (file
));
672 * Convert from directory name to filename.
674 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
675 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
676 * On UNIX, it's simple: just make sure there isn't a terminating /
678 * Value is nonzero if the string output is different from the input.
682 directory_file_name (src
, dst
)
690 struct FAB fab
= cc$rms_fab
;
691 struct NAM nam
= cc$rms_nam
;
692 char esa
[NAM$C_MAXRSS
];
697 if (! index (src
, '/')
698 && (src
[slen
- 1] == ']'
699 || src
[slen
- 1] == ':'
700 || src
[slen
- 1] == '>'))
702 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
704 fab
.fab$b_fns
= slen
;
705 fab
.fab$l_nam
= &nam
;
706 fab
.fab$l_fop
= FAB$M_NAM
;
709 nam
.nam$b_ess
= sizeof esa
;
710 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
712 /* We call SYS$PARSE to handle such things as [--] for us. */
713 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
715 slen
= nam
.nam$b_esl
;
716 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
721 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
723 /* what about when we have logical_name:???? */
724 if (src
[slen
- 1] == ':')
725 { /* Xlate logical name and see what we get */
726 ptr
= strcpy (dst
, src
); /* upper case for getenv */
729 if ('a' <= *ptr
&& *ptr
<= 'z')
733 dst
[slen
- 1] = 0; /* remove colon */
734 if (!(src
= egetenv (dst
)))
736 /* should we jump to the beginning of this procedure?
737 Good points: allows us to use logical names that xlate
739 Bad points: can be a problem if we just translated to a device
741 For now, I'll punt and always expect VMS names, and hope for
744 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
745 { /* no recursion here! */
751 { /* not a directory spec */
756 bracket
= src
[slen
- 1];
758 /* If bracket is ']' or '>', bracket - 2 is the corresponding
760 ptr
= index (src
, bracket
- 2);
762 { /* no opening bracket */
766 if (!(rptr
= rindex (src
, '.')))
769 strncpy (dst
, src
, slen
);
773 dst
[slen
++] = bracket
;
778 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
779 then translate the device and recurse. */
780 if (dst
[slen
- 1] == ':'
781 && dst
[slen
- 2] != ':' /* skip decnet nodes */
782 && strcmp (src
+ slen
, "[000000]") == 0)
784 dst
[slen
- 1] = '\0';
785 if ((ptr
= egetenv (dst
))
786 && (rlen
= strlen (ptr
) - 1) > 0
787 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
788 && ptr
[rlen
- 1] == '.')
790 char * buf
= (char *) alloca (strlen (ptr
) + 1);
794 return directory_file_name (buf
, dst
);
799 strcat (dst
, "[000000]");
803 rlen
= strlen (rptr
) - 1;
804 strncat (dst
, rptr
, rlen
);
805 dst
[slen
+ rlen
] = '\0';
806 strcat (dst
, ".DIR.1");
810 /* Process as Unix format: just remove any final slash.
811 But leave "/" unchanged; do not change it to "". */
814 /* Handle // as root for apollo's. */
815 if ((slen
> 2 && dst
[slen
- 1] == '/')
816 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
820 && IS_DIRECTORY_SEP (dst
[slen
- 1])
822 && !IS_ANY_SEP (dst
[slen
- 2])
828 CORRECT_DIR_SEPS (dst
);
833 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
835 doc
: /* Returns the file name of the directory named DIRECTORY.
836 This is the name of the file that holds the data for the directory DIRECTORY.
837 This operation exists because a directory is also a file, but its name as
838 a directory is different from its name as a file.
839 In Unix-syntax, this function just removes the final slash.
840 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
841 it returns a file name such as \"[X]Y.DIR.1\". */)
843 Lisp_Object directory
;
848 CHECK_STRING (directory
);
850 if (NILP (directory
))
853 /* If the file name has special constructs in it,
854 call the corresponding file handler. */
855 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
857 return call2 (handler
, Qdirectory_file_name
, directory
);
860 /* 20 extra chars is insufficient for VMS, since we might perform a
861 logical name translation. an equivalence string can be up to 255
862 chars long, so grab that much extra space... - sss */
863 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
865 buf
= (char *) alloca (SBYTES (directory
) + 20);
867 directory_file_name (SDATA (directory
), buf
);
868 return make_specified_string (buf
, -1, strlen (buf
),
869 STRING_MULTIBYTE (directory
));
872 static char make_temp_name_tbl
[64] =
874 'A','B','C','D','E','F','G','H',
875 'I','J','K','L','M','N','O','P',
876 'Q','R','S','T','U','V','W','X',
877 'Y','Z','a','b','c','d','e','f',
878 'g','h','i','j','k','l','m','n',
879 'o','p','q','r','s','t','u','v',
880 'w','x','y','z','0','1','2','3',
881 '4','5','6','7','8','9','-','_'
884 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
886 /* Value is a temporary file name starting with PREFIX, a string.
888 The Emacs process number forms part of the result, so there is
889 no danger of generating a name being used by another process.
890 In addition, this function makes an attempt to choose a name
891 which has no existing file. To make this work, PREFIX should be
892 an absolute file name.
894 BASE64_P non-zero means add the pid as 3 characters in base64
895 encoding. In this case, 6 characters will be added to PREFIX to
896 form the file name. Otherwise, if Emacs is running on a system
897 with long file names, add the pid as a decimal number.
899 This function signals an error if no unique file name could be
903 make_temp_name (prefix
, base64_p
)
910 unsigned char *p
, *data
;
914 CHECK_STRING (prefix
);
916 /* VAL is created by adding 6 characters to PREFIX. The first
917 three are the PID of this process, in base 64, and the second
918 three are incremented if the file already exists. This ensures
919 262144 unique file names per PID per PREFIX. */
921 pid
= (int) getpid ();
925 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
927 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
932 #ifdef HAVE_LONG_FILE_NAMES
933 sprintf (pidbuf
, "%d", pid
);
934 pidlen
= strlen (pidbuf
);
936 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
937 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
938 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
943 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
944 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
945 if (!STRING_MULTIBYTE (prefix
))
946 STRING_SET_UNIBYTE (val
);
948 bcopy(SDATA (prefix
), data
, len
);
951 bcopy (pidbuf
, p
, pidlen
);
954 /* Here we try to minimize useless stat'ing when this function is
955 invoked many times successively with the same PREFIX. We achieve
956 this by initializing count to a random value, and incrementing it
959 We don't want make-temp-name to be called while dumping,
960 because then make_temp_name_count_initialized_p would get set
961 and then make_temp_name_count would not be set when Emacs starts. */
963 if (!make_temp_name_count_initialized_p
)
965 make_temp_name_count
= (unsigned) time (NULL
);
966 make_temp_name_count_initialized_p
= 1;
972 unsigned num
= make_temp_name_count
;
974 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
975 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
976 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
978 /* Poor man's congruential RN generator. Replace with
979 ++make_temp_name_count for debugging. */
980 make_temp_name_count
+= 25229;
981 make_temp_name_count
%= 225307;
983 if (stat (data
, &ignored
) < 0)
985 /* We want to return only if errno is ENOENT. */
989 /* The error here is dubious, but there is little else we
990 can do. The alternatives are to return nil, which is
991 as bad as (and in many cases worse than) throwing the
992 error, or to ignore the error, which will likely result
993 in looping through 225307 stat's, which is not only
994 dog-slow, but also useless since it will fallback to
995 the errow below, anyway. */
996 report_file_error ("Cannot create temporary name for prefix",
997 Fcons (prefix
, Qnil
));
1002 error ("Cannot create temporary name for prefix `%s'",
1008 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1009 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1010 The Emacs process number forms part of the result,
1011 so there is no danger of generating a name being used by another process.
1013 In addition, this function makes an attempt to choose a name
1014 which has no existing file. To make this work,
1015 PREFIX should be an absolute file name.
1017 There is a race condition between calling `make-temp-name' and creating the
1018 file which opens all kinds of security holes. For that reason, you should
1019 probably use `make-temp-file' instead, except in three circumstances:
1021 * If you are creating the file in the user's home directory.
1022 * If you are creating a directory rather than an ordinary file.
1023 * If you are taking special precautions as `make-temp-file' does. */)
1027 return make_temp_name (prefix
, 0);
1032 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1033 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1034 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1035 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1036 the current buffer's value of `default-directory' is used.
1037 File name components that are `.' are removed, and
1038 so are file name components followed by `..', along with the `..' itself;
1039 note that these simplifications are done without checking the resulting
1040 file names in the file system.
1041 An initial `~/' expands to your home directory.
1042 An initial `~USER/' expands to USER's home directory.
1043 See also the function `substitute-in-file-name'. */)
1044 (name
, default_directory
)
1045 Lisp_Object name
, default_directory
;
1049 register unsigned char *newdir
, *p
, *o
;
1051 unsigned char *target
;
1054 unsigned char * colon
= 0;
1055 unsigned char * close
= 0;
1056 unsigned char * slash
= 0;
1057 unsigned char * brack
= 0;
1058 int lbrack
= 0, rbrack
= 0;
1063 int collapse_newdir
= 1;
1067 Lisp_Object handler
, result
;
1071 CHECK_STRING (name
);
1073 /* If the file name has special constructs in it,
1074 call the corresponding file handler. */
1075 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1076 if (!NILP (handler
))
1077 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1079 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1080 if (NILP (default_directory
))
1081 default_directory
= current_buffer
->directory
;
1082 if (! STRINGP (default_directory
))
1085 /* "/" is not considered a root directory on DOS_NT, so using "/"
1086 here causes an infinite recursion in, e.g., the following:
1088 (let (default-directory)
1089 (expand-file-name "a"))
1091 To avoid this, we set default_directory to the root of the
1093 extern char *emacs_root_dir (void);
1095 default_directory
= build_string (emacs_root_dir ());
1097 default_directory
= build_string ("/");
1101 if (!NILP (default_directory
))
1103 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1104 if (!NILP (handler
))
1105 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1108 o
= SDATA (default_directory
);
1110 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1111 It would be better to do this down below where we actually use
1112 default_directory. Unfortunately, calling Fexpand_file_name recursively
1113 could invoke GC, and the strings might be relocated. This would
1114 be annoying because we have pointers into strings lying around
1115 that would need adjusting, and people would add new pointers to
1116 the code and forget to adjust them, resulting in intermittent bugs.
1117 Putting this call here avoids all that crud.
1119 The EQ test avoids infinite recursion. */
1120 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1121 /* Save time in some common cases - as long as default_directory
1122 is not relative, it can be canonicalized with name below (if it
1123 is needed at all) without requiring it to be expanded now. */
1125 /* Detect MSDOS file names with drive specifiers. */
1126 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1128 /* Detect Windows file names in UNC format. */
1129 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1131 #else /* not DOS_NT */
1132 /* Detect Unix absolute file names (/... alone is not absolute on
1134 && ! (IS_DIRECTORY_SEP (o
[0]))
1135 #endif /* not DOS_NT */
1138 struct gcpro gcpro1
;
1141 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1145 name
= FILE_SYSTEM_CASE (name
);
1147 multibyte
= STRING_MULTIBYTE (name
);
1150 /* We will force directory separators to be either all \ or /, so make
1151 a local copy to modify, even if there ends up being no change. */
1152 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1154 /* Note if special escape prefix is present, but remove for now. */
1155 if (nm
[0] == '/' && nm
[1] == ':')
1161 /* Find and remove drive specifier if present; this makes nm absolute
1162 even if the rest of the name appears to be relative. Only look for
1163 drive specifier at the beginning. */
1164 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1171 /* If we see "c://somedir", we want to strip the first slash after the
1172 colon when stripping the drive letter. Otherwise, this expands to
1174 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1176 #endif /* WINDOWSNT */
1180 /* Discard any previous drive specifier if nm is now in UNC format. */
1181 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1187 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1188 none are found, we can probably return right away. We will avoid
1189 allocating a new string if name is already fully expanded. */
1191 IS_DIRECTORY_SEP (nm
[0])
1193 && drive
&& !is_escaped
1196 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1203 /* If it turns out that the filename we want to return is just a
1204 suffix of FILENAME, we don't need to go through and edit
1205 things; we just need to construct a new string using data
1206 starting at the middle of FILENAME. If we set lose to a
1207 non-zero value, that means we've discovered that we can't do
1214 /* Since we know the name is absolute, we can assume that each
1215 element starts with a "/". */
1217 /* "." and ".." are hairy. */
1218 if (IS_DIRECTORY_SEP (p
[0])
1220 && (IS_DIRECTORY_SEP (p
[2])
1222 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1225 /* We want to replace multiple `/' in a row with a single
1228 && IS_DIRECTORY_SEP (p
[0])
1229 && IS_DIRECTORY_SEP (p
[1]))
1236 /* if dev:[dir]/, move nm to / */
1237 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1238 nm
= (brack
? brack
+ 1 : colon
+ 1);
1239 lbrack
= rbrack
= 0;
1246 #ifdef NO_HYPHENS_IN_FILENAMES
1247 if (lbrack
== rbrack
)
1249 /* Avoid clobbering negative version numbers. */
1254 #endif /* NO_HYPHENS_IN_FILENAMES */
1256 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1257 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1259 #ifdef NO_HYPHENS_IN_FILENAMES
1262 #endif /* NO_HYPHENS_IN_FILENAMES */
1263 /* count open brackets, reset close bracket pointer */
1264 if (p
[0] == '[' || p
[0] == '<')
1265 lbrack
++, brack
= 0;
1266 /* count close brackets, set close bracket pointer */
1267 if (p
[0] == ']' || p
[0] == '>')
1268 rbrack
++, brack
= p
;
1269 /* detect ][ or >< */
1270 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1272 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1273 nm
= p
+ 1, lose
= 1;
1274 if (p
[0] == ':' && (colon
|| slash
))
1275 /* if dev1:[dir]dev2:, move nm to dev2: */
1281 /* if /name/dev:, move nm to dev: */
1284 /* if node::dev:, move colon following dev */
1285 else if (colon
&& colon
[-1] == ':')
1287 /* if dev1:dev2:, move nm to dev2: */
1288 else if (colon
&& colon
[-1] != ':')
1293 if (p
[0] == ':' && !colon
)
1299 if (lbrack
== rbrack
)
1302 else if (p
[0] == '.')
1310 if (index (nm
, '/'))
1312 nm
= sys_translate_unix (nm
);
1313 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1317 /* Make sure directories are all separated with / or \ as
1318 desired, but avoid allocation of a new string when not
1320 CORRECT_DIR_SEPS (nm
);
1322 if (IS_DIRECTORY_SEP (nm
[1]))
1324 if (strcmp (nm
, SDATA (name
)) != 0)
1325 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1329 /* drive must be set, so this is okay */
1330 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1334 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1335 temp
[0] = DRIVE_LETTER (drive
);
1336 name
= concat2 (build_string (temp
), name
);
1339 #else /* not DOS_NT */
1340 if (nm
== SDATA (name
))
1342 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1343 #endif /* not DOS_NT */
1347 /* At this point, nm might or might not be an absolute file name. We
1348 need to expand ~ or ~user if present, otherwise prefix nm with
1349 default_directory if nm is not absolute, and finally collapse /./
1350 and /foo/../ sequences.
1352 We set newdir to be the appropriate prefix if one is needed:
1353 - the relevant user directory if nm starts with ~ or ~user
1354 - the specified drive's working dir (DOS/NT only) if nm does not
1356 - the value of default_directory.
1358 Note that these prefixes are not guaranteed to be absolute (except
1359 for the working dir of a drive). Therefore, to ensure we always
1360 return an absolute name, if the final prefix is not absolute we
1361 append it to the current working directory. */
1365 if (nm
[0] == '~') /* prefix ~ */
1367 if (IS_DIRECTORY_SEP (nm
[1])
1371 || nm
[1] == 0) /* ~ by itself */
1375 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1376 newdir
= (unsigned char *) "";
1378 /* egetenv may return a unibyte string, which will bite us since
1379 we expect the directory to be multibyte. */
1380 tem
= build_string (newdir
);
1381 if (!STRING_MULTIBYTE (tem
))
1383 hdir
= DECODE_FILE (tem
);
1384 newdir
= SDATA (hdir
);
1387 collapse_newdir
= 0;
1390 nm
++; /* Don't leave the slash in nm. */
1393 else /* ~user/filename */
1395 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1400 o
= (unsigned char *) alloca (p
- nm
+ 1);
1401 bcopy ((char *) nm
, o
, p
- nm
);
1405 pw
= (struct passwd
*) getpwnam (o
+ 1);
1409 newdir
= (unsigned char *) pw
-> pw_dir
;
1411 nm
= p
+ 1; /* skip the terminator */
1415 collapse_newdir
= 0;
1420 /* If we don't find a user of that name, leave the name
1421 unchanged; don't move nm forward to p. */
1426 /* On DOS and Windows, nm is absolute if a drive name was specified;
1427 use the drive's current directory as the prefix if needed. */
1428 if (!newdir
&& drive
)
1430 /* Get default directory if needed to make nm absolute. */
1431 if (!IS_DIRECTORY_SEP (nm
[0]))
1433 newdir
= alloca (MAXPATHLEN
+ 1);
1434 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1439 /* Either nm starts with /, or drive isn't mounted. */
1440 newdir
= alloca (4);
1441 newdir
[0] = DRIVE_LETTER (drive
);
1449 /* Finally, if no prefix has been specified and nm is not absolute,
1450 then it must be expanded relative to default_directory. */
1454 /* /... alone is not absolute on DOS and Windows. */
1455 && !IS_DIRECTORY_SEP (nm
[0])
1458 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1465 newdir
= SDATA (default_directory
);
1466 multibyte
|= STRING_MULTIBYTE (default_directory
);
1468 /* Note if special escape prefix is present, but remove for now. */
1469 if (newdir
[0] == '/' && newdir
[1] == ':')
1480 /* First ensure newdir is an absolute name. */
1482 /* Detect MSDOS file names with drive specifiers. */
1483 ! (IS_DRIVE (newdir
[0])
1484 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1486 /* Detect Windows file names in UNC format. */
1487 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1491 /* Effectively, let newdir be (expand-file-name newdir cwd).
1492 Because of the admonition against calling expand-file-name
1493 when we have pointers into lisp strings, we accomplish this
1494 indirectly by prepending newdir to nm if necessary, and using
1495 cwd (or the wd of newdir's drive) as the new newdir. */
1497 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1502 if (!IS_DIRECTORY_SEP (nm
[0]))
1504 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1505 file_name_as_directory (tmp
, newdir
);
1509 newdir
= alloca (MAXPATHLEN
+ 1);
1512 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1519 /* Strip off drive name from prefix, if present. */
1520 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1526 /* Keep only a prefix from newdir if nm starts with slash
1527 (//server/share for UNC, nothing otherwise). */
1528 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1531 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1533 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1535 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1537 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1549 /* Get rid of any slash at the end of newdir, unless newdir is
1550 just / or // (an incomplete UNC name). */
1551 length
= strlen (newdir
);
1552 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1554 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1558 unsigned char *temp
= (unsigned char *) alloca (length
);
1559 bcopy (newdir
, temp
, length
- 1);
1560 temp
[length
- 1] = 0;
1568 /* Now concatenate the directory and name to new space in the stack frame */
1569 tlen
+= strlen (nm
) + 1;
1571 /* Reserve space for drive specifier and escape prefix, since either
1572 or both may need to be inserted. (The Microsoft x86 compiler
1573 produces incorrect code if the following two lines are combined.) */
1574 target
= (unsigned char *) alloca (tlen
+ 4);
1576 #else /* not DOS_NT */
1577 target
= (unsigned char *) alloca (tlen
);
1578 #endif /* not DOS_NT */
1584 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1587 /* If newdir is effectively "C:/", then the drive letter will have
1588 been stripped and newdir will be "/". Concatenating with an
1589 absolute directory in nm produces "//", which will then be
1590 incorrectly treated as a network share. Ignore newdir in
1591 this case (keeping the drive letter). */
1592 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1593 && newdir
[1] == '\0'))
1595 strcpy (target
, newdir
);
1599 file_name_as_directory (target
, newdir
);
1602 strcat (target
, nm
);
1604 if (index (target
, '/'))
1605 strcpy (target
, sys_translate_unix (target
));
1608 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1610 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1619 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1625 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1626 /* brackets are offset from each other by 2 */
1629 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1630 /* convert [foo][bar] to [bar] */
1631 while (o
[-1] != '[' && o
[-1] != '<')
1633 else if (*p
== '-' && *o
!= '.')
1636 else if (p
[0] == '-' && o
[-1] == '.'
1637 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1638 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1642 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1643 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1645 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1647 /* else [foo.-] ==> [-] */
1651 #ifdef NO_HYPHENS_IN_FILENAMES
1653 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1654 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1656 #endif /* NO_HYPHENS_IN_FILENAMES */
1660 if (!IS_DIRECTORY_SEP (*p
))
1664 else if (p
[1] == '.'
1665 && (IS_DIRECTORY_SEP (p
[2])
1668 /* If "/." is the entire filename, keep the "/". Otherwise,
1669 just delete the whole "/.". */
1670 if (o
== target
&& p
[2] == '\0')
1674 else if (p
[1] == '.' && p
[2] == '.'
1675 /* `/../' is the "superroot" on certain file systems.
1676 Turned off on DOS_NT systems because they have no
1677 "superroot" and because this causes us to produce
1678 file names like "d:/../foo" which fail file-related
1679 functions of the underlying OS. (To reproduce, try a
1680 long series of "../../" in default_directory, longer
1681 than the number of levels from the root.) */
1685 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1687 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1689 /* Keep initial / only if this is the whole name. */
1690 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1694 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1695 /* Collapse multiple `/' in a row. */
1701 #endif /* not VMS */
1705 /* At last, set drive name. */
1707 /* Except for network file name. */
1708 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1709 #endif /* WINDOWSNT */
1711 if (!drive
) abort ();
1713 target
[0] = DRIVE_LETTER (drive
);
1716 /* Reinsert the escape prefix if required. */
1723 CORRECT_DIR_SEPS (target
);
1726 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1728 /* Again look to see if the file name has special constructs in it
1729 and perhaps call the corresponding file handler. This is needed
1730 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1731 the ".." component gives us "/user@host:/bar/../baz" which needs
1732 to be expanded again. */
1733 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1734 if (!NILP (handler
))
1735 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1741 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1742 This is the old version of expand-file-name, before it was thoroughly
1743 rewritten for Emacs 10.31. We leave this version here commented-out,
1744 because the code is very complex and likely to have subtle bugs. If
1745 bugs _are_ found, it might be of interest to look at the old code and
1746 see what did it do in the relevant situation.
1748 Don't remove this code: it's true that it will be accessible via CVS,
1749 but a few years from deletion, people will forget it is there. */
1751 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1752 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1753 "Convert FILENAME to absolute, and canonicalize it.\n\
1754 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1755 \(does not start with slash); if DEFAULT is nil or missing,\n\
1756 the current buffer's value of default-directory is used.\n\
1757 Filenames containing `.' or `..' as components are simplified;\n\
1758 initial `~/' expands to your home directory.\n\
1759 See also the function `substitute-in-file-name'.")
1761 Lisp_Object name
, defalt
;
1765 register unsigned char *newdir
, *p
, *o
;
1767 unsigned char *target
;
1771 unsigned char * colon
= 0;
1772 unsigned char * close
= 0;
1773 unsigned char * slash
= 0;
1774 unsigned char * brack
= 0;
1775 int lbrack
= 0, rbrack
= 0;
1779 CHECK_STRING (name
);
1782 /* Filenames on VMS are always upper case. */
1783 name
= Fupcase (name
);
1788 /* If nm is absolute, flush ...// and detect /./ and /../.
1789 If no /./ or /../ we can return right away. */
1801 if (p
[0] == '/' && p
[1] == '/'
1803 /* // at start of filename is meaningful on Apollo system. */
1808 if (p
[0] == '/' && p
[1] == '~')
1809 nm
= p
+ 1, lose
= 1;
1810 if (p
[0] == '/' && p
[1] == '.'
1811 && (p
[2] == '/' || p
[2] == 0
1812 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1818 /* if dev:[dir]/, move nm to / */
1819 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1820 nm
= (brack
? brack
+ 1 : colon
+ 1);
1821 lbrack
= rbrack
= 0;
1829 /* VMS pre V4.4,convert '-'s in filenames. */
1830 if (lbrack
== rbrack
)
1832 if (dots
< 2) /* this is to allow negative version numbers */
1838 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1839 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1845 /* count open brackets, reset close bracket pointer */
1846 if (p
[0] == '[' || p
[0] == '<')
1847 lbrack
++, brack
= 0;
1848 /* count close brackets, set close bracket pointer */
1849 if (p
[0] == ']' || p
[0] == '>')
1850 rbrack
++, brack
= p
;
1851 /* detect ][ or >< */
1852 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1854 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1855 nm
= p
+ 1, lose
= 1;
1856 if (p
[0] == ':' && (colon
|| slash
))
1857 /* if dev1:[dir]dev2:, move nm to dev2: */
1863 /* If /name/dev:, move nm to dev: */
1866 /* If node::dev:, move colon following dev */
1867 else if (colon
&& colon
[-1] == ':')
1869 /* If dev1:dev2:, move nm to dev2: */
1870 else if (colon
&& colon
[-1] != ':')
1875 if (p
[0] == ':' && !colon
)
1881 if (lbrack
== rbrack
)
1884 else if (p
[0] == '.')
1892 if (index (nm
, '/'))
1893 return build_string (sys_translate_unix (nm
));
1895 if (nm
== SDATA (name
))
1897 return build_string (nm
);
1901 /* Now determine directory to start with and put it in NEWDIR */
1905 if (nm
[0] == '~') /* prefix ~ */
1910 || nm
[1] == 0)/* ~/filename */
1912 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1913 newdir
= (unsigned char *) "";
1916 nm
++; /* Don't leave the slash in nm. */
1919 else /* ~user/filename */
1921 /* Get past ~ to user */
1922 unsigned char *user
= nm
+ 1;
1923 /* Find end of name. */
1924 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1925 int len
= ptr
? ptr
- user
: strlen (user
);
1927 unsigned char *ptr1
= index (user
, ':');
1928 if (ptr1
!= 0 && ptr1
- user
< len
)
1931 /* Copy the user name into temp storage. */
1932 o
= (unsigned char *) alloca (len
+ 1);
1933 bcopy ((char *) user
, o
, len
);
1936 /* Look up the user name. */
1938 pw
= (struct passwd
*) getpwnam (o
+ 1);
1941 error ("\"%s\" isn't a registered user", o
+ 1);
1943 newdir
= (unsigned char *) pw
->pw_dir
;
1945 /* Discard the user name from NM. */
1952 #endif /* not VMS */
1956 defalt
= current_buffer
->directory
;
1957 CHECK_STRING (defalt
);
1958 newdir
= SDATA (defalt
);
1961 /* Now concatenate the directory and name to new space in the stack frame */
1963 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1964 target
= (unsigned char *) alloca (tlen
);
1970 if (nm
[0] == 0 || nm
[0] == '/')
1971 strcpy (target
, newdir
);
1974 file_name_as_directory (target
, newdir
);
1977 strcat (target
, nm
);
1979 if (index (target
, '/'))
1980 strcpy (target
, sys_translate_unix (target
));
1983 /* Now canonicalize by removing /. and /foo/.. if they appear */
1991 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1997 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1998 /* brackets are offset from each other by 2 */
2001 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
2002 /* convert [foo][bar] to [bar] */
2003 while (o
[-1] != '[' && o
[-1] != '<')
2005 else if (*p
== '-' && *o
!= '.')
2008 else if (p
[0] == '-' && o
[-1] == '.'
2009 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2010 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2014 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2015 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2017 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2019 /* else [foo.-] ==> [-] */
2025 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2026 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2036 else if (!strncmp (p
, "//", 2)
2038 /* // at start of filename is meaningful in Apollo system. */
2046 else if (p
[0] == '/' && p
[1] == '.'
2047 && (p
[2] == '/' || p
[2] == 0))
2049 else if (!strncmp (p
, "/..", 3)
2050 /* `/../' is the "superroot" on certain file systems. */
2052 && (p
[3] == '/' || p
[3] == 0))
2054 while (o
!= target
&& *--o
!= '/')
2057 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2061 if (o
== target
&& *o
== '/')
2069 #endif /* not VMS */
2072 return make_string (target
, o
- target
);
2076 /* If /~ or // appears, discard everything through first slash. */
2078 file_name_absolute_p (filename
)
2079 const unsigned char *filename
;
2082 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2084 /* ??? This criterion is probably wrong for '<'. */
2085 || index (filename
, ':') || index (filename
, '<')
2086 || (*filename
== '[' && (filename
[1] != '-'
2087 || (filename
[2] != '.' && filename
[2] != ']'))
2088 && filename
[1] != '.')
2091 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2092 && IS_DIRECTORY_SEP (filename
[2]))
2097 static unsigned char *
2098 search_embedded_absfilename (nm
, endp
)
2099 unsigned char *nm
, *endp
;
2101 unsigned char *p
, *s
;
2103 for (p
= nm
+ 1; p
< endp
; p
++)
2107 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2109 || IS_DIRECTORY_SEP (p
[-1]))
2110 && file_name_absolute_p (p
)
2111 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2112 /* // at start of file name is meaningful in Apollo,
2113 WindowsNT and Cygwin systems. */
2114 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2115 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2118 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2123 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2125 unsigned char *o
= alloca (s
- p
+ 1);
2127 bcopy (p
, o
, s
- p
);
2130 /* If we have ~user and `user' exists, discard
2131 everything up to ~. But if `user' does not exist, leave
2132 ~user alone, it might be a literal file name. */
2134 pw
= getpwnam (o
+ 1);
2146 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2147 Ssubstitute_in_file_name
, 1, 1, 0,
2148 doc
: /* Substitute environment variables referred to in FILENAME.
2149 `$FOO' where FOO is an environment variable name means to substitute
2150 the value of that variable. The variable name should be terminated
2151 with a character not a letter, digit or underscore; otherwise, enclose
2152 the entire variable name in braces.
2153 If `/~' appears, all of FILENAME through that `/' is discarded.
2155 On VMS, `$' substitution is not done; this function does little and only
2156 duplicates what `expand-file-name' does. */)
2158 Lisp_Object filename
;
2162 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2163 unsigned char *target
= NULL
;
2165 int substituted
= 0;
2167 Lisp_Object handler
;
2169 CHECK_STRING (filename
);
2171 /* If the file name has special constructs in it,
2172 call the corresponding file handler. */
2173 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2174 if (!NILP (handler
))
2175 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2177 nm
= SDATA (filename
);
2179 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2180 CORRECT_DIR_SEPS (nm
);
2181 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2183 endp
= nm
+ SBYTES (filename
);
2185 /* If /~ or // appears, discard everything through first slash. */
2186 p
= search_embedded_absfilename (nm
, endp
);
2188 /* Start over with the new string, so we check the file-name-handler
2189 again. Important with filenames like "/home/foo//:/hello///there"
2190 which whould substitute to "/:/hello///there" rather than "/there". */
2191 return Fsubstitute_in_file_name
2192 (make_specified_string (p
, -1, endp
- p
,
2193 STRING_MULTIBYTE (filename
)));
2199 /* See if any variables are substituted into the string
2200 and find the total length of their values in `total' */
2202 for (p
= nm
; p
!= endp
;)
2212 /* "$$" means a single "$" */
2221 while (p
!= endp
&& *p
!= '}') p
++;
2222 if (*p
!= '}') goto missingclose
;
2228 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2232 /* Copy out the variable name */
2233 target
= (unsigned char *) alloca (s
- o
+ 1);
2234 strncpy (target
, o
, s
- o
);
2237 strupr (target
); /* $home == $HOME etc. */
2240 /* Get variable value */
2241 o
= (unsigned char *) egetenv (target
);
2243 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2244 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2254 /* If substitution required, recopy the string and do it */
2255 /* Make space in stack frame for the new copy */
2256 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2259 /* Copy the rest of the name through, replacing $ constructs with values */
2276 while (p
!= endp
&& *p
!= '}') p
++;
2277 if (*p
!= '}') goto missingclose
;
2283 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2287 /* Copy out the variable name */
2288 target
= (unsigned char *) alloca (s
- o
+ 1);
2289 strncpy (target
, o
, s
- o
);
2292 strupr (target
); /* $home == $HOME etc. */
2295 /* Get variable value */
2296 o
= (unsigned char *) egetenv (target
);
2300 strcpy (x
, target
); x
+= strlen (target
);
2302 else if (STRING_MULTIBYTE (filename
))
2304 /* If the original string is multibyte,
2305 convert what we substitute into multibyte. */
2308 int c
= unibyte_char_to_multibyte (*o
++);
2309 x
+= CHAR_STRING (c
, x
);
2321 /* If /~ or // appears, discard everything through first slash. */
2322 while ((p
= search_embedded_absfilename (xnm
, x
)))
2323 /* This time we do not start over because we've already expanded envvars
2324 and replaced $$ with $. Maybe we should start over as well, but we'd
2325 need to quote some $ to $$ first. */
2328 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2331 error ("Bad format environment-variable substitution");
2333 error ("Missing \"}\" in environment-variable substitution");
2335 error ("Substituting nonexistent environment variable \"%s\"", target
);
2338 #endif /* not VMS */
2342 /* A slightly faster and more convenient way to get
2343 (directory-file-name (expand-file-name FOO)). */
2346 expand_and_dir_to_file (filename
, defdir
)
2347 Lisp_Object filename
, defdir
;
2349 register Lisp_Object absname
;
2351 absname
= Fexpand_file_name (filename
, defdir
);
2354 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2355 if (c
== ':' || c
== ']' || c
== '>')
2356 absname
= Fdirectory_file_name (absname
);
2359 /* Remove final slash, if any (unless this is the root dir).
2360 stat behaves differently depending! */
2361 if (SCHARS (absname
) > 1
2362 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2363 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2364 /* We cannot take shortcuts; they might be wrong for magic file names. */
2365 absname
= Fdirectory_file_name (absname
);
2370 /* Signal an error if the file ABSNAME already exists.
2371 If INTERACTIVE is nonzero, ask the user whether to proceed,
2372 and bypass the error if the user says to go ahead.
2373 QUERYSTRING is a name for the action that is being considered
2376 *STATPTR is used to store the stat information if the file exists.
2377 If the file does not exist, STATPTR->st_mode is set to 0.
2378 If STATPTR is null, we don't store into it.
2380 If QUICK is nonzero, we ask for y or n, not yes or no. */
2383 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2384 Lisp_Object absname
;
2385 unsigned char *querystring
;
2387 struct stat
*statptr
;
2390 register Lisp_Object tem
, encoded_filename
;
2391 struct stat statbuf
;
2392 struct gcpro gcpro1
;
2394 encoded_filename
= ENCODE_FILE (absname
);
2396 /* stat is a good way to tell whether the file exists,
2397 regardless of what access permissions it has. */
2398 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2401 xsignal2 (Qfile_already_exists
,
2402 build_string ("File already exists"), absname
);
2404 tem
= format2 ("File %s already exists; %s anyway? ",
2405 absname
, build_string (querystring
));
2407 tem
= Fy_or_n_p (tem
);
2409 tem
= do_yes_or_no_p (tem
);
2412 xsignal2 (Qfile_already_exists
,
2413 build_string ("File already exists"), absname
);
2420 statptr
->st_mode
= 0;
2425 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2426 "fCopy file: \nGCopy %s to file: \np\nP",
2427 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2428 If NEWNAME names a directory, copy FILE there.
2430 This function always sets the file modes of the output file to match
2433 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2434 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2435 signal a `file-already-exists' error without overwriting. If
2436 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2437 about overwriting; this is what happens in interactive use with M-x.
2438 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2441 Fourth arg KEEP-TIME non-nil means give the output file the same
2442 last-modified time as the old one. (This works on only some systems.)
2444 A prefix arg makes KEEP-TIME non-nil.
2446 If PRESERVE-UID-GID is non-nil, we try to transfer the
2447 uid and gid of FILE to NEWNAME. */)
2448 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2449 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2450 Lisp_Object preserve_uid_gid
;
2453 char buf
[16 * 1024];
2454 struct stat st
, out_st
;
2455 Lisp_Object handler
;
2456 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2457 int count
= SPECPDL_INDEX ();
2458 int input_file_statable_p
;
2459 Lisp_Object encoded_file
, encoded_newname
;
2461 encoded_file
= encoded_newname
= Qnil
;
2462 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2463 CHECK_STRING (file
);
2464 CHECK_STRING (newname
);
2466 if (!NILP (Ffile_directory_p (newname
)))
2467 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2469 newname
= Fexpand_file_name (newname
, Qnil
);
2471 file
= Fexpand_file_name (file
, Qnil
);
2473 /* If the input file name has special constructs in it,
2474 call the corresponding file handler. */
2475 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2476 /* Likewise for output file name. */
2478 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2479 if (!NILP (handler
))
2480 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2481 ok_if_already_exists
, keep_time
));
2483 encoded_file
= ENCODE_FILE (file
);
2484 encoded_newname
= ENCODE_FILE (newname
);
2486 if (NILP (ok_if_already_exists
)
2487 || INTEGERP (ok_if_already_exists
))
2488 barf_or_query_if_file_exists (newname
, "copy to it",
2489 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2490 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2494 if (!CopyFile (SDATA (encoded_file
),
2495 SDATA (encoded_newname
),
2497 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2498 /* CopyFile retains the timestamp by default. */
2499 else if (NILP (keep_time
))
2505 EMACS_GET_TIME (now
);
2506 filename
= SDATA (encoded_newname
);
2508 /* Ensure file is writable while its modified time is set. */
2509 attributes
= GetFileAttributes (filename
);
2510 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2511 if (set_file_times (filename
, now
, now
))
2513 /* Restore original attributes. */
2514 SetFileAttributes (filename
, attributes
);
2515 xsignal2 (Qfile_date_error
,
2516 build_string ("Cannot set file date"), newname
);
2518 /* Restore original attributes. */
2519 SetFileAttributes (filename
, attributes
);
2521 #else /* not WINDOWSNT */
2523 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2527 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2529 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2531 /* We can only copy regular files and symbolic links. Other files are not
2533 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2535 #if !defined (MSDOS) || __DJGPP__ > 1
2536 if (out_st
.st_mode
!= 0
2537 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2540 report_file_error ("Input and output files are the same",
2541 Fcons (file
, Fcons (newname
, Qnil
)));
2545 #if defined (S_ISREG) && defined (S_ISLNK)
2546 if (input_file_statable_p
)
2548 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2550 #if defined (EISDIR)
2551 /* Get a better looking error message. */
2554 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2557 #endif /* S_ISREG && S_ISLNK */
2560 /* Create the copy file with the same record format as the input file */
2561 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2564 /* System's default file type was set to binary by _fmode in emacs.c. */
2565 ofd
= emacs_open (SDATA (encoded_newname
),
2566 O_WRONLY
| O_TRUNC
| O_CREAT
2567 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2568 S_IREAD
| S_IWRITE
);
2569 #else /* not MSDOS */
2570 ofd
= emacs_open (SDATA (encoded_newname
),
2571 O_WRONLY
| O_TRUNC
| O_CREAT
2572 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2574 #endif /* not MSDOS */
2577 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2579 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2583 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2584 if (emacs_write (ofd
, buf
, n
) != n
)
2585 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2589 /* Preserve the original file modes, and if requested, also its
2591 if (input_file_statable_p
)
2593 if (! NILP (preserve_uid_gid
))
2594 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2595 fchmod (ofd
, st
.st_mode
& 07777);
2597 #endif /* not MSDOS */
2599 /* Closing the output clobbers the file times on some systems. */
2600 if (emacs_close (ofd
) < 0)
2601 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2603 if (input_file_statable_p
)
2605 if (!NILP (keep_time
))
2607 EMACS_TIME atime
, mtime
;
2608 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2609 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2610 if (set_file_times (SDATA (encoded_newname
),
2612 xsignal2 (Qfile_date_error
,
2613 build_string ("Cannot set file date"), newname
);
2619 #if defined (__DJGPP__) && __DJGPP__ > 1
2620 if (input_file_statable_p
)
2622 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2623 and if it can't, it tells so. Otherwise, under MSDOS we usually
2624 get only the READ bit, which will make the copied file read-only,
2625 so it's better not to chmod at all. */
2626 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2627 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2629 #endif /* DJGPP version 2 or newer */
2630 #endif /* not WINDOWSNT */
2632 /* Discard the unwind protects. */
2633 specpdl_ptr
= specpdl
+ count
;
2639 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2640 Smake_directory_internal
, 1, 1, 0,
2641 doc
: /* Create a new directory named DIRECTORY. */)
2643 Lisp_Object directory
;
2645 const unsigned char *dir
;
2646 Lisp_Object handler
;
2647 Lisp_Object encoded_dir
;
2649 CHECK_STRING (directory
);
2650 directory
= Fexpand_file_name (directory
, Qnil
);
2652 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2653 if (!NILP (handler
))
2654 return call2 (handler
, Qmake_directory_internal
, directory
);
2656 encoded_dir
= ENCODE_FILE (directory
);
2658 dir
= SDATA (encoded_dir
);
2661 if (mkdir (dir
) != 0)
2663 if (mkdir (dir
, 0777) != 0)
2665 report_file_error ("Creating directory", list1 (directory
));
2670 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2671 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2673 Lisp_Object directory
;
2675 const unsigned char *dir
;
2676 Lisp_Object handler
;
2677 Lisp_Object encoded_dir
;
2679 CHECK_STRING (directory
);
2680 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2682 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2683 if (!NILP (handler
))
2684 return call2 (handler
, Qdelete_directory
, directory
);
2686 encoded_dir
= ENCODE_FILE (directory
);
2688 dir
= SDATA (encoded_dir
);
2690 if (rmdir (dir
) != 0)
2691 report_file_error ("Removing directory", list1 (directory
));
2696 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2697 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2698 If file has multiple names, it continues to exist with the other names. */)
2700 Lisp_Object filename
;
2702 Lisp_Object handler
;
2703 Lisp_Object encoded_file
;
2704 struct gcpro gcpro1
;
2707 if (!NILP (Ffile_directory_p (filename
))
2708 && NILP (Ffile_symlink_p (filename
)))
2709 xsignal2 (Qfile_error
,
2710 build_string ("Removing old name: is a directory"),
2713 filename
= Fexpand_file_name (filename
, Qnil
);
2715 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2716 if (!NILP (handler
))
2717 return call2 (handler
, Qdelete_file
, filename
);
2719 encoded_file
= ENCODE_FILE (filename
);
2721 if (0 > unlink (SDATA (encoded_file
)))
2722 report_file_error ("Removing old name", list1 (filename
));
2727 internal_delete_file_1 (ignore
)
2733 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2736 internal_delete_file (filename
)
2737 Lisp_Object filename
;
2740 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2741 Qt
, internal_delete_file_1
);
2745 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2746 "fRename file: \nGRename %s to file: \np",
2747 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2748 If file has names other than FILE, it continues to have those names.
2749 Signals a `file-already-exists' error if a file NEWNAME already exists
2750 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2751 A number as third arg means request confirmation if NEWNAME already exists.
2752 This is what happens in interactive use with M-x. */)
2753 (file
, newname
, ok_if_already_exists
)
2754 Lisp_Object file
, newname
, ok_if_already_exists
;
2756 Lisp_Object handler
;
2757 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2758 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2760 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2761 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2762 CHECK_STRING (file
);
2763 CHECK_STRING (newname
);
2764 file
= Fexpand_file_name (file
, Qnil
);
2766 if ((!NILP (Ffile_directory_p (newname
)))
2768 /* If the file names are identical but for the case,
2769 don't attempt to move directory to itself. */
2770 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2773 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2775 newname
= Fexpand_file_name (newname
, Qnil
);
2777 /* If the file name has special constructs in it,
2778 call the corresponding file handler. */
2779 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2781 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2782 if (!NILP (handler
))
2783 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2784 file
, newname
, ok_if_already_exists
));
2786 encoded_file
= ENCODE_FILE (file
);
2787 encoded_newname
= ENCODE_FILE (newname
);
2790 /* If the file names are identical but for the case, don't ask for
2791 confirmation: they simply want to change the letter-case of the
2793 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2795 if (NILP (ok_if_already_exists
)
2796 || INTEGERP (ok_if_already_exists
))
2797 barf_or_query_if_file_exists (newname
, "rename to it",
2798 INTEGERP (ok_if_already_exists
), 0, 0);
2800 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2802 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2803 || 0 > unlink (SDATA (encoded_file
)))
2809 symlink_target
= Ffile_symlink_p (file
);
2810 if (! NILP (symlink_target
))
2811 Fmake_symbolic_link (symlink_target
, newname
,
2812 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2815 Fcopy_file (file
, newname
,
2816 /* We have already prompted if it was an integer,
2817 so don't have copy-file prompt again. */
2818 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2821 Fdelete_file (file
);
2824 report_file_error ("Renaming", list2 (file
, newname
));
2830 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2831 "fAdd name to file: \nGName to add to %s: \np",
2832 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2833 Signals a `file-already-exists' error if a file NEWNAME already exists
2834 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2835 A number as third arg means request confirmation if NEWNAME already exists.
2836 This is what happens in interactive use with M-x. */)
2837 (file
, newname
, ok_if_already_exists
)
2838 Lisp_Object file
, newname
, ok_if_already_exists
;
2840 Lisp_Object handler
;
2841 Lisp_Object encoded_file
, encoded_newname
;
2842 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2844 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2845 encoded_file
= encoded_newname
= Qnil
;
2846 CHECK_STRING (file
);
2847 CHECK_STRING (newname
);
2848 file
= Fexpand_file_name (file
, Qnil
);
2850 if (!NILP (Ffile_directory_p (newname
)))
2851 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2853 newname
= Fexpand_file_name (newname
, Qnil
);
2855 /* If the file name has special constructs in it,
2856 call the corresponding file handler. */
2857 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2858 if (!NILP (handler
))
2859 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2860 newname
, ok_if_already_exists
));
2862 /* If the new name has special constructs in it,
2863 call the corresponding file handler. */
2864 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2865 if (!NILP (handler
))
2866 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2867 newname
, ok_if_already_exists
));
2869 encoded_file
= ENCODE_FILE (file
);
2870 encoded_newname
= ENCODE_FILE (newname
);
2872 if (NILP (ok_if_already_exists
)
2873 || INTEGERP (ok_if_already_exists
))
2874 barf_or_query_if_file_exists (newname
, "make it a new name",
2875 INTEGERP (ok_if_already_exists
), 0, 0);
2877 unlink (SDATA (newname
));
2878 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2879 report_file_error ("Adding new name", list2 (file
, newname
));
2885 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2886 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2887 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2888 Both args must be strings.
2889 Signals a `file-already-exists' error if a file LINKNAME already exists
2890 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2891 A number as third arg means request confirmation if LINKNAME already exists.
2892 This happens for interactive use with M-x. */)
2893 (filename
, linkname
, ok_if_already_exists
)
2894 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2896 Lisp_Object handler
;
2897 Lisp_Object encoded_filename
, encoded_linkname
;
2898 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2900 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2901 encoded_filename
= encoded_linkname
= Qnil
;
2902 CHECK_STRING (filename
);
2903 CHECK_STRING (linkname
);
2904 /* If the link target has a ~, we must expand it to get
2905 a truly valid file name. Otherwise, do not expand;
2906 we want to permit links to relative file names. */
2907 if (SREF (filename
, 0) == '~')
2908 filename
= Fexpand_file_name (filename
, Qnil
);
2910 if (!NILP (Ffile_directory_p (linkname
)))
2911 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2913 linkname
= Fexpand_file_name (linkname
, Qnil
);
2915 /* If the file name has special constructs in it,
2916 call the corresponding file handler. */
2917 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2918 if (!NILP (handler
))
2919 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2920 linkname
, ok_if_already_exists
));
2922 /* If the new link name has special constructs in it,
2923 call the corresponding file handler. */
2924 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2925 if (!NILP (handler
))
2926 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2927 linkname
, ok_if_already_exists
));
2930 encoded_filename
= ENCODE_FILE (filename
);
2931 encoded_linkname
= ENCODE_FILE (linkname
);
2933 if (NILP (ok_if_already_exists
)
2934 || INTEGERP (ok_if_already_exists
))
2935 barf_or_query_if_file_exists (linkname
, "make it a link",
2936 INTEGERP (ok_if_already_exists
), 0, 0);
2937 if (0 > symlink (SDATA (encoded_filename
),
2938 SDATA (encoded_linkname
)))
2940 /* If we didn't complain already, silently delete existing file. */
2941 if (errno
== EEXIST
)
2943 unlink (SDATA (encoded_linkname
));
2944 if (0 <= symlink (SDATA (encoded_filename
),
2945 SDATA (encoded_linkname
)))
2952 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2959 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2961 #endif /* S_IFLNK */
2966 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2967 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2968 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2969 If STRING is nil or a null string, the logical name NAME is deleted. */)
2974 CHECK_STRING (name
);
2976 delete_logical_name (SDATA (name
));
2979 CHECK_STRING (string
);
2981 if (SCHARS (string
) == 0)
2982 delete_logical_name (SDATA (name
));
2984 define_logical_name (SDATA (name
), SDATA (string
));
2993 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2994 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2996 Lisp_Object path
, login
;
3000 CHECK_STRING (path
);
3001 CHECK_STRING (login
);
3003 netresult
= netunam (SDATA (path
), SDATA (login
));
3005 if (netresult
== -1)
3010 #endif /* HPUX_NET */
3012 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3014 doc
: /* Return t if file FILENAME specifies an absolute file name.
3015 On Unix, this is a name starting with a `/' or a `~'. */)
3017 Lisp_Object filename
;
3019 CHECK_STRING (filename
);
3020 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3023 /* Return nonzero if file FILENAME exists and can be executed. */
3026 check_executable (filename
)
3030 int len
= strlen (filename
);
3033 if (stat (filename
, &st
) < 0)
3035 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3036 return ((st
.st_mode
& S_IEXEC
) != 0);
3038 return (S_ISREG (st
.st_mode
)
3040 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3041 || stricmp (suffix
, ".exe") == 0
3042 || stricmp (suffix
, ".bat") == 0)
3043 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3044 #endif /* not WINDOWSNT */
3045 #else /* not DOS_NT */
3046 #ifdef HAVE_EUIDACCESS
3047 return (euidaccess (filename
, 1) >= 0);
3049 /* Access isn't quite right because it uses the real uid
3050 and we really want to test with the effective uid.
3051 But Unix doesn't give us a right way to do it. */
3052 return (access (filename
, 1) >= 0);
3054 #endif /* not DOS_NT */
3057 /* Return nonzero if file FILENAME exists and can be written. */
3060 check_writable (filename
)
3065 if (stat (filename
, &st
) < 0)
3067 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3068 #else /* not MSDOS */
3069 #ifdef HAVE_EUIDACCESS
3070 return (euidaccess (filename
, 2) >= 0);
3072 /* Access isn't quite right because it uses the real uid
3073 and we really want to test with the effective uid.
3074 But Unix doesn't give us a right way to do it.
3075 Opening with O_WRONLY could work for an ordinary file,
3076 but would lose for directories. */
3077 return (access (filename
, 2) >= 0);
3079 #endif /* not MSDOS */
3082 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3083 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3084 See also `file-readable-p' and `file-attributes'.
3085 This returns nil for a symlink to a nonexistent file.
3086 Use `file-symlink-p' to test for such links. */)
3088 Lisp_Object filename
;
3090 Lisp_Object absname
;
3091 Lisp_Object handler
;
3092 struct stat statbuf
;
3094 CHECK_STRING (filename
);
3095 absname
= Fexpand_file_name (filename
, Qnil
);
3097 /* If the file name has special constructs in it,
3098 call the corresponding file handler. */
3099 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3100 if (!NILP (handler
))
3101 return call2 (handler
, Qfile_exists_p
, absname
);
3103 absname
= ENCODE_FILE (absname
);
3105 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3108 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3109 doc
: /* Return t if FILENAME can be executed by you.
3110 For a directory, this means you can access files in that directory. */)
3112 Lisp_Object filename
;
3114 Lisp_Object absname
;
3115 Lisp_Object handler
;
3117 CHECK_STRING (filename
);
3118 absname
= Fexpand_file_name (filename
, Qnil
);
3120 /* If the file name has special constructs in it,
3121 call the corresponding file handler. */
3122 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3123 if (!NILP (handler
))
3124 return call2 (handler
, Qfile_executable_p
, absname
);
3126 absname
= ENCODE_FILE (absname
);
3128 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3131 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3132 doc
: /* Return t if file FILENAME exists and you can read it.
3133 See also `file-exists-p' and `file-attributes'. */)
3135 Lisp_Object filename
;
3137 Lisp_Object absname
;
3138 Lisp_Object handler
;
3141 struct stat statbuf
;
3143 CHECK_STRING (filename
);
3144 absname
= Fexpand_file_name (filename
, Qnil
);
3146 /* If the file name has special constructs in it,
3147 call the corresponding file handler. */
3148 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3149 if (!NILP (handler
))
3150 return call2 (handler
, Qfile_readable_p
, absname
);
3152 absname
= ENCODE_FILE (absname
);
3154 #if defined(DOS_NT) || defined(macintosh)
3155 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3157 if (access (SDATA (absname
), 0) == 0)
3160 #else /* not DOS_NT and not macintosh */
3162 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3163 /* Opening a fifo without O_NONBLOCK can wait.
3164 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3165 except in the case of a fifo, on a system which handles it. */
3166 desc
= stat (SDATA (absname
), &statbuf
);
3169 if (S_ISFIFO (statbuf
.st_mode
))
3170 flags
|= O_NONBLOCK
;
3172 desc
= emacs_open (SDATA (absname
), flags
, 0);
3177 #endif /* not DOS_NT and not macintosh */
3180 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3182 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3183 doc
: /* Return t if file FILENAME can be written or created by you. */)
3185 Lisp_Object filename
;
3187 Lisp_Object absname
, dir
, encoded
;
3188 Lisp_Object handler
;
3189 struct stat statbuf
;
3191 CHECK_STRING (filename
);
3192 absname
= Fexpand_file_name (filename
, Qnil
);
3194 /* If the file name has special constructs in it,
3195 call the corresponding file handler. */
3196 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3197 if (!NILP (handler
))
3198 return call2 (handler
, Qfile_writable_p
, absname
);
3200 encoded
= ENCODE_FILE (absname
);
3201 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3202 return (check_writable (SDATA (encoded
))
3205 dir
= Ffile_name_directory (absname
);
3208 dir
= Fdirectory_file_name (dir
);
3212 dir
= Fdirectory_file_name (dir
);
3215 dir
= ENCODE_FILE (dir
);
3217 /* The read-only attribute of the parent directory doesn't affect
3218 whether a file or directory can be created within it. Some day we
3219 should check ACLs though, which do affect this. */
3220 if (stat (SDATA (dir
), &statbuf
) < 0)
3222 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3224 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3229 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3230 doc
: /* Access file FILENAME, and get an error if that does not work.
3231 The second argument STRING is used in the error message.
3232 If there is no error, returns nil. */)
3234 Lisp_Object filename
, string
;
3236 Lisp_Object handler
, encoded_filename
, absname
;
3239 CHECK_STRING (filename
);
3240 absname
= Fexpand_file_name (filename
, Qnil
);
3242 CHECK_STRING (string
);
3244 /* If the file name has special constructs in it,
3245 call the corresponding file handler. */
3246 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3247 if (!NILP (handler
))
3248 return call3 (handler
, Qaccess_file
, absname
, string
);
3250 encoded_filename
= ENCODE_FILE (absname
);
3252 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3254 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3260 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3261 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3262 The value is the link target, as a string.
3263 Otherwise it returns nil.
3265 This function returns t when given the name of a symlink that
3266 points to a nonexistent file. */)
3268 Lisp_Object filename
;
3270 Lisp_Object handler
;
3272 CHECK_STRING (filename
);
3273 filename
= Fexpand_file_name (filename
, Qnil
);
3275 /* If the file name has special constructs in it,
3276 call the corresponding file handler. */
3277 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3278 if (!NILP (handler
))
3279 return call2 (handler
, Qfile_symlink_p
, filename
);
3288 filename
= ENCODE_FILE (filename
);
3295 buf
= (char *) xrealloc (buf
, bufsize
);
3296 bzero (buf
, bufsize
);
3299 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3303 /* HP-UX reports ERANGE if buffer is too small. */
3304 if (errno
== ERANGE
)
3314 while (valsize
>= bufsize
);
3316 val
= make_string (buf
, valsize
);
3317 if (buf
[0] == '/' && index (buf
, ':'))
3318 val
= concat2 (build_string ("/:"), val
);
3320 val
= DECODE_FILE (val
);
3323 #else /* not S_IFLNK */
3325 #endif /* not S_IFLNK */
3328 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3329 doc
: /* Return t if FILENAME names an existing directory.
3330 Symbolic links to directories count as directories.
3331 See `file-symlink-p' to distinguish symlinks. */)
3333 Lisp_Object filename
;
3335 register Lisp_Object absname
;
3337 Lisp_Object handler
;
3339 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3341 /* If the file name has special constructs in it,
3342 call the corresponding file handler. */
3343 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3344 if (!NILP (handler
))
3345 return call2 (handler
, Qfile_directory_p
, absname
);
3347 absname
= ENCODE_FILE (absname
);
3349 if (stat (SDATA (absname
), &st
) < 0)
3351 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3354 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3355 doc
: /* Return t if file FILENAME names a directory you can open.
3356 For the value to be t, FILENAME must specify the name of a directory as a file,
3357 and the directory must allow you to open files in it. In order to use a
3358 directory as a buffer's current directory, this predicate must return true.
3359 A directory name spec may be given instead; then the value is t
3360 if the directory so specified exists and really is a readable and
3361 searchable directory. */)
3363 Lisp_Object filename
;
3365 Lisp_Object handler
;
3367 struct gcpro gcpro1
;
3369 /* If the file name has special constructs in it,
3370 call the corresponding file handler. */
3371 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3372 if (!NILP (handler
))
3373 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3376 tem
= (NILP (Ffile_directory_p (filename
))
3377 || NILP (Ffile_executable_p (filename
)));
3379 return tem
? Qnil
: Qt
;
3382 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3383 doc
: /* Return t if FILENAME names a regular file.
3384 This is the sort of file that holds an ordinary stream of data bytes.
3385 Symbolic links to regular files count as regular files.
3386 See `file-symlink-p' to distinguish symlinks. */)
3388 Lisp_Object filename
;
3390 register Lisp_Object absname
;
3392 Lisp_Object handler
;
3394 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3396 /* If the file name has special constructs in it,
3397 call the corresponding file handler. */
3398 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3399 if (!NILP (handler
))
3400 return call2 (handler
, Qfile_regular_p
, absname
);
3402 absname
= ENCODE_FILE (absname
);
3407 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3409 /* Tell stat to use expensive method to get accurate info. */
3410 Vw32_get_true_file_attributes
= Qt
;
3411 result
= stat (SDATA (absname
), &st
);
3412 Vw32_get_true_file_attributes
= tem
;
3416 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3419 if (stat (SDATA (absname
), &st
) < 0)
3421 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3425 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3426 doc
: /* Return mode bits of file named FILENAME, as an integer.
3427 Return nil, if file does not exist or is not accessible. */)
3429 Lisp_Object filename
;
3431 Lisp_Object absname
;
3433 Lisp_Object handler
;
3435 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3437 /* If the file name has special constructs in it,
3438 call the corresponding file handler. */
3439 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3440 if (!NILP (handler
))
3441 return call2 (handler
, Qfile_modes
, absname
);
3443 absname
= ENCODE_FILE (absname
);
3445 if (stat (SDATA (absname
), &st
) < 0)
3447 #if defined (MSDOS) && __DJGPP__ < 2
3448 if (check_executable (SDATA (absname
)))
3449 st
.st_mode
|= S_IEXEC
;
3450 #endif /* MSDOS && __DJGPP__ < 2 */
3452 return make_number (st
.st_mode
& 07777);
3455 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3456 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3457 Only the 12 low bits of MODE are used. */)
3459 Lisp_Object filename
, mode
;
3461 Lisp_Object absname
, encoded_absname
;
3462 Lisp_Object handler
;
3464 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3465 CHECK_NUMBER (mode
);
3467 /* If the file name has special constructs in it,
3468 call the corresponding file handler. */
3469 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3470 if (!NILP (handler
))
3471 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3473 encoded_absname
= ENCODE_FILE (absname
);
3475 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3476 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3481 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3482 doc
: /* Set the file permission bits for newly created files.
3483 The argument MODE should be an integer; only the low 9 bits are used.
3484 This setting is inherited by subprocesses. */)
3488 CHECK_NUMBER (mode
);
3490 umask ((~ XINT (mode
)) & 0777);
3495 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3496 doc
: /* Return the default file protection for created files.
3497 The value is an integer. */)
3503 realmask
= umask (0);
3506 XSETINT (value
, (~ realmask
) & 0777);
3510 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3512 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3513 doc
: /* Set times of file FILENAME to TIME.
3514 Set both access and modification times.
3515 Return t on success, else nil.
3516 Use the current time if TIME is nil. TIME is in the format of
3519 Lisp_Object filename
, time
;
3521 Lisp_Object absname
, encoded_absname
;
3522 Lisp_Object handler
;
3526 if (! lisp_time_argument (time
, &sec
, &usec
))
3527 error ("Invalid time specification");
3529 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3531 /* If the file name has special constructs in it,
3532 call the corresponding file handler. */
3533 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3534 if (!NILP (handler
))
3535 return call3 (handler
, Qset_file_times
, absname
, time
);
3537 encoded_absname
= ENCODE_FILE (absname
);
3542 EMACS_SET_SECS (t
, sec
);
3543 EMACS_SET_USECS (t
, usec
);
3545 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3550 /* Setting times on a directory always fails. */
3551 if (stat (SDATA (encoded_absname
), &st
) == 0
3552 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3555 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3564 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3565 doc
: /* Tell Unix to finish all pending disk updates. */)
3572 #endif /* HAVE_SYNC */
3574 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3575 doc
: /* Return t if file FILE1 is newer than file FILE2.
3576 If FILE1 does not exist, the answer is nil;
3577 otherwise, if FILE2 does not exist, the answer is t. */)
3579 Lisp_Object file1
, file2
;
3581 Lisp_Object absname1
, absname2
;
3584 Lisp_Object handler
;
3585 struct gcpro gcpro1
, gcpro2
;
3587 CHECK_STRING (file1
);
3588 CHECK_STRING (file2
);
3591 GCPRO2 (absname1
, file2
);
3592 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3593 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3596 /* If the file name has special constructs in it,
3597 call the corresponding file handler. */
3598 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3600 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3601 if (!NILP (handler
))
3602 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3604 GCPRO2 (absname1
, absname2
);
3605 absname1
= ENCODE_FILE (absname1
);
3606 absname2
= ENCODE_FILE (absname2
);
3609 if (stat (SDATA (absname1
), &st
) < 0)
3612 mtime1
= st
.st_mtime
;
3614 if (stat (SDATA (absname2
), &st
) < 0)
3617 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3621 Lisp_Object Qfind_buffer_file_type
;
3624 #ifndef READ_BUF_SIZE
3625 #define READ_BUF_SIZE (64 << 10)
3628 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3630 /* This function is called after Lisp functions to decide a coding
3631 system are called, or when they cause an error. Before they are
3632 called, the current buffer is set unibyte and it contains only a
3633 newly inserted text (thus the buffer was empty before the
3636 The functions may set markers, overlays, text properties, or even
3637 alter the buffer contents, change the current buffer.
3639 Here, we reset all those changes by:
3640 o set back the current buffer.
3641 o move all markers and overlays to BEG.
3642 o remove all text properties.
3643 o set back the buffer multibyteness. */
3646 decide_coding_unwind (unwind_data
)
3647 Lisp_Object unwind_data
;
3649 Lisp_Object multibyte
, undo_list
, buffer
;
3651 multibyte
= XCAR (unwind_data
);
3652 unwind_data
= XCDR (unwind_data
);
3653 undo_list
= XCAR (unwind_data
);
3654 buffer
= XCDR (unwind_data
);
3656 if (current_buffer
!= XBUFFER (buffer
))
3657 set_buffer_internal (XBUFFER (buffer
));
3658 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3659 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3660 BUF_INTERVALS (current_buffer
) = 0;
3661 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3663 /* Now we are safe to change the buffer's multibyteness directly. */
3664 current_buffer
->enable_multibyte_characters
= multibyte
;
3665 current_buffer
->undo_list
= undo_list
;
3671 /* Used to pass values from insert-file-contents to read_non_regular. */
3673 static int non_regular_fd
;
3674 static int non_regular_inserted
;
3675 static int non_regular_nbytes
;
3678 /* Read from a non-regular file.
3679 Read non_regular_trytry bytes max from non_regular_fd.
3680 Non_regular_inserted specifies where to put the read bytes.
3681 Value is the number of bytes read. */
3690 nbytes
= emacs_read (non_regular_fd
,
3691 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3692 non_regular_nbytes
);
3694 return make_number (nbytes
);
3698 /* Condition-case handler used when reading from non-regular files
3699 in insert-file-contents. */
3702 read_non_regular_quit ()
3708 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3710 doc
: /* Insert contents of file FILENAME after point.
3711 Returns list of absolute file name and number of characters inserted.
3712 If second argument VISIT is non-nil, the buffer's visited filename
3713 and last save file modtime are set, and it is marked unmodified.
3714 If visiting and the file does not exist, visiting is completed
3715 before the error is signaled.
3716 The optional third and fourth arguments BEG and END
3717 specify what portion of the file to insert.
3718 These arguments count bytes in the file, not characters in the buffer.
3719 If VISIT is non-nil, BEG and END must be nil.
3721 If optional fifth argument REPLACE is non-nil,
3722 it means replace the current buffer contents (in the accessible portion)
3723 with the file contents. This is better than simply deleting and inserting
3724 the whole thing because (1) it preserves some marker positions
3725 and (2) it puts less data in the undo list.
3726 When REPLACE is non-nil, the value is the number of characters actually read,
3727 which is often less than the number of characters to be read.
3729 This does code conversion according to the value of
3730 `coding-system-for-read' or `file-coding-system-alist',
3731 and sets the variable `last-coding-system-used' to the coding system
3733 (filename
, visit
, beg
, end
, replace
)
3734 Lisp_Object filename
, visit
, beg
, end
, replace
;
3739 register int how_much
;
3740 register int unprocessed
;
3741 int count
= SPECPDL_INDEX ();
3742 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3743 Lisp_Object handler
, val
, insval
, orig_filename
;
3746 int not_regular
= 0;
3747 unsigned char read_buf
[READ_BUF_SIZE
];
3748 struct coding_system coding
;
3749 unsigned char buffer
[1 << 14];
3750 int replace_handled
= 0;
3751 int set_coding_system
= 0;
3752 int coding_system_decided
= 0;
3754 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3755 int we_locked_file
= 0;
3757 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3758 error ("Cannot do file visiting in an indirect buffer");
3760 if (!NILP (current_buffer
->read_only
))
3761 Fbarf_if_buffer_read_only ();
3765 orig_filename
= Qnil
;
3767 GCPRO4 (filename
, val
, p
, orig_filename
);
3769 CHECK_STRING (filename
);
3770 filename
= Fexpand_file_name (filename
, Qnil
);
3772 /* If the file name has special constructs in it,
3773 call the corresponding file handler. */
3774 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3775 if (!NILP (handler
))
3777 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3778 visit
, beg
, end
, replace
);
3779 if (CONSP (val
) && CONSP (XCDR (val
)))
3780 inserted
= XINT (XCAR (XCDR (val
)));
3784 orig_filename
= filename
;
3785 filename
= ENCODE_FILE (filename
);
3791 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3793 /* Tell stat to use expensive method to get accurate info. */
3794 Vw32_get_true_file_attributes
= Qt
;
3795 total
= stat (SDATA (filename
), &st
);
3796 Vw32_get_true_file_attributes
= tem
;
3801 if (stat (SDATA (filename
), &st
) < 0)
3803 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3804 || fstat (fd
, &st
) < 0)
3805 #endif /* not APOLLO */
3806 #endif /* WINDOWSNT */
3808 if (fd
>= 0) emacs_close (fd
);
3811 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3814 if (!NILP (Vcoding_system_for_read
))
3815 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3820 /* This code will need to be changed in order to work on named
3821 pipes, and it's probably just not worth it. So we should at
3822 least signal an error. */
3823 if (!S_ISREG (st
.st_mode
))
3830 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3831 xsignal2 (Qfile_error
,
3832 build_string ("not a regular file"), orig_filename
);
3837 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3840 /* Replacement should preserve point as it preserves markers. */
3841 if (!NILP (replace
))
3842 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3844 record_unwind_protect (close_file_unwind
, make_number (fd
));
3846 /* Supposedly happens on VMS. */
3847 /* Can happen on any platform that uses long as type of off_t, but allows
3848 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3849 give a message suitable for the latter case. */
3850 if (! not_regular
&& st
.st_size
< 0)
3851 error ("Maximum buffer size exceeded");
3853 /* Prevent redisplay optimizations. */
3854 current_buffer
->clip_changed
= 1;
3858 if (!NILP (beg
) || !NILP (end
))
3859 error ("Attempt to visit less than an entire file");
3860 if (BEG
< Z
&& NILP (replace
))
3861 error ("Cannot do file visiting in a non-empty buffer");
3867 XSETFASTINT (beg
, 0);
3875 XSETINT (end
, st
.st_size
);
3877 /* Arithmetic overflow can occur if an Emacs integer cannot
3878 represent the file size, or if the calculations below
3879 overflow. The calculations below double the file size
3880 twice, so check that it can be multiplied by 4 safely. */
3881 if (XINT (end
) != st
.st_size
3882 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3883 error ("Maximum buffer size exceeded");
3885 /* The file size returned from stat may be zero, but data
3886 may be readable nonetheless, for example when this is a
3887 file in the /proc filesystem. */
3888 if (st
.st_size
== 0)
3889 XSETINT (end
, READ_BUF_SIZE
);
3893 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3895 /* We use emacs-mule for auto saving... */
3896 setup_coding_system (Qemacs_mule
, &coding
);
3897 /* ... but with the special flag to indicate to read in a
3898 multibyte sequence for eight-bit-control char as is. */
3900 coding
.src_multibyte
= 0;
3901 coding
.dst_multibyte
3902 = !NILP (current_buffer
->enable_multibyte_characters
);
3903 coding
.eol_type
= CODING_EOL_LF
;
3904 coding_system_decided
= 1;
3908 /* Decide the coding system to use for reading the file now
3909 because we can't use an optimized method for handling
3910 `coding:' tag if the current buffer is not empty. */
3914 if (!NILP (Vcoding_system_for_read
))
3915 val
= Vcoding_system_for_read
;
3918 /* Don't try looking inside a file for a coding system
3919 specification if it is not seekable. */
3920 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3922 /* Find a coding system specified in the heading two
3923 lines or in the tailing several lines of the file.
3924 We assume that the 1K-byte and 3K-byte for heading
3925 and tailing respectively are sufficient for this
3929 if (st
.st_size
<= (1024 * 4))
3930 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3933 nread
= emacs_read (fd
, read_buf
, 1024);
3936 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3937 report_file_error ("Setting file position",
3938 Fcons (orig_filename
, Qnil
));
3939 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3944 error ("IO error reading %s: %s",
3945 SDATA (orig_filename
), emacs_strerror (errno
));
3948 struct buffer
*prev
= current_buffer
;
3952 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3954 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3955 buf
= XBUFFER (buffer
);
3957 delete_all_overlays (buf
);
3958 buf
->directory
= current_buffer
->directory
;
3959 buf
->read_only
= Qnil
;
3960 buf
->filename
= Qnil
;
3961 buf
->undo_list
= Qt
;
3962 eassert (buf
->overlays_before
== NULL
);
3963 eassert (buf
->overlays_after
== NULL
);
3965 set_buffer_internal (buf
);
3967 buf
->enable_multibyte_characters
= Qnil
;
3969 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3970 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3971 val
= call2 (Vset_auto_coding_function
,
3972 filename
, make_number (nread
));
3973 set_buffer_internal (prev
);
3975 /* Discard the unwind protect for recovering the
3979 /* Rewind the file for the actual read done later. */
3980 if (lseek (fd
, 0, 0) < 0)
3981 report_file_error ("Setting file position",
3982 Fcons (orig_filename
, Qnil
));
3988 /* If we have not yet decided a coding system, check
3989 file-coding-system-alist. */
3990 Lisp_Object args
[6], coding_systems
;
3992 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3993 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3994 coding_systems
= Ffind_operation_coding_system (6, args
);
3995 if (CONSP (coding_systems
))
3996 val
= XCAR (coding_systems
);
4000 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4001 /* Ensure we set Vlast_coding_system_used. */
4002 set_coding_system
= 1;
4004 if (NILP (current_buffer
->enable_multibyte_characters
)
4006 /* We must suppress all character code conversion except for
4007 end-of-line conversion. */
4008 setup_raw_text_coding_system (&coding
);
4010 coding
.src_multibyte
= 0;
4011 coding
.dst_multibyte
4012 = !NILP (current_buffer
->enable_multibyte_characters
);
4013 coding_system_decided
= 1;
4016 /* If requested, replace the accessible part of the buffer
4017 with the file contents. Avoid replacing text at the
4018 beginning or end of the buffer that matches the file contents;
4019 that preserves markers pointing to the unchanged parts.
4021 Here we implement this feature in an optimized way
4022 for the case where code conversion is NOT needed.
4023 The following if-statement handles the case of conversion
4024 in a less optimal way.
4026 If the code conversion is "automatic" then we try using this
4027 method and hope for the best.
4028 But if we discover the need for conversion, we give up on this method
4029 and let the following if-statement handle the replace job. */
4032 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4034 /* same_at_start and same_at_end count bytes,
4035 because file access counts bytes
4036 and BEG and END count bytes. */
4037 int same_at_start
= BEGV_BYTE
;
4038 int same_at_end
= ZV_BYTE
;
4040 /* There is still a possibility we will find the need to do code
4041 conversion. If that happens, we set this variable to 1 to
4042 give up on handling REPLACE in the optimized way. */
4043 int giveup_match_end
= 0;
4045 if (XINT (beg
) != 0)
4047 if (lseek (fd
, XINT (beg
), 0) < 0)
4048 report_file_error ("Setting file position",
4049 Fcons (orig_filename
, Qnil
));
4054 /* Count how many chars at the start of the file
4055 match the text at the beginning of the buffer. */
4060 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4062 error ("IO error reading %s: %s",
4063 SDATA (orig_filename
), emacs_strerror (errno
));
4064 else if (nread
== 0)
4067 if (coding
.type
== coding_type_undecided
)
4068 detect_coding (&coding
, buffer
, nread
);
4069 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4070 /* We found that the file should be decoded somehow.
4071 Let's give up here. */
4073 giveup_match_end
= 1;
4077 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4078 detect_eol (&coding
, buffer
, nread
);
4079 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4080 && coding
.eol_type
!= CODING_EOL_LF
)
4081 /* We found that the format of eol should be decoded.
4082 Let's give up here. */
4084 giveup_match_end
= 1;
4089 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4090 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4091 same_at_start
++, bufpos
++;
4092 /* If we found a discrepancy, stop the scan.
4093 Otherwise loop around and scan the next bufferful. */
4094 if (bufpos
!= nread
)
4098 /* If the file matches the buffer completely,
4099 there's no need to replace anything. */
4100 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4104 /* Truncate the buffer to the size of the file. */
4105 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4110 /* Count how many chars at the end of the file
4111 match the text at the end of the buffer. But, if we have
4112 already found that decoding is necessary, don't waste time. */
4113 while (!giveup_match_end
)
4115 int total_read
, nread
, bufpos
, curpos
, trial
;
4117 /* At what file position are we now scanning? */
4118 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4119 /* If the entire file matches the buffer tail, stop the scan. */
4122 /* How much can we scan in the next step? */
4123 trial
= min (curpos
, sizeof buffer
);
4124 if (lseek (fd
, curpos
- trial
, 0) < 0)
4125 report_file_error ("Setting file position",
4126 Fcons (orig_filename
, Qnil
));
4128 total_read
= nread
= 0;
4129 while (total_read
< trial
)
4131 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4133 error ("IO error reading %s: %s",
4134 SDATA (orig_filename
), emacs_strerror (errno
));
4135 else if (nread
== 0)
4137 total_read
+= nread
;
4140 /* Scan this bufferful from the end, comparing with
4141 the Emacs buffer. */
4142 bufpos
= total_read
;
4144 /* Compare with same_at_start to avoid counting some buffer text
4145 as matching both at the file's beginning and at the end. */
4146 while (bufpos
> 0 && same_at_end
> same_at_start
4147 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4148 same_at_end
--, bufpos
--;
4150 /* If we found a discrepancy, stop the scan.
4151 Otherwise loop around and scan the preceding bufferful. */
4154 /* If this discrepancy is because of code conversion,
4155 we cannot use this method; giveup and try the other. */
4156 if (same_at_end
> same_at_start
4157 && FETCH_BYTE (same_at_end
- 1) >= 0200
4158 && ! NILP (current_buffer
->enable_multibyte_characters
)
4159 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4160 giveup_match_end
= 1;
4169 if (! giveup_match_end
)
4173 /* We win! We can handle REPLACE the optimized way. */
4175 /* Extend the start of non-matching text area to multibyte
4176 character boundary. */
4177 if (! NILP (current_buffer
->enable_multibyte_characters
))
4178 while (same_at_start
> BEGV_BYTE
4179 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4182 /* Extend the end of non-matching text area to multibyte
4183 character boundary. */
4184 if (! NILP (current_buffer
->enable_multibyte_characters
))
4185 while (same_at_end
< ZV_BYTE
4186 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4189 /* Don't try to reuse the same piece of text twice. */
4190 overlap
= (same_at_start
- BEGV_BYTE
4191 - (same_at_end
+ st
.st_size
- ZV
));
4193 same_at_end
+= overlap
;
4195 /* Arrange to read only the nonmatching middle part of the file. */
4196 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4197 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4199 del_range_byte (same_at_start
, same_at_end
, 0);
4200 /* Insert from the file at the proper position. */
4201 temp
= BYTE_TO_CHAR (same_at_start
);
4202 SET_PT_BOTH (temp
, same_at_start
);
4204 /* If display currently starts at beginning of line,
4205 keep it that way. */
4206 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4207 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4209 replace_handled
= 1;
4213 /* If requested, replace the accessible part of the buffer
4214 with the file contents. Avoid replacing text at the
4215 beginning or end of the buffer that matches the file contents;
4216 that preserves markers pointing to the unchanged parts.
4218 Here we implement this feature for the case where code conversion
4219 is needed, in a simple way that needs a lot of memory.
4220 The preceding if-statement handles the case of no conversion
4221 in a more optimized way. */
4222 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4224 int same_at_start
= BEGV_BYTE
;
4225 int same_at_end
= ZV_BYTE
;
4228 /* Make sure that the gap is large enough. */
4229 int bufsize
= 2 * st
.st_size
;
4230 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4233 /* First read the whole file, performing code conversion into
4234 CONVERSION_BUFFER. */
4236 if (lseek (fd
, XINT (beg
), 0) < 0)
4238 xfree (conversion_buffer
);
4239 report_file_error ("Setting file position",
4240 Fcons (orig_filename
, Qnil
));
4243 total
= st
.st_size
; /* Total bytes in the file. */
4244 how_much
= 0; /* Bytes read from file so far. */
4245 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4246 unprocessed
= 0; /* Bytes not processed in previous loop. */
4248 while (how_much
< total
)
4250 /* try is reserved in some compilers (Microsoft C) */
4251 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4252 unsigned char *destination
= read_buf
+ unprocessed
;
4255 /* Allow quitting out of the actual I/O. */
4258 this = emacs_read (fd
, destination
, trytry
);
4261 if (this < 0 || this + unprocessed
== 0)
4269 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4271 int require
, result
;
4273 this += unprocessed
;
4275 /* If we are using more space than estimated,
4276 make CONVERSION_BUFFER bigger. */
4277 require
= decoding_buffer_size (&coding
, this);
4278 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4280 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4281 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4284 /* Convert this batch with results in CONVERSION_BUFFER. */
4285 if (how_much
>= total
) /* This is the last block. */
4286 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4287 if (coding
.composing
!= COMPOSITION_DISABLED
)
4288 coding_allocate_composition_data (&coding
, BEGV
);
4289 result
= decode_coding (&coding
, read_buf
,
4290 conversion_buffer
+ inserted
,
4291 this, bufsize
- inserted
);
4293 /* Save for next iteration whatever we didn't convert. */
4294 unprocessed
= this - coding
.consumed
;
4295 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4296 if (!NILP (current_buffer
->enable_multibyte_characters
))
4297 this = coding
.produced
;
4299 this = str_as_unibyte (conversion_buffer
+ inserted
,
4306 /* At this point, INSERTED is how many characters (i.e. bytes)
4307 are present in CONVERSION_BUFFER.
4308 HOW_MUCH should equal TOTAL,
4309 or should be <= 0 if we couldn't read the file. */
4313 xfree (conversion_buffer
);
4314 coding_free_composition_data (&coding
);
4315 error ("IO error reading %s: %s",
4316 SDATA (orig_filename
), emacs_strerror (errno
));
4319 /* Compare the beginning of the converted file
4320 with the buffer text. */
4323 while (bufpos
< inserted
&& same_at_start
< same_at_end
4324 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4325 same_at_start
++, bufpos
++;
4327 /* If the file matches the buffer completely,
4328 there's no need to replace anything. */
4330 if (bufpos
== inserted
)
4332 xfree (conversion_buffer
);
4333 coding_free_composition_data (&coding
);
4336 /* Truncate the buffer to the size of the file. */
4337 del_range_byte (same_at_start
, same_at_end
, 0);
4342 /* Extend the start of non-matching text area to multibyte
4343 character boundary. */
4344 if (! NILP (current_buffer
->enable_multibyte_characters
))
4345 while (same_at_start
> BEGV_BYTE
4346 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4349 /* Scan this bufferful from the end, comparing with
4350 the Emacs buffer. */
4353 /* Compare with same_at_start to avoid counting some buffer text
4354 as matching both at the file's beginning and at the end. */
4355 while (bufpos
> 0 && same_at_end
> same_at_start
4356 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4357 same_at_end
--, bufpos
--;
4359 /* Extend the end of non-matching text area to multibyte
4360 character boundary. */
4361 if (! NILP (current_buffer
->enable_multibyte_characters
))
4362 while (same_at_end
< ZV_BYTE
4363 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4366 /* Don't try to reuse the same piece of text twice. */
4367 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4369 same_at_end
+= overlap
;
4371 /* If display currently starts at beginning of line,
4372 keep it that way. */
4373 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4374 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4376 /* Replace the chars that we need to replace,
4377 and update INSERTED to equal the number of bytes
4378 we are taking from the file. */
4379 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4381 if (same_at_end
!= same_at_start
)
4383 del_range_byte (same_at_start
, same_at_end
, 0);
4385 same_at_start
= GPT_BYTE
;
4389 temp
= BYTE_TO_CHAR (same_at_start
);
4391 /* Insert from the file at the proper position. */
4392 SET_PT_BOTH (temp
, same_at_start
);
4393 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4395 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4396 coding_restore_composition (&coding
, Fcurrent_buffer ());
4397 coding_free_composition_data (&coding
);
4399 /* Set `inserted' to the number of inserted characters. */
4400 inserted
= PT
- temp
;
4401 /* Set point before the inserted characters. */
4402 SET_PT_BOTH (temp
, same_at_start
);
4404 xfree (conversion_buffer
);
4413 register Lisp_Object temp
;
4415 total
= XINT (end
) - XINT (beg
);
4417 /* Make sure point-max won't overflow after this insertion. */
4418 XSETINT (temp
, total
);
4419 if (total
!= XINT (temp
))
4420 error ("Maximum buffer size exceeded");
4423 /* For a special file, all we can do is guess. */
4424 total
= READ_BUF_SIZE
;
4426 if (NILP (visit
) && inserted
> 0)
4428 #ifdef CLASH_DETECTION
4429 if (!NILP (current_buffer
->file_truename
)
4430 /* Make binding buffer-file-name to nil effective. */
4431 && !NILP (current_buffer
->filename
)
4432 && SAVE_MODIFF
>= MODIFF
)
4434 #endif /* CLASH_DETECTION */
4435 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4439 if (GAP_SIZE
< total
)
4440 make_gap (total
- GAP_SIZE
);
4442 if (XINT (beg
) != 0 || !NILP (replace
))
4444 if (lseek (fd
, XINT (beg
), 0) < 0)
4445 report_file_error ("Setting file position",
4446 Fcons (orig_filename
, Qnil
));
4449 /* In the following loop, HOW_MUCH contains the total bytes read so
4450 far for a regular file, and not changed for a special file. But,
4451 before exiting the loop, it is set to a negative value if I/O
4455 /* Total bytes inserted. */
4458 /* Here, we don't do code conversion in the loop. It is done by
4459 code_convert_region after all data are read into the buffer. */
4461 int gap_size
= GAP_SIZE
;
4463 while (how_much
< total
)
4465 /* try is reserved in some compilers (Microsoft C) */
4466 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4473 /* Maybe make more room. */
4474 if (gap_size
< trytry
)
4476 make_gap (total
- gap_size
);
4477 gap_size
= GAP_SIZE
;
4480 /* Read from the file, capturing `quit'. When an
4481 error occurs, end the loop, and arrange for a quit
4482 to be signaled after decoding the text we read. */
4483 non_regular_fd
= fd
;
4484 non_regular_inserted
= inserted
;
4485 non_regular_nbytes
= trytry
;
4486 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4487 read_non_regular_quit
);
4498 /* Allow quitting out of the actual I/O. We don't make text
4499 part of the buffer until all the reading is done, so a C-g
4500 here doesn't do any harm. */
4503 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4515 /* For a regular file, where TOTAL is the real size,
4516 count HOW_MUCH to compare with it.
4517 For a special file, where TOTAL is just a buffer size,
4518 so don't bother counting in HOW_MUCH.
4519 (INSERTED is where we count the number of characters inserted.) */
4526 /* Now we have read all the file data into the gap.
4527 If it was empty, undo marking the buffer modified. */
4531 #ifdef CLASH_DETECTION
4533 unlock_file (current_buffer
->file_truename
);
4535 Vdeactivate_mark
= old_Vdeactivate_mark
;
4538 Vdeactivate_mark
= Qt
;
4540 /* Make the text read part of the buffer. */
4541 GAP_SIZE
-= inserted
;
4543 GPT_BYTE
+= inserted
;
4545 ZV_BYTE
+= inserted
;
4550 /* Put an anchor to ensure multi-byte form ends at gap. */
4555 /* Discard the unwind protect for closing the file. */
4559 error ("IO error reading %s: %s",
4560 SDATA (orig_filename
), emacs_strerror (errno
));
4564 if (! coding_system_decided
)
4566 /* The coding system is not yet decided. Decide it by an
4567 optimized method for handling `coding:' tag.
4569 Note that we can get here only if the buffer was empty
4570 before the insertion. */
4574 if (!NILP (Vcoding_system_for_read
))
4575 val
= Vcoding_system_for_read
;
4578 /* Since we are sure that the current buffer was empty
4579 before the insertion, we can toggle
4580 enable-multibyte-characters directly here without taking
4581 care of marker adjustment and byte combining problem. By
4582 this way, we can run Lisp program safely before decoding
4583 the inserted text. */
4584 Lisp_Object unwind_data
;
4585 int count
= SPECPDL_INDEX ();
4587 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4588 Fcons (current_buffer
->undo_list
,
4589 Fcurrent_buffer ()));
4590 current_buffer
->enable_multibyte_characters
= Qnil
;
4591 current_buffer
->undo_list
= Qt
;
4592 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4594 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4596 val
= call2 (Vset_auto_coding_function
,
4597 filename
, make_number (inserted
));
4602 /* If the coding system is not yet decided, check
4603 file-coding-system-alist. */
4604 Lisp_Object args
[6], coding_systems
;
4606 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4607 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4608 coding_systems
= Ffind_operation_coding_system (6, args
);
4609 if (CONSP (coding_systems
))
4610 val
= XCAR (coding_systems
);
4612 unbind_to (count
, Qnil
);
4613 inserted
= Z_BYTE
- BEG_BYTE
;
4616 /* The following kludgy code is to avoid some compiler bug.
4618 setup_coding_system (val, &coding);
4621 struct coding_system temp_coding
;
4622 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4623 bcopy (&temp_coding
, &coding
, sizeof coding
);
4625 /* Ensure we set Vlast_coding_system_used. */
4626 set_coding_system
= 1;
4628 if (NILP (current_buffer
->enable_multibyte_characters
)
4630 /* We must suppress all character code conversion except for
4631 end-of-line conversion. */
4632 setup_raw_text_coding_system (&coding
);
4633 coding
.src_multibyte
= 0;
4634 coding
.dst_multibyte
4635 = !NILP (current_buffer
->enable_multibyte_characters
);
4639 /* Can't do this if part of the buffer might be preserved. */
4641 && (coding
.type
== coding_type_no_conversion
4642 || coding
.type
== coding_type_raw_text
))
4644 /* Visiting a file with these coding system makes the buffer
4646 current_buffer
->enable_multibyte_characters
= Qnil
;
4647 coding
.dst_multibyte
= 0;
4650 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4652 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4654 if (coding
.type
== coding_type_ccl
)
4655 coding
.spec
.ccl
.decoder
.quit_silently
= 1;
4656 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4658 if (coding
.type
== coding_type_ccl
)
4659 coding
.spec
.ccl
.decoder
.quit_silently
= 0;
4660 if (coding
.result
== CODING_FINISH_INTERRUPT
)
4662 /* Fixme: It is better that we report that the decoding
4663 was interruppted by the user, and the current buffer
4664 contents doesn't reflect the file correctly. */
4665 Fsignal (Qquit
, Qnil
);
4667 inserted
= coding
.produced_char
;
4670 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4674 /* Now INSERTED is measured in characters. */
4677 /* Use the conversion type to determine buffer-file-type
4678 (find-buffer-file-type is now used to help determine the
4680 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4681 || coding
.eol_type
== CODING_EOL_LF
)
4682 && ! CODING_REQUIRE_DECODING (&coding
))
4683 current_buffer
->buffer_file_type
= Qt
;
4685 current_buffer
->buffer_file_type
= Qnil
;
4692 if (!EQ (current_buffer
->undo_list
, Qt
))
4693 current_buffer
->undo_list
= Qnil
;
4695 stat (SDATA (filename
), &st
);
4700 current_buffer
->modtime
= st
.st_mtime
;
4701 current_buffer
->filename
= orig_filename
;
4704 SAVE_MODIFF
= MODIFF
;
4705 current_buffer
->auto_save_modified
= MODIFF
;
4706 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4707 #ifdef CLASH_DETECTION
4710 if (!NILP (current_buffer
->file_truename
))
4711 unlock_file (current_buffer
->file_truename
);
4712 unlock_file (filename
);
4714 #endif /* CLASH_DETECTION */
4716 xsignal2 (Qfile_error
,
4717 build_string ("not a regular file"), orig_filename
);
4720 if (set_coding_system
)
4721 Vlast_coding_system_used
= coding
.symbol
;
4723 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4725 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4727 if (! NILP (insval
))
4729 CHECK_NUMBER (insval
);
4730 inserted
= XFASTINT (insval
);
4734 /* Decode file format */
4737 int empty_undo_list_p
= 0;
4739 /* If we're anyway going to discard undo information, don't
4740 record it in the first place. The buffer's undo list at this
4741 point is either nil or t when visiting a file. */
4744 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4745 current_buffer
->undo_list
= Qt
;
4748 insval
= call3 (Qformat_decode
,
4749 Qnil
, make_number (inserted
), visit
);
4750 CHECK_NUMBER (insval
);
4751 inserted
= XFASTINT (insval
);
4754 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4757 /* Call after-change hooks for the inserted text, aside from the case
4758 of normal visiting (not with REPLACE), which is done in a new buffer
4759 "before" the buffer is changed. */
4760 if (inserted
> 0 && total
> 0
4761 && (NILP (visit
) || !NILP (replace
)))
4763 signal_after_change (PT
, 0, inserted
);
4764 update_compositions (PT
, PT
, CHECK_BORDER
);
4767 p
= Vafter_insert_file_functions
;
4770 insval
= call1 (XCAR (p
), make_number (inserted
));
4773 CHECK_NUMBER (insval
);
4774 inserted
= XFASTINT (insval
);
4781 && current_buffer
->modtime
== -1)
4783 /* If visiting nonexistent file, return nil. */
4784 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4788 Fsignal (Qquit
, Qnil
);
4790 /* ??? Retval needs to be dealt with in all cases consistently. */
4792 val
= Fcons (orig_filename
,
4793 Fcons (make_number (inserted
),
4796 RETURN_UNGCPRO (unbind_to (count
, val
));
4799 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4800 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4801 Lisp_Object
, Lisp_Object
));
4803 /* If build_annotations switched buffers, switch back to BUF.
4804 Kill the temporary buffer that was selected in the meantime.
4806 Since this kill only the last temporary buffer, some buffers remain
4807 not killed if build_annotations switched buffers more than once.
4811 build_annotations_unwind (buf
)
4816 if (XBUFFER (buf
) == current_buffer
)
4818 tembuf
= Fcurrent_buffer ();
4820 Fkill_buffer (tembuf
);
4824 /* Decide the coding-system to encode the data with. */
4827 choose_write_coding_system (start
, end
, filename
,
4828 append
, visit
, lockname
, coding
)
4829 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4830 struct coding_system
*coding
;
4835 && NILP (Fstring_equal (current_buffer
->filename
,
4836 current_buffer
->auto_save_file_name
)))
4838 /* We use emacs-mule for auto saving... */
4839 setup_coding_system (Qemacs_mule
, coding
);
4840 /* ... but with the special flag to indicate not to strip off
4841 leading code of eight-bit-control chars. */
4843 /* We force LF for end-of-line because that is faster. */
4844 coding
->eol_type
= CODING_EOL_LF
;
4845 goto done_setup_coding
;
4847 else if (!NILP (Vcoding_system_for_write
))
4849 val
= Vcoding_system_for_write
;
4850 if (coding_system_require_warning
4851 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4852 /* Confirm that VAL can surely encode the current region. */
4853 val
= call5 (Vselect_safe_coding_system_function
,
4854 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4859 /* If the variable `buffer-file-coding-system' is set locally,
4860 it means that the file was read with some kind of code
4861 conversion or the variable is explicitly set by users. We
4862 had better write it out with the same coding system even if
4863 `enable-multibyte-characters' is nil.
4865 If it is not set locally, we anyway have to convert EOL
4866 format if the default value of `buffer-file-coding-system'
4867 tells that it is not Unix-like (LF only) format. */
4868 int using_default_coding
= 0;
4869 int force_raw_text
= 0;
4871 val
= current_buffer
->buffer_file_coding_system
;
4873 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4876 if (NILP (current_buffer
->enable_multibyte_characters
))
4882 /* Check file-coding-system-alist. */
4883 Lisp_Object args
[7], coding_systems
;
4885 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4886 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4888 coding_systems
= Ffind_operation_coding_system (7, args
);
4889 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4890 val
= XCDR (coding_systems
);
4894 && !NILP (current_buffer
->buffer_file_coding_system
))
4896 /* If we still have not decided a coding system, use the
4897 default value of buffer-file-coding-system. */
4898 val
= current_buffer
->buffer_file_coding_system
;
4899 using_default_coding
= 1;
4903 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4904 /* Confirm that VAL can surely encode the current region. */
4905 val
= call5 (Vselect_safe_coding_system_function
,
4906 start
, end
, val
, Qnil
, filename
);
4908 setup_coding_system (Fcheck_coding_system (val
), coding
);
4909 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4910 && !using_default_coding
)
4912 if (! EQ (default_buffer_file_coding
.symbol
,
4913 buffer_defaults
.buffer_file_coding_system
))
4914 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4915 &default_buffer_file_coding
);
4916 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4918 Lisp_Object subsidiaries
;
4920 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4921 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4922 if (VECTORP (subsidiaries
)
4923 && XVECTOR (subsidiaries
)->size
== 3)
4925 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4930 setup_raw_text_coding_system (coding
);
4931 goto done_setup_coding
;
4934 setup_coding_system (Fcheck_coding_system (val
), coding
);
4937 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4938 coding
->eol_type
= system_eol_type
;
4939 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4940 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4943 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4944 "r\nFWrite region to file: \ni\ni\ni\np",
4945 doc
: /* Write current region into specified file.
4946 When called from a program, requires three arguments:
4947 START, END and FILENAME. START and END are normally buffer positions
4948 specifying the part of the buffer to write.
4949 If START is nil, that means to use the entire buffer contents.
4950 If START is a string, then output that string to the file
4951 instead of any buffer contents; END is ignored.
4953 Optional fourth argument APPEND if non-nil means
4954 append to existing file contents (if any). If it is an integer,
4955 seek to that offset in the file before writing.
4956 Optional fifth argument VISIT, if t or a string, means
4957 set the last-save-file-modtime of buffer to this file's modtime
4958 and mark buffer not modified.
4959 If VISIT is a string, it is a second file name;
4960 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4961 VISIT is also the file name to lock and unlock for clash detection.
4962 If VISIT is neither t nor nil nor a string,
4963 that means do not display the \"Wrote file\" message.
4964 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4965 use for locking and unlocking, overriding FILENAME and VISIT.
4966 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4967 for an existing file with the same name. If MUSTBENEW is `excl',
4968 that means to get an error if the file already exists; never overwrite.
4969 If MUSTBENEW is neither nil nor `excl', that means ask for
4970 confirmation before overwriting, but do go ahead and overwrite the file
4971 if the user confirms.
4973 This does code conversion according to the value of
4974 `coding-system-for-write', `buffer-file-coding-system', or
4975 `file-coding-system-alist', and sets the variable
4976 `last-coding-system-used' to the coding system actually used. */)
4977 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4978 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4983 const unsigned char *fn
;
4986 int count
= SPECPDL_INDEX ();
4989 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4991 Lisp_Object handler
;
4992 Lisp_Object visit_file
;
4993 Lisp_Object annotations
;
4994 Lisp_Object encoded_filename
;
4995 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4996 int quietly
= !NILP (visit
);
4997 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4998 struct buffer
*given_buffer
;
5000 int buffer_file_type
= O_BINARY
;
5002 struct coding_system coding
;
5004 if (current_buffer
->base_buffer
&& visiting
)
5005 error ("Cannot do file visiting in an indirect buffer");
5007 if (!NILP (start
) && !STRINGP (start
))
5008 validate_region (&start
, &end
);
5011 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5013 filename
= Fexpand_file_name (filename
, Qnil
);
5015 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5016 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5018 if (STRINGP (visit
))
5019 visit_file
= Fexpand_file_name (visit
, Qnil
);
5021 visit_file
= filename
;
5023 if (NILP (lockname
))
5024 lockname
= visit_file
;
5028 /* If the file name has special constructs in it,
5029 call the corresponding file handler. */
5030 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5031 /* If FILENAME has no handler, see if VISIT has one. */
5032 if (NILP (handler
) && STRINGP (visit
))
5033 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5035 if (!NILP (handler
))
5038 val
= call6 (handler
, Qwrite_region
, start
, end
,
5039 filename
, append
, visit
);
5043 SAVE_MODIFF
= MODIFF
;
5044 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5045 current_buffer
->filename
= visit_file
;
5051 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5053 /* Special kludge to simplify auto-saving. */
5056 XSETFASTINT (start
, BEG
);
5057 XSETFASTINT (end
, Z
);
5061 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5062 count1
= SPECPDL_INDEX ();
5064 given_buffer
= current_buffer
;
5066 if (!STRINGP (start
))
5068 annotations
= build_annotations (start
, end
);
5070 if (current_buffer
!= given_buffer
)
5072 XSETFASTINT (start
, BEGV
);
5073 XSETFASTINT (end
, ZV
);
5079 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5081 /* Decide the coding-system to encode the data with.
5082 We used to make this choice before calling build_annotations, but that
5083 leads to problems when a write-annotate-function takes care of
5084 unsavable chars (as was the case with X-Symbol). */
5085 choose_write_coding_system (start
, end
, filename
,
5086 append
, visit
, lockname
, &coding
);
5087 Vlast_coding_system_used
= coding
.symbol
;
5089 given_buffer
= current_buffer
;
5090 if (! STRINGP (start
))
5092 annotations
= build_annotations_2 (start
, end
,
5093 coding
.pre_write_conversion
, annotations
);
5094 if (current_buffer
!= given_buffer
)
5096 XSETFASTINT (start
, BEGV
);
5097 XSETFASTINT (end
, ZV
);
5101 #ifdef CLASH_DETECTION
5104 #if 0 /* This causes trouble for GNUS. */
5105 /* If we've locked this file for some other buffer,
5106 query before proceeding. */
5107 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5108 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5111 lock_file (lockname
);
5113 #endif /* CLASH_DETECTION */
5115 encoded_filename
= ENCODE_FILE (filename
);
5117 fn
= SDATA (encoded_filename
);
5121 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5122 #else /* not DOS_NT */
5123 desc
= emacs_open (fn
, O_WRONLY
, 0);
5124 #endif /* not DOS_NT */
5126 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5128 if (auto_saving
) /* Overwrite any previous version of autosave file */
5130 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5131 desc
= emacs_open (fn
, O_RDWR
, 0);
5133 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5134 ? SDATA (current_buffer
->filename
) : 0,
5137 else /* Write to temporary name and rename if no errors */
5139 Lisp_Object temp_name
;
5140 temp_name
= Ffile_name_directory (filename
);
5142 if (!NILP (temp_name
))
5144 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5145 build_string ("$$SAVE$$")));
5146 fname
= SDATA (filename
);
5147 fn
= SDATA (temp_name
);
5148 desc
= creat_copy_attrs (fname
, fn
);
5151 /* If we can't open the temporary file, try creating a new
5152 version of the original file. VMS "creat" creates a
5153 new version rather than truncating an existing file. */
5156 desc
= creat (fn
, 0666);
5157 #if 0 /* This can clobber an existing file and fail to replace it,
5158 if the user runs out of space. */
5161 /* We can't make a new version;
5162 try to truncate and rewrite existing version if any. */
5164 desc
= emacs_open (fn
, O_RDWR
, 0);
5170 desc
= creat (fn
, 0666);
5174 desc
= emacs_open (fn
,
5175 O_WRONLY
| O_CREAT
| buffer_file_type
5176 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5177 S_IREAD
| S_IWRITE
);
5178 #else /* not DOS_NT */
5179 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5180 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5181 auto_saving
? auto_save_mode_bits
: 0666);
5182 #endif /* not DOS_NT */
5183 #endif /* not VMS */
5187 #ifdef CLASH_DETECTION
5189 if (!auto_saving
) unlock_file (lockname
);
5191 #endif /* CLASH_DETECTION */
5193 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5196 record_unwind_protect (close_file_unwind
, make_number (desc
));
5198 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5202 if (NUMBERP (append
))
5203 ret
= lseek (desc
, XINT (append
), 1);
5205 ret
= lseek (desc
, 0, 2);
5208 #ifdef CLASH_DETECTION
5209 if (!auto_saving
) unlock_file (lockname
);
5210 #endif /* CLASH_DETECTION */
5212 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5220 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5221 * if we do writes that don't end with a carriage return. Furthermore
5222 * it cannot handle writes of more then 16K. The modified
5223 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5224 * this EXCEPT for the last record (if it doesn't end with a carriage
5225 * return). This implies that if your buffer doesn't end with a carriage
5226 * return, you get one free... tough. However it also means that if
5227 * we make two calls to sys_write (a la the following code) you can
5228 * get one at the gap as well. The easiest way to fix this (honest)
5229 * is to move the gap to the next newline (or the end of the buffer).
5234 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5235 move_gap (find_next_newline (GPT
, 1));
5237 /* Whether VMS or not, we must move the gap to the next of newline
5238 when we must put designation sequences at beginning of line. */
5239 if (INTEGERP (start
)
5240 && coding
.type
== coding_type_iso2022
5241 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5242 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5244 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5245 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5246 move_gap_both (PT
, PT_BYTE
);
5247 SET_PT_BOTH (opoint
, opoint_byte
);
5254 if (STRINGP (start
))
5256 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5257 &annotations
, &coding
);
5260 else if (XINT (start
) != XINT (end
))
5262 tem
= CHAR_TO_BYTE (XINT (start
));
5264 if (XINT (start
) < GPT
)
5266 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5267 min (GPT
, XINT (end
)) - XINT (start
),
5268 &annotations
, &coding
);
5272 if (XINT (end
) > GPT
&& !failure
)
5274 tem
= max (XINT (start
), GPT
);
5275 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5276 &annotations
, &coding
);
5282 /* If file was empty, still need to write the annotations */
5283 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5284 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5288 if (CODING_REQUIRE_FLUSHING (&coding
)
5289 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5292 /* We have to flush out a data. */
5293 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5294 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5301 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5302 Disk full in NFS may be reported here. */
5303 /* mib says that closing the file will try to write as fast as NFS can do
5304 it, and that means the fsync here is not crucial for autosave files. */
5305 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5307 /* If fsync fails with EINTR, don't treat that as serious. Also
5308 ignore EINVAL which happens when fsync is not supported on this
5310 if (errno
!= EINTR
&& errno
!= EINVAL
)
5311 failure
= 1, save_errno
= errno
;
5315 /* Spurious "file has changed on disk" warnings have been
5316 observed on Suns as well.
5317 It seems that `close' can change the modtime, under nfs.
5319 (This has supposedly been fixed in Sunos 4,
5320 but who knows about all the other machines with NFS?) */
5323 /* On VMS and APOLLO, must do the stat after the close
5324 since closing changes the modtime. */
5327 /* Recall that #if defined does not work on VMS. */
5334 /* NFS can report a write failure now. */
5335 if (emacs_close (desc
) < 0)
5336 failure
= 1, save_errno
= errno
;
5339 /* If we wrote to a temporary name and had no errors, rename to real name. */
5343 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5351 /* Discard the unwind protect for close_file_unwind. */
5352 specpdl_ptr
= specpdl
+ count1
;
5353 /* Restore the original current buffer. */
5354 visit_file
= unbind_to (count
, visit_file
);
5356 #ifdef CLASH_DETECTION
5358 unlock_file (lockname
);
5359 #endif /* CLASH_DETECTION */
5361 /* Do this before reporting IO error
5362 to avoid a "file has changed on disk" warning on
5363 next attempt to save. */
5365 current_buffer
->modtime
= st
.st_mtime
;
5368 error ("IO error writing %s: %s", SDATA (filename
),
5369 emacs_strerror (save_errno
));
5373 SAVE_MODIFF
= MODIFF
;
5374 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5375 current_buffer
->filename
= visit_file
;
5376 update_mode_lines
++;
5381 && ! NILP (Fstring_equal (current_buffer
->filename
,
5382 current_buffer
->auto_save_file_name
)))
5383 SAVE_MODIFF
= MODIFF
;
5389 message_with_string ((INTEGERP (append
)
5399 Lisp_Object
merge ();
5401 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5402 doc
: /* Return t if (car A) is numerically less than (car B). */)
5406 return Flss (Fcar (a
), Fcar (b
));
5409 /* Build the complete list of annotations appropriate for writing out
5410 the text between START and END, by calling all the functions in
5411 write-region-annotate-functions and merging the lists they return.
5412 If one of these functions switches to a different buffer, we assume
5413 that buffer contains altered text. Therefore, the caller must
5414 make sure to restore the current buffer in all cases,
5415 as save-excursion would do. */
5418 build_annotations (start
, end
)
5419 Lisp_Object start
, end
;
5421 Lisp_Object annotations
;
5423 struct gcpro gcpro1
, gcpro2
;
5424 Lisp_Object original_buffer
;
5425 int i
, used_global
= 0;
5427 XSETBUFFER (original_buffer
, current_buffer
);
5430 p
= Vwrite_region_annotate_functions
;
5431 GCPRO2 (annotations
, p
);
5434 struct buffer
*given_buffer
= current_buffer
;
5435 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5436 { /* Use the global value of the hook. */
5439 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5441 p
= Fappend (2, arg
);
5444 Vwrite_region_annotations_so_far
= annotations
;
5445 res
= call2 (XCAR (p
), start
, end
);
5446 /* If the function makes a different buffer current,
5447 assume that means this buffer contains altered text to be output.
5448 Reset START and END from the buffer bounds
5449 and discard all previous annotations because they should have
5450 been dealt with by this function. */
5451 if (current_buffer
!= given_buffer
)
5453 XSETFASTINT (start
, BEGV
);
5454 XSETFASTINT (end
, ZV
);
5457 Flength (res
); /* Check basic validity of return value */
5458 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5462 /* Now do the same for annotation functions implied by the file-format */
5463 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5464 p
= current_buffer
->auto_save_file_format
;
5466 p
= current_buffer
->file_format
;
5467 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5469 struct buffer
*given_buffer
= current_buffer
;
5471 Vwrite_region_annotations_so_far
= annotations
;
5473 /* Value is either a list of annotations or nil if the function
5474 has written annotations to a temporary buffer, which is now
5476 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5477 original_buffer
, make_number (i
));
5478 if (current_buffer
!= given_buffer
)
5480 XSETFASTINT (start
, BEGV
);
5481 XSETFASTINT (end
, ZV
);
5486 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5494 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5495 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5497 struct gcpro gcpro1
;
5500 GCPRO1 (annotations
);
5501 /* At last, do the same for the function PRE_WRITE_CONVERSION
5502 implied by the current coding-system. */
5503 if (!NILP (pre_write_conversion
))
5505 struct buffer
*given_buffer
= current_buffer
;
5506 Vwrite_region_annotations_so_far
= annotations
;
5507 res
= call2 (pre_write_conversion
, start
, end
);
5509 annotations
= (current_buffer
!= given_buffer
5511 : merge (annotations
, res
, Qcar_less_than_car
));
5518 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5519 If STRING is nil, POS is the character position in the current buffer.
5520 Intersperse with them the annotations from *ANNOT
5521 which fall within the range of POS to POS + NCHARS,
5522 each at its appropriate position.
5524 We modify *ANNOT by discarding elements as we use them up.
5526 The return value is negative in case of system call failure. */
5529 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5532 register int nchars
;
5535 struct coding_system
*coding
;
5539 int lastpos
= pos
+ nchars
;
5541 while (NILP (*annot
) || CONSP (*annot
))
5543 tem
= Fcar_safe (Fcar (*annot
));
5546 nextpos
= XFASTINT (tem
);
5548 /* If there are no more annotations in this range,
5549 output the rest of the range all at once. */
5550 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5551 return e_write (desc
, string
, pos
, lastpos
, coding
);
5553 /* Output buffer text up to the next annotation's position. */
5556 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5560 /* Output the annotation. */
5561 tem
= Fcdr (Fcar (*annot
));
5564 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5567 *annot
= Fcdr (*annot
);
5572 #ifndef WRITE_BUF_SIZE
5573 #define WRITE_BUF_SIZE (16 * 1024)
5576 /* Write text in the range START and END into descriptor DESC,
5577 encoding them with coding system CODING. If STRING is nil, START
5578 and END are character positions of the current buffer, else they
5579 are indexes to the string STRING. */
5582 e_write (desc
, string
, start
, end
, coding
)
5586 struct coding_system
*coding
;
5588 register char *addr
;
5589 register int nbytes
;
5590 char buf
[WRITE_BUF_SIZE
];
5594 coding
->composing
= COMPOSITION_DISABLED
;
5595 if (coding
->composing
!= COMPOSITION_DISABLED
)
5596 coding_save_composition (coding
, start
, end
, string
);
5598 if (STRINGP (string
))
5600 addr
= SDATA (string
);
5601 nbytes
= SBYTES (string
);
5602 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5604 else if (start
< end
)
5606 /* It is assured that the gap is not in the range START and END-1. */
5607 addr
= CHAR_POS_ADDR (start
);
5608 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5609 coding
->src_multibyte
5610 = !NILP (current_buffer
->enable_multibyte_characters
);
5616 coding
->src_multibyte
= 1;
5619 /* We used to have a code for handling selective display here. But,
5620 now it is handled within encode_coding. */
5625 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5626 if (coding
->produced
> 0)
5628 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5629 if (coding
->produced
)
5635 nbytes
-= coding
->consumed
;
5636 addr
+= coding
->consumed
;
5637 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5640 /* The source text ends by an incomplete multibyte form.
5641 There's no way other than write it out as is. */
5642 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5651 start
+= coding
->consumed_char
;
5652 if (coding
->cmp_data
)
5653 coding_adjust_composition_offset (coding
, start
);
5656 if (coding
->cmp_data
)
5657 coding_free_composition_data (coding
);
5662 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5663 Sverify_visited_file_modtime
, 1, 1, 0,
5664 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5665 This means that the file has not been changed since it was visited or saved.
5666 See Info node `(elisp)Modification Time' for more details. */)
5672 Lisp_Object handler
;
5673 Lisp_Object filename
;
5678 if (!STRINGP (b
->filename
)) return Qt
;
5679 if (b
->modtime
== 0) return Qt
;
5681 /* If the file name has special constructs in it,
5682 call the corresponding file handler. */
5683 handler
= Ffind_file_name_handler (b
->filename
,
5684 Qverify_visited_file_modtime
);
5685 if (!NILP (handler
))
5686 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5688 filename
= ENCODE_FILE (b
->filename
);
5690 if (stat (SDATA (filename
), &st
) < 0)
5692 /* If the file doesn't exist now and didn't exist before,
5693 we say that it isn't modified, provided the error is a tame one. */
5694 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5699 if (st
.st_mtime
== b
->modtime
5700 /* If both are positive, accept them if they are off by one second. */
5701 || (st
.st_mtime
> 0 && b
->modtime
> 0
5702 && (st
.st_mtime
== b
->modtime
+ 1
5703 || st
.st_mtime
== b
->modtime
- 1)))
5708 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5709 Sclear_visited_file_modtime
, 0, 0, 0,
5710 doc
: /* Clear out records of last mod time of visited file.
5711 Next attempt to save will certainly not complain of a discrepancy. */)
5714 current_buffer
->modtime
= 0;
5718 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5719 Svisited_file_modtime
, 0, 0, 0,
5720 doc
: /* Return the current buffer's recorded visited file modification time.
5721 The value is a list of the form (HIGH LOW), like the time values
5722 that `file-attributes' returns. If the current buffer has no recorded
5723 file modification time, this function returns 0.
5724 See Info node `(elisp)Modification Time' for more details. */)
5727 if (! current_buffer
->modtime
)
5728 return make_number (0);
5729 return make_time ((time_t) current_buffer
->modtime
);
5732 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5733 Sset_visited_file_modtime
, 0, 1, 0,
5734 doc
: /* Update buffer's recorded modification time from the visited file's time.
5735 Useful if the buffer was not read from the file normally
5736 or if the file itself has been changed for some known benign reason.
5737 An argument specifies the modification time value to use
5738 \(instead of that of the visited file), in the form of a list
5739 \(HIGH . LOW) or (HIGH LOW). */)
5741 Lisp_Object time_list
;
5743 if (!NILP (time_list
))
5744 current_buffer
->modtime
= cons_to_long (time_list
);
5747 register Lisp_Object filename
;
5749 Lisp_Object handler
;
5751 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5753 /* If the file name has special constructs in it,
5754 call the corresponding file handler. */
5755 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5756 if (!NILP (handler
))
5757 /* The handler can find the file name the same way we did. */
5758 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5760 filename
= ENCODE_FILE (filename
);
5762 if (stat (SDATA (filename
), &st
) >= 0)
5763 current_buffer
->modtime
= st
.st_mtime
;
5770 auto_save_error (error
)
5773 Lisp_Object args
[3], msg
;
5775 struct gcpro gcpro1
;
5779 auto_save_error_occurred
= 1;
5783 args
[0] = build_string ("Auto-saving %s: %s");
5784 args
[1] = current_buffer
->name
;
5785 args
[2] = Ferror_message_string (error
);
5786 msg
= Fformat (3, args
);
5788 nbytes
= SBYTES (msg
);
5789 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5790 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5792 for (i
= 0; i
< 3; ++i
)
5795 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5797 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5798 Fsleep_for (make_number (1), Qnil
);
5812 auto_save_mode_bits
= 0666;
5814 /* Get visited file's mode to become the auto save file's mode. */
5815 if (! NILP (current_buffer
->filename
))
5817 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5818 /* But make sure we can overwrite it later! */
5819 auto_save_mode_bits
= st
.st_mode
| 0600;
5820 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5822 /* Remote files don't cooperate with stat. */
5823 auto_save_mode_bits
= XINT (modes
) | 0600;
5827 Fwrite_region (Qnil
, Qnil
,
5828 current_buffer
->auto_save_file_name
,
5829 Qnil
, Qlambda
, Qnil
, Qnil
);
5833 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5836 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5848 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5851 minibuffer_auto_raise
= XINT (value
);
5856 do_auto_save_make_dir (dir
)
5861 call2 (Qmake_directory
, dir
, Qt
);
5862 XSETFASTINT (mode
, 0700);
5863 return Fset_file_modes (dir
, mode
);
5867 do_auto_save_eh (ignore
)
5873 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5874 doc
: /* Auto-save all buffers that need it.
5875 This is all buffers that have auto-saving enabled
5876 and are changed since last auto-saved.
5877 Auto-saving writes the buffer into a file
5878 so that your editing is not lost if the system crashes.
5879 This file is not the file you visited; that changes only when you save.
5880 Normally we run the normal hook `auto-save-hook' before saving.
5882 A non-nil NO-MESSAGE argument means do not print any message if successful.
5883 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5884 (no_message
, current_only
)
5885 Lisp_Object no_message
, current_only
;
5887 struct buffer
*old
= current_buffer
, *b
;
5888 Lisp_Object tail
, buf
;
5890 int do_handled_files
;
5892 FILE *stream
= NULL
;
5893 int count
= SPECPDL_INDEX ();
5894 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5895 int old_message_p
= 0;
5896 struct gcpro gcpro1
, gcpro2
;
5898 if (max_specpdl_size
< specpdl_size
+ 40)
5899 max_specpdl_size
= specpdl_size
+ 40;
5904 if (NILP (no_message
))
5906 old_message_p
= push_message ();
5907 record_unwind_protect (pop_message_unwind
, Qnil
);
5910 /* Ordinarily don't quit within this function,
5911 but don't make it impossible to quit (in case we get hung in I/O). */
5915 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5916 point to non-strings reached from Vbuffer_alist. */
5918 if (!NILP (Vrun_hooks
))
5919 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5921 if (STRINGP (Vauto_save_list_file_name
))
5923 Lisp_Object listfile
;
5925 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5927 /* Don't try to create the directory when shutting down Emacs,
5928 because creating the directory might signal an error, and
5929 that would leave Emacs in a strange state. */
5930 if (!NILP (Vrun_hooks
))
5934 GCPRO2 (dir
, listfile
);
5935 dir
= Ffile_name_directory (listfile
);
5936 if (NILP (Ffile_directory_p (dir
)))
5937 internal_condition_case_1 (do_auto_save_make_dir
,
5938 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5943 stream
= fopen (SDATA (listfile
), "w");
5946 record_unwind_protect (do_auto_save_unwind
,
5947 make_save_value (stream
, 0));
5948 record_unwind_protect (do_auto_save_unwind_1
,
5949 make_number (minibuffer_auto_raise
));
5950 minibuffer_auto_raise
= 0;
5952 auto_save_error_occurred
= 0;
5954 /* On first pass, save all files that don't have handlers.
5955 On second pass, save all files that do have handlers.
5957 If Emacs is crashing, the handlers may tweak what is causing
5958 Emacs to crash in the first place, and it would be a shame if
5959 Emacs failed to autosave perfectly ordinary files because it
5960 couldn't handle some ange-ftp'd file. */
5962 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5963 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5965 buf
= XCDR (XCAR (tail
));
5968 /* Record all the buffers that have auto save mode
5969 in the special file that lists them. For each of these buffers,
5970 Record visited name (if any) and auto save name. */
5971 if (STRINGP (b
->auto_save_file_name
)
5972 && stream
!= NULL
&& do_handled_files
== 0)
5975 if (!NILP (b
->filename
))
5977 fwrite (SDATA (b
->filename
), 1,
5978 SBYTES (b
->filename
), stream
);
5980 putc ('\n', stream
);
5981 fwrite (SDATA (b
->auto_save_file_name
), 1,
5982 SBYTES (b
->auto_save_file_name
), stream
);
5983 putc ('\n', stream
);
5987 if (!NILP (current_only
)
5988 && b
!= current_buffer
)
5991 /* Don't auto-save indirect buffers.
5992 The base buffer takes care of it. */
5996 /* Check for auto save enabled
5997 and file changed since last auto save
5998 and file changed since last real save. */
5999 if (STRINGP (b
->auto_save_file_name
)
6000 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
6001 && b
->auto_save_modified
< BUF_MODIFF (b
)
6002 /* -1 means we've turned off autosaving for a while--see below. */
6003 && XINT (b
->save_length
) >= 0
6004 && (do_handled_files
6005 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
6008 EMACS_TIME before_time
, after_time
;
6010 EMACS_GET_TIME (before_time
);
6012 /* If we had a failure, don't try again for 20 minutes. */
6013 if (b
->auto_save_failure_time
>= 0
6014 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6017 if ((XFASTINT (b
->save_length
) * 10
6018 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6019 /* A short file is likely to change a large fraction;
6020 spare the user annoying messages. */
6021 && XFASTINT (b
->save_length
) > 5000
6022 /* These messages are frequent and annoying for `*mail*'. */
6023 && !EQ (b
->filename
, Qnil
)
6024 && NILP (no_message
))
6026 /* It has shrunk too much; turn off auto-saving here. */
6027 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6028 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6030 minibuffer_auto_raise
= 0;
6031 /* Turn off auto-saving until there's a real save,
6032 and prevent any more warnings. */
6033 XSETINT (b
->save_length
, -1);
6034 Fsleep_for (make_number (1), Qnil
);
6037 set_buffer_internal (b
);
6038 if (!auto_saved
&& NILP (no_message
))
6039 message1 ("Auto-saving...");
6040 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6042 b
->auto_save_modified
= BUF_MODIFF (b
);
6043 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6044 set_buffer_internal (old
);
6046 EMACS_GET_TIME (after_time
);
6048 /* If auto-save took more than 60 seconds,
6049 assume it was an NFS failure that got a timeout. */
6050 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6051 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6055 /* Prevent another auto save till enough input events come in. */
6056 record_auto_save ();
6058 if (auto_saved
&& NILP (no_message
))
6062 /* If we are going to restore an old message,
6063 give time to read ours. */
6064 sit_for (make_number (1), 0, 0);
6067 else if (!auto_save_error_occurred
)
6068 /* Don't overwrite the error message if an error occurred.
6069 If we displayed a message and then restored a state
6070 with no message, leave a "done" message on the screen. */
6071 message1 ("Auto-saving...done");
6076 /* This restores the message-stack status. */
6077 unbind_to (count
, Qnil
);
6081 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6082 Sset_buffer_auto_saved
, 0, 0, 0,
6083 doc
: /* Mark current buffer as auto-saved with its current text.
6084 No auto-save file will be written until the buffer changes again. */)
6087 current_buffer
->auto_save_modified
= MODIFF
;
6088 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6089 current_buffer
->auto_save_failure_time
= -1;
6093 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6094 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6095 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6098 current_buffer
->auto_save_failure_time
= -1;
6102 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6104 doc
: /* Return t if current buffer has been auto-saved recently.
6105 More precisely, if it has been auto-saved since last read from or saved
6106 in the visited file. If the buffer has no visited file,
6107 then any auto-save counts as "recent". */)
6110 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6113 /* Reading and completing file names */
6114 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6115 extern Lisp_Object Qcompletion_ignore_case
;
6117 /* In the string VAL, change each $ to $$ and return the result. */
6120 double_dollars (val
)
6123 register const unsigned char *old
;
6124 register unsigned char *new;
6128 osize
= SBYTES (val
);
6130 /* Count the number of $ characters. */
6131 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6132 if (*old
++ == '$') count
++;
6136 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6139 for (n
= osize
; n
> 0; n
--)
6153 read_file_name_cleanup (arg
)
6156 return (current_buffer
->directory
= arg
);
6159 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6161 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6162 (string
, dir
, action
)
6163 Lisp_Object string
, dir
, action
;
6164 /* action is nil for complete, t for return list of completions,
6165 lambda for verify final value */
6167 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6169 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6171 CHECK_STRING (string
);
6178 /* No need to protect ACTION--we only compare it with t and nil. */
6179 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6181 if (SCHARS (string
) == 0)
6183 if (EQ (action
, Qlambda
))
6191 orig_string
= string
;
6192 string
= Fsubstitute_in_file_name (string
);
6193 changed
= NILP (Fstring_equal (string
, orig_string
));
6194 name
= Ffile_name_nondirectory (string
);
6195 val
= Ffile_name_directory (string
);
6197 realdir
= Fexpand_file_name (val
, realdir
);
6202 specdir
= Ffile_name_directory (string
);
6203 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6208 return double_dollars (string
);
6212 if (!NILP (specdir
))
6213 val
= concat2 (specdir
, val
);
6215 return double_dollars (val
);
6218 #endif /* not VMS */
6222 if (EQ (action
, Qt
))
6224 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6228 if (NILP (Vread_file_name_predicate
)
6229 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6233 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6235 /* Brute-force speed up for directory checking:
6236 Discard strings which don't end in a slash. */
6237 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6239 Lisp_Object tem
= XCAR (all
);
6242 && (len
= SBYTES (tem
), len
> 0)
6243 && IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6244 comp
= Fcons (tem
, comp
);
6250 /* Must do it the hard (and slow) way. */
6252 GCPRO3 (all
, comp
, specdir
);
6253 count
= SPECPDL_INDEX ();
6254 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6255 current_buffer
->directory
= realdir
;
6256 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6258 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6260 comp
= Fcons (XCAR (all
), comp
);
6262 unbind_to (count
, Qnil
);
6265 return Fnreverse (comp
);
6268 /* Only other case actually used is ACTION = lambda */
6270 /* Supposedly this helps commands such as `cd' that read directory names,
6271 but can someone explain how it helps them? -- RMS */
6272 if (SCHARS (name
) == 0)
6275 string
= Fexpand_file_name (string
, dir
);
6276 if (!NILP (Vread_file_name_predicate
))
6277 return call1 (Vread_file_name_predicate
, string
);
6278 return Ffile_exists_p (string
);
6281 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6282 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6283 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6284 The return value is only relevant for a call to `read-file-name' that happens
6285 before any other event (mouse or keypress) is handeled. */)
6288 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6289 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6298 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6299 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6300 Value is not expanded---you must call `expand-file-name' yourself.
6301 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6302 the same non-empty string that was inserted by this function.
6303 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6304 except that if INITIAL is specified, that combined with DIR is used.)
6305 If the user exits with an empty minibuffer, this function returns
6306 an empty string. (This can only happen if the user erased the
6307 pre-inserted contents or if `insert-default-directory' is nil.)
6308 Fourth arg MUSTMATCH non-nil means require existing file's name.
6309 Non-nil and non-t means also require confirmation after completion.
6310 Fifth arg INITIAL specifies text to start with.
6311 If optional sixth arg PREDICATE is non-nil, possible completions and
6312 the resulting file name must satisfy (funcall PREDICATE NAME).
6313 DIR should be an absolute directory name. It defaults to the value of
6314 `default-directory'.
6316 If this command was invoked with the mouse, use a file dialog box if
6317 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6318 provides a file dialog box.
6320 See also `read-file-name-completion-ignore-case'
6321 and `read-file-name-function'. */)
6322 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6323 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6325 Lisp_Object val
, insdef
, tem
;
6326 struct gcpro gcpro1
, gcpro2
;
6327 register char *homedir
;
6328 Lisp_Object decoded_homedir
;
6329 int replace_in_history
= 0;
6330 int add_to_history
= 0;
6334 dir
= current_buffer
->directory
;
6335 if (NILP (Ffile_name_absolute_p (dir
)))
6336 dir
= Fexpand_file_name (dir
, Qnil
);
6337 if (NILP (default_filename
))
6340 ? Fexpand_file_name (initial
, dir
)
6341 : current_buffer
->filename
);
6343 /* If dir starts with user's homedir, change that to ~. */
6344 homedir
= (char *) egetenv ("HOME");
6346 /* homedir can be NULL in temacs, since Vprocess_environment is not
6347 yet set up. We shouldn't crash in that case. */
6350 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6351 CORRECT_DIR_SEPS (homedir
);
6356 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6359 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6360 SBYTES (decoded_homedir
))
6361 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6363 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6364 dir
= concat2 (build_string ("~"), dir
);
6366 /* Likewise for default_filename. */
6368 && STRINGP (default_filename
)
6369 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6370 SBYTES (decoded_homedir
))
6371 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6374 = Fsubstring (default_filename
,
6375 make_number (SCHARS (decoded_homedir
)), Qnil
);
6376 default_filename
= concat2 (build_string ("~"), default_filename
);
6378 if (!NILP (default_filename
))
6380 CHECK_STRING (default_filename
);
6381 default_filename
= double_dollars (default_filename
);
6384 if (insert_default_directory
&& STRINGP (dir
))
6387 if (!NILP (initial
))
6389 Lisp_Object args
[2], pos
;
6393 insdef
= Fconcat (2, args
);
6394 pos
= make_number (SCHARS (double_dollars (dir
)));
6395 insdef
= Fcons (double_dollars (insdef
), pos
);
6398 insdef
= double_dollars (insdef
);
6400 else if (STRINGP (initial
))
6401 insdef
= Fcons (double_dollars (initial
), make_number (0));
6405 if (!NILP (Vread_file_name_function
))
6407 Lisp_Object args
[7];
6409 GCPRO2 (insdef
, default_filename
);
6410 args
[0] = Vread_file_name_function
;
6413 args
[3] = default_filename
;
6414 args
[4] = mustmatch
;
6416 args
[6] = predicate
;
6417 RETURN_UNGCPRO (Ffuncall (7, args
));
6420 count
= SPECPDL_INDEX ();
6421 specbind (Qcompletion_ignore_case
,
6422 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6423 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6424 specbind (intern ("read-file-name-predicate"),
6425 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6427 GCPRO2 (insdef
, default_filename
);
6429 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6430 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6432 /* If DIR contains a file name, split it. */
6434 file
= Ffile_name_nondirectory (dir
);
6435 if (SCHARS (file
) && NILP (default_filename
))
6437 default_filename
= file
;
6438 dir
= Ffile_name_directory (dir
);
6440 if (!NILP(default_filename
))
6441 default_filename
= Fexpand_file_name (default_filename
, dir
);
6442 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6443 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6448 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6449 dir
, mustmatch
, insdef
,
6450 Qfile_name_history
, default_filename
, Qnil
);
6452 tem
= Fsymbol_value (Qfile_name_history
);
6453 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6454 replace_in_history
= 1;
6456 /* If Fcompleting_read returned the inserted default string itself
6457 (rather than a new string with the same contents),
6458 it has to mean that the user typed RET with the minibuffer empty.
6459 In that case, we really want to return ""
6460 so that commands such as set-visited-file-name can distinguish. */
6461 if (EQ (val
, default_filename
))
6463 /* In this case, Fcompleting_read has not added an element
6464 to the history. Maybe we should. */
6465 if (! replace_in_history
)
6471 unbind_to (count
, Qnil
);
6474 error ("No file name specified");
6476 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6478 if (!NILP (tem
) && !NILP (default_filename
))
6479 val
= default_filename
;
6480 val
= Fsubstitute_in_file_name (val
);
6482 if (replace_in_history
)
6483 /* Replace what Fcompleting_read added to the history
6484 with what we will actually return. */
6486 Lisp_Object val1
= double_dollars (val
);
6487 tem
= Fsymbol_value (Qfile_name_history
);
6488 if (history_delete_duplicates
)
6489 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6490 XSETCAR (tem
, val1
);
6492 else if (add_to_history
)
6494 /* Add the value to the history--but not if it matches
6495 the last value already there. */
6496 Lisp_Object val1
= double_dollars (val
);
6497 tem
= Fsymbol_value (Qfile_name_history
);
6498 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6500 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6501 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6512 /* Must be set before any path manipulation is performed. */
6513 XSETFASTINT (Vdirectory_sep_char
, '/');
6520 Qoperations
= intern ("operations");
6521 Qexpand_file_name
= intern ("expand-file-name");
6522 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6523 Qdirectory_file_name
= intern ("directory-file-name");
6524 Qfile_name_directory
= intern ("file-name-directory");
6525 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6526 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6527 Qfile_name_as_directory
= intern ("file-name-as-directory");
6528 Qcopy_file
= intern ("copy-file");
6529 Qmake_directory_internal
= intern ("make-directory-internal");
6530 Qmake_directory
= intern ("make-directory");
6531 Qdelete_directory
= intern ("delete-directory");
6532 Qdelete_file
= intern ("delete-file");
6533 Qrename_file
= intern ("rename-file");
6534 Qadd_name_to_file
= intern ("add-name-to-file");
6535 Qmake_symbolic_link
= intern ("make-symbolic-link");
6536 Qfile_exists_p
= intern ("file-exists-p");
6537 Qfile_executable_p
= intern ("file-executable-p");
6538 Qfile_readable_p
= intern ("file-readable-p");
6539 Qfile_writable_p
= intern ("file-writable-p");
6540 Qfile_symlink_p
= intern ("file-symlink-p");
6541 Qaccess_file
= intern ("access-file");
6542 Qfile_directory_p
= intern ("file-directory-p");
6543 Qfile_regular_p
= intern ("file-regular-p");
6544 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6545 Qfile_modes
= intern ("file-modes");
6546 Qset_file_modes
= intern ("set-file-modes");
6547 Qset_file_times
= intern ("set-file-times");
6548 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6549 Qinsert_file_contents
= intern ("insert-file-contents");
6550 Qwrite_region
= intern ("write-region");
6551 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6552 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6553 Qauto_save_coding
= intern ("auto-save-coding");
6555 staticpro (&Qoperations
);
6556 staticpro (&Qexpand_file_name
);
6557 staticpro (&Qsubstitute_in_file_name
);
6558 staticpro (&Qdirectory_file_name
);
6559 staticpro (&Qfile_name_directory
);
6560 staticpro (&Qfile_name_nondirectory
);
6561 staticpro (&Qunhandled_file_name_directory
);
6562 staticpro (&Qfile_name_as_directory
);
6563 staticpro (&Qcopy_file
);
6564 staticpro (&Qmake_directory_internal
);
6565 staticpro (&Qmake_directory
);
6566 staticpro (&Qdelete_directory
);
6567 staticpro (&Qdelete_file
);
6568 staticpro (&Qrename_file
);
6569 staticpro (&Qadd_name_to_file
);
6570 staticpro (&Qmake_symbolic_link
);
6571 staticpro (&Qfile_exists_p
);
6572 staticpro (&Qfile_executable_p
);
6573 staticpro (&Qfile_readable_p
);
6574 staticpro (&Qfile_writable_p
);
6575 staticpro (&Qaccess_file
);
6576 staticpro (&Qfile_symlink_p
);
6577 staticpro (&Qfile_directory_p
);
6578 staticpro (&Qfile_regular_p
);
6579 staticpro (&Qfile_accessible_directory_p
);
6580 staticpro (&Qfile_modes
);
6581 staticpro (&Qset_file_modes
);
6582 staticpro (&Qset_file_times
);
6583 staticpro (&Qfile_newer_than_file_p
);
6584 staticpro (&Qinsert_file_contents
);
6585 staticpro (&Qwrite_region
);
6586 staticpro (&Qverify_visited_file_modtime
);
6587 staticpro (&Qset_visited_file_modtime
);
6588 staticpro (&Qauto_save_coding
);
6590 Qfile_name_history
= intern ("file-name-history");
6591 Fset (Qfile_name_history
, Qnil
);
6592 staticpro (&Qfile_name_history
);
6594 Qfile_error
= intern ("file-error");
6595 staticpro (&Qfile_error
);
6596 Qfile_already_exists
= intern ("file-already-exists");
6597 staticpro (&Qfile_already_exists
);
6598 Qfile_date_error
= intern ("file-date-error");
6599 staticpro (&Qfile_date_error
);
6600 Qexcl
= intern ("excl");
6604 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6605 staticpro (&Qfind_buffer_file_type
);
6608 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6609 doc
: /* *Coding system for encoding file names.
6610 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6611 Vfile_name_coding_system
= Qnil
;
6613 DEFVAR_LISP ("default-file-name-coding-system",
6614 &Vdefault_file_name_coding_system
,
6615 doc
: /* Default coding system for encoding file names.
6616 This variable is used only when `file-name-coding-system' is nil.
6618 This variable is set/changed by the command `set-language-environment'.
6619 User should not set this variable manually,
6620 instead use `file-name-coding-system' to get a constant encoding
6621 of file names regardless of the current language environment. */);
6622 Vdefault_file_name_coding_system
= Qnil
;
6624 Qformat_decode
= intern ("format-decode");
6625 staticpro (&Qformat_decode
);
6626 Qformat_annotate_function
= intern ("format-annotate-function");
6627 staticpro (&Qformat_annotate_function
);
6628 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6629 staticpro (&Qafter_insert_file_set_coding
);
6631 Qcar_less_than_car
= intern ("car-less-than-car");
6632 staticpro (&Qcar_less_than_car
);
6634 Fput (Qfile_error
, Qerror_conditions
,
6635 list2 (Qfile_error
, Qerror
));
6636 Fput (Qfile_error
, Qerror_message
,
6637 build_string ("File error"));
6639 Fput (Qfile_already_exists
, Qerror_conditions
,
6640 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6641 Fput (Qfile_already_exists
, Qerror_message
,
6642 build_string ("File already exists"));
6644 Fput (Qfile_date_error
, Qerror_conditions
,
6645 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6646 Fput (Qfile_date_error
, Qerror_message
,
6647 build_string ("Cannot set file date"));
6649 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6650 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6651 Vread_file_name_function
= Qnil
;
6653 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6654 doc
: /* Current predicate used by `read-file-name-internal'. */);
6655 Vread_file_name_predicate
= Qnil
;
6657 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6658 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6659 #if defined VMS || defined DOS_NT || defined MAC_OS
6660 read_file_name_completion_ignore_case
= 1;
6662 read_file_name_completion_ignore_case
= 0;
6665 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6666 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6668 When the initial minibuffer contents show a name of a file or a directory,
6669 typing RETURN without editing the initial contents is equivalent to typing
6670 the default file name.
6672 If this variable is non-nil, the minibuffer contents are always
6673 initially non-empty, and typing RETURN without editing will fetch the
6674 default name, if one is provided. Note however that this default name
6675 is not necessarily the same as initial contents inserted in the minibuffer,
6676 if the initial contents is just the default directory.
6678 If this variable is nil, the minibuffer often starts out empty. In
6679 that case you may have to explicitly fetch the next history element to
6680 request the default name; typing RETURN without editing will leave
6681 the minibuffer empty.
6683 For some commands, exiting with an empty minibuffer has a special meaning,
6684 such as making the current buffer visit no file in the case of
6685 `set-visited-file-name'. */);
6686 insert_default_directory
= 1;
6688 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6689 doc
: /* *Non-nil means write new files with record format `stmlf'.
6690 nil means use format `var'. This variable is meaningful only on VMS. */);
6691 vms_stmlf_recfm
= 0;
6693 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6694 doc
: /* Directory separator character for built-in functions that return file names.
6695 The value is always ?/. Don't use this variable, just use `/'. */);
6697 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6698 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6699 If a file name matches REGEXP, then all I/O on that file is done by calling
6702 The first argument given to HANDLER is the name of the I/O primitive
6703 to be handled; the remaining arguments are the arguments that were
6704 passed to that primitive. For example, if you do
6705 (file-exists-p FILENAME)
6706 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6707 (funcall HANDLER 'file-exists-p FILENAME)
6708 The function `find-file-name-handler' checks this list for a handler
6709 for its argument. */);
6710 Vfile_name_handler_alist
= Qnil
;
6712 DEFVAR_LISP ("set-auto-coding-function",
6713 &Vset_auto_coding_function
,
6714 doc
: /* If non-nil, a function to call to decide a coding system of file.
6715 Two arguments are passed to this function: the file name
6716 and the length of a file contents following the point.
6717 This function should return a coding system to decode the file contents.
6718 It should check the file name against `auto-coding-alist'.
6719 If no coding system is decided, it should check a coding system
6720 specified in the heading lines with the format:
6721 -*- ... coding: CODING-SYSTEM; ... -*-
6722 or local variable spec of the tailing lines with `coding:' tag. */);
6723 Vset_auto_coding_function
= Qnil
;
6725 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6726 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6727 Each is passed one argument, the number of characters inserted.
6728 It should return the new character count, and leave point the same.
6729 If `insert-file-contents' is intercepted by a handler from
6730 `file-name-handler-alist', that handler is responsible for calling the
6731 functions in `after-insert-file-functions' if appropriate. */);
6732 Vafter_insert_file_functions
= Qnil
;
6734 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6735 doc
: /* A list of functions to be called at the start of `write-region'.
6736 Each is passed two arguments, START and END as for `write-region'.
6737 These are usually two numbers but not always; see the documentation
6738 for `write-region'. The function should return a list of pairs
6739 of the form (POSITION . STRING), consisting of strings to be effectively
6740 inserted at the specified positions of the file being written (1 means to
6741 insert before the first byte written). The POSITIONs must be sorted into
6742 increasing order. If there are several functions in the list, the several
6743 lists are merged destructively. Alternatively, the function can return
6744 with a different buffer current; in that case it should pay attention
6745 to the annotations returned by previous functions and listed in
6746 `write-region-annotations-so-far'.*/);
6747 Vwrite_region_annotate_functions
= Qnil
;
6748 staticpro (&Qwrite_region_annotate_functions
);
6749 Qwrite_region_annotate_functions
6750 = intern ("write-region-annotate-functions");
6752 DEFVAR_LISP ("write-region-annotations-so-far",
6753 &Vwrite_region_annotations_so_far
,
6754 doc
: /* When an annotation function is called, this holds the previous annotations.
6755 These are the annotations made by other annotation functions
6756 that were already called. See also `write-region-annotate-functions'. */);
6757 Vwrite_region_annotations_so_far
= Qnil
;
6759 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6760 doc
: /* A list of file name handlers that temporarily should not be used.
6761 This applies only to the operation `inhibit-file-name-operation'. */);
6762 Vinhibit_file_name_handlers
= Qnil
;
6764 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6765 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6766 Vinhibit_file_name_operation
= Qnil
;
6768 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6769 doc
: /* File name in which we write a list of all auto save file names.
6770 This variable is initialized automatically from `auto-save-list-file-prefix'
6771 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6772 a non-nil value. */);
6773 Vauto_save_list_file_name
= Qnil
;
6776 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6777 doc
: /* *Non-nil means don't call fsync in `write-region'.
6778 This variable affects calls to `write-region' as well as save commands.
6779 A non-nil value may result in data loss! */);
6780 write_region_inhibit_fsync
= 0;
6783 defsubr (&Sfind_file_name_handler
);
6784 defsubr (&Sfile_name_directory
);
6785 defsubr (&Sfile_name_nondirectory
);
6786 defsubr (&Sunhandled_file_name_directory
);
6787 defsubr (&Sfile_name_as_directory
);
6788 defsubr (&Sdirectory_file_name
);
6789 defsubr (&Smake_temp_name
);
6790 defsubr (&Sexpand_file_name
);
6791 defsubr (&Ssubstitute_in_file_name
);
6792 defsubr (&Scopy_file
);
6793 defsubr (&Smake_directory_internal
);
6794 defsubr (&Sdelete_directory
);
6795 defsubr (&Sdelete_file
);
6796 defsubr (&Srename_file
);
6797 defsubr (&Sadd_name_to_file
);
6798 defsubr (&Smake_symbolic_link
);
6800 defsubr (&Sdefine_logical_name
);
6803 defsubr (&Ssysnetunam
);
6804 #endif /* HPUX_NET */
6805 defsubr (&Sfile_name_absolute_p
);
6806 defsubr (&Sfile_exists_p
);
6807 defsubr (&Sfile_executable_p
);
6808 defsubr (&Sfile_readable_p
);
6809 defsubr (&Sfile_writable_p
);
6810 defsubr (&Saccess_file
);
6811 defsubr (&Sfile_symlink_p
);
6812 defsubr (&Sfile_directory_p
);
6813 defsubr (&Sfile_accessible_directory_p
);
6814 defsubr (&Sfile_regular_p
);
6815 defsubr (&Sfile_modes
);
6816 defsubr (&Sset_file_modes
);
6817 defsubr (&Sset_file_times
);
6818 defsubr (&Sset_default_file_modes
);
6819 defsubr (&Sdefault_file_modes
);
6820 defsubr (&Sfile_newer_than_file_p
);
6821 defsubr (&Sinsert_file_contents
);
6822 defsubr (&Swrite_region
);
6823 defsubr (&Scar_less_than_car
);
6824 defsubr (&Sverify_visited_file_modtime
);
6825 defsubr (&Sclear_visited_file_modtime
);
6826 defsubr (&Svisited_file_modtime
);
6827 defsubr (&Sset_visited_file_modtime
);
6828 defsubr (&Sdo_auto_save
);
6829 defsubr (&Sset_buffer_auto_saved
);
6830 defsubr (&Sclear_buffer_auto_save_failure
);
6831 defsubr (&Srecent_auto_save_p
);
6833 defsubr (&Sread_file_name_internal
);
6834 defsubr (&Sread_file_name
);
6835 defsubr (&Snext_read_file_uses_dialog_p
);
6838 defsubr (&Sunix_sync
);
6842 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6843 (do not change this comment) */