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. */
31 #include <sys/types.h>
38 #if !defined (S_ISLNK) && defined (S_IFLNK)
39 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
42 #if !defined (S_ISFIFO) && defined (S_IFIFO)
43 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
46 #if !defined (S_ISREG) && defined (S_IFREG)
47 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
72 #include "intervals.h"
74 #include "character.h"
77 #include "blockinput.h"
79 #include "dispextern.h"
86 #endif /* not WINDOWSNT */
90 #include <sys/param.h>
98 #define CORRECT_DIR_SEPS(s) \
99 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
100 else unixtodos_filename (s); \
102 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
103 redirector allows the six letters between 'Z' and 'a' as well. */
105 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
108 #define IS_DRIVE(x) isalpha (x)
110 /* Need to lower-case the drive letter, or else expanded
111 filenames will sometimes compare inequal, because
112 `expand-file-name' doesn't always down-case the drive letter. */
113 #define DRIVE_LETTER(x) (tolower (x))
134 #include "commands.h"
135 extern int use_dialog_box
;
136 extern int use_file_dialog
;
150 #ifndef FILE_SYSTEM_CASE
151 #define FILE_SYSTEM_CASE(filename) (filename)
154 /* Nonzero during writing of auto-save files */
157 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
158 a new file with the same mode as the original */
159 int auto_save_mode_bits
;
161 /* Set by auto_save_1 if an error occurred during the last auto-save. */
162 int auto_save_error_occurred
;
164 /* The symbol bound to coding-system-for-read when
165 insert-file-contents is called for recovering a file. This is not
166 an actual coding system name, but just an indicator to tell
167 insert-file-contents to use `emacs-mule' with a special flag for
168 auto saving and recovering a file. */
169 Lisp_Object Qauto_save_coding
;
171 /* Coding system for file names, or nil if none. */
172 Lisp_Object Vfile_name_coding_system
;
174 /* Coding system for file names used only when
175 Vfile_name_coding_system is nil. */
176 Lisp_Object Vdefault_file_name_coding_system
;
178 /* Alist of elements (REGEXP . HANDLER) for file names
179 whose I/O is done with a special handler. */
180 Lisp_Object Vfile_name_handler_alist
;
182 /* Property name of a file name handler,
183 which gives a list of operations it handles.. */
184 Lisp_Object Qoperations
;
186 /* Lisp functions for translating file formats */
187 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
189 /* Function to be called to decide a coding system of a reading file. */
190 Lisp_Object Vset_auto_coding_function
;
192 /* Functions to be called to process text properties in inserted file. */
193 Lisp_Object Vafter_insert_file_functions
;
195 /* Lisp function for setting buffer-file-coding-system and the
196 multibyteness of the current buffer after inserting a file. */
197 Lisp_Object Qafter_insert_file_set_coding
;
199 /* Functions to be called to create text property annotations for file. */
200 Lisp_Object Vwrite_region_annotate_functions
;
201 Lisp_Object Qwrite_region_annotate_functions
;
203 /* During build_annotations, each time an annotation function is called,
204 this holds the annotations made by the previous functions. */
205 Lisp_Object Vwrite_region_annotations_so_far
;
207 /* File name in which we write a list of all our auto save files. */
208 Lisp_Object Vauto_save_list_file_name
;
210 /* Function to call to read a file name. */
211 Lisp_Object Vread_file_name_function
;
213 /* Current predicate used by read_file_name_internal. */
214 Lisp_Object Vread_file_name_predicate
;
216 /* Nonzero means completion ignores case when reading file name. */
217 int read_file_name_completion_ignore_case
;
219 /* Nonzero means, when reading a filename in the minibuffer,
220 start out by inserting the default directory into the minibuffer. */
221 int insert_default_directory
;
223 /* On VMS, nonzero means write new files with record format stmlf.
224 Zero means use var format. */
227 /* On NT, specifies the directory separator character, used (eg.) when
228 expanding file names. This can be bound to / or \. */
229 Lisp_Object Vdirectory_sep_char
;
232 /* Nonzero means skip the call to fsync in Fwrite-region. */
233 int write_region_inhibit_fsync
;
236 extern Lisp_Object Vuser_login_name
;
239 extern Lisp_Object Vw32_get_true_file_attributes
;
242 extern int minibuf_level
;
244 extern int minibuffer_auto_raise
;
246 extern int history_delete_duplicates
;
248 /* These variables describe handlers that have "already" had a chance
249 to handle the current operation.
251 Vinhibit_file_name_handlers is a list of file name handlers.
252 Vinhibit_file_name_operation is the operation being handled.
253 If we try to handle that operation, we ignore those handlers. */
255 static Lisp_Object Vinhibit_file_name_handlers
;
256 static Lisp_Object Vinhibit_file_name_operation
;
258 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
260 Lisp_Object Qfile_name_history
;
262 Lisp_Object Qcar_less_than_car
;
264 static int a_write
P_ ((int, Lisp_Object
, int, int,
265 Lisp_Object
*, struct coding_system
*));
266 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
270 report_file_error (string
, data
)
274 Lisp_Object errstring
;
278 synchronize_system_messages_locale ();
279 str
= strerror (errorno
);
280 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
282 Vlocale_coding_system
, 0);
288 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
291 /* System error messages are capitalized. Downcase the initial
292 unless it is followed by a slash. */
293 if (SREF (errstring
, 1) != '/')
294 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
296 xsignal (Qfile_error
,
297 Fcons (build_string (string
), Fcons (errstring
, data
)));
302 close_file_unwind (fd
)
305 emacs_close (XFASTINT (fd
));
309 /* Restore point, having saved it as a marker. */
312 restore_point_unwind (location
)
313 Lisp_Object location
;
315 Fgoto_char (location
);
316 Fset_marker (location
, Qnil
, Qnil
);
321 Lisp_Object Qexpand_file_name
;
322 Lisp_Object Qsubstitute_in_file_name
;
323 Lisp_Object Qdirectory_file_name
;
324 Lisp_Object Qfile_name_directory
;
325 Lisp_Object Qfile_name_nondirectory
;
326 Lisp_Object Qunhandled_file_name_directory
;
327 Lisp_Object Qfile_name_as_directory
;
328 Lisp_Object Qcopy_file
;
329 Lisp_Object Qmake_directory_internal
;
330 Lisp_Object Qmake_directory
;
331 Lisp_Object Qdelete_directory
;
332 Lisp_Object Qdelete_file
;
333 Lisp_Object Qrename_file
;
334 Lisp_Object Qadd_name_to_file
;
335 Lisp_Object Qmake_symbolic_link
;
336 Lisp_Object Qfile_exists_p
;
337 Lisp_Object Qfile_executable_p
;
338 Lisp_Object Qfile_readable_p
;
339 Lisp_Object Qfile_writable_p
;
340 Lisp_Object Qfile_symlink_p
;
341 Lisp_Object Qaccess_file
;
342 Lisp_Object Qfile_directory_p
;
343 Lisp_Object Qfile_regular_p
;
344 Lisp_Object Qfile_accessible_directory_p
;
345 Lisp_Object Qfile_modes
;
346 Lisp_Object Qset_file_modes
;
347 Lisp_Object Qset_file_times
;
348 Lisp_Object Qfile_newer_than_file_p
;
349 Lisp_Object Qinsert_file_contents
;
350 Lisp_Object Qwrite_region
;
351 Lisp_Object Qverify_visited_file_modtime
;
352 Lisp_Object Qset_visited_file_modtime
;
354 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
355 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
356 Otherwise, return nil.
357 A file name is handled if one of the regular expressions in
358 `file-name-handler-alist' matches it.
360 If OPERATION equals `inhibit-file-name-operation', then we ignore
361 any handlers that are members of `inhibit-file-name-handlers',
362 but we still do run any other handlers. This lets handlers
363 use the standard functions without calling themselves recursively. */)
364 (filename
, operation
)
365 Lisp_Object filename
, operation
;
367 /* This function must not munge the match data. */
368 Lisp_Object chain
, inhibited_handlers
, result
;
372 CHECK_STRING (filename
);
374 if (EQ (operation
, Vinhibit_file_name_operation
))
375 inhibited_handlers
= Vinhibit_file_name_handlers
;
377 inhibited_handlers
= Qnil
;
379 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
380 chain
= XCDR (chain
))
386 Lisp_Object string
= XCAR (elt
);
388 Lisp_Object handler
= XCDR (elt
);
389 Lisp_Object operations
= Qnil
;
391 if (SYMBOLP (handler
))
392 operations
= Fget (handler
, Qoperations
);
395 && (match_pos
= fast_string_match (string
, filename
)) > pos
396 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
400 handler
= XCDR (elt
);
401 tem
= Fmemq (handler
, inhibited_handlers
);
415 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
417 doc
: /* Return the directory component in file name FILENAME.
418 Return nil if FILENAME does not include a directory.
419 Otherwise return a directory name.
420 Given a Unix syntax file name, returns a string ending in slash;
421 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
423 Lisp_Object filename
;
426 register const unsigned char *beg
;
428 register unsigned char *beg
;
430 register const unsigned char *p
;
433 CHECK_STRING (filename
);
435 /* If the file name has special constructs in it,
436 call the corresponding file handler. */
437 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
439 return call2 (handler
, Qfile_name_directory
, filename
);
441 filename
= FILE_SYSTEM_CASE (filename
);
442 beg
= SDATA (filename
);
444 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
446 p
= beg
+ SBYTES (filename
);
448 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
450 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
453 /* only recognise drive specifier at the beginning */
455 /* handle the "/:d:foo" and "/:foo" cases correctly */
456 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
457 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
464 /* Expansion of "c:" to drive and default directory. */
467 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
468 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
469 unsigned char *r
= res
;
471 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
473 strncpy (res
, beg
, 2);
478 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
480 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
483 p
= beg
+ strlen (beg
);
486 CORRECT_DIR_SEPS (beg
);
489 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
492 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
493 Sfile_name_nondirectory
, 1, 1, 0,
494 doc
: /* Return file name FILENAME sans its directory.
495 For example, in a Unix-syntax file name,
496 this is everything after the last slash,
497 or the entire name if it contains no slash. */)
499 Lisp_Object filename
;
501 register const unsigned char *beg
, *p
, *end
;
504 CHECK_STRING (filename
);
506 /* If the file name has special constructs in it,
507 call the corresponding file handler. */
508 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
510 return call2 (handler
, Qfile_name_nondirectory
, filename
);
512 beg
= SDATA (filename
);
513 end
= p
= beg
+ SBYTES (filename
);
515 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
517 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
520 /* only recognise drive specifier at beginning */
522 /* handle the "/:d:foo" case correctly */
523 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
528 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
531 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
532 Sunhandled_file_name_directory
, 1, 1, 0,
533 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
534 A `directly usable' directory name is one that may be used without the
535 intervention of any file handler.
536 If FILENAME is a directly usable file itself, return
537 \(file-name-directory FILENAME).
538 If FILENAME refers to a file which is not accessible from a local process,
539 then this should return nil.
540 The `call-process' and `start-process' functions use this function to
541 get a current directory to run processes in. */)
543 Lisp_Object filename
;
547 /* If the file name has special constructs in it,
548 call the corresponding file handler. */
549 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
551 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
553 return Ffile_name_directory (filename
);
558 file_name_as_directory (out
, in
)
561 int size
= strlen (in
) - 1;
574 /* Is it already a directory string? */
575 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
577 /* Is it a VMS directory file name? If so, hack VMS syntax. */
578 else if (! index (in
, '/')
579 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
580 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
581 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
582 || ! strncmp (&in
[size
- 5], ".dir", 4))
583 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
584 && in
[size
] == '1')))
586 register char *p
, *dot
;
590 dir:x.dir --> dir:[x]
591 dir:[x]y.dir --> dir:[x.y] */
593 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
596 strncpy (out
, in
, p
- in
);
615 dot
= index (p
, '.');
618 /* blindly remove any extension */
619 size
= strlen (out
) + (dot
- p
);
620 strncat (out
, p
, dot
- p
);
631 /* For Unix syntax, Append a slash if necessary */
632 if (!IS_DIRECTORY_SEP (out
[size
]))
634 /* Cannot use DIRECTORY_SEP, which could have any value */
636 out
[size
+ 2] = '\0';
639 CORRECT_DIR_SEPS (out
);
645 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
646 Sfile_name_as_directory
, 1, 1, 0,
647 doc
: /* Return a string representing the file name FILE interpreted as a directory.
648 This operation exists because a directory is also a file, but its name as
649 a directory is different from its name as a file.
650 The result can be used as the value of `default-directory'
651 or passed as second argument to `expand-file-name'.
652 For a Unix-syntax file name, just appends a slash.
653 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
664 /* If the file name has special constructs in it,
665 call the corresponding file handler. */
666 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
668 return call2 (handler
, Qfile_name_as_directory
, file
);
670 buf
= (char *) alloca (SBYTES (file
) + 10);
671 file_name_as_directory (buf
, SDATA (file
));
672 return make_specified_string (buf
, -1, strlen (buf
),
673 STRING_MULTIBYTE (file
));
677 * Convert from directory name to filename.
679 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
680 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
681 * On UNIX, it's simple: just make sure there isn't a terminating /
683 * Value is nonzero if the string output is different from the input.
687 directory_file_name (src
, dst
)
695 struct FAB fab
= cc$rms_fab
;
696 struct NAM nam
= cc$rms_nam
;
697 char esa
[NAM$C_MAXRSS
];
702 if (! index (src
, '/')
703 && (src
[slen
- 1] == ']'
704 || src
[slen
- 1] == ':'
705 || src
[slen
- 1] == '>'))
707 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
709 fab
.fab$b_fns
= slen
;
710 fab
.fab$l_nam
= &nam
;
711 fab
.fab$l_fop
= FAB$M_NAM
;
714 nam
.nam$b_ess
= sizeof esa
;
715 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
717 /* We call SYS$PARSE to handle such things as [--] for us. */
718 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
720 slen
= nam
.nam$b_esl
;
721 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
726 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
728 /* what about when we have logical_name:???? */
729 if (src
[slen
- 1] == ':')
730 { /* Xlate logical name and see what we get */
731 ptr
= strcpy (dst
, src
); /* upper case for getenv */
734 if ('a' <= *ptr
&& *ptr
<= 'z')
738 dst
[slen
- 1] = 0; /* remove colon */
739 if (!(src
= egetenv (dst
)))
741 /* should we jump to the beginning of this procedure?
742 Good points: allows us to use logical names that xlate
744 Bad points: can be a problem if we just translated to a device
746 For now, I'll punt and always expect VMS names, and hope for
749 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
750 { /* no recursion here! */
756 { /* not a directory spec */
761 bracket
= src
[slen
- 1];
763 /* If bracket is ']' or '>', bracket - 2 is the corresponding
765 ptr
= index (src
, bracket
- 2);
767 { /* no opening bracket */
771 if (!(rptr
= rindex (src
, '.')))
774 strncpy (dst
, src
, slen
);
778 dst
[slen
++] = bracket
;
783 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
784 then translate the device and recurse. */
785 if (dst
[slen
- 1] == ':'
786 && dst
[slen
- 2] != ':' /* skip decnet nodes */
787 && strcmp (src
+ slen
, "[000000]") == 0)
789 dst
[slen
- 1] = '\0';
790 if ((ptr
= egetenv (dst
))
791 && (rlen
= strlen (ptr
) - 1) > 0
792 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
793 && ptr
[rlen
- 1] == '.')
795 char * buf
= (char *) alloca (strlen (ptr
) + 1);
799 return directory_file_name (buf
, dst
);
804 strcat (dst
, "[000000]");
808 rlen
= strlen (rptr
) - 1;
809 strncat (dst
, rptr
, rlen
);
810 dst
[slen
+ rlen
] = '\0';
811 strcat (dst
, ".DIR.1");
815 /* Process as Unix format: just remove any final slash.
816 But leave "/" unchanged; do not change it to "". */
819 && IS_DIRECTORY_SEP (dst
[slen
- 1])
821 && !IS_ANY_SEP (dst
[slen
- 2])
826 CORRECT_DIR_SEPS (dst
);
831 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
833 doc
: /* Returns the file name of the directory named DIRECTORY.
834 This is the name of the file that holds the data for the directory DIRECTORY.
835 This operation exists because a directory is also a file, but its name as
836 a directory is different from its name as a file.
837 In Unix-syntax, this function just removes the final slash.
838 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
839 it returns a file name such as \"[X]Y.DIR.1\". */)
841 Lisp_Object directory
;
846 CHECK_STRING (directory
);
848 if (NILP (directory
))
851 /* If the file name has special constructs in it,
852 call the corresponding file handler. */
853 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
855 return call2 (handler
, Qdirectory_file_name
, directory
);
858 /* 20 extra chars is insufficient for VMS, since we might perform a
859 logical name translation. an equivalence string can be up to 255
860 chars long, so grab that much extra space... - sss */
861 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
863 buf
= (char *) alloca (SBYTES (directory
) + 20);
865 directory_file_name (SDATA (directory
), buf
);
866 return make_specified_string (buf
, -1, strlen (buf
),
867 STRING_MULTIBYTE (directory
));
870 static char make_temp_name_tbl
[64] =
872 'A','B','C','D','E','F','G','H',
873 'I','J','K','L','M','N','O','P',
874 'Q','R','S','T','U','V','W','X',
875 'Y','Z','a','b','c','d','e','f',
876 'g','h','i','j','k','l','m','n',
877 'o','p','q','r','s','t','u','v',
878 'w','x','y','z','0','1','2','3',
879 '4','5','6','7','8','9','-','_'
882 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
884 /* Value is a temporary file name starting with PREFIX, a string.
886 The Emacs process number forms part of the result, so there is
887 no danger of generating a name being used by another process.
888 In addition, this function makes an attempt to choose a name
889 which has no existing file. To make this work, PREFIX should be
890 an absolute file name.
892 BASE64_P non-zero means add the pid as 3 characters in base64
893 encoding. In this case, 6 characters will be added to PREFIX to
894 form the file name. Otherwise, if Emacs is running on a system
895 with long file names, add the pid as a decimal number.
897 This function signals an error if no unique file name could be
901 make_temp_name (prefix
, base64_p
)
908 unsigned char *p
, *data
;
912 CHECK_STRING (prefix
);
914 /* VAL is created by adding 6 characters to PREFIX. The first
915 three are the PID of this process, in base 64, and the second
916 three are incremented if the file already exists. This ensures
917 262144 unique file names per PID per PREFIX. */
919 pid
= (int) getpid ();
923 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
924 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
925 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
930 #ifdef HAVE_LONG_FILE_NAMES
931 sprintf (pidbuf
, "%d", pid
);
932 pidlen
= strlen (pidbuf
);
934 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
935 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
936 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
941 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
942 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
943 if (!STRING_MULTIBYTE (prefix
))
944 STRING_SET_UNIBYTE (val
);
946 bcopy(SDATA (prefix
), data
, len
);
949 bcopy (pidbuf
, p
, pidlen
);
952 /* Here we try to minimize useless stat'ing when this function is
953 invoked many times successively with the same PREFIX. We achieve
954 this by initializing count to a random value, and incrementing it
957 We don't want make-temp-name to be called while dumping,
958 because then make_temp_name_count_initialized_p would get set
959 and then make_temp_name_count would not be set when Emacs starts. */
961 if (!make_temp_name_count_initialized_p
)
963 make_temp_name_count
= (unsigned) time (NULL
);
964 make_temp_name_count_initialized_p
= 1;
970 unsigned num
= make_temp_name_count
;
972 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
973 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
974 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
976 /* Poor man's congruential RN generator. Replace with
977 ++make_temp_name_count for debugging. */
978 make_temp_name_count
+= 25229;
979 make_temp_name_count
%= 225307;
981 if (stat (data
, &ignored
) < 0)
983 /* We want to return only if errno is ENOENT. */
987 /* The error here is dubious, but there is little else we
988 can do. The alternatives are to return nil, which is
989 as bad as (and in many cases worse than) throwing the
990 error, or to ignore the error, which will likely result
991 in looping through 225307 stat's, which is not only
992 dog-slow, but also useless since it will fallback to
993 the errow below, anyway. */
994 report_file_error ("Cannot create temporary name for prefix",
995 Fcons (prefix
, Qnil
));
1000 error ("Cannot create temporary name for prefix `%s'",
1006 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1007 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1008 The Emacs process number forms part of the result,
1009 so there is no danger of generating a name being used by another process.
1011 In addition, this function makes an attempt to choose a name
1012 which has no existing file. To make this work,
1013 PREFIX should be an absolute file name.
1015 There is a race condition between calling `make-temp-name' and creating the
1016 file which opens all kinds of security holes. For that reason, you should
1017 probably use `make-temp-file' instead, except in three circumstances:
1019 * If you are creating the file in the user's home directory.
1020 * If you are creating a directory rather than an ordinary file.
1021 * If you are taking special precautions as `make-temp-file' does. */)
1025 return make_temp_name (prefix
, 0);
1030 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1031 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1032 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1033 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1034 the current buffer's value of `default-directory' is used.
1035 File name components that are `.' are removed, and
1036 so are file name components followed by `..', along with the `..' itself;
1037 note that these simplifications are done without checking the resulting
1038 file names in the file system.
1039 An initial `~/' expands to your home directory.
1040 An initial `~USER/' expands to USER's home directory.
1041 See also the function `substitute-in-file-name'. */)
1042 (name
, default_directory
)
1043 Lisp_Object name
, default_directory
;
1047 register unsigned char *newdir
, *p
, *o
;
1049 unsigned char *target
;
1052 unsigned char * colon
= 0;
1053 unsigned char * close
= 0;
1054 unsigned char * slash
= 0;
1055 unsigned char * brack
= 0;
1056 int lbrack
= 0, rbrack
= 0;
1061 int collapse_newdir
= 1;
1065 Lisp_Object handler
, result
;
1069 CHECK_STRING (name
);
1071 /* If the file name has special constructs in it,
1072 call the corresponding file handler. */
1073 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1074 if (!NILP (handler
))
1075 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1077 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1078 if (NILP (default_directory
))
1079 default_directory
= current_buffer
->directory
;
1080 if (! STRINGP (default_directory
))
1083 /* "/" is not considered a root directory on DOS_NT, so using "/"
1084 here causes an infinite recursion in, e.g., the following:
1086 (let (default-directory)
1087 (expand-file-name "a"))
1089 To avoid this, we set default_directory to the root of the
1091 extern char *emacs_root_dir (void);
1093 default_directory
= build_string (emacs_root_dir ());
1095 default_directory
= build_string ("/");
1099 if (!NILP (default_directory
))
1101 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1102 if (!NILP (handler
))
1103 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1106 o
= SDATA (default_directory
);
1108 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1109 It would be better to do this down below where we actually use
1110 default_directory. Unfortunately, calling Fexpand_file_name recursively
1111 could invoke GC, and the strings might be relocated. This would
1112 be annoying because we have pointers into strings lying around
1113 that would need adjusting, and people would add new pointers to
1114 the code and forget to adjust them, resulting in intermittent bugs.
1115 Putting this call here avoids all that crud.
1117 The EQ test avoids infinite recursion. */
1118 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1119 /* Save time in some common cases - as long as default_directory
1120 is not relative, it can be canonicalized with name below (if it
1121 is needed at all) without requiring it to be expanded now. */
1123 /* Detect MSDOS file names with drive specifiers. */
1124 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1126 /* Detect Windows file names in UNC format. */
1127 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1129 #else /* not DOS_NT */
1130 /* Detect Unix absolute file names (/... alone is not absolute on
1132 && ! (IS_DIRECTORY_SEP (o
[0]))
1133 #endif /* not DOS_NT */
1136 struct gcpro gcpro1
;
1139 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1143 name
= FILE_SYSTEM_CASE (name
);
1144 multibyte
= STRING_MULTIBYTE (name
);
1145 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
1148 default_directory
= string_to_multibyte (default_directory
);
1151 name
= string_to_multibyte (name
);
1159 /* We will force directory separators to be either all \ or /, so make
1160 a local copy to modify, even if there ends up being no change. */
1161 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1163 /* Note if special escape prefix is present, but remove for now. */
1164 if (nm
[0] == '/' && nm
[1] == ':')
1170 /* Find and remove drive specifier if present; this makes nm absolute
1171 even if the rest of the name appears to be relative. Only look for
1172 drive specifier at the beginning. */
1173 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1180 /* If we see "c://somedir", we want to strip the first slash after the
1181 colon when stripping the drive letter. Otherwise, this expands to
1183 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1185 #endif /* WINDOWSNT */
1189 /* Discard any previous drive specifier if nm is now in UNC format. */
1190 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1196 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1197 none are found, we can probably return right away. We will avoid
1198 allocating a new string if name is already fully expanded. */
1200 IS_DIRECTORY_SEP (nm
[0])
1202 && drive
&& !is_escaped
1205 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1212 /* If it turns out that the filename we want to return is just a
1213 suffix of FILENAME, we don't need to go through and edit
1214 things; we just need to construct a new string using data
1215 starting at the middle of FILENAME. If we set lose to a
1216 non-zero value, that means we've discovered that we can't do
1223 /* Since we know the name is absolute, we can assume that each
1224 element starts with a "/". */
1226 /* "." and ".." are hairy. */
1227 if (IS_DIRECTORY_SEP (p
[0])
1229 && (IS_DIRECTORY_SEP (p
[2])
1231 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1234 /* We want to replace multiple `/' in a row with a single
1237 && IS_DIRECTORY_SEP (p
[0])
1238 && IS_DIRECTORY_SEP (p
[1]))
1245 /* if dev:[dir]/, move nm to / */
1246 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1247 nm
= (brack
? brack
+ 1 : colon
+ 1);
1248 lbrack
= rbrack
= 0;
1255 #ifdef NO_HYPHENS_IN_FILENAMES
1256 if (lbrack
== rbrack
)
1258 /* Avoid clobbering negative version numbers. */
1263 #endif /* NO_HYPHENS_IN_FILENAMES */
1265 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1266 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1268 #ifdef NO_HYPHENS_IN_FILENAMES
1271 #endif /* NO_HYPHENS_IN_FILENAMES */
1272 /* count open brackets, reset close bracket pointer */
1273 if (p
[0] == '[' || p
[0] == '<')
1274 lbrack
++, brack
= 0;
1275 /* count close brackets, set close bracket pointer */
1276 if (p
[0] == ']' || p
[0] == '>')
1277 rbrack
++, brack
= p
;
1278 /* detect ][ or >< */
1279 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1281 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1282 nm
= p
+ 1, lose
= 1;
1283 if (p
[0] == ':' && (colon
|| slash
))
1284 /* if dev1:[dir]dev2:, move nm to dev2: */
1290 /* if /name/dev:, move nm to dev: */
1293 /* if node::dev:, move colon following dev */
1294 else if (colon
&& colon
[-1] == ':')
1296 /* if dev1:dev2:, move nm to dev2: */
1297 else if (colon
&& colon
[-1] != ':')
1302 if (p
[0] == ':' && !colon
)
1308 if (lbrack
== rbrack
)
1311 else if (p
[0] == '.')
1319 if (index (nm
, '/'))
1321 nm
= sys_translate_unix (nm
);
1322 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1326 /* Make sure directories are all separated with / or \ as
1327 desired, but avoid allocation of a new string when not
1329 CORRECT_DIR_SEPS (nm
);
1331 if (IS_DIRECTORY_SEP (nm
[1]))
1333 if (strcmp (nm
, SDATA (name
)) != 0)
1334 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1338 /* drive must be set, so this is okay */
1339 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1343 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1344 temp
[0] = DRIVE_LETTER (drive
);
1345 name
= concat2 (build_string (temp
), name
);
1348 #else /* not DOS_NT */
1349 if (nm
== SDATA (name
))
1351 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1352 #endif /* not DOS_NT */
1356 /* At this point, nm might or might not be an absolute file name. We
1357 need to expand ~ or ~user if present, otherwise prefix nm with
1358 default_directory if nm is not absolute, and finally collapse /./
1359 and /foo/../ sequences.
1361 We set newdir to be the appropriate prefix if one is needed:
1362 - the relevant user directory if nm starts with ~ or ~user
1363 - the specified drive's working dir (DOS/NT only) if nm does not
1365 - the value of default_directory.
1367 Note that these prefixes are not guaranteed to be absolute (except
1368 for the working dir of a drive). Therefore, to ensure we always
1369 return an absolute name, if the final prefix is not absolute we
1370 append it to the current working directory. */
1374 if (nm
[0] == '~') /* prefix ~ */
1376 if (IS_DIRECTORY_SEP (nm
[1])
1380 || nm
[1] == 0) /* ~ by itself */
1384 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1385 newdir
= (unsigned char *) "";
1387 /* egetenv may return a unibyte string, which will bite us since
1388 we expect the directory to be multibyte. */
1389 tem
= build_string (newdir
);
1390 if (!STRING_MULTIBYTE (tem
))
1392 hdir
= DECODE_FILE (tem
);
1393 newdir
= SDATA (hdir
);
1396 collapse_newdir
= 0;
1399 nm
++; /* Don't leave the slash in nm. */
1402 else /* ~user/filename */
1404 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1409 o
= (unsigned char *) alloca (p
- nm
+ 1);
1410 bcopy ((char *) nm
, o
, p
- nm
);
1414 pw
= (struct passwd
*) getpwnam (o
+ 1);
1418 newdir
= (unsigned char *) pw
-> pw_dir
;
1420 nm
= p
+ 1; /* skip the terminator */
1424 collapse_newdir
= 0;
1429 /* If we don't find a user of that name, leave the name
1430 unchanged; don't move nm forward to p. */
1435 /* On DOS and Windows, nm is absolute if a drive name was specified;
1436 use the drive's current directory as the prefix if needed. */
1437 if (!newdir
&& drive
)
1439 /* Get default directory if needed to make nm absolute. */
1440 if (!IS_DIRECTORY_SEP (nm
[0]))
1442 newdir
= alloca (MAXPATHLEN
+ 1);
1443 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1448 /* Either nm starts with /, or drive isn't mounted. */
1449 newdir
= alloca (4);
1450 newdir
[0] = DRIVE_LETTER (drive
);
1458 /* Finally, if no prefix has been specified and nm is not absolute,
1459 then it must be expanded relative to default_directory. */
1463 /* /... alone is not absolute on DOS and Windows. */
1464 && !IS_DIRECTORY_SEP (nm
[0])
1467 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1474 newdir
= SDATA (default_directory
);
1476 /* Note if special escape prefix is present, but remove for now. */
1477 if (newdir
[0] == '/' && newdir
[1] == ':')
1488 /* First ensure newdir is an absolute name. */
1490 /* Detect MSDOS file names with drive specifiers. */
1491 ! (IS_DRIVE (newdir
[0])
1492 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1494 /* Detect Windows file names in UNC format. */
1495 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1499 /* Effectively, let newdir be (expand-file-name newdir cwd).
1500 Because of the admonition against calling expand-file-name
1501 when we have pointers into lisp strings, we accomplish this
1502 indirectly by prepending newdir to nm if necessary, and using
1503 cwd (or the wd of newdir's drive) as the new newdir. */
1505 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1510 if (!IS_DIRECTORY_SEP (nm
[0]))
1512 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1513 file_name_as_directory (tmp
, newdir
);
1517 newdir
= alloca (MAXPATHLEN
+ 1);
1520 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1527 /* Strip off drive name from prefix, if present. */
1528 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1534 /* Keep only a prefix from newdir if nm starts with slash
1535 (//server/share for UNC, nothing otherwise). */
1536 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1539 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1541 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1543 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1545 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1557 /* Get rid of any slash at the end of newdir, unless newdir is
1558 just / or // (an incomplete UNC name). */
1559 length
= strlen (newdir
);
1560 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1562 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1566 unsigned char *temp
= (unsigned char *) alloca (length
);
1567 bcopy (newdir
, temp
, length
- 1);
1568 temp
[length
- 1] = 0;
1576 /* Now concatenate the directory and name to new space in the stack frame */
1577 tlen
+= strlen (nm
) + 1;
1579 /* Reserve space for drive specifier and escape prefix, since either
1580 or both may need to be inserted. (The Microsoft x86 compiler
1581 produces incorrect code if the following two lines are combined.) */
1582 target
= (unsigned char *) alloca (tlen
+ 4);
1584 #else /* not DOS_NT */
1585 target
= (unsigned char *) alloca (tlen
);
1586 #endif /* not DOS_NT */
1592 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1595 /* If newdir is effectively "C:/", then the drive letter will have
1596 been stripped and newdir will be "/". Concatenating with an
1597 absolute directory in nm produces "//", which will then be
1598 incorrectly treated as a network share. Ignore newdir in
1599 this case (keeping the drive letter). */
1600 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1601 && newdir
[1] == '\0'))
1603 strcpy (target
, newdir
);
1607 file_name_as_directory (target
, newdir
);
1610 strcat (target
, nm
);
1612 if (index (target
, '/'))
1613 strcpy (target
, sys_translate_unix (target
));
1616 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1618 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1627 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1633 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1634 /* brackets are offset from each other by 2 */
1637 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1638 /* convert [foo][bar] to [bar] */
1639 while (o
[-1] != '[' && o
[-1] != '<')
1641 else if (*p
== '-' && *o
!= '.')
1644 else if (p
[0] == '-' && o
[-1] == '.'
1645 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1646 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1650 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1651 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1653 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1655 /* else [foo.-] ==> [-] */
1659 #ifdef NO_HYPHENS_IN_FILENAMES
1661 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1662 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1664 #endif /* NO_HYPHENS_IN_FILENAMES */
1668 if (!IS_DIRECTORY_SEP (*p
))
1672 else if (p
[1] == '.'
1673 && (IS_DIRECTORY_SEP (p
[2])
1676 /* If "/." is the entire filename, keep the "/". Otherwise,
1677 just delete the whole "/.". */
1678 if (o
== target
&& p
[2] == '\0')
1682 else if (p
[1] == '.' && p
[2] == '.'
1683 /* `/../' is the "superroot" on certain file systems.
1684 Turned off on DOS_NT systems because they have no
1685 "superroot" and because this causes us to produce
1686 file names like "d:/../foo" which fail file-related
1687 functions of the underlying OS. (To reproduce, try a
1688 long series of "../../" in default_directory, longer
1689 than the number of levels from the root.) */
1693 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1695 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1697 /* Keep initial / only if this is the whole name. */
1698 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1702 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1703 /* Collapse multiple `/' in a row. */
1709 #endif /* not VMS */
1713 /* At last, set drive name. */
1715 /* Except for network file name. */
1716 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1717 #endif /* WINDOWSNT */
1719 if (!drive
) abort ();
1721 target
[0] = DRIVE_LETTER (drive
);
1724 /* Reinsert the escape prefix if required. */
1731 CORRECT_DIR_SEPS (target
);
1734 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1736 /* Again look to see if the file name has special constructs in it
1737 and perhaps call the corresponding file handler. This is needed
1738 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1739 the ".." component gives us "/user@host:/bar/../baz" which needs
1740 to be expanded again. */
1741 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1742 if (!NILP (handler
))
1743 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1749 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1750 This is the old version of expand-file-name, before it was thoroughly
1751 rewritten for Emacs 10.31. We leave this version here commented-out,
1752 because the code is very complex and likely to have subtle bugs. If
1753 bugs _are_ found, it might be of interest to look at the old code and
1754 see what did it do in the relevant situation.
1756 Don't remove this code: it's true that it will be accessible via CVS,
1757 but a few years from deletion, people will forget it is there. */
1759 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1760 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1761 "Convert FILENAME to absolute, and canonicalize it.\n\
1762 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1763 \(does not start with slash); if DEFAULT is nil or missing,\n\
1764 the current buffer's value of default-directory is used.\n\
1765 Filenames containing `.' or `..' as components are simplified;\n\
1766 initial `~/' expands to your home directory.\n\
1767 See also the function `substitute-in-file-name'.")
1769 Lisp_Object name
, defalt
;
1773 register unsigned char *newdir
, *p
, *o
;
1775 unsigned char *target
;
1779 unsigned char * colon
= 0;
1780 unsigned char * close
= 0;
1781 unsigned char * slash
= 0;
1782 unsigned char * brack
= 0;
1783 int lbrack
= 0, rbrack
= 0;
1787 CHECK_STRING (name
);
1790 /* Filenames on VMS are always upper case. */
1791 name
= Fupcase (name
);
1796 /* If nm is absolute, flush ...// and detect /./ and /../.
1797 If no /./ or /../ we can return right away. */
1809 if (p
[0] == '/' && p
[1] == '/'
1812 if (p
[0] == '/' && p
[1] == '~')
1813 nm
= p
+ 1, lose
= 1;
1814 if (p
[0] == '/' && p
[1] == '.'
1815 && (p
[2] == '/' || p
[2] == 0
1816 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1822 /* if dev:[dir]/, move nm to / */
1823 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1824 nm
= (brack
? brack
+ 1 : colon
+ 1);
1825 lbrack
= rbrack
= 0;
1833 /* VMS pre V4.4,convert '-'s in filenames. */
1834 if (lbrack
== rbrack
)
1836 if (dots
< 2) /* this is to allow negative version numbers */
1842 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1843 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1849 /* count open brackets, reset close bracket pointer */
1850 if (p
[0] == '[' || p
[0] == '<')
1851 lbrack
++, brack
= 0;
1852 /* count close brackets, set close bracket pointer */
1853 if (p
[0] == ']' || p
[0] == '>')
1854 rbrack
++, brack
= p
;
1855 /* detect ][ or >< */
1856 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1858 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1859 nm
= p
+ 1, lose
= 1;
1860 if (p
[0] == ':' && (colon
|| slash
))
1861 /* if dev1:[dir]dev2:, move nm to dev2: */
1867 /* If /name/dev:, move nm to dev: */
1870 /* If node::dev:, move colon following dev */
1871 else if (colon
&& colon
[-1] == ':')
1873 /* If dev1:dev2:, move nm to dev2: */
1874 else if (colon
&& colon
[-1] != ':')
1879 if (p
[0] == ':' && !colon
)
1885 if (lbrack
== rbrack
)
1888 else if (p
[0] == '.')
1896 if (index (nm
, '/'))
1897 return build_string (sys_translate_unix (nm
));
1899 if (nm
== SDATA (name
))
1901 return build_string (nm
);
1905 /* Now determine directory to start with and put it in NEWDIR */
1909 if (nm
[0] == '~') /* prefix ~ */
1914 || nm
[1] == 0)/* ~/filename */
1916 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1917 newdir
= (unsigned char *) "";
1920 nm
++; /* Don't leave the slash in nm. */
1923 else /* ~user/filename */
1925 /* Get past ~ to user */
1926 unsigned char *user
= nm
+ 1;
1927 /* Find end of name. */
1928 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1929 int len
= ptr
? ptr
- user
: strlen (user
);
1931 unsigned char *ptr1
= index (user
, ':');
1932 if (ptr1
!= 0 && ptr1
- user
< len
)
1935 /* Copy the user name into temp storage. */
1936 o
= (unsigned char *) alloca (len
+ 1);
1937 bcopy ((char *) user
, o
, len
);
1940 /* Look up the user name. */
1942 pw
= (struct passwd
*) getpwnam (o
+ 1);
1945 error ("\"%s\" isn't a registered user", o
+ 1);
1947 newdir
= (unsigned char *) pw
->pw_dir
;
1949 /* Discard the user name from NM. */
1956 #endif /* not VMS */
1960 defalt
= current_buffer
->directory
;
1961 CHECK_STRING (defalt
);
1962 newdir
= SDATA (defalt
);
1965 /* Now concatenate the directory and name to new space in the stack frame */
1967 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1968 target
= (unsigned char *) alloca (tlen
);
1974 if (nm
[0] == 0 || nm
[0] == '/')
1975 strcpy (target
, newdir
);
1978 file_name_as_directory (target
, newdir
);
1981 strcat (target
, nm
);
1983 if (index (target
, '/'))
1984 strcpy (target
, sys_translate_unix (target
));
1987 /* Now canonicalize by removing /. and /foo/.. if they appear */
1995 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
2001 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
2002 /* brackets are offset from each other by 2 */
2005 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
2006 /* convert [foo][bar] to [bar] */
2007 while (o
[-1] != '[' && o
[-1] != '<')
2009 else if (*p
== '-' && *o
!= '.')
2012 else if (p
[0] == '-' && o
[-1] == '.'
2013 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2014 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2018 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2019 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2021 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2023 /* else [foo.-] ==> [-] */
2029 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2030 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2040 else if (!strncmp (p
, "//", 2)
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
!= '/')
2056 if (o
== target
&& *o
== '/')
2064 #endif /* not VMS */
2067 return make_string (target
, o
- target
);
2071 /* If /~ or // appears, discard everything through first slash. */
2073 file_name_absolute_p (filename
)
2074 const unsigned char *filename
;
2077 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2079 /* ??? This criterion is probably wrong for '<'. */
2080 || index (filename
, ':') || index (filename
, '<')
2081 || (*filename
== '[' && (filename
[1] != '-'
2082 || (filename
[2] != '.' && filename
[2] != ']'))
2083 && filename
[1] != '.')
2086 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2087 && IS_DIRECTORY_SEP (filename
[2]))
2092 static unsigned char *
2093 search_embedded_absfilename (nm
, endp
)
2094 unsigned char *nm
, *endp
;
2096 unsigned char *p
, *s
;
2098 for (p
= nm
+ 1; p
< endp
; p
++)
2102 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2104 || IS_DIRECTORY_SEP (p
[-1]))
2105 && file_name_absolute_p (p
)
2106 #if defined (WINDOWSNT) || defined(CYGWIN)
2107 /* // at start of file name is meaningful in Apollo,
2108 WindowsNT and Cygwin systems. */
2109 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2110 #endif /* not (WINDOWSNT || CYGWIN) */
2113 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2118 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2120 unsigned char *o
= alloca (s
- p
+ 1);
2122 bcopy (p
, o
, s
- p
);
2125 /* If we have ~user and `user' exists, discard
2126 everything up to ~. But if `user' does not exist, leave
2127 ~user alone, it might be a literal file name. */
2129 pw
= getpwnam (o
+ 1);
2141 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2142 Ssubstitute_in_file_name
, 1, 1, 0,
2143 doc
: /* Substitute environment variables referred to in FILENAME.
2144 `$FOO' where FOO is an environment variable name means to substitute
2145 the value of that variable. The variable name should be terminated
2146 with a character not a letter, digit or underscore; otherwise, enclose
2147 the entire variable name in braces.
2148 If `/~' appears, all of FILENAME through that `/' is discarded.
2150 On VMS, `$' substitution is not done; this function does little and only
2151 duplicates what `expand-file-name' does. */)
2153 Lisp_Object filename
;
2157 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2158 unsigned char *target
= NULL
;
2160 int substituted
= 0;
2162 Lisp_Object handler
;
2164 CHECK_STRING (filename
);
2166 /* If the file name has special constructs in it,
2167 call the corresponding file handler. */
2168 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2169 if (!NILP (handler
))
2170 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2172 nm
= SDATA (filename
);
2174 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2175 CORRECT_DIR_SEPS (nm
);
2176 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2178 endp
= nm
+ SBYTES (filename
);
2180 /* If /~ or // appears, discard everything through first slash. */
2181 p
= search_embedded_absfilename (nm
, endp
);
2183 /* Start over with the new string, so we check the file-name-handler
2184 again. Important with filenames like "/home/foo//:/hello///there"
2185 which whould substitute to "/:/hello///there" rather than "/there". */
2186 return Fsubstitute_in_file_name
2187 (make_specified_string (p
, -1, endp
- p
,
2188 STRING_MULTIBYTE (filename
)));
2194 /* See if any variables are substituted into the string
2195 and find the total length of their values in `total' */
2197 for (p
= nm
; p
!= endp
;)
2207 /* "$$" means a single "$" */
2216 while (p
!= endp
&& *p
!= '}') p
++;
2217 if (*p
!= '}') goto missingclose
;
2223 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2227 /* Copy out the variable name */
2228 target
= (unsigned char *) alloca (s
- o
+ 1);
2229 strncpy (target
, o
, s
- o
);
2232 strupr (target
); /* $home == $HOME etc. */
2235 /* Get variable value */
2236 o
= (unsigned char *) egetenv (target
);
2238 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2239 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2249 /* If substitution required, recopy the string and do it */
2250 /* Make space in stack frame for the new copy */
2251 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2254 /* Copy the rest of the name through, replacing $ constructs with values */
2271 while (p
!= endp
&& *p
!= '}') p
++;
2272 if (*p
!= '}') goto missingclose
;
2278 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2282 /* Copy out the variable name */
2283 target
= (unsigned char *) alloca (s
- o
+ 1);
2284 strncpy (target
, o
, s
- o
);
2287 strupr (target
); /* $home == $HOME etc. */
2290 /* Get variable value */
2291 o
= (unsigned char *) egetenv (target
);
2295 strcpy (x
, target
); x
+= strlen (target
);
2297 else if (STRING_MULTIBYTE (filename
))
2299 /* If the original string is multibyte,
2300 convert what we substitute into multibyte. */
2304 c
= unibyte_char_to_multibyte (c
);
2305 x
+= CHAR_STRING (c
, x
);
2317 /* If /~ or // appears, discard everything through first slash. */
2318 while ((p
= search_embedded_absfilename (xnm
, x
)))
2319 /* This time we do not start over because we've already expanded envvars
2320 and replaced $$ with $. Maybe we should start over as well, but we'd
2321 need to quote some $ to $$ first. */
2324 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2327 error ("Bad format environment-variable substitution");
2329 error ("Missing \"}\" in environment-variable substitution");
2331 error ("Substituting nonexistent environment variable \"%s\"", target
);
2334 #endif /* not VMS */
2338 /* A slightly faster and more convenient way to get
2339 (directory-file-name (expand-file-name FOO)). */
2342 expand_and_dir_to_file (filename
, defdir
)
2343 Lisp_Object filename
, defdir
;
2345 register Lisp_Object absname
;
2347 absname
= Fexpand_file_name (filename
, defdir
);
2350 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2351 if (c
== ':' || c
== ']' || c
== '>')
2352 absname
= Fdirectory_file_name (absname
);
2355 /* Remove final slash, if any (unless this is the root dir).
2356 stat behaves differently depending! */
2357 if (SCHARS (absname
) > 1
2358 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2359 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2360 /* We cannot take shortcuts; they might be wrong for magic file names. */
2361 absname
= Fdirectory_file_name (absname
);
2366 /* Signal an error if the file ABSNAME already exists.
2367 If INTERACTIVE is nonzero, ask the user whether to proceed,
2368 and bypass the error if the user says to go ahead.
2369 QUERYSTRING is a name for the action that is being considered
2372 *STATPTR is used to store the stat information if the file exists.
2373 If the file does not exist, STATPTR->st_mode is set to 0.
2374 If STATPTR is null, we don't store into it.
2376 If QUICK is nonzero, we ask for y or n, not yes or no. */
2379 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2380 Lisp_Object absname
;
2381 unsigned char *querystring
;
2383 struct stat
*statptr
;
2386 register Lisp_Object tem
, encoded_filename
;
2387 struct stat statbuf
;
2388 struct gcpro gcpro1
;
2390 encoded_filename
= ENCODE_FILE (absname
);
2392 /* stat is a good way to tell whether the file exists,
2393 regardless of what access permissions it has. */
2394 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2397 xsignal2 (Qfile_already_exists
,
2398 build_string ("File already exists"), absname
);
2400 tem
= format2 ("File %s already exists; %s anyway? ",
2401 absname
, build_string (querystring
));
2403 tem
= Fy_or_n_p (tem
);
2405 tem
= do_yes_or_no_p (tem
);
2408 xsignal2 (Qfile_already_exists
,
2409 build_string ("File already exists"), absname
);
2416 statptr
->st_mode
= 0;
2421 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2422 "fCopy file: \nGCopy %s to file: \np\nP",
2423 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2424 If NEWNAME names a directory, copy FILE there.
2426 This function always sets the file modes of the output file to match
2429 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2430 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2431 signal a `file-already-exists' error without overwriting. If
2432 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2433 about overwriting; this is what happens in interactive use with M-x.
2434 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2437 Fourth arg KEEP-TIME non-nil means give the output file the same
2438 last-modified time as the old one. (This works on only some systems.)
2440 A prefix arg makes KEEP-TIME non-nil.
2442 If PRESERVE-UID-GID is non-nil, we try to transfer the
2443 uid and gid of FILE to NEWNAME. */)
2444 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2445 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2446 Lisp_Object preserve_uid_gid
;
2449 char buf
[16 * 1024];
2450 struct stat st
, out_st
;
2451 Lisp_Object handler
;
2452 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2453 int count
= SPECPDL_INDEX ();
2454 int input_file_statable_p
;
2455 Lisp_Object encoded_file
, encoded_newname
;
2457 encoded_file
= encoded_newname
= Qnil
;
2458 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2459 CHECK_STRING (file
);
2460 CHECK_STRING (newname
);
2462 if (!NILP (Ffile_directory_p (newname
)))
2463 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2465 newname
= Fexpand_file_name (newname
, Qnil
);
2467 file
= Fexpand_file_name (file
, Qnil
);
2469 /* If the input file name has special constructs in it,
2470 call the corresponding file handler. */
2471 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2472 /* Likewise for output file name. */
2474 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2475 if (!NILP (handler
))
2476 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
2477 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
2479 encoded_file
= ENCODE_FILE (file
);
2480 encoded_newname
= ENCODE_FILE (newname
);
2482 if (NILP (ok_if_already_exists
)
2483 || INTEGERP (ok_if_already_exists
))
2484 barf_or_query_if_file_exists (newname
, "copy to it",
2485 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2486 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2490 if (!CopyFile (SDATA (encoded_file
),
2491 SDATA (encoded_newname
),
2493 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2494 /* CopyFile retains the timestamp by default. */
2495 else if (NILP (keep_time
))
2501 EMACS_GET_TIME (now
);
2502 filename
= SDATA (encoded_newname
);
2504 /* Ensure file is writable while its modified time is set. */
2505 attributes
= GetFileAttributes (filename
);
2506 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2507 if (set_file_times (filename
, now
, now
))
2509 /* Restore original attributes. */
2510 SetFileAttributes (filename
, attributes
);
2511 xsignal2 (Qfile_date_error
,
2512 build_string ("Cannot set file date"), newname
);
2514 /* Restore original attributes. */
2515 SetFileAttributes (filename
, attributes
);
2517 #else /* not WINDOWSNT */
2519 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2523 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2525 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2527 /* We can only copy regular files and symbolic links. Other files are not
2529 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2531 #if !defined (MSDOS) || __DJGPP__ > 1
2532 if (out_st
.st_mode
!= 0
2533 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2536 report_file_error ("Input and output files are the same",
2537 Fcons (file
, Fcons (newname
, Qnil
)));
2541 #if defined (S_ISREG) && defined (S_ISLNK)
2542 if (input_file_statable_p
)
2544 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2546 #if defined (EISDIR)
2547 /* Get a better looking error message. */
2550 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2553 #endif /* S_ISREG && S_ISLNK */
2556 /* Create the copy file with the same record format as the input file */
2557 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2560 /* System's default file type was set to binary by _fmode in emacs.c. */
2561 ofd
= emacs_open (SDATA (encoded_newname
),
2562 O_WRONLY
| O_TRUNC
| O_CREAT
2563 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2564 S_IREAD
| S_IWRITE
);
2565 #else /* not MSDOS */
2566 ofd
= emacs_open (SDATA (encoded_newname
),
2567 O_WRONLY
| O_TRUNC
| O_CREAT
2568 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2570 #endif /* not MSDOS */
2573 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2575 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2579 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2580 if (emacs_write (ofd
, buf
, n
) != n
)
2581 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2585 /* Preserve the original file modes, and if requested, also its
2587 if (input_file_statable_p
)
2589 if (! NILP (preserve_uid_gid
))
2590 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2591 fchmod (ofd
, st
.st_mode
& 07777);
2593 #endif /* not MSDOS */
2595 /* Closing the output clobbers the file times on some systems. */
2596 if (emacs_close (ofd
) < 0)
2597 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2599 if (input_file_statable_p
)
2601 if (!NILP (keep_time
))
2603 EMACS_TIME atime
, mtime
;
2604 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2605 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2606 if (set_file_times (SDATA (encoded_newname
),
2608 xsignal2 (Qfile_date_error
,
2609 build_string ("Cannot set file date"), newname
);
2615 #if defined (__DJGPP__) && __DJGPP__ > 1
2616 if (input_file_statable_p
)
2618 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2619 and if it can't, it tells so. Otherwise, under MSDOS we usually
2620 get only the READ bit, which will make the copied file read-only,
2621 so it's better not to chmod at all. */
2622 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2623 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2625 #endif /* DJGPP version 2 or newer */
2626 #endif /* not WINDOWSNT */
2628 /* Discard the unwind protects. */
2629 specpdl_ptr
= specpdl
+ count
;
2635 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2636 Smake_directory_internal
, 1, 1, 0,
2637 doc
: /* Create a new directory named DIRECTORY. */)
2639 Lisp_Object directory
;
2641 const unsigned char *dir
;
2642 Lisp_Object handler
;
2643 Lisp_Object encoded_dir
;
2645 CHECK_STRING (directory
);
2646 directory
= Fexpand_file_name (directory
, Qnil
);
2648 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2649 if (!NILP (handler
))
2650 return call2 (handler
, Qmake_directory_internal
, directory
);
2652 encoded_dir
= ENCODE_FILE (directory
);
2654 dir
= SDATA (encoded_dir
);
2657 if (mkdir (dir
) != 0)
2659 if (mkdir (dir
, 0777) != 0)
2661 report_file_error ("Creating directory", list1 (directory
));
2666 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2667 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2669 Lisp_Object directory
;
2671 const unsigned char *dir
;
2672 Lisp_Object handler
;
2673 Lisp_Object encoded_dir
;
2675 CHECK_STRING (directory
);
2676 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2678 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2679 if (!NILP (handler
))
2680 return call2 (handler
, Qdelete_directory
, directory
);
2682 encoded_dir
= ENCODE_FILE (directory
);
2684 dir
= SDATA (encoded_dir
);
2686 if (rmdir (dir
) != 0)
2687 report_file_error ("Removing directory", list1 (directory
));
2692 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2693 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2694 If file has multiple names, it continues to exist with the other names. */)
2696 Lisp_Object filename
;
2698 Lisp_Object handler
;
2699 Lisp_Object encoded_file
;
2700 struct gcpro gcpro1
;
2703 if (!NILP (Ffile_directory_p (filename
))
2704 && NILP (Ffile_symlink_p (filename
)))
2705 xsignal2 (Qfile_error
,
2706 build_string ("Removing old name: is a directory"),
2709 filename
= Fexpand_file_name (filename
, Qnil
);
2711 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2712 if (!NILP (handler
))
2713 return call2 (handler
, Qdelete_file
, filename
);
2715 encoded_file
= ENCODE_FILE (filename
);
2717 if (0 > unlink (SDATA (encoded_file
)))
2718 report_file_error ("Removing old name", list1 (filename
));
2723 internal_delete_file_1 (ignore
)
2729 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2732 internal_delete_file (filename
)
2733 Lisp_Object filename
;
2736 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2737 Qt
, internal_delete_file_1
);
2741 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2742 "fRename file: \nGRename %s to file: \np",
2743 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2744 If file has names other than FILE, it continues to have those names.
2745 Signals a `file-already-exists' error if a file NEWNAME already exists
2746 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2747 A number as third arg means request confirmation if NEWNAME already exists.
2748 This is what happens in interactive use with M-x. */)
2749 (file
, newname
, ok_if_already_exists
)
2750 Lisp_Object file
, newname
, ok_if_already_exists
;
2752 Lisp_Object handler
;
2753 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2754 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2756 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2757 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2758 CHECK_STRING (file
);
2759 CHECK_STRING (newname
);
2760 file
= Fexpand_file_name (file
, Qnil
);
2762 if ((!NILP (Ffile_directory_p (newname
)))
2764 /* If the file names are identical but for the case,
2765 don't attempt to move directory to itself. */
2766 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2769 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2771 newname
= Fexpand_file_name (newname
, Qnil
);
2773 /* If the file name has special constructs in it,
2774 call the corresponding file handler. */
2775 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2777 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2778 if (!NILP (handler
))
2779 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2780 file
, newname
, ok_if_already_exists
));
2782 encoded_file
= ENCODE_FILE (file
);
2783 encoded_newname
= ENCODE_FILE (newname
);
2786 /* If the file names are identical but for the case, don't ask for
2787 confirmation: they simply want to change the letter-case of the
2789 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2791 if (NILP (ok_if_already_exists
)
2792 || INTEGERP (ok_if_already_exists
))
2793 barf_or_query_if_file_exists (newname
, "rename to it",
2794 INTEGERP (ok_if_already_exists
), 0, 0);
2796 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2798 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2799 || 0 > unlink (SDATA (encoded_file
)))
2805 symlink_target
= Ffile_symlink_p (file
);
2806 if (! NILP (symlink_target
))
2807 Fmake_symbolic_link (symlink_target
, newname
,
2808 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2811 Fcopy_file (file
, newname
,
2812 /* We have already prompted if it was an integer,
2813 so don't have copy-file prompt again. */
2814 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2817 Fdelete_file (file
);
2820 report_file_error ("Renaming", list2 (file
, newname
));
2826 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2827 "fAdd name to file: \nGName to add to %s: \np",
2828 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2829 Signals a `file-already-exists' error if a file NEWNAME already exists
2830 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2831 A number as third arg means request confirmation if NEWNAME already exists.
2832 This is what happens in interactive use with M-x. */)
2833 (file
, newname
, ok_if_already_exists
)
2834 Lisp_Object file
, newname
, ok_if_already_exists
;
2836 Lisp_Object handler
;
2837 Lisp_Object encoded_file
, encoded_newname
;
2838 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2840 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2841 encoded_file
= encoded_newname
= Qnil
;
2842 CHECK_STRING (file
);
2843 CHECK_STRING (newname
);
2844 file
= Fexpand_file_name (file
, Qnil
);
2846 if (!NILP (Ffile_directory_p (newname
)))
2847 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2849 newname
= Fexpand_file_name (newname
, Qnil
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2854 if (!NILP (handler
))
2855 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2856 newname
, ok_if_already_exists
));
2858 /* If the new name has special constructs in it,
2859 call the corresponding file handler. */
2860 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2861 if (!NILP (handler
))
2862 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2863 newname
, ok_if_already_exists
));
2865 encoded_file
= ENCODE_FILE (file
);
2866 encoded_newname
= ENCODE_FILE (newname
);
2868 if (NILP (ok_if_already_exists
)
2869 || INTEGERP (ok_if_already_exists
))
2870 barf_or_query_if_file_exists (newname
, "make it a new name",
2871 INTEGERP (ok_if_already_exists
), 0, 0);
2873 unlink (SDATA (newname
));
2874 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2875 report_file_error ("Adding new name", list2 (file
, newname
));
2882 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2883 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2884 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2885 Both args must be strings.
2886 Signals a `file-already-exists' error if a file LINKNAME already exists
2887 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2888 A number as third arg means request confirmation if LINKNAME already exists.
2889 This happens for interactive use with M-x. */)
2890 (filename
, linkname
, ok_if_already_exists
)
2891 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2893 Lisp_Object handler
;
2894 Lisp_Object encoded_filename
, encoded_linkname
;
2895 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2897 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2898 encoded_filename
= encoded_linkname
= Qnil
;
2899 CHECK_STRING (filename
);
2900 CHECK_STRING (linkname
);
2901 /* If the link target has a ~, we must expand it to get
2902 a truly valid file name. Otherwise, do not expand;
2903 we want to permit links to relative file names. */
2904 if (SREF (filename
, 0) == '~')
2905 filename
= Fexpand_file_name (filename
, Qnil
);
2907 if (!NILP (Ffile_directory_p (linkname
)))
2908 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2910 linkname
= Fexpand_file_name (linkname
, Qnil
);
2912 /* If the file name has special constructs in it,
2913 call the corresponding file handler. */
2914 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2915 if (!NILP (handler
))
2916 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2917 linkname
, ok_if_already_exists
));
2919 /* If the new link name has special constructs in it,
2920 call the corresponding file handler. */
2921 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2922 if (!NILP (handler
))
2923 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2924 linkname
, ok_if_already_exists
));
2926 encoded_filename
= ENCODE_FILE (filename
);
2927 encoded_linkname
= ENCODE_FILE (linkname
);
2929 if (NILP (ok_if_already_exists
)
2930 || INTEGERP (ok_if_already_exists
))
2931 barf_or_query_if_file_exists (linkname
, "make it a link",
2932 INTEGERP (ok_if_already_exists
), 0, 0);
2933 if (0 > symlink (SDATA (encoded_filename
),
2934 SDATA (encoded_linkname
)))
2936 /* If we didn't complain already, silently delete existing file. */
2937 if (errno
== EEXIST
)
2939 unlink (SDATA (encoded_linkname
));
2940 if (0 <= symlink (SDATA (encoded_filename
),
2941 SDATA (encoded_linkname
)))
2948 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2953 #endif /* S_IFLNK */
2957 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2958 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2959 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2960 If STRING is nil or a null string, the logical name NAME is deleted. */)
2965 CHECK_STRING (name
);
2967 delete_logical_name (SDATA (name
));
2970 CHECK_STRING (string
);
2972 if (SCHARS (string
) == 0)
2973 delete_logical_name (SDATA (name
));
2975 define_logical_name (SDATA (name
), SDATA (string
));
2984 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2985 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2987 Lisp_Object path
, login
;
2991 CHECK_STRING (path
);
2992 CHECK_STRING (login
);
2994 netresult
= netunam (SDATA (path
), SDATA (login
));
2996 if (netresult
== -1)
3001 #endif /* HPUX_NET */
3003 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3005 doc
: /* Return t if file FILENAME specifies an absolute file name.
3006 On Unix, this is a name starting with a `/' or a `~'. */)
3008 Lisp_Object filename
;
3010 CHECK_STRING (filename
);
3011 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3014 /* Return nonzero if file FILENAME exists and can be executed. */
3017 check_executable (filename
)
3021 int len
= strlen (filename
);
3024 if (stat (filename
, &st
) < 0)
3026 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3027 return ((st
.st_mode
& S_IEXEC
) != 0);
3029 return (S_ISREG (st
.st_mode
)
3031 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3032 || stricmp (suffix
, ".exe") == 0
3033 || stricmp (suffix
, ".bat") == 0)
3034 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3035 #endif /* not WINDOWSNT */
3036 #else /* not DOS_NT */
3037 #ifdef HAVE_EUIDACCESS
3038 return (euidaccess (filename
, 1) >= 0);
3040 /* Access isn't quite right because it uses the real uid
3041 and we really want to test with the effective uid.
3042 But Unix doesn't give us a right way to do it. */
3043 return (access (filename
, 1) >= 0);
3045 #endif /* not DOS_NT */
3048 /* Return nonzero if file FILENAME exists and can be written. */
3051 check_writable (filename
)
3056 if (stat (filename
, &st
) < 0)
3058 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3059 #else /* not MSDOS */
3060 #ifdef HAVE_EUIDACCESS
3061 return (euidaccess (filename
, 2) >= 0);
3063 /* Access isn't quite right because it uses the real uid
3064 and we really want to test with the effective uid.
3065 But Unix doesn't give us a right way to do it.
3066 Opening with O_WRONLY could work for an ordinary file,
3067 but would lose for directories. */
3068 return (access (filename
, 2) >= 0);
3070 #endif /* not MSDOS */
3073 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3074 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3075 See also `file-readable-p' and `file-attributes'.
3076 This returns nil for a symlink to a nonexistent file.
3077 Use `file-symlink-p' to test for such links. */)
3079 Lisp_Object filename
;
3081 Lisp_Object absname
;
3082 Lisp_Object handler
;
3083 struct stat statbuf
;
3085 CHECK_STRING (filename
);
3086 absname
= Fexpand_file_name (filename
, Qnil
);
3088 /* If the file name has special constructs in it,
3089 call the corresponding file handler. */
3090 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3091 if (!NILP (handler
))
3092 return call2 (handler
, Qfile_exists_p
, absname
);
3094 absname
= ENCODE_FILE (absname
);
3096 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3099 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3100 doc
: /* Return t if FILENAME can be executed by you.
3101 For a directory, this means you can access files in that directory. */)
3103 Lisp_Object filename
;
3105 Lisp_Object absname
;
3106 Lisp_Object handler
;
3108 CHECK_STRING (filename
);
3109 absname
= Fexpand_file_name (filename
, Qnil
);
3111 /* If the file name has special constructs in it,
3112 call the corresponding file handler. */
3113 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3114 if (!NILP (handler
))
3115 return call2 (handler
, Qfile_executable_p
, absname
);
3117 absname
= ENCODE_FILE (absname
);
3119 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3122 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3123 doc
: /* Return t if file FILENAME exists and you can read it.
3124 See also `file-exists-p' and `file-attributes'. */)
3126 Lisp_Object filename
;
3128 Lisp_Object absname
;
3129 Lisp_Object handler
;
3132 struct stat statbuf
;
3134 CHECK_STRING (filename
);
3135 absname
= Fexpand_file_name (filename
, Qnil
);
3137 /* If the file name has special constructs in it,
3138 call the corresponding file handler. */
3139 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3140 if (!NILP (handler
))
3141 return call2 (handler
, Qfile_readable_p
, absname
);
3143 absname
= ENCODE_FILE (absname
);
3145 #if defined(DOS_NT) || defined(macintosh)
3146 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3148 if (access (SDATA (absname
), 0) == 0)
3151 #else /* not DOS_NT and not macintosh */
3153 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3154 /* Opening a fifo without O_NONBLOCK can wait.
3155 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3156 except in the case of a fifo, on a system which handles it. */
3157 desc
= stat (SDATA (absname
), &statbuf
);
3160 if (S_ISFIFO (statbuf
.st_mode
))
3161 flags
|= O_NONBLOCK
;
3163 desc
= emacs_open (SDATA (absname
), flags
, 0);
3168 #endif /* not DOS_NT and not macintosh */
3171 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3173 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3174 doc
: /* Return t if file FILENAME can be written or created by you. */)
3176 Lisp_Object filename
;
3178 Lisp_Object absname
, dir
, encoded
;
3179 Lisp_Object handler
;
3180 struct stat statbuf
;
3182 CHECK_STRING (filename
);
3183 absname
= Fexpand_file_name (filename
, Qnil
);
3185 /* If the file name has special constructs in it,
3186 call the corresponding file handler. */
3187 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3188 if (!NILP (handler
))
3189 return call2 (handler
, Qfile_writable_p
, absname
);
3191 encoded
= ENCODE_FILE (absname
);
3192 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3193 return (check_writable (SDATA (encoded
))
3196 dir
= Ffile_name_directory (absname
);
3199 dir
= Fdirectory_file_name (dir
);
3203 dir
= Fdirectory_file_name (dir
);
3206 dir
= ENCODE_FILE (dir
);
3208 /* The read-only attribute of the parent directory doesn't affect
3209 whether a file or directory can be created within it. Some day we
3210 should check ACLs though, which do affect this. */
3211 if (stat (SDATA (dir
), &statbuf
) < 0)
3213 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3215 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3220 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3221 doc
: /* Access file FILENAME, and get an error if that does not work.
3222 The second argument STRING is used in the error message.
3223 If there is no error, returns nil. */)
3225 Lisp_Object filename
, string
;
3227 Lisp_Object handler
, encoded_filename
, absname
;
3230 CHECK_STRING (filename
);
3231 absname
= Fexpand_file_name (filename
, Qnil
);
3233 CHECK_STRING (string
);
3235 /* If the file name has special constructs in it,
3236 call the corresponding file handler. */
3237 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3238 if (!NILP (handler
))
3239 return call3 (handler
, Qaccess_file
, absname
, string
);
3241 encoded_filename
= ENCODE_FILE (absname
);
3243 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3245 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3251 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3252 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3253 The value is the link target, as a string.
3254 Otherwise it returns nil.
3256 This function returns t when given the name of a symlink that
3257 points to a nonexistent file. */)
3259 Lisp_Object filename
;
3261 Lisp_Object handler
;
3263 CHECK_STRING (filename
);
3264 filename
= Fexpand_file_name (filename
, Qnil
);
3266 /* If the file name has special constructs in it,
3267 call the corresponding file handler. */
3268 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3269 if (!NILP (handler
))
3270 return call2 (handler
, Qfile_symlink_p
, filename
);
3279 filename
= ENCODE_FILE (filename
);
3286 buf
= (char *) xrealloc (buf
, bufsize
);
3287 bzero (buf
, bufsize
);
3290 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3294 /* HP-UX reports ERANGE if buffer is too small. */
3295 if (errno
== ERANGE
)
3305 while (valsize
>= bufsize
);
3307 val
= make_string (buf
, valsize
);
3308 if (buf
[0] == '/' && index (buf
, ':'))
3309 val
= concat2 (build_string ("/:"), val
);
3311 val
= DECODE_FILE (val
);
3314 #else /* not S_IFLNK */
3316 #endif /* not S_IFLNK */
3319 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3320 doc
: /* Return t if FILENAME names an existing directory.
3321 Symbolic links to directories count as directories.
3322 See `file-symlink-p' to distinguish symlinks. */)
3324 Lisp_Object filename
;
3326 register Lisp_Object absname
;
3328 Lisp_Object handler
;
3330 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3332 /* If the file name has special constructs in it,
3333 call the corresponding file handler. */
3334 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3335 if (!NILP (handler
))
3336 return call2 (handler
, Qfile_directory_p
, absname
);
3338 absname
= ENCODE_FILE (absname
);
3340 if (stat (SDATA (absname
), &st
) < 0)
3342 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3345 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3346 doc
: /* Return t if file FILENAME names a directory you can open.
3347 For the value to be t, FILENAME must specify the name of a directory as a file,
3348 and the directory must allow you to open files in it. In order to use a
3349 directory as a buffer's current directory, this predicate must return true.
3350 A directory name spec may be given instead; then the value is t
3351 if the directory so specified exists and really is a readable and
3352 searchable directory. */)
3354 Lisp_Object filename
;
3356 Lisp_Object handler
;
3358 struct gcpro gcpro1
;
3360 /* If the file name has special constructs in it,
3361 call the corresponding file handler. */
3362 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3363 if (!NILP (handler
))
3364 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3367 tem
= (NILP (Ffile_directory_p (filename
))
3368 || NILP (Ffile_executable_p (filename
)));
3370 return tem
? Qnil
: Qt
;
3373 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3374 doc
: /* Return t if FILENAME names a regular file.
3375 This is the sort of file that holds an ordinary stream of data bytes.
3376 Symbolic links to regular files count as regular files.
3377 See `file-symlink-p' to distinguish symlinks. */)
3379 Lisp_Object filename
;
3381 register Lisp_Object absname
;
3383 Lisp_Object handler
;
3385 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3387 /* If the file name has special constructs in it,
3388 call the corresponding file handler. */
3389 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3390 if (!NILP (handler
))
3391 return call2 (handler
, Qfile_regular_p
, absname
);
3393 absname
= ENCODE_FILE (absname
);
3398 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3400 /* Tell stat to use expensive method to get accurate info. */
3401 Vw32_get_true_file_attributes
= Qt
;
3402 result
= stat (SDATA (absname
), &st
);
3403 Vw32_get_true_file_attributes
= tem
;
3407 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3410 if (stat (SDATA (absname
), &st
) < 0)
3412 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3416 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3417 doc
: /* Return mode bits of file named FILENAME, as an integer.
3418 Return nil, if file does not exist or is not accessible. */)
3420 Lisp_Object filename
;
3422 Lisp_Object absname
;
3424 Lisp_Object handler
;
3426 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3428 /* If the file name has special constructs in it,
3429 call the corresponding file handler. */
3430 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3431 if (!NILP (handler
))
3432 return call2 (handler
, Qfile_modes
, absname
);
3434 absname
= ENCODE_FILE (absname
);
3436 if (stat (SDATA (absname
), &st
) < 0)
3438 #if defined (MSDOS) && __DJGPP__ < 2
3439 if (check_executable (SDATA (absname
)))
3440 st
.st_mode
|= S_IEXEC
;
3441 #endif /* MSDOS && __DJGPP__ < 2 */
3443 return make_number (st
.st_mode
& 07777);
3446 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3447 "(let ((file (read-file-name \"File: \"))) \
3448 (list file (read-file-modes nil file)))",
3449 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3450 Only the 12 low bits of MODE are used. */)
3452 Lisp_Object filename
, mode
;
3454 Lisp_Object absname
, encoded_absname
;
3455 Lisp_Object handler
;
3457 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3458 CHECK_NUMBER (mode
);
3460 /* If the file name has special constructs in it,
3461 call the corresponding file handler. */
3462 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3463 if (!NILP (handler
))
3464 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3466 encoded_absname
= ENCODE_FILE (absname
);
3468 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3469 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3474 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3475 doc
: /* Set the file permission bits for newly created files.
3476 The argument MODE should be an integer; only the low 9 bits are used.
3477 This setting is inherited by subprocesses. */)
3481 CHECK_NUMBER (mode
);
3483 umask ((~ XINT (mode
)) & 0777);
3488 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3489 doc
: /* Return the default file protection for created files.
3490 The value is an integer. */)
3496 realmask
= umask (0);
3499 XSETINT (value
, (~ realmask
) & 0777);
3503 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3505 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3506 doc
: /* Set times of file FILENAME to TIME.
3507 Set both access and modification times.
3508 Return t on success, else nil.
3509 Use the current time if TIME is nil. TIME is in the format of
3512 Lisp_Object filename
, time
;
3514 Lisp_Object absname
, encoded_absname
;
3515 Lisp_Object handler
;
3519 if (! lisp_time_argument (time
, &sec
, &usec
))
3520 error ("Invalid time specification");
3522 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3524 /* If the file name has special constructs in it,
3525 call the corresponding file handler. */
3526 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3527 if (!NILP (handler
))
3528 return call3 (handler
, Qset_file_times
, absname
, time
);
3530 encoded_absname
= ENCODE_FILE (absname
);
3535 EMACS_SET_SECS (t
, sec
);
3536 EMACS_SET_USECS (t
, usec
);
3538 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3543 /* Setting times on a directory always fails. */
3544 if (stat (SDATA (encoded_absname
), &st
) == 0
3545 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3548 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3557 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3558 doc
: /* Tell Unix to finish all pending disk updates. */)
3565 #endif /* HAVE_SYNC */
3567 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3568 doc
: /* Return t if file FILE1 is newer than file FILE2.
3569 If FILE1 does not exist, the answer is nil;
3570 otherwise, if FILE2 does not exist, the answer is t. */)
3572 Lisp_Object file1
, file2
;
3574 Lisp_Object absname1
, absname2
;
3577 Lisp_Object handler
;
3578 struct gcpro gcpro1
, gcpro2
;
3580 CHECK_STRING (file1
);
3581 CHECK_STRING (file2
);
3584 GCPRO2 (absname1
, file2
);
3585 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3586 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3589 /* If the file name has special constructs in it,
3590 call the corresponding file handler. */
3591 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3593 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3594 if (!NILP (handler
))
3595 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3597 GCPRO2 (absname1
, absname2
);
3598 absname1
= ENCODE_FILE (absname1
);
3599 absname2
= ENCODE_FILE (absname2
);
3602 if (stat (SDATA (absname1
), &st
) < 0)
3605 mtime1
= st
.st_mtime
;
3607 if (stat (SDATA (absname2
), &st
) < 0)
3610 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3614 Lisp_Object Qfind_buffer_file_type
;
3617 #ifndef READ_BUF_SIZE
3618 #define READ_BUF_SIZE (64 << 10)
3621 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3623 /* This function is called after Lisp functions to decide a coding
3624 system are called, or when they cause an error. Before they are
3625 called, the current buffer is set unibyte and it contains only a
3626 newly inserted text (thus the buffer was empty before the
3629 The functions may set markers, overlays, text properties, or even
3630 alter the buffer contents, change the current buffer.
3632 Here, we reset all those changes by:
3633 o set back the current buffer.
3634 o move all markers and overlays to BEG.
3635 o remove all text properties.
3636 o set back the buffer multibyteness. */
3639 decide_coding_unwind (unwind_data
)
3640 Lisp_Object unwind_data
;
3642 Lisp_Object multibyte
, undo_list
, buffer
;
3644 multibyte
= XCAR (unwind_data
);
3645 unwind_data
= XCDR (unwind_data
);
3646 undo_list
= XCAR (unwind_data
);
3647 buffer
= XCDR (unwind_data
);
3649 if (current_buffer
!= XBUFFER (buffer
))
3650 set_buffer_internal (XBUFFER (buffer
));
3651 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3652 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3653 BUF_INTERVALS (current_buffer
) = 0;
3654 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3656 /* Now we are safe to change the buffer's multibyteness directly. */
3657 current_buffer
->enable_multibyte_characters
= multibyte
;
3658 current_buffer
->undo_list
= undo_list
;
3664 /* Used to pass values from insert-file-contents to read_non_regular. */
3666 static int non_regular_fd
;
3667 static int non_regular_inserted
;
3668 static int non_regular_nbytes
;
3671 /* Read from a non-regular file.
3672 Read non_regular_trytry bytes max from non_regular_fd.
3673 Non_regular_inserted specifies where to put the read bytes.
3674 Value is the number of bytes read. */
3683 nbytes
= emacs_read (non_regular_fd
,
3684 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3685 non_regular_nbytes
);
3687 return make_number (nbytes
);
3691 /* Condition-case handler used when reading from non-regular files
3692 in insert-file-contents. */
3695 read_non_regular_quit ()
3701 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3703 doc
: /* Insert contents of file FILENAME after point.
3704 Returns list of absolute file name and number of characters inserted.
3705 If second argument VISIT is non-nil, the buffer's visited filename and
3706 last save file modtime are set, and it is marked unmodified. If
3707 visiting and the file does not exist, visiting is completed before the
3710 The optional third and fourth arguments BEG and END specify what portion
3711 of the file to insert. These arguments count bytes in the file, not
3712 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3714 If optional fifth argument REPLACE is non-nil, replace the current
3715 buffer contents (in the accessible portion) with the file contents.
3716 This is better than simply deleting and inserting the whole thing
3717 because (1) it preserves some marker positions and (2) it puts less data
3718 in the undo list. When REPLACE is non-nil, the second return value is
3719 the number of characters that replace previous buffer contents.
3721 This function does code conversion according to the value of
3722 `coding-system-for-read' or `file-coding-system-alist', and sets the
3723 variable `last-coding-system-used' to the coding system actually used. */)
3724 (filename
, visit
, beg
, end
, replace
)
3725 Lisp_Object filename
, visit
, beg
, end
, replace
;
3731 register int how_much
;
3732 register int unprocessed
;
3733 int count
= SPECPDL_INDEX ();
3734 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3735 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3738 int not_regular
= 0;
3739 unsigned char read_buf
[READ_BUF_SIZE
];
3740 struct coding_system coding
;
3741 unsigned char buffer
[1 << 14];
3742 int replace_handled
= 0;
3743 int set_coding_system
= 0;
3744 Lisp_Object coding_system
;
3746 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3747 int we_locked_file
= 0;
3749 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3750 error ("Cannot do file visiting in an indirect buffer");
3752 if (!NILP (current_buffer
->read_only
))
3753 Fbarf_if_buffer_read_only ();
3757 orig_filename
= Qnil
;
3760 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3762 CHECK_STRING (filename
);
3763 filename
= Fexpand_file_name (filename
, Qnil
);
3765 /* The value Qnil means that the coding system is not yet
3767 coding_system
= Qnil
;
3769 /* If the file name has special constructs in it,
3770 call the corresponding file handler. */
3771 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3772 if (!NILP (handler
))
3774 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3775 visit
, beg
, end
, replace
);
3776 if (CONSP (val
) && CONSP (XCDR (val
)))
3777 inserted
= XINT (XCAR (XCDR (val
)));
3781 orig_filename
= filename
;
3782 filename
= ENCODE_FILE (filename
);
3788 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3790 /* Tell stat to use expensive method to get accurate info. */
3791 Vw32_get_true_file_attributes
= Qt
;
3792 total
= stat (SDATA (filename
), &st
);
3793 Vw32_get_true_file_attributes
= tem
;
3797 if (stat (SDATA (filename
), &st
) < 0)
3798 #endif /* WINDOWSNT */
3800 if (fd
>= 0) emacs_close (fd
);
3803 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3806 if (!NILP (Vcoding_system_for_read
))
3807 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3812 /* This code will need to be changed in order to work on named
3813 pipes, and it's probably just not worth it. So we should at
3814 least signal an error. */
3815 if (!S_ISREG (st
.st_mode
))
3822 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3823 xsignal2 (Qfile_error
,
3824 build_string ("not a regular file"), orig_filename
);
3829 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3832 /* Replacement should preserve point as it preserves markers. */
3833 if (!NILP (replace
))
3834 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3836 record_unwind_protect (close_file_unwind
, make_number (fd
));
3838 /* Supposedly happens on VMS. */
3839 /* Can happen on any platform that uses long as type of off_t, but allows
3840 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3841 give a message suitable for the latter case. */
3842 if (! not_regular
&& st
.st_size
< 0)
3843 error ("Maximum buffer size exceeded");
3845 /* Prevent redisplay optimizations. */
3846 current_buffer
->clip_changed
= 1;
3850 if (!NILP (beg
) || !NILP (end
))
3851 error ("Attempt to visit less than an entire file");
3852 if (BEG
< Z
&& NILP (replace
))
3853 error ("Cannot do file visiting in a non-empty buffer");
3859 XSETFASTINT (beg
, 0);
3867 XSETINT (end
, st
.st_size
);
3869 /* Arithmetic overflow can occur if an Emacs integer cannot
3870 represent the file size, or if the calculations below
3871 overflow. The calculations below double the file size
3872 twice, so check that it can be multiplied by 4 safely. */
3873 if (XINT (end
) != st
.st_size
3874 || st
.st_size
> INT_MAX
/ 4)
3875 error ("Maximum buffer size exceeded");
3877 /* The file size returned from stat may be zero, but data
3878 may be readable nonetheless, for example when this is a
3879 file in the /proc filesystem. */
3880 if (st
.st_size
== 0)
3881 XSETINT (end
, READ_BUF_SIZE
);
3885 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3887 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3888 setup_coding_system (coding_system
, &coding
);
3889 /* Ensure we set Vlast_coding_system_used. */
3890 set_coding_system
= 1;
3894 /* Decide the coding system to use for reading the file now
3895 because we can't use an optimized method for handling
3896 `coding:' tag if the current buffer is not empty. */
3897 if (!NILP (Vcoding_system_for_read
))
3898 coding_system
= Vcoding_system_for_read
;
3901 /* Don't try looking inside a file for a coding system
3902 specification if it is not seekable. */
3903 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3905 /* Find a coding system specified in the heading two
3906 lines or in the tailing several lines of the file.
3907 We assume that the 1K-byte and 3K-byte for heading
3908 and tailing respectively are sufficient for this
3912 if (st
.st_size
<= (1024 * 4))
3913 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3916 nread
= emacs_read (fd
, read_buf
, 1024);
3919 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3920 report_file_error ("Setting file position",
3921 Fcons (orig_filename
, Qnil
));
3922 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3927 error ("IO error reading %s: %s",
3928 SDATA (orig_filename
), emacs_strerror (errno
));
3931 struct buffer
*prev
= current_buffer
;
3935 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3937 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3938 buf
= XBUFFER (buffer
);
3940 delete_all_overlays (buf
);
3941 buf
->directory
= current_buffer
->directory
;
3942 buf
->read_only
= Qnil
;
3943 buf
->filename
= Qnil
;
3944 buf
->undo_list
= Qt
;
3945 eassert (buf
->overlays_before
== NULL
);
3946 eassert (buf
->overlays_after
== NULL
);
3948 set_buffer_internal (buf
);
3950 buf
->enable_multibyte_characters
= Qnil
;
3952 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3953 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3954 coding_system
= call2 (Vset_auto_coding_function
,
3955 filename
, make_number (nread
));
3956 set_buffer_internal (prev
);
3958 /* Discard the unwind protect for recovering the
3962 /* Rewind the file for the actual read done later. */
3963 if (lseek (fd
, 0, 0) < 0)
3964 report_file_error ("Setting file position",
3965 Fcons (orig_filename
, Qnil
));
3969 if (NILP (coding_system
))
3971 /* If we have not yet decided a coding system, check
3972 file-coding-system-alist. */
3973 Lisp_Object args
[6];
3975 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3976 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3977 coding_system
= Ffind_operation_coding_system (6, args
);
3978 if (CONSP (coding_system
))
3979 coding_system
= XCAR (coding_system
);
3983 if (NILP (coding_system
))
3984 coding_system
= Qundecided
;
3986 CHECK_CODING_SYSTEM (coding_system
);
3988 if (NILP (current_buffer
->enable_multibyte_characters
))
3989 /* We must suppress all character code conversion except for
3990 end-of-line conversion. */
3991 coding_system
= raw_text_coding_system (coding_system
);
3993 setup_coding_system (coding_system
, &coding
);
3994 /* Ensure we set Vlast_coding_system_used. */
3995 set_coding_system
= 1;
3998 /* If requested, replace the accessible part of the buffer
3999 with the file contents. Avoid replacing text at the
4000 beginning or end of the buffer that matches the file contents;
4001 that preserves markers pointing to the unchanged parts.
4003 Here we implement this feature in an optimized way
4004 for the case where code conversion is NOT needed.
4005 The following if-statement handles the case of conversion
4006 in a less optimal way.
4008 If the code conversion is "automatic" then we try using this
4009 method and hope for the best.
4010 But if we discover the need for conversion, we give up on this method
4011 and let the following if-statement handle the replace job. */
4014 && (NILP (coding_system
)
4015 || ! CODING_REQUIRE_DECODING (&coding
)))
4017 /* same_at_start and same_at_end count bytes,
4018 because file access counts bytes
4019 and BEG and END count bytes. */
4020 int same_at_start
= BEGV_BYTE
;
4021 int same_at_end
= ZV_BYTE
;
4023 /* There is still a possibility we will find the need to do code
4024 conversion. If that happens, we set this variable to 1 to
4025 give up on handling REPLACE in the optimized way. */
4026 int giveup_match_end
= 0;
4028 if (XINT (beg
) != 0)
4030 if (lseek (fd
, XINT (beg
), 0) < 0)
4031 report_file_error ("Setting file position",
4032 Fcons (orig_filename
, Qnil
));
4037 /* Count how many chars at the start of the file
4038 match the text at the beginning of the buffer. */
4043 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4045 error ("IO error reading %s: %s",
4046 SDATA (orig_filename
), emacs_strerror (errno
));
4047 else if (nread
== 0)
4050 if (CODING_REQUIRE_DETECTION (&coding
))
4052 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4054 setup_coding_system (coding_system
, &coding
);
4057 if (CODING_REQUIRE_DECODING (&coding
))
4058 /* We found that the file should be decoded somehow.
4059 Let's give up here. */
4061 giveup_match_end
= 1;
4066 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4067 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4068 same_at_start
++, bufpos
++;
4069 /* If we found a discrepancy, stop the scan.
4070 Otherwise loop around and scan the next bufferful. */
4071 if (bufpos
!= nread
)
4075 /* If the file matches the buffer completely,
4076 there's no need to replace anything. */
4077 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4081 /* Truncate the buffer to the size of the file. */
4082 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4087 /* Count how many chars at the end of the file
4088 match the text at the end of the buffer. But, if we have
4089 already found that decoding is necessary, don't waste time. */
4090 while (!giveup_match_end
)
4092 int total_read
, nread
, bufpos
, curpos
, trial
;
4094 /* At what file position are we now scanning? */
4095 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4096 /* If the entire file matches the buffer tail, stop the scan. */
4099 /* How much can we scan in the next step? */
4100 trial
= min (curpos
, sizeof buffer
);
4101 if (lseek (fd
, curpos
- trial
, 0) < 0)
4102 report_file_error ("Setting file position",
4103 Fcons (orig_filename
, Qnil
));
4105 total_read
= nread
= 0;
4106 while (total_read
< trial
)
4108 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4110 error ("IO error reading %s: %s",
4111 SDATA (orig_filename
), emacs_strerror (errno
));
4112 else if (nread
== 0)
4114 total_read
+= nread
;
4117 /* Scan this bufferful from the end, comparing with
4118 the Emacs buffer. */
4119 bufpos
= total_read
;
4121 /* Compare with same_at_start to avoid counting some buffer text
4122 as matching both at the file's beginning and at the end. */
4123 while (bufpos
> 0 && same_at_end
> same_at_start
4124 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4125 same_at_end
--, bufpos
--;
4127 /* If we found a discrepancy, stop the scan.
4128 Otherwise loop around and scan the preceding bufferful. */
4131 /* If this discrepancy is because of code conversion,
4132 we cannot use this method; giveup and try the other. */
4133 if (same_at_end
> same_at_start
4134 && FETCH_BYTE (same_at_end
- 1) >= 0200
4135 && ! NILP (current_buffer
->enable_multibyte_characters
)
4136 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4137 giveup_match_end
= 1;
4146 if (! giveup_match_end
)
4150 /* We win! We can handle REPLACE the optimized way. */
4152 /* Extend the start of non-matching text area to multibyte
4153 character boundary. */
4154 if (! NILP (current_buffer
->enable_multibyte_characters
))
4155 while (same_at_start
> BEGV_BYTE
4156 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4159 /* Extend the end of non-matching text area to multibyte
4160 character boundary. */
4161 if (! NILP (current_buffer
->enable_multibyte_characters
))
4162 while (same_at_end
< ZV_BYTE
4163 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4166 /* Don't try to reuse the same piece of text twice. */
4167 overlap
= (same_at_start
- BEGV_BYTE
4168 - (same_at_end
+ st
.st_size
- ZV
));
4170 same_at_end
+= overlap
;
4172 /* Arrange to read only the nonmatching middle part of the file. */
4173 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4174 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4176 del_range_byte (same_at_start
, same_at_end
, 0);
4177 /* Insert from the file at the proper position. */
4178 temp
= BYTE_TO_CHAR (same_at_start
);
4179 SET_PT_BOTH (temp
, same_at_start
);
4181 /* If display currently starts at beginning of line,
4182 keep it that way. */
4183 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4184 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4186 replace_handled
= 1;
4190 /* If requested, replace the accessible part of the buffer
4191 with the file contents. Avoid replacing text at the
4192 beginning or end of the buffer that matches the file contents;
4193 that preserves markers pointing to the unchanged parts.
4195 Here we implement this feature for the case where code conversion
4196 is needed, in a simple way that needs a lot of memory.
4197 The preceding if-statement handles the case of no conversion
4198 in a more optimized way. */
4199 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4201 EMACS_INT same_at_start
= BEGV_BYTE
;
4202 EMACS_INT same_at_end
= ZV_BYTE
;
4203 EMACS_INT same_at_start_charpos
;
4204 EMACS_INT inserted_chars
;
4207 unsigned char *decoded
;
4209 int this_count
= SPECPDL_INDEX ();
4210 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4211 Lisp_Object conversion_buffer
;
4213 conversion_buffer
= code_conversion_save (1, multibyte
);
4215 /* First read the whole file, performing code conversion into
4216 CONVERSION_BUFFER. */
4218 if (lseek (fd
, XINT (beg
), 0) < 0)
4219 report_file_error ("Setting file position",
4220 Fcons (orig_filename
, Qnil
));
4222 total
= st
.st_size
; /* Total bytes in the file. */
4223 how_much
= 0; /* Bytes read from file so far. */
4224 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4225 unprocessed
= 0; /* Bytes not processed in previous loop. */
4227 GCPRO1 (conversion_buffer
);
4228 while (how_much
< total
)
4230 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4231 quitting while reading a huge while. */
4232 /* try is reserved in some compilers (Microsoft C) */
4233 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4236 /* Allow quitting out of the actual I/O. */
4239 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4251 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
4252 BUF_Z (XBUFFER (conversion_buffer
)));
4253 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4255 unprocessed
= coding
.carryover_bytes
;
4256 if (coding
.carryover_bytes
> 0)
4257 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4262 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4263 if we couldn't read the file. */
4266 error ("IO error reading %s: %s",
4267 SDATA (orig_filename
), emacs_strerror (errno
));
4269 if (unprocessed
> 0)
4271 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4272 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4274 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4277 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4278 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4279 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4281 /* Compare the beginning of the converted string with the buffer
4285 while (bufpos
< inserted
&& same_at_start
< same_at_end
4286 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4287 same_at_start
++, bufpos
++;
4289 /* If the file matches the head of buffer completely,
4290 there's no need to replace anything. */
4292 if (bufpos
== inserted
)
4295 /* Truncate the buffer to the size of the file. */
4296 if (same_at_start
== same_at_end
)
4299 del_range_byte (same_at_start
, same_at_end
, 0);
4302 unbind_to (this_count
, Qnil
);
4306 /* Extend the start of non-matching text area to the previous
4307 multibyte character boundary. */
4308 if (! NILP (current_buffer
->enable_multibyte_characters
))
4309 while (same_at_start
> BEGV_BYTE
4310 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4313 /* Scan this bufferful from the end, comparing with
4314 the Emacs buffer. */
4317 /* Compare with same_at_start to avoid counting some buffer text
4318 as matching both at the file's beginning and at the end. */
4319 while (bufpos
> 0 && same_at_end
> same_at_start
4320 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4321 same_at_end
--, bufpos
--;
4323 /* Extend the end of non-matching text area to the next
4324 multibyte character boundary. */
4325 if (! NILP (current_buffer
->enable_multibyte_characters
))
4326 while (same_at_end
< ZV_BYTE
4327 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4330 /* Don't try to reuse the same piece of text twice. */
4331 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4333 same_at_end
+= overlap
;
4335 /* If display currently starts at beginning of line,
4336 keep it that way. */
4337 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4338 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4340 /* Replace the chars that we need to replace,
4341 and update INSERTED to equal the number of bytes
4342 we are taking from the decoded string. */
4343 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4345 if (same_at_end
!= same_at_start
)
4347 del_range_byte (same_at_start
, same_at_end
, 0);
4349 same_at_start
= GPT_BYTE
;
4353 temp
= BYTE_TO_CHAR (same_at_start
);
4355 /* Insert from the file at the proper position. */
4356 SET_PT_BOTH (temp
, same_at_start
);
4357 same_at_start_charpos
4358 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4359 same_at_start
- BEGV_BYTE
4360 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4362 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4363 same_at_start
+ inserted
- BEGV_BYTE
4364 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4365 - same_at_start_charpos
);
4366 /* This binding is to avoid ask-user-about-supersession-threat
4367 being called in insert_from_buffer (via in
4368 prepare_to_modify_buffer). */
4369 specbind (intern ("buffer-file-name"), Qnil
);
4370 insert_from_buffer (XBUFFER (conversion_buffer
),
4371 same_at_start_charpos
, inserted_chars
, 0);
4372 /* Set `inserted' to the number of inserted characters. */
4373 inserted
= PT
- temp
;
4374 /* Set point before the inserted characters. */
4375 SET_PT_BOTH (temp
, same_at_start
);
4377 unbind_to (this_count
, Qnil
);
4384 register Lisp_Object temp
;
4386 total
= XINT (end
) - XINT (beg
);
4388 /* Make sure point-max won't overflow after this insertion. */
4389 XSETINT (temp
, total
);
4390 if (total
!= XINT (temp
))
4391 error ("Maximum buffer size exceeded");
4394 /* For a special file, all we can do is guess. */
4395 total
= READ_BUF_SIZE
;
4397 if (NILP (visit
) && inserted
> 0)
4399 #ifdef CLASH_DETECTION
4400 if (!NILP (current_buffer
->file_truename
)
4401 /* Make binding buffer-file-name to nil effective. */
4402 && !NILP (current_buffer
->filename
)
4403 && SAVE_MODIFF
>= MODIFF
)
4405 #endif /* CLASH_DETECTION */
4406 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4410 if (GAP_SIZE
< total
)
4411 make_gap (total
- GAP_SIZE
);
4413 if (XINT (beg
) != 0 || !NILP (replace
))
4415 if (lseek (fd
, XINT (beg
), 0) < 0)
4416 report_file_error ("Setting file position",
4417 Fcons (orig_filename
, Qnil
));
4420 /* In the following loop, HOW_MUCH contains the total bytes read so
4421 far for a regular file, and not changed for a special file. But,
4422 before exiting the loop, it is set to a negative value if I/O
4426 /* Total bytes inserted. */
4429 /* Here, we don't do code conversion in the loop. It is done by
4430 decode_coding_gap after all data are read into the buffer. */
4432 int gap_size
= GAP_SIZE
;
4434 while (how_much
< total
)
4436 /* try is reserved in some compilers (Microsoft C) */
4437 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4444 /* Maybe make more room. */
4445 if (gap_size
< trytry
)
4447 make_gap (total
- gap_size
);
4448 gap_size
= GAP_SIZE
;
4451 /* Read from the file, capturing `quit'. When an
4452 error occurs, end the loop, and arrange for a quit
4453 to be signaled after decoding the text we read. */
4454 non_regular_fd
= fd
;
4455 non_regular_inserted
= inserted
;
4456 non_regular_nbytes
= trytry
;
4457 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4458 read_non_regular_quit
);
4469 /* Allow quitting out of the actual I/O. We don't make text
4470 part of the buffer until all the reading is done, so a C-g
4471 here doesn't do any harm. */
4474 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4486 /* For a regular file, where TOTAL is the real size,
4487 count HOW_MUCH to compare with it.
4488 For a special file, where TOTAL is just a buffer size,
4489 so don't bother counting in HOW_MUCH.
4490 (INSERTED is where we count the number of characters inserted.) */
4497 /* Now we have read all the file data into the gap.
4498 If it was empty, undo marking the buffer modified. */
4502 #ifdef CLASH_DETECTION
4504 unlock_file (current_buffer
->file_truename
);
4506 Vdeactivate_mark
= old_Vdeactivate_mark
;
4509 Vdeactivate_mark
= Qt
;
4511 /* Make the text read part of the buffer. */
4512 GAP_SIZE
-= inserted
;
4514 GPT_BYTE
+= inserted
;
4516 ZV_BYTE
+= inserted
;
4521 /* Put an anchor to ensure multi-byte form ends at gap. */
4526 /* Discard the unwind protect for closing the file. */
4530 error ("IO error reading %s: %s",
4531 SDATA (orig_filename
), emacs_strerror (errno
));
4535 if (NILP (coding_system
))
4537 /* The coding system is not yet decided. Decide it by an
4538 optimized method for handling `coding:' tag.
4540 Note that we can get here only if the buffer was empty
4541 before the insertion. */
4543 if (!NILP (Vcoding_system_for_read
))
4544 coding_system
= Vcoding_system_for_read
;
4547 /* Since we are sure that the current buffer was empty
4548 before the insertion, we can toggle
4549 enable-multibyte-characters directly here without taking
4550 care of marker adjustment. By this way, we can run Lisp
4551 program safely before decoding the inserted text. */
4552 Lisp_Object unwind_data
;
4553 int count
= SPECPDL_INDEX ();
4555 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4556 Fcons (current_buffer
->undo_list
,
4557 Fcurrent_buffer ()));
4558 current_buffer
->enable_multibyte_characters
= Qnil
;
4559 current_buffer
->undo_list
= Qt
;
4560 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4562 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4564 coding_system
= call2 (Vset_auto_coding_function
,
4565 filename
, make_number (inserted
));
4568 if (NILP (coding_system
))
4570 /* If the coding system is not yet decided, check
4571 file-coding-system-alist. */
4572 Lisp_Object args
[6];
4574 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4575 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4576 coding_system
= Ffind_operation_coding_system (6, args
);
4577 if (CONSP (coding_system
))
4578 coding_system
= XCAR (coding_system
);
4580 unbind_to (count
, Qnil
);
4581 inserted
= Z_BYTE
- BEG_BYTE
;
4584 if (NILP (coding_system
))
4585 coding_system
= Qundecided
;
4587 CHECK_CODING_SYSTEM (coding_system
);
4589 if (NILP (current_buffer
->enable_multibyte_characters
))
4590 /* We must suppress all character code conversion except for
4591 end-of-line conversion. */
4592 coding_system
= raw_text_coding_system (coding_system
);
4593 setup_coding_system (coding_system
, &coding
);
4594 /* Ensure we set Vlast_coding_system_used. */
4595 set_coding_system
= 1;
4600 /* When we visit a file by raw-text, we change the buffer to
4602 if (CODING_FOR_UNIBYTE (&coding
)
4603 /* Can't do this if part of the buffer might be preserved. */
4605 /* Visiting a file with these coding system makes the buffer
4607 current_buffer
->enable_multibyte_characters
= Qnil
;
4610 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4611 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4612 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4614 move_gap_both (PT
, PT_BYTE
);
4615 GAP_SIZE
+= inserted
;
4616 ZV_BYTE
-= inserted
;
4620 decode_coding_gap (&coding
, inserted
, inserted
);
4621 inserted
= coding
.produced_char
;
4622 coding_system
= CODING_ID_NAME (coding
.id
);
4624 else if (inserted
> 0)
4625 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4628 /* Now INSERTED is measured in characters. */
4631 /* Use the conversion type to determine buffer-file-type
4632 (find-buffer-file-type is now used to help determine the
4634 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4635 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4636 && ! CODING_REQUIRE_DECODING (&coding
))
4637 current_buffer
->buffer_file_type
= Qt
;
4639 current_buffer
->buffer_file_type
= Qnil
;
4646 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4647 current_buffer
->undo_list
= Qnil
;
4651 current_buffer
->modtime
= st
.st_mtime
;
4652 current_buffer
->filename
= orig_filename
;
4655 SAVE_MODIFF
= MODIFF
;
4656 current_buffer
->auto_save_modified
= MODIFF
;
4657 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4658 #ifdef CLASH_DETECTION
4661 if (!NILP (current_buffer
->file_truename
))
4662 unlock_file (current_buffer
->file_truename
);
4663 unlock_file (filename
);
4665 #endif /* CLASH_DETECTION */
4667 xsignal2 (Qfile_error
,
4668 build_string ("not a regular file"), orig_filename
);
4671 if (set_coding_system
)
4672 Vlast_coding_system_used
= coding_system
;
4674 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4676 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4678 if (! NILP (insval
))
4680 CHECK_NUMBER (insval
);
4681 inserted
= XFASTINT (insval
);
4685 /* Decode file format */
4688 /* Don't run point motion or modification hooks when decoding. */
4689 int count
= SPECPDL_INDEX ();
4690 specbind (Qinhibit_point_motion_hooks
, Qt
);
4691 specbind (Qinhibit_modification_hooks
, Qt
);
4693 /* Save old undo list and don't record undo for decoding. */
4694 old_undo
= current_buffer
->undo_list
;
4695 current_buffer
->undo_list
= Qt
;
4699 insval
= call3 (Qformat_decode
,
4700 Qnil
, make_number (inserted
), visit
);
4701 CHECK_NUMBER (insval
);
4702 inserted
= XFASTINT (insval
);
4706 /* If REPLACE is non-nil and we succeeded in not replacing the
4707 beginning or end of the buffer text with the file's contents,
4708 call format-decode with `point' positioned at the beginning of
4709 the buffer and `inserted' equalling the number of characters
4710 in the buffer. Otherwise, format-decode might fail to
4711 correctly analyze the beginning or end of the buffer. Hence
4712 we temporarily save `point' and `inserted' here and restore
4713 `point' iff format-decode did not insert or delete any text.
4714 Otherwise we leave `point' at point-min. */
4716 int opoint_byte
= PT_BYTE
;
4717 int oinserted
= ZV
- BEGV
;
4718 int ochars_modiff
= CHARS_MODIFF
;
4720 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4721 insval
= call3 (Qformat_decode
,
4722 Qnil
, make_number (oinserted
), visit
);
4723 CHECK_NUMBER (insval
);
4724 if (ochars_modiff
== CHARS_MODIFF
)
4725 /* format_decode didn't modify buffer's characters => move
4726 point back to position before inserted text and leave
4727 value of inserted alone. */
4728 SET_PT_BOTH (opoint
, opoint_byte
);
4730 /* format_decode modified buffer's characters => consider
4731 entire buffer changed and leave point at point-min. */
4732 inserted
= XFASTINT (insval
);
4735 /* For consistency with format-decode call these now iff inserted > 0
4736 (martin 2007-06-28) */
4737 p
= Vafter_insert_file_functions
;
4742 insval
= call1 (XCAR (p
), make_number (inserted
));
4745 CHECK_NUMBER (insval
);
4746 inserted
= XFASTINT (insval
);
4751 /* For the rationale of this see the comment on format-decode above. */
4753 int opoint_byte
= PT_BYTE
;
4754 int oinserted
= ZV
- BEGV
;
4755 int ochars_modiff
= CHARS_MODIFF
;
4757 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4758 insval
= call1 (XCAR (p
), make_number (oinserted
));
4761 CHECK_NUMBER (insval
);
4762 if (ochars_modiff
== CHARS_MODIFF
)
4763 /* after_insert_file_functions didn't modify
4764 buffer's characters => move point back to
4765 position before inserted text and leave value of
4767 SET_PT_BOTH (opoint
, opoint_byte
);
4769 /* after_insert_file_functions did modify buffer's
4770 characters => consider entire buffer changed and
4771 leave point at point-min. */
4772 inserted
= XFASTINT (insval
);
4782 Lisp_Object lbeg
, lend
;
4784 XSETINT (lend
, PT
+ inserted
);
4785 if (CONSP (old_undo
))
4787 Lisp_Object tem
= XCAR (old_undo
);
4788 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4789 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4790 /* In the non-visiting case record only the final insertion. */
4791 current_buffer
->undo_list
=
4792 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4796 /* If undo_list was Qt before, keep it that way.
4797 Otherwise start with an empty undo_list. */
4798 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4800 unbind_to (count
, Qnil
);
4803 /* Call after-change hooks for the inserted text, aside from the case
4804 of normal visiting (not with REPLACE), which is done in a new buffer
4805 "before" the buffer is changed. */
4806 if (inserted
> 0 && total
> 0
4807 && (NILP (visit
) || !NILP (replace
)))
4809 signal_after_change (PT
, 0, inserted
);
4810 update_compositions (PT
, PT
, CHECK_BORDER
);
4814 && current_buffer
->modtime
== -1)
4816 /* If visiting nonexistent file, return nil. */
4817 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4821 Fsignal (Qquit
, Qnil
);
4823 /* ??? Retval needs to be dealt with in all cases consistently. */
4825 val
= Fcons (orig_filename
,
4826 Fcons (make_number (inserted
),
4829 RETURN_UNGCPRO (unbind_to (count
, val
));
4832 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4834 /* If build_annotations switched buffers, switch back to BUF.
4835 Kill the temporary buffer that was selected in the meantime.
4837 Since this kill only the last temporary buffer, some buffers remain
4838 not killed if build_annotations switched buffers more than once.
4842 build_annotations_unwind (buf
)
4847 if (XBUFFER (buf
) == current_buffer
)
4849 tembuf
= Fcurrent_buffer ();
4851 Fkill_buffer (tembuf
);
4855 /* Decide the coding-system to encode the data with. */
4858 choose_write_coding_system (start
, end
, filename
,
4859 append
, visit
, lockname
, coding
)
4860 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4861 struct coding_system
*coding
;
4864 Lisp_Object eol_parent
= Qnil
;
4867 && NILP (Fstring_equal (current_buffer
->filename
,
4868 current_buffer
->auto_save_file_name
)))
4873 else if (!NILP (Vcoding_system_for_write
))
4875 val
= Vcoding_system_for_write
;
4876 if (coding_system_require_warning
4877 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4878 /* Confirm that VAL can surely encode the current region. */
4879 val
= call5 (Vselect_safe_coding_system_function
,
4880 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4885 /* If the variable `buffer-file-coding-system' is set locally,
4886 it means that the file was read with some kind of code
4887 conversion or the variable is explicitly set by users. We
4888 had better write it out with the same coding system even if
4889 `enable-multibyte-characters' is nil.
4891 If it is not set locally, we anyway have to convert EOL
4892 format if the default value of `buffer-file-coding-system'
4893 tells that it is not Unix-like (LF only) format. */
4894 int using_default_coding
= 0;
4895 int force_raw_text
= 0;
4897 val
= current_buffer
->buffer_file_coding_system
;
4899 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4902 if (NILP (current_buffer
->enable_multibyte_characters
))
4908 /* Check file-coding-system-alist. */
4909 Lisp_Object args
[7], coding_systems
;
4911 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4912 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4914 coding_systems
= Ffind_operation_coding_system (7, args
);
4915 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4916 val
= XCDR (coding_systems
);
4921 /* If we still have not decided a coding system, use the
4922 default value of buffer-file-coding-system. */
4923 val
= current_buffer
->buffer_file_coding_system
;
4924 using_default_coding
= 1;
4927 if (! NILP (val
) && ! force_raw_text
)
4929 Lisp_Object spec
, attrs
;
4931 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4932 attrs
= AREF (spec
, 0);
4933 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4938 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4939 /* Confirm that VAL can surely encode the current region. */
4940 val
= call5 (Vselect_safe_coding_system_function
,
4941 start
, end
, val
, Qnil
, filename
);
4943 /* If the decided coding-system doesn't specify end-of-line
4944 format, we use that of
4945 `default-buffer-file-coding-system'. */
4946 if (! using_default_coding
4947 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4948 val
= (coding_inherit_eol_type
4949 (val
, buffer_defaults
.buffer_file_coding_system
));
4951 /* If we decide not to encode text, use `raw-text' or one of its
4954 val
= raw_text_coding_system (val
);
4957 val
= coding_inherit_eol_type (val
, eol_parent
);
4958 setup_coding_system (val
, coding
);
4960 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4961 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4965 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4966 "r\nFWrite region to file: \ni\ni\ni\np",
4967 doc
: /* Write current region into specified file.
4968 When called from a program, requires three arguments:
4969 START, END and FILENAME. START and END are normally buffer positions
4970 specifying the part of the buffer to write.
4971 If START is nil, that means to use the entire buffer contents.
4972 If START is a string, then output that string to the file
4973 instead of any buffer contents; END is ignored.
4975 Optional fourth argument APPEND if non-nil means
4976 append to existing file contents (if any). If it is an integer,
4977 seek to that offset in the file before writing.
4978 Optional fifth argument VISIT, if t or a string, means
4979 set the last-save-file-modtime of buffer to this file's modtime
4980 and mark buffer not modified.
4981 If VISIT is a string, it is a second file name;
4982 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4983 VISIT is also the file name to lock and unlock for clash detection.
4984 If VISIT is neither t nor nil nor a string,
4985 that means do not display the \"Wrote file\" message.
4986 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4987 use for locking and unlocking, overriding FILENAME and VISIT.
4988 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4989 for an existing file with the same name. If MUSTBENEW is `excl',
4990 that means to get an error if the file already exists; never overwrite.
4991 If MUSTBENEW is neither nil nor `excl', that means ask for
4992 confirmation before overwriting, but do go ahead and overwrite the file
4993 if the user confirms.
4995 This does code conversion according to the value of
4996 `coding-system-for-write', `buffer-file-coding-system', or
4997 `file-coding-system-alist', and sets the variable
4998 `last-coding-system-used' to the coding system actually used. */)
4999 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
5000 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
5005 const unsigned char *fn
;
5007 int count
= SPECPDL_INDEX ();
5010 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
5012 Lisp_Object handler
;
5013 Lisp_Object visit_file
;
5014 Lisp_Object annotations
;
5015 Lisp_Object encoded_filename
;
5016 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5017 int quietly
= !NILP (visit
);
5018 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5019 struct buffer
*given_buffer
;
5021 int buffer_file_type
= O_BINARY
;
5023 struct coding_system coding
;
5025 if (current_buffer
->base_buffer
&& visiting
)
5026 error ("Cannot do file visiting in an indirect buffer");
5028 if (!NILP (start
) && !STRINGP (start
))
5029 validate_region (&start
, &end
);
5032 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5034 filename
= Fexpand_file_name (filename
, Qnil
);
5036 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5037 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5039 if (STRINGP (visit
))
5040 visit_file
= Fexpand_file_name (visit
, Qnil
);
5042 visit_file
= filename
;
5044 if (NILP (lockname
))
5045 lockname
= visit_file
;
5049 /* If the file name has special constructs in it,
5050 call the corresponding file handler. */
5051 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5052 /* If FILENAME has no handler, see if VISIT has one. */
5053 if (NILP (handler
) && STRINGP (visit
))
5054 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5056 if (!NILP (handler
))
5059 val
= call6 (handler
, Qwrite_region
, start
, end
,
5060 filename
, append
, visit
);
5064 SAVE_MODIFF
= MODIFF
;
5065 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5066 current_buffer
->filename
= visit_file
;
5072 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5074 /* Special kludge to simplify auto-saving. */
5077 XSETFASTINT (start
, BEG
);
5078 XSETFASTINT (end
, Z
);
5082 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5083 count1
= SPECPDL_INDEX ();
5085 given_buffer
= current_buffer
;
5087 if (!STRINGP (start
))
5089 annotations
= build_annotations (start
, end
);
5091 if (current_buffer
!= given_buffer
)
5093 XSETFASTINT (start
, BEGV
);
5094 XSETFASTINT (end
, ZV
);
5100 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5102 /* Decide the coding-system to encode the data with.
5103 We used to make this choice before calling build_annotations, but that
5104 leads to problems when a write-annotate-function takes care of
5105 unsavable chars (as was the case with X-Symbol). */
5106 Vlast_coding_system_used
5107 = choose_write_coding_system (start
, end
, filename
,
5108 append
, visit
, lockname
, &coding
);
5110 #ifdef CLASH_DETECTION
5113 #if 0 /* This causes trouble for GNUS. */
5114 /* If we've locked this file for some other buffer,
5115 query before proceeding. */
5116 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5117 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5120 lock_file (lockname
);
5122 #endif /* CLASH_DETECTION */
5124 encoded_filename
= ENCODE_FILE (filename
);
5126 fn
= SDATA (encoded_filename
);
5130 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5131 #else /* not DOS_NT */
5132 desc
= emacs_open (fn
, O_WRONLY
, 0);
5133 #endif /* not DOS_NT */
5135 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5137 if (auto_saving
) /* Overwrite any previous version of autosave file */
5139 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5140 desc
= emacs_open (fn
, O_RDWR
, 0);
5142 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5143 ? SDATA (current_buffer
->filename
) : 0,
5146 else /* Write to temporary name and rename if no errors */
5148 Lisp_Object temp_name
;
5149 temp_name
= Ffile_name_directory (filename
);
5151 if (!NILP (temp_name
))
5153 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5154 build_string ("$$SAVE$$")));
5155 fname
= SDATA (filename
);
5156 fn
= SDATA (temp_name
);
5157 desc
= creat_copy_attrs (fname
, fn
);
5160 /* If we can't open the temporary file, try creating a new
5161 version of the original file. VMS "creat" creates a
5162 new version rather than truncating an existing file. */
5165 desc
= creat (fn
, 0666);
5166 #if 0 /* This can clobber an existing file and fail to replace it,
5167 if the user runs out of space. */
5170 /* We can't make a new version;
5171 try to truncate and rewrite existing version if any. */
5173 desc
= emacs_open (fn
, O_RDWR
, 0);
5179 desc
= creat (fn
, 0666);
5183 desc
= emacs_open (fn
,
5184 O_WRONLY
| O_CREAT
| buffer_file_type
5185 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5186 S_IREAD
| S_IWRITE
);
5187 #else /* not DOS_NT */
5188 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5189 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5190 auto_saving
? auto_save_mode_bits
: 0666);
5191 #endif /* not DOS_NT */
5192 #endif /* not VMS */
5196 #ifdef CLASH_DETECTION
5198 if (!auto_saving
) unlock_file (lockname
);
5200 #endif /* CLASH_DETECTION */
5202 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5205 record_unwind_protect (close_file_unwind
, make_number (desc
));
5207 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5211 if (NUMBERP (append
))
5212 ret
= lseek (desc
, XINT (append
), 1);
5214 ret
= lseek (desc
, 0, 2);
5217 #ifdef CLASH_DETECTION
5218 if (!auto_saving
) unlock_file (lockname
);
5219 #endif /* CLASH_DETECTION */
5221 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5229 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5230 * if we do writes that don't end with a carriage return. Furthermore
5231 * it cannot handle writes of more then 16K. The modified
5232 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5233 * this EXCEPT for the last record (if it doesn't end with a carriage
5234 * return). This implies that if your buffer doesn't end with a carriage
5235 * return, you get one free... tough. However it also means that if
5236 * we make two calls to sys_write (a la the following code) you can
5237 * get one at the gap as well. The easiest way to fix this (honest)
5238 * is to move the gap to the next newline (or the end of the buffer).
5243 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5244 move_gap (find_next_newline (GPT
, 1));
5247 /* The new encoding routine doesn't require the following. */
5249 /* Whether VMS or not, we must move the gap to the next of newline
5250 when we must put designation sequences at beginning of line. */
5251 if (INTEGERP (start
)
5252 && coding
.type
== coding_type_iso2022
5253 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5254 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5256 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5257 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5258 move_gap_both (PT
, PT_BYTE
);
5259 SET_PT_BOTH (opoint
, opoint_byte
);
5267 if (STRINGP (start
))
5269 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5270 &annotations
, &coding
);
5273 else if (XINT (start
) != XINT (end
))
5275 failure
= 0 > a_write (desc
, Qnil
,
5276 XINT (start
), XINT (end
) - XINT (start
),
5277 &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
, 1, 1, &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, must do the stat after the close
5324 since closing changes the modtime. */
5326 /* Recall that #if defined does not work on VMS. */
5332 /* NFS can report a write failure now. */
5333 if (emacs_close (desc
) < 0)
5334 failure
= 1, save_errno
= errno
;
5337 /* If we wrote to a temporary name and had no errors, rename to real name. */
5341 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5349 /* Discard the unwind protect for close_file_unwind. */
5350 specpdl_ptr
= specpdl
+ count1
;
5351 /* Restore the original current buffer. */
5352 visit_file
= unbind_to (count
, visit_file
);
5354 #ifdef CLASH_DETECTION
5356 unlock_file (lockname
);
5357 #endif /* CLASH_DETECTION */
5359 /* Do this before reporting IO error
5360 to avoid a "file has changed on disk" warning on
5361 next attempt to save. */
5363 current_buffer
->modtime
= st
.st_mtime
;
5366 error ("IO error writing %s: %s", SDATA (filename
),
5367 emacs_strerror (save_errno
));
5371 SAVE_MODIFF
= MODIFF
;
5372 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5373 current_buffer
->filename
= visit_file
;
5374 update_mode_lines
++;
5379 && ! NILP (Fstring_equal (current_buffer
->filename
,
5380 current_buffer
->auto_save_file_name
)))
5381 SAVE_MODIFF
= MODIFF
;
5387 message_with_string ((INTEGERP (append
)
5397 Lisp_Object
merge ();
5399 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5400 doc
: /* Return t if (car A) is numerically less than (car B). */)
5404 return Flss (Fcar (a
), Fcar (b
));
5407 /* Build the complete list of annotations appropriate for writing out
5408 the text between START and END, by calling all the functions in
5409 write-region-annotate-functions and merging the lists they return.
5410 If one of these functions switches to a different buffer, we assume
5411 that buffer contains altered text. Therefore, the caller must
5412 make sure to restore the current buffer in all cases,
5413 as save-excursion would do. */
5416 build_annotations (start
, end
)
5417 Lisp_Object start
, end
;
5419 Lisp_Object annotations
;
5421 struct gcpro gcpro1
, gcpro2
;
5422 Lisp_Object original_buffer
;
5423 int i
, used_global
= 0;
5425 XSETBUFFER (original_buffer
, current_buffer
);
5428 p
= Vwrite_region_annotate_functions
;
5429 GCPRO2 (annotations
, p
);
5432 struct buffer
*given_buffer
= current_buffer
;
5433 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5434 { /* Use the global value of the hook. */
5437 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5439 p
= Fappend (2, arg
);
5442 Vwrite_region_annotations_so_far
= annotations
;
5443 res
= call2 (XCAR (p
), start
, end
);
5444 /* If the function makes a different buffer current,
5445 assume that means this buffer contains altered text to be output.
5446 Reset START and END from the buffer bounds
5447 and discard all previous annotations because they should have
5448 been dealt with by this function. */
5449 if (current_buffer
!= given_buffer
)
5451 XSETFASTINT (start
, BEGV
);
5452 XSETFASTINT (end
, ZV
);
5455 Flength (res
); /* Check basic validity of return value */
5456 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5460 /* Now do the same for annotation functions implied by the file-format */
5461 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5462 p
= current_buffer
->auto_save_file_format
;
5464 p
= current_buffer
->file_format
;
5465 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5467 struct buffer
*given_buffer
= current_buffer
;
5469 Vwrite_region_annotations_so_far
= annotations
;
5471 /* Value is either a list of annotations or nil if the function
5472 has written annotations to a temporary buffer, which is now
5474 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5475 original_buffer
, make_number (i
));
5476 if (current_buffer
!= given_buffer
)
5478 XSETFASTINT (start
, BEGV
);
5479 XSETFASTINT (end
, ZV
);
5484 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5492 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5493 If STRING is nil, POS is the character position in the current buffer.
5494 Intersperse with them the annotations from *ANNOT
5495 which fall within the range of POS to POS + NCHARS,
5496 each at its appropriate position.
5498 We modify *ANNOT by discarding elements as we use them up.
5500 The return value is negative in case of system call failure. */
5503 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5506 register int nchars
;
5509 struct coding_system
*coding
;
5513 int lastpos
= pos
+ nchars
;
5515 while (NILP (*annot
) || CONSP (*annot
))
5517 tem
= Fcar_safe (Fcar (*annot
));
5520 nextpos
= XFASTINT (tem
);
5522 /* If there are no more annotations in this range,
5523 output the rest of the range all at once. */
5524 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5525 return e_write (desc
, string
, pos
, lastpos
, coding
);
5527 /* Output buffer text up to the next annotation's position. */
5530 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5534 /* Output the annotation. */
5535 tem
= Fcdr (Fcar (*annot
));
5538 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5541 *annot
= Fcdr (*annot
);
5547 /* Write text in the range START and END into descriptor DESC,
5548 encoding them with coding system CODING. If STRING is nil, START
5549 and END are character positions of the current buffer, else they
5550 are indexes to the string STRING. */
5553 e_write (desc
, string
, start
, end
, coding
)
5557 struct coding_system
*coding
;
5559 if (STRINGP (string
))
5562 end
= SCHARS (string
);
5565 /* We used to have a code for handling selective display here. But,
5566 now it is handled within encode_coding. */
5570 if (STRINGP (string
))
5572 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5573 if (CODING_REQUIRE_ENCODING (coding
))
5575 encode_coding_object (coding
, string
,
5576 start
, string_char_to_byte (string
, start
),
5577 end
, string_char_to_byte (string
, end
), Qt
);
5581 coding
->dst_object
= string
;
5582 coding
->consumed_char
= SCHARS (string
);
5583 coding
->produced
= SBYTES (string
);
5588 int start_byte
= CHAR_TO_BYTE (start
);
5589 int end_byte
= CHAR_TO_BYTE (end
);
5591 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5592 if (CODING_REQUIRE_ENCODING (coding
))
5594 encode_coding_object (coding
, Fcurrent_buffer (),
5595 start
, start_byte
, end
, end_byte
, Qt
);
5599 coding
->dst_object
= Qnil
;
5600 coding
->dst_pos_byte
= start_byte
;
5601 if (start
>= GPT
|| end
<= GPT
)
5603 coding
->consumed_char
= end
- start
;
5604 coding
->produced
= end_byte
- start_byte
;
5608 coding
->consumed_char
= GPT
- start
;
5609 coding
->produced
= GPT_BYTE
- start_byte
;
5614 if (coding
->produced
> 0)
5618 STRINGP (coding
->dst_object
)
5619 ? SDATA (coding
->dst_object
)
5620 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5623 if (coding
->produced
)
5626 start
+= coding
->consumed_char
;
5632 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5633 Sverify_visited_file_modtime
, 1, 1, 0,
5634 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5635 This means that the file has not been changed since it was visited or saved.
5636 See Info node `(elisp)Modification Time' for more details. */)
5642 Lisp_Object handler
;
5643 Lisp_Object filename
;
5648 if (!STRINGP (b
->filename
)) return Qt
;
5649 if (b
->modtime
== 0) return Qt
;
5651 /* If the file name has special constructs in it,
5652 call the corresponding file handler. */
5653 handler
= Ffind_file_name_handler (b
->filename
,
5654 Qverify_visited_file_modtime
);
5655 if (!NILP (handler
))
5656 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5658 filename
= ENCODE_FILE (b
->filename
);
5660 if (stat (SDATA (filename
), &st
) < 0)
5662 /* If the file doesn't exist now and didn't exist before,
5663 we say that it isn't modified, provided the error is a tame one. */
5664 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5669 if (st
.st_mtime
== b
->modtime
5670 /* If both are positive, accept them if they are off by one second. */
5671 || (st
.st_mtime
> 0 && b
->modtime
> 0
5672 && (st
.st_mtime
== b
->modtime
+ 1
5673 || st
.st_mtime
== b
->modtime
- 1)))
5678 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5679 Sclear_visited_file_modtime
, 0, 0, 0,
5680 doc
: /* Clear out records of last mod time of visited file.
5681 Next attempt to save will certainly not complain of a discrepancy. */)
5684 current_buffer
->modtime
= 0;
5688 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5689 Svisited_file_modtime
, 0, 0, 0,
5690 doc
: /* Return the current buffer's recorded visited file modification time.
5691 The value is a list of the form (HIGH LOW), like the time values
5692 that `file-attributes' returns. If the current buffer has no recorded
5693 file modification time, this function returns 0.
5694 See Info node `(elisp)Modification Time' for more details. */)
5697 if (! current_buffer
->modtime
)
5698 return make_number (0);
5699 return make_time ((time_t) current_buffer
->modtime
);
5702 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5703 Sset_visited_file_modtime
, 0, 1, 0,
5704 doc
: /* Update buffer's recorded modification time from the visited file's time.
5705 Useful if the buffer was not read from the file normally
5706 or if the file itself has been changed for some known benign reason.
5707 An argument specifies the modification time value to use
5708 \(instead of that of the visited file), in the form of a list
5709 \(HIGH . LOW) or (HIGH LOW). */)
5711 Lisp_Object time_list
;
5713 if (!NILP (time_list
))
5714 current_buffer
->modtime
= cons_to_long (time_list
);
5717 register Lisp_Object filename
;
5719 Lisp_Object handler
;
5721 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5723 /* If the file name has special constructs in it,
5724 call the corresponding file handler. */
5725 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5726 if (!NILP (handler
))
5727 /* The handler can find the file name the same way we did. */
5728 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5730 filename
= ENCODE_FILE (filename
);
5732 if (stat (SDATA (filename
), &st
) >= 0)
5733 current_buffer
->modtime
= st
.st_mtime
;
5740 auto_save_error (error
)
5743 Lisp_Object args
[3], msg
;
5745 struct gcpro gcpro1
;
5749 auto_save_error_occurred
= 1;
5751 ring_bell (XFRAME (selected_frame
));
5753 args
[0] = build_string ("Auto-saving %s: %s");
5754 args
[1] = current_buffer
->name
;
5755 args
[2] = Ferror_message_string (error
);
5756 msg
= Fformat (3, args
);
5758 nbytes
= SBYTES (msg
);
5759 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5760 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5762 for (i
= 0; i
< 3; ++i
)
5765 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5767 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5768 Fsleep_for (make_number (1), Qnil
);
5782 auto_save_mode_bits
= 0666;
5784 /* Get visited file's mode to become the auto save file's mode. */
5785 if (! NILP (current_buffer
->filename
))
5787 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5788 /* But make sure we can overwrite it later! */
5789 auto_save_mode_bits
= st
.st_mode
| 0600;
5790 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5792 /* Remote files don't cooperate with stat. */
5793 auto_save_mode_bits
= XINT (modes
) | 0600;
5797 Fwrite_region (Qnil
, Qnil
,
5798 current_buffer
->auto_save_file_name
,
5799 Qnil
, Qlambda
, Qnil
, Qnil
);
5803 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5806 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5818 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5821 minibuffer_auto_raise
= XINT (value
);
5826 do_auto_save_make_dir (dir
)
5831 call2 (Qmake_directory
, dir
, Qt
);
5832 XSETFASTINT (mode
, 0700);
5833 return Fset_file_modes (dir
, mode
);
5837 do_auto_save_eh (ignore
)
5843 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5844 doc
: /* Auto-save all buffers that need it.
5845 This is all buffers that have auto-saving enabled
5846 and are changed since last auto-saved.
5847 Auto-saving writes the buffer into a file
5848 so that your editing is not lost if the system crashes.
5849 This file is not the file you visited; that changes only when you save.
5850 Normally we run the normal hook `auto-save-hook' before saving.
5852 A non-nil NO-MESSAGE argument means do not print any message if successful.
5853 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5854 (no_message
, current_only
)
5855 Lisp_Object no_message
, current_only
;
5857 struct buffer
*old
= current_buffer
, *b
;
5858 Lisp_Object tail
, buf
;
5860 int do_handled_files
;
5862 FILE *stream
= NULL
;
5863 int count
= SPECPDL_INDEX ();
5864 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5865 int old_message_p
= 0;
5866 struct gcpro gcpro1
, gcpro2
;
5868 if (max_specpdl_size
< specpdl_size
+ 40)
5869 max_specpdl_size
= specpdl_size
+ 40;
5874 if (NILP (no_message
))
5876 old_message_p
= push_message ();
5877 record_unwind_protect (pop_message_unwind
, Qnil
);
5880 /* Ordinarily don't quit within this function,
5881 but don't make it impossible to quit (in case we get hung in I/O). */
5885 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5886 point to non-strings reached from Vbuffer_alist. */
5888 if (!NILP (Vrun_hooks
))
5889 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5891 if (STRINGP (Vauto_save_list_file_name
))
5893 Lisp_Object listfile
;
5895 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5897 /* Don't try to create the directory when shutting down Emacs,
5898 because creating the directory might signal an error, and
5899 that would leave Emacs in a strange state. */
5900 if (!NILP (Vrun_hooks
))
5904 GCPRO2 (dir
, listfile
);
5905 dir
= Ffile_name_directory (listfile
);
5906 if (NILP (Ffile_directory_p (dir
)))
5907 internal_condition_case_1 (do_auto_save_make_dir
,
5908 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5913 stream
= fopen (SDATA (listfile
), "w");
5916 record_unwind_protect (do_auto_save_unwind
,
5917 make_save_value (stream
, 0));
5918 record_unwind_protect (do_auto_save_unwind_1
,
5919 make_number (minibuffer_auto_raise
));
5920 minibuffer_auto_raise
= 0;
5922 auto_save_error_occurred
= 0;
5924 /* On first pass, save all files that don't have handlers.
5925 On second pass, save all files that do have handlers.
5927 If Emacs is crashing, the handlers may tweak what is causing
5928 Emacs to crash in the first place, and it would be a shame if
5929 Emacs failed to autosave perfectly ordinary files because it
5930 couldn't handle some ange-ftp'd file. */
5932 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5933 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5935 buf
= XCDR (XCAR (tail
));
5938 /* Record all the buffers that have auto save mode
5939 in the special file that lists them. For each of these buffers,
5940 Record visited name (if any) and auto save name. */
5941 if (STRINGP (b
->auto_save_file_name
)
5942 && stream
!= NULL
&& do_handled_files
== 0)
5945 if (!NILP (b
->filename
))
5947 fwrite (SDATA (b
->filename
), 1,
5948 SBYTES (b
->filename
), stream
);
5950 putc ('\n', stream
);
5951 fwrite (SDATA (b
->auto_save_file_name
), 1,
5952 SBYTES (b
->auto_save_file_name
), stream
);
5953 putc ('\n', stream
);
5957 if (!NILP (current_only
)
5958 && b
!= current_buffer
)
5961 /* Don't auto-save indirect buffers.
5962 The base buffer takes care of it. */
5966 /* Check for auto save enabled
5967 and file changed since last auto save
5968 and file changed since last real save. */
5969 if (STRINGP (b
->auto_save_file_name
)
5970 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5971 && b
->auto_save_modified
< BUF_MODIFF (b
)
5972 /* -1 means we've turned off autosaving for a while--see below. */
5973 && XINT (b
->save_length
) >= 0
5974 && (do_handled_files
5975 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5978 EMACS_TIME before_time
, after_time
;
5980 EMACS_GET_TIME (before_time
);
5982 /* If we had a failure, don't try again for 20 minutes. */
5983 if (b
->auto_save_failure_time
>= 0
5984 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5987 if ((XFASTINT (b
->save_length
) * 10
5988 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5989 /* A short file is likely to change a large fraction;
5990 spare the user annoying messages. */
5991 && XFASTINT (b
->save_length
) > 5000
5992 /* These messages are frequent and annoying for `*mail*'. */
5993 && !EQ (b
->filename
, Qnil
)
5994 && NILP (no_message
))
5996 /* It has shrunk too much; turn off auto-saving here. */
5997 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5998 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6000 minibuffer_auto_raise
= 0;
6001 /* Turn off auto-saving until there's a real save,
6002 and prevent any more warnings. */
6003 XSETINT (b
->save_length
, -1);
6004 Fsleep_for (make_number (1), Qnil
);
6007 set_buffer_internal (b
);
6008 if (!auto_saved
&& NILP (no_message
))
6009 message1 ("Auto-saving...");
6010 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6012 b
->auto_save_modified
= BUF_MODIFF (b
);
6013 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6014 set_buffer_internal (old
);
6016 EMACS_GET_TIME (after_time
);
6018 /* If auto-save took more than 60 seconds,
6019 assume it was an NFS failure that got a timeout. */
6020 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6021 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6025 /* Prevent another auto save till enough input events come in. */
6026 record_auto_save ();
6028 if (auto_saved
&& NILP (no_message
))
6032 /* If we are going to restore an old message,
6033 give time to read ours. */
6034 sit_for (make_number (1), 0, 0);
6037 else if (!auto_save_error_occurred
)
6038 /* Don't overwrite the error message if an error occurred. */
6039 /* If we displayed a message and then restored a state
6040 with no message, leave a "done" message on the screen. */
6041 message1 ("Auto-saving...done");
6046 /* This restores the message-stack status. */
6047 unbind_to (count
, Qnil
);
6051 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6052 Sset_buffer_auto_saved
, 0, 0, 0,
6053 doc
: /* Mark current buffer as auto-saved with its current text.
6054 No auto-save file will be written until the buffer changes again. */)
6057 current_buffer
->auto_save_modified
= MODIFF
;
6058 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6059 current_buffer
->auto_save_failure_time
= -1;
6063 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6064 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6065 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6068 current_buffer
->auto_save_failure_time
= -1;
6072 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6074 doc
: /* Return t if current buffer has been auto-saved recently.
6075 More precisely, if it has been auto-saved since last read from or saved
6076 in the visited file. If the buffer has no visited file,
6077 then any auto-save counts as "recent". */)
6080 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6083 /* Reading and completing file names */
6084 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6085 extern Lisp_Object Qcompletion_ignore_case
;
6087 /* In the string VAL, change each $ to $$ and return the result. */
6090 double_dollars (val
)
6093 register const unsigned char *old
;
6094 register unsigned char *new;
6098 osize
= SBYTES (val
);
6100 /* Count the number of $ characters. */
6101 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6102 if (*old
++ == '$') count
++;
6106 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6109 for (n
= osize
; n
> 0; n
--)
6123 read_file_name_cleanup (arg
)
6126 return (current_buffer
->directory
= arg
);
6129 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6131 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6132 (string
, dir
, action
)
6133 Lisp_Object string
, dir
, action
;
6134 /* action is nil for complete, t for return list of completions,
6135 lambda for verify final value */
6137 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6139 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6141 CHECK_STRING (string
);
6148 /* No need to protect ACTION--we only compare it with t and nil. */
6149 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6151 if (SCHARS (string
) == 0)
6153 if (EQ (action
, Qlambda
))
6161 orig_string
= string
;
6162 string
= Fsubstitute_in_file_name (string
);
6163 changed
= NILP (Fstring_equal (string
, orig_string
));
6164 name
= Ffile_name_nondirectory (string
);
6165 val
= Ffile_name_directory (string
);
6167 realdir
= Fexpand_file_name (val
, realdir
);
6172 specdir
= Ffile_name_directory (string
);
6173 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6178 return double_dollars (string
);
6182 if (!NILP (specdir
))
6183 val
= concat2 (specdir
, val
);
6185 return double_dollars (val
);
6188 #endif /* not VMS */
6192 if (EQ (action
, Qt
))
6194 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6198 if (NILP (Vread_file_name_predicate
)
6199 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6203 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6205 /* Brute-force speed up for directory checking:
6206 Discard strings which don't end in a slash. */
6207 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6209 Lisp_Object tem
= XCAR (all
);
6211 if (STRINGP (tem
) &&
6212 (len
= SBYTES (tem
), len
> 0) &&
6213 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6214 comp
= Fcons (tem
, comp
);
6220 /* Must do it the hard (and slow) way. */
6222 GCPRO3 (all
, comp
, specdir
);
6223 count
= SPECPDL_INDEX ();
6224 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6225 current_buffer
->directory
= realdir
;
6226 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6228 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6230 comp
= Fcons (XCAR (all
), comp
);
6232 unbind_to (count
, Qnil
);
6235 return Fnreverse (comp
);
6238 /* Only other case actually used is ACTION = lambda */
6240 /* Supposedly this helps commands such as `cd' that read directory names,
6241 but can someone explain how it helps them? -- RMS */
6242 if (SCHARS (name
) == 0)
6245 string
= Fexpand_file_name (string
, dir
);
6246 if (!NILP (Vread_file_name_predicate
))
6247 return call1 (Vread_file_name_predicate
, string
);
6248 return Ffile_exists_p (string
);
6251 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6252 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6253 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6254 The return value is only relevant for a call to `read-file-name' that happens
6255 before any other event (mouse or keypress) is handeled. */)
6258 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6259 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6268 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6269 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6270 Value is not expanded---you must call `expand-file-name' yourself.
6271 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6272 the same non-empty string that was inserted by this function.
6273 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6274 except that if INITIAL is specified, that combined with DIR is used.)
6275 If the user exits with an empty minibuffer, this function returns
6276 an empty string. (This can only happen if the user erased the
6277 pre-inserted contents or if `insert-default-directory' is nil.)
6278 Fourth arg MUSTMATCH non-nil means require existing file's name.
6279 Non-nil and non-t means also require confirmation after completion.
6280 Fifth arg INITIAL specifies text to start with.
6281 If optional sixth arg PREDICATE is non-nil, possible completions and
6282 the resulting file name must satisfy (funcall PREDICATE NAME).
6283 DIR should be an absolute directory name. It defaults to the value of
6284 `default-directory'.
6286 If this command was invoked with the mouse, use a file dialog box if
6287 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6288 provides a file dialog box.
6290 See also `read-file-name-completion-ignore-case'
6291 and `read-file-name-function'. */)
6292 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6293 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6295 Lisp_Object val
, insdef
, tem
;
6296 struct gcpro gcpro1
, gcpro2
;
6297 register char *homedir
;
6298 Lisp_Object decoded_homedir
;
6299 int replace_in_history
= 0;
6300 int add_to_history
= 0;
6304 dir
= current_buffer
->directory
;
6305 if (NILP (Ffile_name_absolute_p (dir
)))
6306 dir
= Fexpand_file_name (dir
, Qnil
);
6307 if (NILP (default_filename
))
6310 ? Fexpand_file_name (initial
, dir
)
6311 : current_buffer
->filename
);
6313 /* If dir starts with user's homedir, change that to ~. */
6314 homedir
= (char *) egetenv ("HOME");
6316 /* homedir can be NULL in temacs, since Vglobal_environment is not
6317 yet set up. We shouldn't crash in that case. */
6320 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6321 CORRECT_DIR_SEPS (homedir
);
6326 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6329 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6330 SBYTES (decoded_homedir
))
6331 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6333 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6334 dir
= concat2 (build_string ("~"), dir
);
6336 /* Likewise for default_filename. */
6338 && STRINGP (default_filename
)
6339 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6340 SBYTES (decoded_homedir
))
6341 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6344 = Fsubstring (default_filename
,
6345 make_number (SCHARS (decoded_homedir
)), Qnil
);
6346 default_filename
= concat2 (build_string ("~"), default_filename
);
6348 if (!NILP (default_filename
))
6350 CHECK_STRING (default_filename
);
6351 default_filename
= double_dollars (default_filename
);
6354 if (insert_default_directory
&& STRINGP (dir
))
6357 if (!NILP (initial
))
6359 Lisp_Object args
[2], pos
;
6363 insdef
= Fconcat (2, args
);
6364 pos
= make_number (SCHARS (double_dollars (dir
)));
6365 insdef
= Fcons (double_dollars (insdef
), pos
);
6368 insdef
= double_dollars (insdef
);
6370 else if (STRINGP (initial
))
6371 insdef
= Fcons (double_dollars (initial
), make_number (0));
6375 if (!NILP (Vread_file_name_function
))
6377 Lisp_Object args
[7];
6379 GCPRO2 (insdef
, default_filename
);
6380 args
[0] = Vread_file_name_function
;
6383 args
[3] = default_filename
;
6384 args
[4] = mustmatch
;
6386 args
[6] = predicate
;
6387 RETURN_UNGCPRO (Ffuncall (7, args
));
6390 count
= SPECPDL_INDEX ();
6391 specbind (Qcompletion_ignore_case
,
6392 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6393 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6394 specbind (intern ("read-file-name-predicate"),
6395 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6397 GCPRO2 (insdef
, default_filename
);
6399 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6400 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6402 /* If DIR contains a file name, split it. */
6404 file
= Ffile_name_nondirectory (dir
);
6405 if (SCHARS (file
) && NILP (default_filename
))
6407 default_filename
= file
;
6408 dir
= Ffile_name_directory (dir
);
6410 if (!NILP(default_filename
))
6411 default_filename
= Fexpand_file_name (default_filename
, dir
);
6412 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6413 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6418 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6419 dir
, mustmatch
, insdef
,
6420 Qfile_name_history
, default_filename
, Qnil
);
6422 tem
= Fsymbol_value (Qfile_name_history
);
6423 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6424 replace_in_history
= 1;
6426 /* If Fcompleting_read returned the inserted default string itself
6427 (rather than a new string with the same contents),
6428 it has to mean that the user typed RET with the minibuffer empty.
6429 In that case, we really want to return ""
6430 so that commands such as set-visited-file-name can distinguish. */
6431 if (EQ (val
, default_filename
))
6433 /* In this case, Fcompleting_read has not added an element
6434 to the history. Maybe we should. */
6435 if (! replace_in_history
)
6438 val
= empty_unibyte_string
;
6441 unbind_to (count
, Qnil
);
6444 error ("No file name specified");
6446 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6448 if (!NILP (tem
) && !NILP (default_filename
))
6449 val
= default_filename
;
6450 val
= Fsubstitute_in_file_name (val
);
6452 if (replace_in_history
)
6453 /* Replace what Fcompleting_read added to the history
6454 with what we will actually return. */
6456 Lisp_Object val1
= double_dollars (val
);
6457 tem
= Fsymbol_value (Qfile_name_history
);
6458 if (history_delete_duplicates
)
6459 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6460 XSETCAR (tem
, val1
);
6462 else if (add_to_history
)
6464 /* Add the value to the history--but not if it matches
6465 the last value already there. */
6466 Lisp_Object val1
= double_dollars (val
);
6467 tem
= Fsymbol_value (Qfile_name_history
);
6468 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6470 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6471 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6482 /* Must be set before any path manipulation is performed. */
6483 XSETFASTINT (Vdirectory_sep_char
, '/');
6490 Qoperations
= intern ("operations");
6491 Qexpand_file_name
= intern ("expand-file-name");
6492 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6493 Qdirectory_file_name
= intern ("directory-file-name");
6494 Qfile_name_directory
= intern ("file-name-directory");
6495 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6496 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6497 Qfile_name_as_directory
= intern ("file-name-as-directory");
6498 Qcopy_file
= intern ("copy-file");
6499 Qmake_directory_internal
= intern ("make-directory-internal");
6500 Qmake_directory
= intern ("make-directory");
6501 Qdelete_directory
= intern ("delete-directory");
6502 Qdelete_file
= intern ("delete-file");
6503 Qrename_file
= intern ("rename-file");
6504 Qadd_name_to_file
= intern ("add-name-to-file");
6505 Qmake_symbolic_link
= intern ("make-symbolic-link");
6506 Qfile_exists_p
= intern ("file-exists-p");
6507 Qfile_executable_p
= intern ("file-executable-p");
6508 Qfile_readable_p
= intern ("file-readable-p");
6509 Qfile_writable_p
= intern ("file-writable-p");
6510 Qfile_symlink_p
= intern ("file-symlink-p");
6511 Qaccess_file
= intern ("access-file");
6512 Qfile_directory_p
= intern ("file-directory-p");
6513 Qfile_regular_p
= intern ("file-regular-p");
6514 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6515 Qfile_modes
= intern ("file-modes");
6516 Qset_file_modes
= intern ("set-file-modes");
6517 Qset_file_times
= intern ("set-file-times");
6518 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6519 Qinsert_file_contents
= intern ("insert-file-contents");
6520 Qwrite_region
= intern ("write-region");
6521 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6522 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6523 Qauto_save_coding
= intern ("auto-save-coding");
6525 staticpro (&Qoperations
);
6526 staticpro (&Qexpand_file_name
);
6527 staticpro (&Qsubstitute_in_file_name
);
6528 staticpro (&Qdirectory_file_name
);
6529 staticpro (&Qfile_name_directory
);
6530 staticpro (&Qfile_name_nondirectory
);
6531 staticpro (&Qunhandled_file_name_directory
);
6532 staticpro (&Qfile_name_as_directory
);
6533 staticpro (&Qcopy_file
);
6534 staticpro (&Qmake_directory_internal
);
6535 staticpro (&Qmake_directory
);
6536 staticpro (&Qdelete_directory
);
6537 staticpro (&Qdelete_file
);
6538 staticpro (&Qrename_file
);
6539 staticpro (&Qadd_name_to_file
);
6540 staticpro (&Qmake_symbolic_link
);
6541 staticpro (&Qfile_exists_p
);
6542 staticpro (&Qfile_executable_p
);
6543 staticpro (&Qfile_readable_p
);
6544 staticpro (&Qfile_writable_p
);
6545 staticpro (&Qaccess_file
);
6546 staticpro (&Qfile_symlink_p
);
6547 staticpro (&Qfile_directory_p
);
6548 staticpro (&Qfile_regular_p
);
6549 staticpro (&Qfile_accessible_directory_p
);
6550 staticpro (&Qfile_modes
);
6551 staticpro (&Qset_file_modes
);
6552 staticpro (&Qset_file_times
);
6553 staticpro (&Qfile_newer_than_file_p
);
6554 staticpro (&Qinsert_file_contents
);
6555 staticpro (&Qwrite_region
);
6556 staticpro (&Qverify_visited_file_modtime
);
6557 staticpro (&Qset_visited_file_modtime
);
6558 staticpro (&Qauto_save_coding
);
6560 Qfile_name_history
= intern ("file-name-history");
6561 Fset (Qfile_name_history
, Qnil
);
6562 staticpro (&Qfile_name_history
);
6564 Qfile_error
= intern ("file-error");
6565 staticpro (&Qfile_error
);
6566 Qfile_already_exists
= intern ("file-already-exists");
6567 staticpro (&Qfile_already_exists
);
6568 Qfile_date_error
= intern ("file-date-error");
6569 staticpro (&Qfile_date_error
);
6570 Qexcl
= intern ("excl");
6574 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6575 staticpro (&Qfind_buffer_file_type
);
6578 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6579 doc
: /* *Coding system for encoding file names.
6580 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6581 Vfile_name_coding_system
= Qnil
;
6583 DEFVAR_LISP ("default-file-name-coding-system",
6584 &Vdefault_file_name_coding_system
,
6585 doc
: /* Default coding system for encoding file names.
6586 This variable is used only when `file-name-coding-system' is nil.
6588 This variable is set/changed by the command `set-language-environment'.
6589 User should not set this variable manually,
6590 instead use `file-name-coding-system' to get a constant encoding
6591 of file names regardless of the current language environment. */);
6592 Vdefault_file_name_coding_system
= Qnil
;
6594 Qformat_decode
= intern ("format-decode");
6595 staticpro (&Qformat_decode
);
6596 Qformat_annotate_function
= intern ("format-annotate-function");
6597 staticpro (&Qformat_annotate_function
);
6598 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6599 staticpro (&Qafter_insert_file_set_coding
);
6601 Qcar_less_than_car
= intern ("car-less-than-car");
6602 staticpro (&Qcar_less_than_car
);
6604 Fput (Qfile_error
, Qerror_conditions
,
6605 list2 (Qfile_error
, Qerror
));
6606 Fput (Qfile_error
, Qerror_message
,
6607 build_string ("File error"));
6609 Fput (Qfile_already_exists
, Qerror_conditions
,
6610 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6611 Fput (Qfile_already_exists
, Qerror_message
,
6612 build_string ("File already exists"));
6614 Fput (Qfile_date_error
, Qerror_conditions
,
6615 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6616 Fput (Qfile_date_error
, Qerror_message
,
6617 build_string ("Cannot set file date"));
6619 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6620 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6621 Vread_file_name_function
= Qnil
;
6623 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6624 doc
: /* Current predicate used by `read-file-name-internal'. */);
6625 Vread_file_name_predicate
= Qnil
;
6627 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6628 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6629 #if defined VMS || defined DOS_NT || defined MAC_OS
6630 read_file_name_completion_ignore_case
= 1;
6632 read_file_name_completion_ignore_case
= 0;
6635 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6636 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6638 When the initial minibuffer contents show a name of a file or a directory,
6639 typing RETURN without editing the initial contents is equivalent to typing
6640 the default file name.
6642 If this variable is non-nil, the minibuffer contents are always
6643 initially non-empty, and typing RETURN without editing will fetch the
6644 default name, if one is provided. Note however that this default name
6645 is not necessarily the same as initial contents inserted in the minibuffer,
6646 if the initial contents is just the default directory.
6648 If this variable is nil, the minibuffer often starts out empty. In
6649 that case you may have to explicitly fetch the next history element to
6650 request the default name; typing RETURN without editing will leave
6651 the minibuffer empty.
6653 For some commands, exiting with an empty minibuffer has a special meaning,
6654 such as making the current buffer visit no file in the case of
6655 `set-visited-file-name'. */);
6656 insert_default_directory
= 1;
6658 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6659 doc
: /* *Non-nil means write new files with record format `stmlf'.
6660 nil means use format `var'. This variable is meaningful only on VMS. */);
6661 vms_stmlf_recfm
= 0;
6663 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6664 doc
: /* Directory separator character for built-in functions that return file names.
6665 The value is always ?/. Don't use this variable, just use `/'. */);
6667 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6668 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6669 If a file name matches REGEXP, then all I/O on that file is done by calling
6672 The first argument given to HANDLER is the name of the I/O primitive
6673 to be handled; the remaining arguments are the arguments that were
6674 passed to that primitive. For example, if you do
6675 (file-exists-p FILENAME)
6676 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6677 (funcall HANDLER 'file-exists-p FILENAME)
6678 The function `find-file-name-handler' checks this list for a handler
6679 for its argument. */);
6680 Vfile_name_handler_alist
= Qnil
;
6682 DEFVAR_LISP ("set-auto-coding-function",
6683 &Vset_auto_coding_function
,
6684 doc
: /* If non-nil, a function to call to decide a coding system of file.
6685 Two arguments are passed to this function: the file name
6686 and the length of a file contents following the point.
6687 This function should return a coding system to decode the file contents.
6688 It should check the file name against `auto-coding-alist'.
6689 If no coding system is decided, it should check a coding system
6690 specified in the heading lines with the format:
6691 -*- ... coding: CODING-SYSTEM; ... -*-
6692 or local variable spec of the tailing lines with `coding:' tag. */);
6693 Vset_auto_coding_function
= Qnil
;
6695 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6696 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6697 Each is passed one argument, the number of characters inserted,
6698 with point at the start of the inserted text. Each function
6699 should leave point the same, and return the new character count.
6700 If `insert-file-contents' is intercepted by a handler from
6701 `file-name-handler-alist', that handler is responsible for calling the
6702 functions in `after-insert-file-functions' if appropriate. */);
6703 Vafter_insert_file_functions
= Qnil
;
6705 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6706 doc
: /* A list of functions to be called at the start of `write-region'.
6707 Each is passed two arguments, START and END as for `write-region'.
6708 These are usually two numbers but not always; see the documentation
6709 for `write-region'. The function should return a list of pairs
6710 of the form (POSITION . STRING), consisting of strings to be effectively
6711 inserted at the specified positions of the file being written (1 means to
6712 insert before the first byte written). The POSITIONs must be sorted into
6713 increasing order. If there are several functions in the list, the several
6714 lists are merged destructively. Alternatively, the function can return
6715 with a different buffer current; in that case it should pay attention
6716 to the annotations returned by previous functions and listed in
6717 `write-region-annotations-so-far'.*/);
6718 Vwrite_region_annotate_functions
= Qnil
;
6719 staticpro (&Qwrite_region_annotate_functions
);
6720 Qwrite_region_annotate_functions
6721 = intern ("write-region-annotate-functions");
6723 DEFVAR_LISP ("write-region-annotations-so-far",
6724 &Vwrite_region_annotations_so_far
,
6725 doc
: /* When an annotation function is called, this holds the previous annotations.
6726 These are the annotations made by other annotation functions
6727 that were already called. See also `write-region-annotate-functions'. */);
6728 Vwrite_region_annotations_so_far
= Qnil
;
6730 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6731 doc
: /* A list of file name handlers that temporarily should not be used.
6732 This applies only to the operation `inhibit-file-name-operation'. */);
6733 Vinhibit_file_name_handlers
= Qnil
;
6735 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6736 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6737 Vinhibit_file_name_operation
= Qnil
;
6739 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6740 doc
: /* File name in which we write a list of all auto save file names.
6741 This variable is initialized automatically from `auto-save-list-file-prefix'
6742 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6743 a non-nil value. */);
6744 Vauto_save_list_file_name
= Qnil
;
6747 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6748 doc
: /* *Non-nil means don't call fsync in `write-region'.
6749 This variable affects calls to `write-region' as well as save commands.
6750 A non-nil value may result in data loss! */);
6751 write_region_inhibit_fsync
= 0;
6754 defsubr (&Sfind_file_name_handler
);
6755 defsubr (&Sfile_name_directory
);
6756 defsubr (&Sfile_name_nondirectory
);
6757 defsubr (&Sunhandled_file_name_directory
);
6758 defsubr (&Sfile_name_as_directory
);
6759 defsubr (&Sdirectory_file_name
);
6760 defsubr (&Smake_temp_name
);
6761 defsubr (&Sexpand_file_name
);
6762 defsubr (&Ssubstitute_in_file_name
);
6763 defsubr (&Scopy_file
);
6764 defsubr (&Smake_directory_internal
);
6765 defsubr (&Sdelete_directory
);
6766 defsubr (&Sdelete_file
);
6767 defsubr (&Srename_file
);
6768 defsubr (&Sadd_name_to_file
);
6770 defsubr (&Smake_symbolic_link
);
6771 #endif /* S_IFLNK */
6773 defsubr (&Sdefine_logical_name
);
6776 defsubr (&Ssysnetunam
);
6777 #endif /* HPUX_NET */
6778 defsubr (&Sfile_name_absolute_p
);
6779 defsubr (&Sfile_exists_p
);
6780 defsubr (&Sfile_executable_p
);
6781 defsubr (&Sfile_readable_p
);
6782 defsubr (&Sfile_writable_p
);
6783 defsubr (&Saccess_file
);
6784 defsubr (&Sfile_symlink_p
);
6785 defsubr (&Sfile_directory_p
);
6786 defsubr (&Sfile_accessible_directory_p
);
6787 defsubr (&Sfile_regular_p
);
6788 defsubr (&Sfile_modes
);
6789 defsubr (&Sset_file_modes
);
6790 defsubr (&Sset_file_times
);
6791 defsubr (&Sset_default_file_modes
);
6792 defsubr (&Sdefault_file_modes
);
6793 defsubr (&Sfile_newer_than_file_p
);
6794 defsubr (&Sinsert_file_contents
);
6795 defsubr (&Swrite_region
);
6796 defsubr (&Scar_less_than_car
);
6797 defsubr (&Sverify_visited_file_modtime
);
6798 defsubr (&Sclear_visited_file_modtime
);
6799 defsubr (&Svisited_file_modtime
);
6800 defsubr (&Sset_visited_file_modtime
);
6801 defsubr (&Sdo_auto_save
);
6802 defsubr (&Sset_buffer_auto_saved
);
6803 defsubr (&Sclear_buffer_auto_save_failure
);
6804 defsubr (&Srecent_auto_save_p
);
6806 defsubr (&Sread_file_name_internal
);
6807 defsubr (&Sread_file_name
);
6808 defsubr (&Snext_read_file_uses_dialog_p
);
6811 defsubr (&Sunix_sync
);
6815 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6816 (do not change this comment) */