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
;
1068 CHECK_STRING (name
);
1070 /* If the file name has special constructs in it,
1071 call the corresponding file handler. */
1072 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1073 if (!NILP (handler
))
1074 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1076 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1077 if (NILP (default_directory
))
1078 default_directory
= current_buffer
->directory
;
1079 if (! STRINGP (default_directory
))
1082 /* "/" is not considered a root directory on DOS_NT, so using "/"
1083 here causes an infinite recursion in, e.g., the following:
1085 (let (default-directory)
1086 (expand-file-name "a"))
1088 To avoid this, we set default_directory to the root of the
1090 extern char *emacs_root_dir (void);
1092 default_directory
= build_string (emacs_root_dir ());
1094 default_directory
= build_string ("/");
1098 if (!NILP (default_directory
))
1100 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1101 if (!NILP (handler
))
1102 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1105 o
= SDATA (default_directory
);
1107 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1108 It would be better to do this down below where we actually use
1109 default_directory. Unfortunately, calling Fexpand_file_name recursively
1110 could invoke GC, and the strings might be relocated. This would
1111 be annoying because we have pointers into strings lying around
1112 that would need adjusting, and people would add new pointers to
1113 the code and forget to adjust them, resulting in intermittent bugs.
1114 Putting this call here avoids all that crud.
1116 The EQ test avoids infinite recursion. */
1117 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1118 /* Save time in some common cases - as long as default_directory
1119 is not relative, it can be canonicalized with name below (if it
1120 is needed at all) without requiring it to be expanded now. */
1122 /* Detect MSDOS file names with drive specifiers. */
1123 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1125 /* Detect Windows file names in UNC format. */
1126 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1128 #else /* not DOS_NT */
1129 /* Detect Unix absolute file names (/... alone is not absolute on
1131 && ! (IS_DIRECTORY_SEP (o
[0]))
1132 #endif /* not DOS_NT */
1135 struct gcpro gcpro1
;
1138 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1142 name
= FILE_SYSTEM_CASE (name
);
1143 multibyte
= STRING_MULTIBYTE (name
);
1144 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
1147 default_directory
= string_to_multibyte (default_directory
);
1150 name
= string_to_multibyte (name
);
1158 /* We will force directory separators to be either all \ or /, so make
1159 a local copy to modify, even if there ends up being no change. */
1160 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1162 /* Note if special escape prefix is present, but remove for now. */
1163 if (nm
[0] == '/' && nm
[1] == ':')
1169 /* Find and remove drive specifier if present; this makes nm absolute
1170 even if the rest of the name appears to be relative. Only look for
1171 drive specifier at the beginning. */
1172 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1179 /* If we see "c://somedir", we want to strip the first slash after the
1180 colon when stripping the drive letter. Otherwise, this expands to
1182 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1184 #endif /* WINDOWSNT */
1188 /* Discard any previous drive specifier if nm is now in UNC format. */
1189 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1195 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1196 none are found, we can probably return right away. We will avoid
1197 allocating a new string if name is already fully expanded. */
1199 IS_DIRECTORY_SEP (nm
[0])
1201 && drive
&& !is_escaped
1204 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1211 /* If it turns out that the filename we want to return is just a
1212 suffix of FILENAME, we don't need to go through and edit
1213 things; we just need to construct a new string using data
1214 starting at the middle of FILENAME. If we set lose to a
1215 non-zero value, that means we've discovered that we can't do
1222 /* Since we know the name is absolute, we can assume that each
1223 element starts with a "/". */
1225 /* "." and ".." are hairy. */
1226 if (IS_DIRECTORY_SEP (p
[0])
1228 && (IS_DIRECTORY_SEP (p
[2])
1230 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1233 /* We want to replace multiple `/' in a row with a single
1236 && IS_DIRECTORY_SEP (p
[0])
1237 && IS_DIRECTORY_SEP (p
[1]))
1244 /* if dev:[dir]/, move nm to / */
1245 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1246 nm
= (brack
? brack
+ 1 : colon
+ 1);
1247 lbrack
= rbrack
= 0;
1254 #ifdef NO_HYPHENS_IN_FILENAMES
1255 if (lbrack
== rbrack
)
1257 /* Avoid clobbering negative version numbers. */
1262 #endif /* NO_HYPHENS_IN_FILENAMES */
1264 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1265 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1267 #ifdef NO_HYPHENS_IN_FILENAMES
1270 #endif /* NO_HYPHENS_IN_FILENAMES */
1271 /* count open brackets, reset close bracket pointer */
1272 if (p
[0] == '[' || p
[0] == '<')
1273 lbrack
++, brack
= 0;
1274 /* count close brackets, set close bracket pointer */
1275 if (p
[0] == ']' || p
[0] == '>')
1276 rbrack
++, brack
= p
;
1277 /* detect ][ or >< */
1278 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1280 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1281 nm
= p
+ 1, lose
= 1;
1282 if (p
[0] == ':' && (colon
|| slash
))
1283 /* if dev1:[dir]dev2:, move nm to dev2: */
1289 /* if /name/dev:, move nm to dev: */
1292 /* if node::dev:, move colon following dev */
1293 else if (colon
&& colon
[-1] == ':')
1295 /* if dev1:dev2:, move nm to dev2: */
1296 else if (colon
&& colon
[-1] != ':')
1301 if (p
[0] == ':' && !colon
)
1307 if (lbrack
== rbrack
)
1310 else if (p
[0] == '.')
1318 if (index (nm
, '/'))
1320 nm
= sys_translate_unix (nm
);
1321 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1325 /* Make sure directories are all separated with / or \ as
1326 desired, but avoid allocation of a new string when not
1328 CORRECT_DIR_SEPS (nm
);
1330 if (IS_DIRECTORY_SEP (nm
[1]))
1332 if (strcmp (nm
, SDATA (name
)) != 0)
1333 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1337 /* drive must be set, so this is okay */
1338 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1342 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1343 temp
[0] = DRIVE_LETTER (drive
);
1344 name
= concat2 (build_string (temp
), name
);
1347 #else /* not DOS_NT */
1348 if (nm
== SDATA (name
))
1350 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1351 #endif /* not DOS_NT */
1355 /* At this point, nm might or might not be an absolute file name. We
1356 need to expand ~ or ~user if present, otherwise prefix nm with
1357 default_directory if nm is not absolute, and finally collapse /./
1358 and /foo/../ sequences.
1360 We set newdir to be the appropriate prefix if one is needed:
1361 - the relevant user directory if nm starts with ~ or ~user
1362 - the specified drive's working dir (DOS/NT only) if nm does not
1364 - the value of default_directory.
1366 Note that these prefixes are not guaranteed to be absolute (except
1367 for the working dir of a drive). Therefore, to ensure we always
1368 return an absolute name, if the final prefix is not absolute we
1369 append it to the current working directory. */
1373 if (nm
[0] == '~') /* prefix ~ */
1375 if (IS_DIRECTORY_SEP (nm
[1])
1379 || nm
[1] == 0) /* ~ by itself */
1381 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1382 newdir
= (unsigned char *) "";
1385 collapse_newdir
= 0;
1388 nm
++; /* Don't leave the slash in nm. */
1391 else /* ~user/filename */
1393 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1398 o
= (unsigned char *) alloca (p
- nm
+ 1);
1399 bcopy ((char *) nm
, o
, p
- nm
);
1403 pw
= (struct passwd
*) getpwnam (o
+ 1);
1407 newdir
= (unsigned char *) pw
-> pw_dir
;
1409 nm
= p
+ 1; /* skip the terminator */
1413 collapse_newdir
= 0;
1418 /* If we don't find a user of that name, leave the name
1419 unchanged; don't move nm forward to p. */
1424 /* On DOS and Windows, nm is absolute if a drive name was specified;
1425 use the drive's current directory as the prefix if needed. */
1426 if (!newdir
&& drive
)
1428 /* Get default directory if needed to make nm absolute. */
1429 if (!IS_DIRECTORY_SEP (nm
[0]))
1431 newdir
= alloca (MAXPATHLEN
+ 1);
1432 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1437 /* Either nm starts with /, or drive isn't mounted. */
1438 newdir
= alloca (4);
1439 newdir
[0] = DRIVE_LETTER (drive
);
1447 /* Finally, if no prefix has been specified and nm is not absolute,
1448 then it must be expanded relative to default_directory. */
1452 /* /... alone is not absolute on DOS and Windows. */
1453 && !IS_DIRECTORY_SEP (nm
[0])
1456 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1463 newdir
= SDATA (default_directory
);
1465 /* Note if special escape prefix is present, but remove for now. */
1466 if (newdir
[0] == '/' && newdir
[1] == ':')
1477 /* First ensure newdir is an absolute name. */
1479 /* Detect MSDOS file names with drive specifiers. */
1480 ! (IS_DRIVE (newdir
[0])
1481 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1483 /* Detect Windows file names in UNC format. */
1484 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1488 /* Effectively, let newdir be (expand-file-name newdir cwd).
1489 Because of the admonition against calling expand-file-name
1490 when we have pointers into lisp strings, we accomplish this
1491 indirectly by prepending newdir to nm if necessary, and using
1492 cwd (or the wd of newdir's drive) as the new newdir. */
1494 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1499 if (!IS_DIRECTORY_SEP (nm
[0]))
1501 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1502 file_name_as_directory (tmp
, newdir
);
1506 newdir
= alloca (MAXPATHLEN
+ 1);
1509 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1516 /* Strip off drive name from prefix, if present. */
1517 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1523 /* Keep only a prefix from newdir if nm starts with slash
1524 (//server/share for UNC, nothing otherwise). */
1525 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1528 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1530 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1532 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1534 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1546 /* Get rid of any slash at the end of newdir, unless newdir is
1547 just / or // (an incomplete UNC name). */
1548 length
= strlen (newdir
);
1549 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1551 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1555 unsigned char *temp
= (unsigned char *) alloca (length
);
1556 bcopy (newdir
, temp
, length
- 1);
1557 temp
[length
- 1] = 0;
1565 /* Now concatenate the directory and name to new space in the stack frame */
1566 tlen
+= strlen (nm
) + 1;
1568 /* Reserve space for drive specifier and escape prefix, since either
1569 or both may need to be inserted. (The Microsoft x86 compiler
1570 produces incorrect code if the following two lines are combined.) */
1571 target
= (unsigned char *) alloca (tlen
+ 4);
1573 #else /* not DOS_NT */
1574 target
= (unsigned char *) alloca (tlen
);
1575 #endif /* not DOS_NT */
1581 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1584 /* If newdir is effectively "C:/", then the drive letter will have
1585 been stripped and newdir will be "/". Concatenating with an
1586 absolute directory in nm produces "//", which will then be
1587 incorrectly treated as a network share. Ignore newdir in
1588 this case (keeping the drive letter). */
1589 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1590 && newdir
[1] == '\0'))
1592 strcpy (target
, newdir
);
1596 file_name_as_directory (target
, newdir
);
1599 strcat (target
, nm
);
1601 if (index (target
, '/'))
1602 strcpy (target
, sys_translate_unix (target
));
1605 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1607 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1616 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1622 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1623 /* brackets are offset from each other by 2 */
1626 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1627 /* convert [foo][bar] to [bar] */
1628 while (o
[-1] != '[' && o
[-1] != '<')
1630 else if (*p
== '-' && *o
!= '.')
1633 else if (p
[0] == '-' && o
[-1] == '.'
1634 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1635 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1639 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1640 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1642 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1644 /* else [foo.-] ==> [-] */
1648 #ifdef NO_HYPHENS_IN_FILENAMES
1650 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1651 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1653 #endif /* NO_HYPHENS_IN_FILENAMES */
1657 if (!IS_DIRECTORY_SEP (*p
))
1661 else if (p
[1] == '.'
1662 && (IS_DIRECTORY_SEP (p
[2])
1665 /* If "/." is the entire filename, keep the "/". Otherwise,
1666 just delete the whole "/.". */
1667 if (o
== target
&& p
[2] == '\0')
1671 else if (p
[1] == '.' && p
[2] == '.'
1672 /* `/../' is the "superroot" on certain file systems.
1673 Turned off on DOS_NT systems because they have no
1674 "superroot" and because this causes us to produce
1675 file names like "d:/../foo" which fail file-related
1676 functions of the underlying OS. (To reproduce, try a
1677 long series of "../../" in default_directory, longer
1678 than the number of levels from the root.) */
1682 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1684 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1686 /* Keep initial / only if this is the whole name. */
1687 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1691 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1692 /* Collapse multiple `/' in a row. */
1698 #endif /* not VMS */
1702 /* At last, set drive name. */
1704 /* Except for network file name. */
1705 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1706 #endif /* WINDOWSNT */
1708 if (!drive
) abort ();
1710 target
[0] = DRIVE_LETTER (drive
);
1713 /* Reinsert the escape prefix if required. */
1720 CORRECT_DIR_SEPS (target
);
1723 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1725 /* Again look to see if the file name has special constructs in it
1726 and perhaps call the corresponding file handler. This is needed
1727 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1728 the ".." component gives us "/user@host:/bar/../baz" which needs
1729 to be expanded again. */
1730 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1731 if (!NILP (handler
))
1732 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1738 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1739 This is the old version of expand-file-name, before it was thoroughly
1740 rewritten for Emacs 10.31. We leave this version here commented-out,
1741 because the code is very complex and likely to have subtle bugs. If
1742 bugs _are_ found, it might be of interest to look at the old code and
1743 see what did it do in the relevant situation.
1745 Don't remove this code: it's true that it will be accessible via CVS,
1746 but a few years from deletion, people will forget it is there. */
1748 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1749 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1750 "Convert FILENAME to absolute, and canonicalize it.\n\
1751 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1752 \(does not start with slash); if DEFAULT is nil or missing,\n\
1753 the current buffer's value of default-directory is used.\n\
1754 Filenames containing `.' or `..' as components are simplified;\n\
1755 initial `~/' expands to your home directory.\n\
1756 See also the function `substitute-in-file-name'.")
1758 Lisp_Object name
, defalt
;
1762 register unsigned char *newdir
, *p
, *o
;
1764 unsigned char *target
;
1768 unsigned char * colon
= 0;
1769 unsigned char * close
= 0;
1770 unsigned char * slash
= 0;
1771 unsigned char * brack
= 0;
1772 int lbrack
= 0, rbrack
= 0;
1776 CHECK_STRING (name
);
1779 /* Filenames on VMS are always upper case. */
1780 name
= Fupcase (name
);
1785 /* If nm is absolute, flush ...// and detect /./ and /../.
1786 If no /./ or /../ we can return right away. */
1798 if (p
[0] == '/' && p
[1] == '/'
1801 if (p
[0] == '/' && p
[1] == '~')
1802 nm
= p
+ 1, lose
= 1;
1803 if (p
[0] == '/' && p
[1] == '.'
1804 && (p
[2] == '/' || p
[2] == 0
1805 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1811 /* if dev:[dir]/, move nm to / */
1812 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1813 nm
= (brack
? brack
+ 1 : colon
+ 1);
1814 lbrack
= rbrack
= 0;
1822 /* VMS pre V4.4,convert '-'s in filenames. */
1823 if (lbrack
== rbrack
)
1825 if (dots
< 2) /* this is to allow negative version numbers */
1831 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1832 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1838 /* count open brackets, reset close bracket pointer */
1839 if (p
[0] == '[' || p
[0] == '<')
1840 lbrack
++, brack
= 0;
1841 /* count close brackets, set close bracket pointer */
1842 if (p
[0] == ']' || p
[0] == '>')
1843 rbrack
++, brack
= p
;
1844 /* detect ][ or >< */
1845 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1847 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1848 nm
= p
+ 1, lose
= 1;
1849 if (p
[0] == ':' && (colon
|| slash
))
1850 /* if dev1:[dir]dev2:, move nm to dev2: */
1856 /* If /name/dev:, move nm to dev: */
1859 /* If node::dev:, move colon following dev */
1860 else if (colon
&& colon
[-1] == ':')
1862 /* If dev1:dev2:, move nm to dev2: */
1863 else if (colon
&& colon
[-1] != ':')
1868 if (p
[0] == ':' && !colon
)
1874 if (lbrack
== rbrack
)
1877 else if (p
[0] == '.')
1885 if (index (nm
, '/'))
1886 return build_string (sys_translate_unix (nm
));
1888 if (nm
== SDATA (name
))
1890 return build_string (nm
);
1894 /* Now determine directory to start with and put it in NEWDIR */
1898 if (nm
[0] == '~') /* prefix ~ */
1903 || nm
[1] == 0)/* ~/filename */
1905 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1906 newdir
= (unsigned char *) "";
1909 nm
++; /* Don't leave the slash in nm. */
1912 else /* ~user/filename */
1914 /* Get past ~ to user */
1915 unsigned char *user
= nm
+ 1;
1916 /* Find end of name. */
1917 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1918 int len
= ptr
? ptr
- user
: strlen (user
);
1920 unsigned char *ptr1
= index (user
, ':');
1921 if (ptr1
!= 0 && ptr1
- user
< len
)
1924 /* Copy the user name into temp storage. */
1925 o
= (unsigned char *) alloca (len
+ 1);
1926 bcopy ((char *) user
, o
, len
);
1929 /* Look up the user name. */
1931 pw
= (struct passwd
*) getpwnam (o
+ 1);
1934 error ("\"%s\" isn't a registered user", o
+ 1);
1936 newdir
= (unsigned char *) pw
->pw_dir
;
1938 /* Discard the user name from NM. */
1945 #endif /* not VMS */
1949 defalt
= current_buffer
->directory
;
1950 CHECK_STRING (defalt
);
1951 newdir
= SDATA (defalt
);
1954 /* Now concatenate the directory and name to new space in the stack frame */
1956 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1957 target
= (unsigned char *) alloca (tlen
);
1963 if (nm
[0] == 0 || nm
[0] == '/')
1964 strcpy (target
, newdir
);
1967 file_name_as_directory (target
, newdir
);
1970 strcat (target
, nm
);
1972 if (index (target
, '/'))
1973 strcpy (target
, sys_translate_unix (target
));
1976 /* Now canonicalize by removing /. and /foo/.. if they appear */
1984 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1990 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1991 /* brackets are offset from each other by 2 */
1994 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1995 /* convert [foo][bar] to [bar] */
1996 while (o
[-1] != '[' && o
[-1] != '<')
1998 else if (*p
== '-' && *o
!= '.')
2001 else if (p
[0] == '-' && o
[-1] == '.'
2002 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2003 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2007 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2008 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2010 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2012 /* else [foo.-] ==> [-] */
2018 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2019 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2029 else if (!strncmp (p
, "//", 2)
2035 else if (p
[0] == '/' && p
[1] == '.'
2036 && (p
[2] == '/' || p
[2] == 0))
2038 else if (!strncmp (p
, "/..", 3)
2039 /* `/../' is the "superroot" on certain file systems. */
2041 && (p
[3] == '/' || p
[3] == 0))
2043 while (o
!= target
&& *--o
!= '/')
2045 if (o
== target
&& *o
== '/')
2053 #endif /* not VMS */
2056 return make_string (target
, o
- target
);
2060 /* If /~ or // appears, discard everything through first slash. */
2062 file_name_absolute_p (filename
)
2063 const unsigned char *filename
;
2066 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2068 /* ??? This criterion is probably wrong for '<'. */
2069 || index (filename
, ':') || index (filename
, '<')
2070 || (*filename
== '[' && (filename
[1] != '-'
2071 || (filename
[2] != '.' && filename
[2] != ']'))
2072 && filename
[1] != '.')
2075 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2076 && IS_DIRECTORY_SEP (filename
[2]))
2081 static unsigned char *
2082 search_embedded_absfilename (nm
, endp
)
2083 unsigned char *nm
, *endp
;
2085 unsigned char *p
, *s
;
2087 for (p
= nm
+ 1; p
< endp
; p
++)
2091 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2093 || IS_DIRECTORY_SEP (p
[-1]))
2094 && file_name_absolute_p (p
)
2095 #if defined (WINDOWSNT) || defined(CYGWIN)
2096 /* // at start of file name is meaningful in Apollo,
2097 WindowsNT and Cygwin systems. */
2098 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2099 #endif /* not (WINDOWSNT || CYGWIN) */
2102 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2107 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2109 unsigned char *o
= alloca (s
- p
+ 1);
2111 bcopy (p
, o
, s
- p
);
2114 /* If we have ~user and `user' exists, discard
2115 everything up to ~. But if `user' does not exist, leave
2116 ~user alone, it might be a literal file name. */
2118 pw
= getpwnam (o
+ 1);
2130 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2131 Ssubstitute_in_file_name
, 1, 1, 0,
2132 doc
: /* Substitute environment variables referred to in FILENAME.
2133 `$FOO' where FOO is an environment variable name means to substitute
2134 the value of that variable. The variable name should be terminated
2135 with a character not a letter, digit or underscore; otherwise, enclose
2136 the entire variable name in braces.
2137 If `/~' appears, all of FILENAME through that `/' is discarded.
2139 On VMS, `$' substitution is not done; this function does little and only
2140 duplicates what `expand-file-name' does. */)
2142 Lisp_Object filename
;
2146 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2147 unsigned char *target
= NULL
;
2149 int substituted
= 0;
2151 Lisp_Object handler
;
2153 CHECK_STRING (filename
);
2155 /* If the file name has special constructs in it,
2156 call the corresponding file handler. */
2157 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2158 if (!NILP (handler
))
2159 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2161 nm
= SDATA (filename
);
2163 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2164 CORRECT_DIR_SEPS (nm
);
2165 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2167 endp
= nm
+ SBYTES (filename
);
2169 /* If /~ or // appears, discard everything through first slash. */
2170 p
= search_embedded_absfilename (nm
, endp
);
2172 /* Start over with the new string, so we check the file-name-handler
2173 again. Important with filenames like "/home/foo//:/hello///there"
2174 which whould substitute to "/:/hello///there" rather than "/there". */
2175 return Fsubstitute_in_file_name
2176 (make_specified_string (p
, -1, endp
- p
,
2177 STRING_MULTIBYTE (filename
)));
2183 /* See if any variables are substituted into the string
2184 and find the total length of their values in `total' */
2186 for (p
= nm
; p
!= endp
;)
2196 /* "$$" means a single "$" */
2205 while (p
!= endp
&& *p
!= '}') p
++;
2206 if (*p
!= '}') goto missingclose
;
2212 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2216 /* Copy out the variable name */
2217 target
= (unsigned char *) alloca (s
- o
+ 1);
2218 strncpy (target
, o
, s
- o
);
2221 strupr (target
); /* $home == $HOME etc. */
2224 /* Get variable value */
2225 o
= (unsigned char *) egetenv (target
);
2228 total
+= strlen (o
);
2238 /* If substitution required, recopy the string and do it */
2239 /* Make space in stack frame for the new copy */
2240 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2243 /* Copy the rest of the name through, replacing $ constructs with values */
2260 while (p
!= endp
&& *p
!= '}') p
++;
2261 if (*p
!= '}') goto missingclose
;
2267 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2271 /* Copy out the variable name */
2272 target
= (unsigned char *) alloca (s
- o
+ 1);
2273 strncpy (target
, o
, s
- o
);
2276 strupr (target
); /* $home == $HOME etc. */
2279 /* Get variable value */
2280 o
= (unsigned char *) egetenv (target
);
2284 strcpy (x
, target
); x
+= strlen (target
);
2286 else if (STRING_MULTIBYTE (filename
))
2288 /* If the original string is multibyte,
2289 convert what we substitute into multibyte. */
2293 c
= unibyte_char_to_multibyte (c
);
2294 x
+= CHAR_STRING (c
, x
);
2306 /* If /~ or // appears, discard everything through first slash. */
2307 while ((p
= search_embedded_absfilename (xnm
, x
)))
2308 /* This time we do not start over because we've already expanded envvars
2309 and replaced $$ with $. Maybe we should start over as well, but we'd
2310 need to quote some $ to $$ first. */
2313 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2316 error ("Bad format environment-variable substitution");
2318 error ("Missing \"}\" in environment-variable substitution");
2320 error ("Substituting nonexistent environment variable \"%s\"", target
);
2323 #endif /* not VMS */
2327 /* A slightly faster and more convenient way to get
2328 (directory-file-name (expand-file-name FOO)). */
2331 expand_and_dir_to_file (filename
, defdir
)
2332 Lisp_Object filename
, defdir
;
2334 register Lisp_Object absname
;
2336 absname
= Fexpand_file_name (filename
, defdir
);
2339 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2340 if (c
== ':' || c
== ']' || c
== '>')
2341 absname
= Fdirectory_file_name (absname
);
2344 /* Remove final slash, if any (unless this is the root dir).
2345 stat behaves differently depending! */
2346 if (SCHARS (absname
) > 1
2347 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2348 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2349 /* We cannot take shortcuts; they might be wrong for magic file names. */
2350 absname
= Fdirectory_file_name (absname
);
2355 /* Signal an error if the file ABSNAME already exists.
2356 If INTERACTIVE is nonzero, ask the user whether to proceed,
2357 and bypass the error if the user says to go ahead.
2358 QUERYSTRING is a name for the action that is being considered
2361 *STATPTR is used to store the stat information if the file exists.
2362 If the file does not exist, STATPTR->st_mode is set to 0.
2363 If STATPTR is null, we don't store into it.
2365 If QUICK is nonzero, we ask for y or n, not yes or no. */
2368 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2369 Lisp_Object absname
;
2370 unsigned char *querystring
;
2372 struct stat
*statptr
;
2375 register Lisp_Object tem
, encoded_filename
;
2376 struct stat statbuf
;
2377 struct gcpro gcpro1
;
2379 encoded_filename
= ENCODE_FILE (absname
);
2381 /* stat is a good way to tell whether the file exists,
2382 regardless of what access permissions it has. */
2383 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2386 xsignal2 (Qfile_already_exists
,
2387 build_string ("File already exists"), absname
);
2389 tem
= format2 ("File %s already exists; %s anyway? ",
2390 absname
, build_string (querystring
));
2392 tem
= Fy_or_n_p (tem
);
2394 tem
= do_yes_or_no_p (tem
);
2397 xsignal2 (Qfile_already_exists
,
2398 build_string ("File already exists"), absname
);
2405 statptr
->st_mode
= 0;
2410 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2411 "fCopy file: \nGCopy %s to file: \np\nP",
2412 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2413 If NEWNAME names a directory, copy FILE there.
2415 This function always sets the file modes of the output file to match
2418 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2419 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2420 signal a `file-already-exists' error without overwriting. If
2421 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2422 about overwriting; this is what happens in interactive use with M-x.
2423 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2426 Fourth arg KEEP-TIME non-nil means give the output file the same
2427 last-modified time as the old one. (This works on only some systems.)
2429 A prefix arg makes KEEP-TIME non-nil.
2431 If PRESERVE-UID-GID is non-nil, we try to transfer the
2432 uid and gid of FILE to NEWNAME. */)
2433 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2434 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2435 Lisp_Object preserve_uid_gid
;
2438 char buf
[16 * 1024];
2439 struct stat st
, out_st
;
2440 Lisp_Object handler
;
2441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2442 int count
= SPECPDL_INDEX ();
2443 int input_file_statable_p
;
2444 Lisp_Object encoded_file
, encoded_newname
;
2446 encoded_file
= encoded_newname
= Qnil
;
2447 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2448 CHECK_STRING (file
);
2449 CHECK_STRING (newname
);
2451 if (!NILP (Ffile_directory_p (newname
)))
2452 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2454 newname
= Fexpand_file_name (newname
, Qnil
);
2456 file
= Fexpand_file_name (file
, Qnil
);
2458 /* If the input file name has special constructs in it,
2459 call the corresponding file handler. */
2460 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2461 /* Likewise for output file name. */
2463 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2464 if (!NILP (handler
))
2465 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
2466 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
2468 encoded_file
= ENCODE_FILE (file
);
2469 encoded_newname
= ENCODE_FILE (newname
);
2471 if (NILP (ok_if_already_exists
)
2472 || INTEGERP (ok_if_already_exists
))
2473 barf_or_query_if_file_exists (newname
, "copy to it",
2474 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2475 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2479 if (!CopyFile (SDATA (encoded_file
),
2480 SDATA (encoded_newname
),
2482 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2483 /* CopyFile retains the timestamp by default. */
2484 else if (NILP (keep_time
))
2490 EMACS_GET_TIME (now
);
2491 filename
= SDATA (encoded_newname
);
2493 /* Ensure file is writable while its modified time is set. */
2494 attributes
= GetFileAttributes (filename
);
2495 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2496 if (set_file_times (filename
, now
, now
))
2498 /* Restore original attributes. */
2499 SetFileAttributes (filename
, attributes
);
2500 xsignal2 (Qfile_date_error
,
2501 build_string ("Cannot set file date"), newname
);
2503 /* Restore original attributes. */
2504 SetFileAttributes (filename
, attributes
);
2506 #else /* not WINDOWSNT */
2508 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2512 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2514 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2516 /* We can only copy regular files and symbolic links. Other files are not
2518 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2520 #if !defined (MSDOS) || __DJGPP__ > 1
2521 if (out_st
.st_mode
!= 0
2522 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2525 report_file_error ("Input and output files are the same",
2526 Fcons (file
, Fcons (newname
, Qnil
)));
2530 #if defined (S_ISREG) && defined (S_ISLNK)
2531 if (input_file_statable_p
)
2533 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2535 #if defined (EISDIR)
2536 /* Get a better looking error message. */
2539 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2542 #endif /* S_ISREG && S_ISLNK */
2545 /* Create the copy file with the same record format as the input file */
2546 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2549 /* System's default file type was set to binary by _fmode in emacs.c. */
2550 ofd
= emacs_open (SDATA (encoded_newname
),
2551 O_WRONLY
| O_TRUNC
| O_CREAT
2552 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2553 S_IREAD
| S_IWRITE
);
2554 #else /* not MSDOS */
2555 ofd
= emacs_open (SDATA (encoded_newname
),
2556 O_WRONLY
| O_TRUNC
| O_CREAT
2557 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2559 #endif /* not MSDOS */
2562 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2564 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2568 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2569 if (emacs_write (ofd
, buf
, n
) != n
)
2570 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2574 /* Preserve the original file modes, and if requested, also its
2576 if (input_file_statable_p
)
2578 if (! NILP (preserve_uid_gid
))
2579 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2580 fchmod (ofd
, st
.st_mode
& 07777);
2582 #endif /* not MSDOS */
2584 /* Closing the output clobbers the file times on some systems. */
2585 if (emacs_close (ofd
) < 0)
2586 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2588 if (input_file_statable_p
)
2590 if (!NILP (keep_time
))
2592 EMACS_TIME atime
, mtime
;
2593 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2594 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2595 if (set_file_times (SDATA (encoded_newname
),
2597 xsignal2 (Qfile_date_error
,
2598 build_string ("Cannot set file date"), newname
);
2604 #if defined (__DJGPP__) && __DJGPP__ > 1
2605 if (input_file_statable_p
)
2607 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2608 and if it can't, it tells so. Otherwise, under MSDOS we usually
2609 get only the READ bit, which will make the copied file read-only,
2610 so it's better not to chmod at all. */
2611 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2612 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2614 #endif /* DJGPP version 2 or newer */
2615 #endif /* not WINDOWSNT */
2617 /* Discard the unwind protects. */
2618 specpdl_ptr
= specpdl
+ count
;
2624 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2625 Smake_directory_internal
, 1, 1, 0,
2626 doc
: /* Create a new directory named DIRECTORY. */)
2628 Lisp_Object directory
;
2630 const unsigned char *dir
;
2631 Lisp_Object handler
;
2632 Lisp_Object encoded_dir
;
2634 CHECK_STRING (directory
);
2635 directory
= Fexpand_file_name (directory
, Qnil
);
2637 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2638 if (!NILP (handler
))
2639 return call2 (handler
, Qmake_directory_internal
, directory
);
2641 encoded_dir
= ENCODE_FILE (directory
);
2643 dir
= SDATA (encoded_dir
);
2646 if (mkdir (dir
) != 0)
2648 if (mkdir (dir
, 0777) != 0)
2650 report_file_error ("Creating directory", list1 (directory
));
2655 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2656 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2658 Lisp_Object directory
;
2660 const unsigned char *dir
;
2661 Lisp_Object handler
;
2662 Lisp_Object encoded_dir
;
2664 CHECK_STRING (directory
);
2665 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2667 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2668 if (!NILP (handler
))
2669 return call2 (handler
, Qdelete_directory
, directory
);
2671 encoded_dir
= ENCODE_FILE (directory
);
2673 dir
= SDATA (encoded_dir
);
2675 if (rmdir (dir
) != 0)
2676 report_file_error ("Removing directory", list1 (directory
));
2681 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2682 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2683 If file has multiple names, it continues to exist with the other names. */)
2685 Lisp_Object filename
;
2687 Lisp_Object handler
;
2688 Lisp_Object encoded_file
;
2689 struct gcpro gcpro1
;
2692 if (!NILP (Ffile_directory_p (filename
))
2693 && NILP (Ffile_symlink_p (filename
)))
2694 xsignal2 (Qfile_error
,
2695 build_string ("Removing old name: is a directory"),
2698 filename
= Fexpand_file_name (filename
, Qnil
);
2700 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2701 if (!NILP (handler
))
2702 return call2 (handler
, Qdelete_file
, filename
);
2704 encoded_file
= ENCODE_FILE (filename
);
2706 if (0 > unlink (SDATA (encoded_file
)))
2707 report_file_error ("Removing old name", list1 (filename
));
2712 internal_delete_file_1 (ignore
)
2718 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2721 internal_delete_file (filename
)
2722 Lisp_Object filename
;
2725 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2726 Qt
, internal_delete_file_1
);
2730 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2731 "fRename file: \nGRename %s to file: \np",
2732 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2733 If file has names other than FILE, it continues to have those names.
2734 Signals a `file-already-exists' error if a file NEWNAME already exists
2735 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2736 A number as third arg means request confirmation if NEWNAME already exists.
2737 This is what happens in interactive use with M-x. */)
2738 (file
, newname
, ok_if_already_exists
)
2739 Lisp_Object file
, newname
, ok_if_already_exists
;
2741 Lisp_Object handler
;
2742 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2743 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2745 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2746 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2747 CHECK_STRING (file
);
2748 CHECK_STRING (newname
);
2749 file
= Fexpand_file_name (file
, Qnil
);
2751 if ((!NILP (Ffile_directory_p (newname
)))
2753 /* If the file names are identical but for the case,
2754 don't attempt to move directory to itself. */
2755 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2758 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2760 newname
= Fexpand_file_name (newname
, Qnil
);
2762 /* If the file name has special constructs in it,
2763 call the corresponding file handler. */
2764 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2766 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2767 if (!NILP (handler
))
2768 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2769 file
, newname
, ok_if_already_exists
));
2771 encoded_file
= ENCODE_FILE (file
);
2772 encoded_newname
= ENCODE_FILE (newname
);
2775 /* If the file names are identical but for the case, don't ask for
2776 confirmation: they simply want to change the letter-case of the
2778 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2780 if (NILP (ok_if_already_exists
)
2781 || INTEGERP (ok_if_already_exists
))
2782 barf_or_query_if_file_exists (newname
, "rename to it",
2783 INTEGERP (ok_if_already_exists
), 0, 0);
2785 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2787 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2788 || 0 > unlink (SDATA (encoded_file
)))
2794 symlink_target
= Ffile_symlink_p (file
);
2795 if (! NILP (symlink_target
))
2796 Fmake_symbolic_link (symlink_target
, newname
,
2797 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2800 Fcopy_file (file
, newname
,
2801 /* We have already prompted if it was an integer,
2802 so don't have copy-file prompt again. */
2803 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2806 Fdelete_file (file
);
2809 report_file_error ("Renaming", list2 (file
, newname
));
2815 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2816 "fAdd name to file: \nGName to add to %s: \np",
2817 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2818 Signals a `file-already-exists' error if a file NEWNAME already exists
2819 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2820 A number as third arg means request confirmation if NEWNAME already exists.
2821 This is what happens in interactive use with M-x. */)
2822 (file
, newname
, ok_if_already_exists
)
2823 Lisp_Object file
, newname
, ok_if_already_exists
;
2825 Lisp_Object handler
;
2826 Lisp_Object encoded_file
, encoded_newname
;
2827 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2829 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2830 encoded_file
= encoded_newname
= Qnil
;
2831 CHECK_STRING (file
);
2832 CHECK_STRING (newname
);
2833 file
= Fexpand_file_name (file
, Qnil
);
2835 if (!NILP (Ffile_directory_p (newname
)))
2836 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2838 newname
= Fexpand_file_name (newname
, Qnil
);
2840 /* If the file name has special constructs in it,
2841 call the corresponding file handler. */
2842 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2843 if (!NILP (handler
))
2844 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2845 newname
, ok_if_already_exists
));
2847 /* If the new name has special constructs in it,
2848 call the corresponding file handler. */
2849 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2850 if (!NILP (handler
))
2851 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2852 newname
, ok_if_already_exists
));
2854 encoded_file
= ENCODE_FILE (file
);
2855 encoded_newname
= ENCODE_FILE (newname
);
2857 if (NILP (ok_if_already_exists
)
2858 || INTEGERP (ok_if_already_exists
))
2859 barf_or_query_if_file_exists (newname
, "make it a new name",
2860 INTEGERP (ok_if_already_exists
), 0, 0);
2862 unlink (SDATA (newname
));
2863 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2864 report_file_error ("Adding new name", list2 (file
, newname
));
2871 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2872 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2873 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2874 Both args must be strings.
2875 Signals a `file-already-exists' error if a file LINKNAME already exists
2876 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2877 A number as third arg means request confirmation if LINKNAME already exists.
2878 This happens for interactive use with M-x. */)
2879 (filename
, linkname
, ok_if_already_exists
)
2880 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2882 Lisp_Object handler
;
2883 Lisp_Object encoded_filename
, encoded_linkname
;
2884 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2886 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2887 encoded_filename
= encoded_linkname
= Qnil
;
2888 CHECK_STRING (filename
);
2889 CHECK_STRING (linkname
);
2890 /* If the link target has a ~, we must expand it to get
2891 a truly valid file name. Otherwise, do not expand;
2892 we want to permit links to relative file names. */
2893 if (SREF (filename
, 0) == '~')
2894 filename
= Fexpand_file_name (filename
, Qnil
);
2896 if (!NILP (Ffile_directory_p (linkname
)))
2897 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2899 linkname
= Fexpand_file_name (linkname
, Qnil
);
2901 /* If the file name has special constructs in it,
2902 call the corresponding file handler. */
2903 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2904 if (!NILP (handler
))
2905 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2906 linkname
, ok_if_already_exists
));
2908 /* If the new link name has special constructs in it,
2909 call the corresponding file handler. */
2910 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2911 if (!NILP (handler
))
2912 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2913 linkname
, ok_if_already_exists
));
2915 encoded_filename
= ENCODE_FILE (filename
);
2916 encoded_linkname
= ENCODE_FILE (linkname
);
2918 if (NILP (ok_if_already_exists
)
2919 || INTEGERP (ok_if_already_exists
))
2920 barf_or_query_if_file_exists (linkname
, "make it a link",
2921 INTEGERP (ok_if_already_exists
), 0, 0);
2922 if (0 > symlink (SDATA (encoded_filename
),
2923 SDATA (encoded_linkname
)))
2925 /* If we didn't complain already, silently delete existing file. */
2926 if (errno
== EEXIST
)
2928 unlink (SDATA (encoded_linkname
));
2929 if (0 <= symlink (SDATA (encoded_filename
),
2930 SDATA (encoded_linkname
)))
2937 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2942 #endif /* S_IFLNK */
2946 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2947 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2948 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2949 If STRING is nil or a null string, the logical name NAME is deleted. */)
2954 CHECK_STRING (name
);
2956 delete_logical_name (SDATA (name
));
2959 CHECK_STRING (string
);
2961 if (SCHARS (string
) == 0)
2962 delete_logical_name (SDATA (name
));
2964 define_logical_name (SDATA (name
), SDATA (string
));
2973 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2974 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2976 Lisp_Object path
, login
;
2980 CHECK_STRING (path
);
2981 CHECK_STRING (login
);
2983 netresult
= netunam (SDATA (path
), SDATA (login
));
2985 if (netresult
== -1)
2990 #endif /* HPUX_NET */
2992 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2994 doc
: /* Return t if file FILENAME specifies an absolute file name.
2995 On Unix, this is a name starting with a `/' or a `~'. */)
2997 Lisp_Object filename
;
2999 CHECK_STRING (filename
);
3000 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3003 /* Return nonzero if file FILENAME exists and can be executed. */
3006 check_executable (filename
)
3010 int len
= strlen (filename
);
3013 if (stat (filename
, &st
) < 0)
3015 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3016 return ((st
.st_mode
& S_IEXEC
) != 0);
3018 return (S_ISREG (st
.st_mode
)
3020 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3021 || stricmp (suffix
, ".exe") == 0
3022 || stricmp (suffix
, ".bat") == 0)
3023 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3024 #endif /* not WINDOWSNT */
3025 #else /* not DOS_NT */
3026 #ifdef HAVE_EUIDACCESS
3027 return (euidaccess (filename
, 1) >= 0);
3029 /* Access isn't quite right because it uses the real uid
3030 and we really want to test with the effective uid.
3031 But Unix doesn't give us a right way to do it. */
3032 return (access (filename
, 1) >= 0);
3034 #endif /* not DOS_NT */
3037 /* Return nonzero if file FILENAME exists and can be written. */
3040 check_writable (filename
)
3045 if (stat (filename
, &st
) < 0)
3047 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3048 #else /* not MSDOS */
3049 #ifdef HAVE_EUIDACCESS
3050 return (euidaccess (filename
, 2) >= 0);
3052 /* Access isn't quite right because it uses the real uid
3053 and we really want to test with the effective uid.
3054 But Unix doesn't give us a right way to do it.
3055 Opening with O_WRONLY could work for an ordinary file,
3056 but would lose for directories. */
3057 return (access (filename
, 2) >= 0);
3059 #endif /* not MSDOS */
3062 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3063 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3064 See also `file-readable-p' and `file-attributes'.
3065 This returns nil for a symlink to a nonexistent file.
3066 Use `file-symlink-p' to test for such links. */)
3068 Lisp_Object filename
;
3070 Lisp_Object absname
;
3071 Lisp_Object handler
;
3072 struct stat statbuf
;
3074 CHECK_STRING (filename
);
3075 absname
= Fexpand_file_name (filename
, Qnil
);
3077 /* If the file name has special constructs in it,
3078 call the corresponding file handler. */
3079 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3080 if (!NILP (handler
))
3081 return call2 (handler
, Qfile_exists_p
, absname
);
3083 absname
= ENCODE_FILE (absname
);
3085 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3088 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3089 doc
: /* Return t if FILENAME can be executed by you.
3090 For a directory, this means you can access files in that directory. */)
3092 Lisp_Object filename
;
3094 Lisp_Object absname
;
3095 Lisp_Object handler
;
3097 CHECK_STRING (filename
);
3098 absname
= Fexpand_file_name (filename
, Qnil
);
3100 /* If the file name has special constructs in it,
3101 call the corresponding file handler. */
3102 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3103 if (!NILP (handler
))
3104 return call2 (handler
, Qfile_executable_p
, absname
);
3106 absname
= ENCODE_FILE (absname
);
3108 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3111 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3112 doc
: /* Return t if file FILENAME exists and you can read it.
3113 See also `file-exists-p' and `file-attributes'. */)
3115 Lisp_Object filename
;
3117 Lisp_Object absname
;
3118 Lisp_Object handler
;
3121 struct stat statbuf
;
3123 CHECK_STRING (filename
);
3124 absname
= Fexpand_file_name (filename
, Qnil
);
3126 /* If the file name has special constructs in it,
3127 call the corresponding file handler. */
3128 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3129 if (!NILP (handler
))
3130 return call2 (handler
, Qfile_readable_p
, absname
);
3132 absname
= ENCODE_FILE (absname
);
3134 #if defined(DOS_NT) || defined(macintosh)
3135 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3137 if (access (SDATA (absname
), 0) == 0)
3140 #else /* not DOS_NT and not macintosh */
3142 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3143 /* Opening a fifo without O_NONBLOCK can wait.
3144 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3145 except in the case of a fifo, on a system which handles it. */
3146 desc
= stat (SDATA (absname
), &statbuf
);
3149 if (S_ISFIFO (statbuf
.st_mode
))
3150 flags
|= O_NONBLOCK
;
3152 desc
= emacs_open (SDATA (absname
), flags
, 0);
3157 #endif /* not DOS_NT and not macintosh */
3160 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3162 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3163 doc
: /* Return t if file FILENAME can be written or created by you. */)
3165 Lisp_Object filename
;
3167 Lisp_Object absname
, dir
, encoded
;
3168 Lisp_Object handler
;
3169 struct stat statbuf
;
3171 CHECK_STRING (filename
);
3172 absname
= Fexpand_file_name (filename
, Qnil
);
3174 /* If the file name has special constructs in it,
3175 call the corresponding file handler. */
3176 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3177 if (!NILP (handler
))
3178 return call2 (handler
, Qfile_writable_p
, absname
);
3180 encoded
= ENCODE_FILE (absname
);
3181 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3182 return (check_writable (SDATA (encoded
))
3185 dir
= Ffile_name_directory (absname
);
3188 dir
= Fdirectory_file_name (dir
);
3192 dir
= Fdirectory_file_name (dir
);
3195 dir
= ENCODE_FILE (dir
);
3197 /* The read-only attribute of the parent directory doesn't affect
3198 whether a file or directory can be created within it. Some day we
3199 should check ACLs though, which do affect this. */
3200 if (stat (SDATA (dir
), &statbuf
) < 0)
3202 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3204 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3209 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3210 doc
: /* Access file FILENAME, and get an error if that does not work.
3211 The second argument STRING is used in the error message.
3212 If there is no error, returns nil. */)
3214 Lisp_Object filename
, string
;
3216 Lisp_Object handler
, encoded_filename
, absname
;
3219 CHECK_STRING (filename
);
3220 absname
= Fexpand_file_name (filename
, Qnil
);
3222 CHECK_STRING (string
);
3224 /* If the file name has special constructs in it,
3225 call the corresponding file handler. */
3226 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3227 if (!NILP (handler
))
3228 return call3 (handler
, Qaccess_file
, absname
, string
);
3230 encoded_filename
= ENCODE_FILE (absname
);
3232 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3234 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3240 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3241 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3242 The value is the link target, as a string.
3243 Otherwise it returns nil.
3245 This function returns t when given the name of a symlink that
3246 points to a nonexistent file. */)
3248 Lisp_Object filename
;
3250 Lisp_Object handler
;
3252 CHECK_STRING (filename
);
3253 filename
= Fexpand_file_name (filename
, Qnil
);
3255 /* If the file name has special constructs in it,
3256 call the corresponding file handler. */
3257 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3258 if (!NILP (handler
))
3259 return call2 (handler
, Qfile_symlink_p
, filename
);
3268 filename
= ENCODE_FILE (filename
);
3275 buf
= (char *) xrealloc (buf
, bufsize
);
3276 bzero (buf
, bufsize
);
3279 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3283 /* HP-UX reports ERANGE if buffer is too small. */
3284 if (errno
== ERANGE
)
3294 while (valsize
>= bufsize
);
3296 val
= make_string (buf
, valsize
);
3297 if (buf
[0] == '/' && index (buf
, ':'))
3298 val
= concat2 (build_string ("/:"), val
);
3300 val
= DECODE_FILE (val
);
3303 #else /* not S_IFLNK */
3305 #endif /* not S_IFLNK */
3308 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3309 doc
: /* Return t if FILENAME names an existing directory.
3310 Symbolic links to directories count as directories.
3311 See `file-symlink-p' to distinguish symlinks. */)
3313 Lisp_Object filename
;
3315 register Lisp_Object absname
;
3317 Lisp_Object handler
;
3319 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3321 /* If the file name has special constructs in it,
3322 call the corresponding file handler. */
3323 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3324 if (!NILP (handler
))
3325 return call2 (handler
, Qfile_directory_p
, absname
);
3327 absname
= ENCODE_FILE (absname
);
3329 if (stat (SDATA (absname
), &st
) < 0)
3331 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3334 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3335 doc
: /* Return t if file FILENAME names a directory you can open.
3336 For the value to be t, FILENAME must specify the name of a directory as a file,
3337 and the directory must allow you to open files in it. In order to use a
3338 directory as a buffer's current directory, this predicate must return true.
3339 A directory name spec may be given instead; then the value is t
3340 if the directory so specified exists and really is a readable and
3341 searchable directory. */)
3343 Lisp_Object filename
;
3345 Lisp_Object handler
;
3347 struct gcpro gcpro1
;
3349 /* If the file name has special constructs in it,
3350 call the corresponding file handler. */
3351 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3352 if (!NILP (handler
))
3353 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3356 tem
= (NILP (Ffile_directory_p (filename
))
3357 || NILP (Ffile_executable_p (filename
)));
3359 return tem
? Qnil
: Qt
;
3362 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3363 doc
: /* Return t if FILENAME names a regular file.
3364 This is the sort of file that holds an ordinary stream of data bytes.
3365 Symbolic links to regular files count as regular files.
3366 See `file-symlink-p' to distinguish symlinks. */)
3368 Lisp_Object filename
;
3370 register Lisp_Object absname
;
3372 Lisp_Object handler
;
3374 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3376 /* If the file name has special constructs in it,
3377 call the corresponding file handler. */
3378 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3379 if (!NILP (handler
))
3380 return call2 (handler
, Qfile_regular_p
, absname
);
3382 absname
= ENCODE_FILE (absname
);
3387 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3389 /* Tell stat to use expensive method to get accurate info. */
3390 Vw32_get_true_file_attributes
= Qt
;
3391 result
= stat (SDATA (absname
), &st
);
3392 Vw32_get_true_file_attributes
= tem
;
3396 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3399 if (stat (SDATA (absname
), &st
) < 0)
3401 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3405 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3406 doc
: /* Return mode bits of file named FILENAME, as an integer.
3407 Return nil, if file does not exist or is not accessible. */)
3409 Lisp_Object filename
;
3411 Lisp_Object absname
;
3413 Lisp_Object handler
;
3415 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3417 /* If the file name has special constructs in it,
3418 call the corresponding file handler. */
3419 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3420 if (!NILP (handler
))
3421 return call2 (handler
, Qfile_modes
, absname
);
3423 absname
= ENCODE_FILE (absname
);
3425 if (stat (SDATA (absname
), &st
) < 0)
3427 #if defined (MSDOS) && __DJGPP__ < 2
3428 if (check_executable (SDATA (absname
)))
3429 st
.st_mode
|= S_IEXEC
;
3430 #endif /* MSDOS && __DJGPP__ < 2 */
3432 return make_number (st
.st_mode
& 07777);
3435 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3436 "(let ((file (read-file-name \"File: \"))) \
3437 (list file (read-file-modes nil file)))",
3438 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3439 Only the 12 low bits of MODE are used. */)
3441 Lisp_Object filename
, mode
;
3443 Lisp_Object absname
, encoded_absname
;
3444 Lisp_Object handler
;
3446 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3447 CHECK_NUMBER (mode
);
3449 /* If the file name has special constructs in it,
3450 call the corresponding file handler. */
3451 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3452 if (!NILP (handler
))
3453 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3455 encoded_absname
= ENCODE_FILE (absname
);
3457 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3458 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3463 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3464 doc
: /* Set the file permission bits for newly created files.
3465 The argument MODE should be an integer; only the low 9 bits are used.
3466 This setting is inherited by subprocesses. */)
3470 CHECK_NUMBER (mode
);
3472 umask ((~ XINT (mode
)) & 0777);
3477 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3478 doc
: /* Return the default file protection for created files.
3479 The value is an integer. */)
3485 realmask
= umask (0);
3488 XSETINT (value
, (~ realmask
) & 0777);
3492 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3494 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3495 doc
: /* Set times of file FILENAME to TIME.
3496 Set both access and modification times.
3497 Return t on success, else nil.
3498 Use the current time if TIME is nil. TIME is in the format of
3501 Lisp_Object filename
, time
;
3503 Lisp_Object absname
, encoded_absname
;
3504 Lisp_Object handler
;
3508 if (! lisp_time_argument (time
, &sec
, &usec
))
3509 error ("Invalid time specification");
3511 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3513 /* If the file name has special constructs in it,
3514 call the corresponding file handler. */
3515 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3516 if (!NILP (handler
))
3517 return call3 (handler
, Qset_file_times
, absname
, time
);
3519 encoded_absname
= ENCODE_FILE (absname
);
3524 EMACS_SET_SECS (t
, sec
);
3525 EMACS_SET_USECS (t
, usec
);
3527 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3532 /* Setting times on a directory always fails. */
3533 if (stat (SDATA (encoded_absname
), &st
) == 0
3534 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3537 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3546 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3547 doc
: /* Tell Unix to finish all pending disk updates. */)
3554 #endif /* HAVE_SYNC */
3556 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3557 doc
: /* Return t if file FILE1 is newer than file FILE2.
3558 If FILE1 does not exist, the answer is nil;
3559 otherwise, if FILE2 does not exist, the answer is t. */)
3561 Lisp_Object file1
, file2
;
3563 Lisp_Object absname1
, absname2
;
3566 Lisp_Object handler
;
3567 struct gcpro gcpro1
, gcpro2
;
3569 CHECK_STRING (file1
);
3570 CHECK_STRING (file2
);
3573 GCPRO2 (absname1
, file2
);
3574 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3575 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3578 /* If the file name has special constructs in it,
3579 call the corresponding file handler. */
3580 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3582 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3583 if (!NILP (handler
))
3584 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3586 GCPRO2 (absname1
, absname2
);
3587 absname1
= ENCODE_FILE (absname1
);
3588 absname2
= ENCODE_FILE (absname2
);
3591 if (stat (SDATA (absname1
), &st
) < 0)
3594 mtime1
= st
.st_mtime
;
3596 if (stat (SDATA (absname2
), &st
) < 0)
3599 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3603 Lisp_Object Qfind_buffer_file_type
;
3606 #ifndef READ_BUF_SIZE
3607 #define READ_BUF_SIZE (64 << 10)
3610 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3612 /* This function is called after Lisp functions to decide a coding
3613 system are called, or when they cause an error. Before they are
3614 called, the current buffer is set unibyte and it contains only a
3615 newly inserted text (thus the buffer was empty before the
3618 The functions may set markers, overlays, text properties, or even
3619 alter the buffer contents, change the current buffer.
3621 Here, we reset all those changes by:
3622 o set back the current buffer.
3623 o move all markers and overlays to BEG.
3624 o remove all text properties.
3625 o set back the buffer multibyteness. */
3628 decide_coding_unwind (unwind_data
)
3629 Lisp_Object unwind_data
;
3631 Lisp_Object multibyte
, undo_list
, buffer
;
3633 multibyte
= XCAR (unwind_data
);
3634 unwind_data
= XCDR (unwind_data
);
3635 undo_list
= XCAR (unwind_data
);
3636 buffer
= XCDR (unwind_data
);
3638 if (current_buffer
!= XBUFFER (buffer
))
3639 set_buffer_internal (XBUFFER (buffer
));
3640 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3641 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3642 BUF_INTERVALS (current_buffer
) = 0;
3643 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3645 /* Now we are safe to change the buffer's multibyteness directly. */
3646 current_buffer
->enable_multibyte_characters
= multibyte
;
3647 current_buffer
->undo_list
= undo_list
;
3653 /* Used to pass values from insert-file-contents to read_non_regular. */
3655 static int non_regular_fd
;
3656 static int non_regular_inserted
;
3657 static int non_regular_nbytes
;
3660 /* Read from a non-regular file.
3661 Read non_regular_trytry bytes max from non_regular_fd.
3662 Non_regular_inserted specifies where to put the read bytes.
3663 Value is the number of bytes read. */
3672 nbytes
= emacs_read (non_regular_fd
,
3673 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3674 non_regular_nbytes
);
3676 return make_number (nbytes
);
3680 /* Condition-case handler used when reading from non-regular files
3681 in insert-file-contents. */
3684 read_non_regular_quit ()
3690 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3692 doc
: /* Insert contents of file FILENAME after point.
3693 Returns list of absolute file name and number of characters inserted.
3694 If second argument VISIT is non-nil, the buffer's visited filename and
3695 last save file modtime are set, and it is marked unmodified. If
3696 visiting and the file does not exist, visiting is completed before the
3699 The optional third and fourth arguments BEG and END specify what portion
3700 of the file to insert. These arguments count bytes in the file, not
3701 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3703 If optional fifth argument REPLACE is non-nil, replace the current
3704 buffer contents (in the accessible portion) with the file contents.
3705 This is better than simply deleting and inserting the whole thing
3706 because (1) it preserves some marker positions and (2) it puts less data
3707 in the undo list. When REPLACE is non-nil, the second return value is
3708 the number of characters that replace previous buffer contents.
3710 This function does code conversion according to the value of
3711 `coding-system-for-read' or `file-coding-system-alist', and sets the
3712 variable `last-coding-system-used' to the coding system actually used. */)
3713 (filename
, visit
, beg
, end
, replace
)
3714 Lisp_Object filename
, visit
, beg
, end
, replace
;
3719 register int how_much
;
3720 register int unprocessed
;
3721 int count
= SPECPDL_INDEX ();
3722 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3723 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3726 int not_regular
= 0;
3727 unsigned char read_buf
[READ_BUF_SIZE
];
3728 struct coding_system coding
;
3729 unsigned char buffer
[1 << 14];
3730 int replace_handled
= 0;
3731 int set_coding_system
= 0;
3732 Lisp_Object coding_system
;
3734 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3735 int we_locked_file
= 0;
3737 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3738 error ("Cannot do file visiting in an indirect buffer");
3740 if (!NILP (current_buffer
->read_only
))
3741 Fbarf_if_buffer_read_only ();
3745 orig_filename
= Qnil
;
3748 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3750 CHECK_STRING (filename
);
3751 filename
= Fexpand_file_name (filename
, Qnil
);
3753 /* The value Qnil means that the coding system is not yet
3755 coding_system
= Qnil
;
3757 /* If the file name has special constructs in it,
3758 call the corresponding file handler. */
3759 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3760 if (!NILP (handler
))
3762 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3763 visit
, beg
, end
, replace
);
3764 if (CONSP (val
) && CONSP (XCDR (val
)))
3765 inserted
= XINT (XCAR (XCDR (val
)));
3769 orig_filename
= filename
;
3770 filename
= ENCODE_FILE (filename
);
3776 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3778 /* Tell stat to use expensive method to get accurate info. */
3779 Vw32_get_true_file_attributes
= Qt
;
3780 total
= stat (SDATA (filename
), &st
);
3781 Vw32_get_true_file_attributes
= tem
;
3785 if (stat (SDATA (filename
), &st
) < 0)
3786 #endif /* WINDOWSNT */
3788 if (fd
>= 0) emacs_close (fd
);
3791 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3794 if (!NILP (Vcoding_system_for_read
))
3795 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3800 /* This code will need to be changed in order to work on named
3801 pipes, and it's probably just not worth it. So we should at
3802 least signal an error. */
3803 if (!S_ISREG (st
.st_mode
))
3810 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3811 xsignal2 (Qfile_error
,
3812 build_string ("not a regular file"), orig_filename
);
3817 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3820 /* Replacement should preserve point as it preserves markers. */
3821 if (!NILP (replace
))
3822 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3824 record_unwind_protect (close_file_unwind
, make_number (fd
));
3826 /* Supposedly happens on VMS. */
3827 /* Can happen on any platform that uses long as type of off_t, but allows
3828 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3829 give a message suitable for the latter case. */
3830 if (! not_regular
&& st
.st_size
< 0)
3831 error ("Maximum buffer size exceeded");
3833 /* Prevent redisplay optimizations. */
3834 current_buffer
->clip_changed
= 1;
3838 if (!NILP (beg
) || !NILP (end
))
3839 error ("Attempt to visit less than an entire file");
3840 if (BEG
< Z
&& NILP (replace
))
3841 error ("Cannot do file visiting in a non-empty buffer");
3847 XSETFASTINT (beg
, 0);
3855 XSETINT (end
, st
.st_size
);
3857 /* Arithmetic overflow can occur if an Emacs integer cannot
3858 represent the file size, or if the calculations below
3859 overflow. The calculations below double the file size
3860 twice, so check that it can be multiplied by 4 safely. */
3861 if (XINT (end
) != st
.st_size
3862 || st
.st_size
> INT_MAX
/ 4)
3863 error ("Maximum buffer size exceeded");
3865 /* The file size returned from stat may be zero, but data
3866 may be readable nonetheless, for example when this is a
3867 file in the /proc filesystem. */
3868 if (st
.st_size
== 0)
3869 XSETINT (end
, READ_BUF_SIZE
);
3873 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3875 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3876 setup_coding_system (coding_system
, &coding
);
3877 /* Ensure we set Vlast_coding_system_used. */
3878 set_coding_system
= 1;
3882 /* Decide the coding system to use for reading the file now
3883 because we can't use an optimized method for handling
3884 `coding:' tag if the current buffer is not empty. */
3885 if (!NILP (Vcoding_system_for_read
))
3886 coding_system
= Vcoding_system_for_read
;
3889 /* Don't try looking inside a file for a coding system
3890 specification if it is not seekable. */
3891 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3893 /* Find a coding system specified in the heading two
3894 lines or in the tailing several lines of the file.
3895 We assume that the 1K-byte and 3K-byte for heading
3896 and tailing respectively are sufficient for this
3900 if (st
.st_size
<= (1024 * 4))
3901 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3904 nread
= emacs_read (fd
, read_buf
, 1024);
3907 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3908 report_file_error ("Setting file position",
3909 Fcons (orig_filename
, Qnil
));
3910 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3915 error ("IO error reading %s: %s",
3916 SDATA (orig_filename
), emacs_strerror (errno
));
3919 struct buffer
*prev
= current_buffer
;
3923 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3925 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3926 buf
= XBUFFER (buffer
);
3928 delete_all_overlays (buf
);
3929 buf
->directory
= current_buffer
->directory
;
3930 buf
->read_only
= Qnil
;
3931 buf
->filename
= Qnil
;
3932 buf
->undo_list
= Qt
;
3933 eassert (buf
->overlays_before
== NULL
);
3934 eassert (buf
->overlays_after
== NULL
);
3936 set_buffer_internal (buf
);
3938 buf
->enable_multibyte_characters
= Qnil
;
3940 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3941 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3942 coding_system
= call2 (Vset_auto_coding_function
,
3943 filename
, make_number (nread
));
3944 set_buffer_internal (prev
);
3946 /* Discard the unwind protect for recovering the
3950 /* Rewind the file for the actual read done later. */
3951 if (lseek (fd
, 0, 0) < 0)
3952 report_file_error ("Setting file position",
3953 Fcons (orig_filename
, Qnil
));
3957 if (NILP (coding_system
))
3959 /* If we have not yet decided a coding system, check
3960 file-coding-system-alist. */
3961 Lisp_Object args
[6];
3963 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3964 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3965 coding_system
= Ffind_operation_coding_system (6, args
);
3966 if (CONSP (coding_system
))
3967 coding_system
= XCAR (coding_system
);
3971 if (NILP (coding_system
))
3972 coding_system
= Qundecided
;
3974 CHECK_CODING_SYSTEM (coding_system
);
3976 if (NILP (current_buffer
->enable_multibyte_characters
))
3977 /* We must suppress all character code conversion except for
3978 end-of-line conversion. */
3979 coding_system
= raw_text_coding_system (coding_system
);
3981 setup_coding_system (coding_system
, &coding
);
3982 /* Ensure we set Vlast_coding_system_used. */
3983 set_coding_system
= 1;
3986 /* If requested, replace the accessible part of the buffer
3987 with the file contents. Avoid replacing text at the
3988 beginning or end of the buffer that matches the file contents;
3989 that preserves markers pointing to the unchanged parts.
3991 Here we implement this feature in an optimized way
3992 for the case where code conversion is NOT needed.
3993 The following if-statement handles the case of conversion
3994 in a less optimal way.
3996 If the code conversion is "automatic" then we try using this
3997 method and hope for the best.
3998 But if we discover the need for conversion, we give up on this method
3999 and let the following if-statement handle the replace job. */
4002 && (NILP (coding_system
)
4003 || ! CODING_REQUIRE_DECODING (&coding
)))
4005 /* same_at_start and same_at_end count bytes,
4006 because file access counts bytes
4007 and BEG and END count bytes. */
4008 int same_at_start
= BEGV_BYTE
;
4009 int same_at_end
= ZV_BYTE
;
4011 /* There is still a possibility we will find the need to do code
4012 conversion. If that happens, we set this variable to 1 to
4013 give up on handling REPLACE in the optimized way. */
4014 int giveup_match_end
= 0;
4016 if (XINT (beg
) != 0)
4018 if (lseek (fd
, XINT (beg
), 0) < 0)
4019 report_file_error ("Setting file position",
4020 Fcons (orig_filename
, Qnil
));
4025 /* Count how many chars at the start of the file
4026 match the text at the beginning of the buffer. */
4031 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4033 error ("IO error reading %s: %s",
4034 SDATA (orig_filename
), emacs_strerror (errno
));
4035 else if (nread
== 0)
4038 if (CODING_REQUIRE_DETECTION (&coding
))
4040 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4042 setup_coding_system (coding_system
, &coding
);
4045 if (CODING_REQUIRE_DECODING (&coding
))
4046 /* We found that the file should be decoded somehow.
4047 Let's give up here. */
4049 giveup_match_end
= 1;
4054 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4055 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4056 same_at_start
++, bufpos
++;
4057 /* If we found a discrepancy, stop the scan.
4058 Otherwise loop around and scan the next bufferful. */
4059 if (bufpos
!= nread
)
4063 /* If the file matches the buffer completely,
4064 there's no need to replace anything. */
4065 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4069 /* Truncate the buffer to the size of the file. */
4070 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4075 /* Count how many chars at the end of the file
4076 match the text at the end of the buffer. But, if we have
4077 already found that decoding is necessary, don't waste time. */
4078 while (!giveup_match_end
)
4080 int total_read
, nread
, bufpos
, curpos
, trial
;
4082 /* At what file position are we now scanning? */
4083 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4084 /* If the entire file matches the buffer tail, stop the scan. */
4087 /* How much can we scan in the next step? */
4088 trial
= min (curpos
, sizeof buffer
);
4089 if (lseek (fd
, curpos
- trial
, 0) < 0)
4090 report_file_error ("Setting file position",
4091 Fcons (orig_filename
, Qnil
));
4093 total_read
= nread
= 0;
4094 while (total_read
< trial
)
4096 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4098 error ("IO error reading %s: %s",
4099 SDATA (orig_filename
), emacs_strerror (errno
));
4100 else if (nread
== 0)
4102 total_read
+= nread
;
4105 /* Scan this bufferful from the end, comparing with
4106 the Emacs buffer. */
4107 bufpos
= total_read
;
4109 /* Compare with same_at_start to avoid counting some buffer text
4110 as matching both at the file's beginning and at the end. */
4111 while (bufpos
> 0 && same_at_end
> same_at_start
4112 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4113 same_at_end
--, bufpos
--;
4115 /* If we found a discrepancy, stop the scan.
4116 Otherwise loop around and scan the preceding bufferful. */
4119 /* If this discrepancy is because of code conversion,
4120 we cannot use this method; giveup and try the other. */
4121 if (same_at_end
> same_at_start
4122 && FETCH_BYTE (same_at_end
- 1) >= 0200
4123 && ! NILP (current_buffer
->enable_multibyte_characters
)
4124 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4125 giveup_match_end
= 1;
4134 if (! giveup_match_end
)
4138 /* We win! We can handle REPLACE the optimized way. */
4140 /* Extend the start of non-matching text area to multibyte
4141 character boundary. */
4142 if (! NILP (current_buffer
->enable_multibyte_characters
))
4143 while (same_at_start
> BEGV_BYTE
4144 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4147 /* Extend the end of non-matching text area to multibyte
4148 character boundary. */
4149 if (! NILP (current_buffer
->enable_multibyte_characters
))
4150 while (same_at_end
< ZV_BYTE
4151 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4154 /* Don't try to reuse the same piece of text twice. */
4155 overlap
= (same_at_start
- BEGV_BYTE
4156 - (same_at_end
+ st
.st_size
- ZV
));
4158 same_at_end
+= overlap
;
4160 /* Arrange to read only the nonmatching middle part of the file. */
4161 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4162 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4164 del_range_byte (same_at_start
, same_at_end
, 0);
4165 /* Insert from the file at the proper position. */
4166 temp
= BYTE_TO_CHAR (same_at_start
);
4167 SET_PT_BOTH (temp
, same_at_start
);
4169 /* If display currently starts at beginning of line,
4170 keep it that way. */
4171 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4172 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4174 replace_handled
= 1;
4178 /* If requested, replace the accessible part of the buffer
4179 with the file contents. Avoid replacing text at the
4180 beginning or end of the buffer that matches the file contents;
4181 that preserves markers pointing to the unchanged parts.
4183 Here we implement this feature for the case where code conversion
4184 is needed, in a simple way that needs a lot of memory.
4185 The preceding if-statement handles the case of no conversion
4186 in a more optimized way. */
4187 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4189 EMACS_INT same_at_start
= BEGV_BYTE
;
4190 EMACS_INT same_at_end
= ZV_BYTE
;
4191 EMACS_INT same_at_start_charpos
;
4192 EMACS_INT inserted_chars
;
4195 unsigned char *decoded
;
4197 int this_count
= SPECPDL_INDEX ();
4198 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4199 Lisp_Object conversion_buffer
;
4201 conversion_buffer
= code_conversion_save (1, multibyte
);
4203 /* First read the whole file, performing code conversion into
4204 CONVERSION_BUFFER. */
4206 if (lseek (fd
, XINT (beg
), 0) < 0)
4207 report_file_error ("Setting file position",
4208 Fcons (orig_filename
, Qnil
));
4210 total
= st
.st_size
; /* Total bytes in the file. */
4211 how_much
= 0; /* Bytes read from file so far. */
4212 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4213 unprocessed
= 0; /* Bytes not processed in previous loop. */
4215 GCPRO1 (conversion_buffer
);
4216 while (how_much
< total
)
4218 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4219 quitting while reading a huge while. */
4220 /* try is reserved in some compilers (Microsoft C) */
4221 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4224 /* Allow quitting out of the actual I/O. */
4227 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4239 BUF_SET_PT (XBUFFER (conversion_buffer
),
4240 BUF_Z (XBUFFER (conversion_buffer
)));
4241 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4243 unprocessed
= coding
.carryover_bytes
;
4244 if (coding
.carryover_bytes
> 0)
4245 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4250 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4251 if we couldn't read the file. */
4254 error ("IO error reading %s: %s",
4255 SDATA (orig_filename
), emacs_strerror (errno
));
4257 if (unprocessed
> 0)
4259 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4260 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4262 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4265 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4266 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4267 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4269 /* Compare the beginning of the converted string with the buffer
4273 while (bufpos
< inserted
&& same_at_start
< same_at_end
4274 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4275 same_at_start
++, bufpos
++;
4277 /* If the file matches the head of buffer completely,
4278 there's no need to replace anything. */
4280 if (bufpos
== inserted
)
4283 /* Truncate the buffer to the size of the file. */
4284 del_range_byte (same_at_start
, same_at_end
, 0);
4287 unbind_to (this_count
, Qnil
);
4291 /* Extend the start of non-matching text area to the previous
4292 multibyte character boundary. */
4293 if (! NILP (current_buffer
->enable_multibyte_characters
))
4294 while (same_at_start
> BEGV_BYTE
4295 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4298 /* Scan this bufferful from the end, comparing with
4299 the Emacs buffer. */
4302 /* Compare with same_at_start to avoid counting some buffer text
4303 as matching both at the file's beginning and at the end. */
4304 while (bufpos
> 0 && same_at_end
> same_at_start
4305 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4306 same_at_end
--, bufpos
--;
4308 /* Extend the end of non-matching text area to the next
4309 multibyte character boundary. */
4310 if (! NILP (current_buffer
->enable_multibyte_characters
))
4311 while (same_at_end
< ZV_BYTE
4312 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4315 /* Don't try to reuse the same piece of text twice. */
4316 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4318 same_at_end
+= overlap
;
4320 /* If display currently starts at beginning of line,
4321 keep it that way. */
4322 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4323 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4325 /* Replace the chars that we need to replace,
4326 and update INSERTED to equal the number of bytes
4327 we are taking from the decoded string. */
4328 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4330 if (same_at_end
!= same_at_start
)
4332 del_range_byte (same_at_start
, same_at_end
, 0);
4334 same_at_start
= GPT_BYTE
;
4338 temp
= BYTE_TO_CHAR (same_at_start
);
4340 /* Insert from the file at the proper position. */
4341 SET_PT_BOTH (temp
, same_at_start
);
4342 same_at_start_charpos
4343 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4344 same_at_start
- BEGV_BYTE
4345 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4347 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4348 same_at_start
+ inserted
- BEGV_BYTE
4349 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4350 - same_at_start_charpos
);
4351 /* This binding is to avoid ask-user-about-supersession-threat
4352 being called in insert_from_buffer (via in
4353 prepare_to_modify_buffer). */
4354 specbind (intern ("buffer-file-name"), Qnil
);
4355 insert_from_buffer (XBUFFER (conversion_buffer
),
4356 same_at_start_charpos
, inserted_chars
, 0);
4357 /* Set `inserted' to the number of inserted characters. */
4358 inserted
= PT
- temp
;
4359 /* Set point before the inserted characters. */
4360 SET_PT_BOTH (temp
, same_at_start
);
4362 unbind_to (this_count
, Qnil
);
4369 register Lisp_Object temp
;
4371 total
= XINT (end
) - XINT (beg
);
4373 /* Make sure point-max won't overflow after this insertion. */
4374 XSETINT (temp
, total
);
4375 if (total
!= XINT (temp
))
4376 error ("Maximum buffer size exceeded");
4379 /* For a special file, all we can do is guess. */
4380 total
= READ_BUF_SIZE
;
4382 if (NILP (visit
) && inserted
> 0)
4384 #ifdef CLASH_DETECTION
4385 if (!NILP (current_buffer
->file_truename
)
4386 /* Make binding buffer-file-name to nil effective. */
4387 && !NILP (current_buffer
->filename
)
4388 && SAVE_MODIFF
>= MODIFF
)
4390 #endif /* CLASH_DETECTION */
4391 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4395 if (GAP_SIZE
< total
)
4396 make_gap (total
- GAP_SIZE
);
4398 if (XINT (beg
) != 0 || !NILP (replace
))
4400 if (lseek (fd
, XINT (beg
), 0) < 0)
4401 report_file_error ("Setting file position",
4402 Fcons (orig_filename
, Qnil
));
4405 /* In the following loop, HOW_MUCH contains the total bytes read so
4406 far for a regular file, and not changed for a special file. But,
4407 before exiting the loop, it is set to a negative value if I/O
4411 /* Total bytes inserted. */
4414 /* Here, we don't do code conversion in the loop. It is done by
4415 decode_coding_gap after all data are read into the buffer. */
4417 int gap_size
= GAP_SIZE
;
4419 while (how_much
< total
)
4421 /* try is reserved in some compilers (Microsoft C) */
4422 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4429 /* Maybe make more room. */
4430 if (gap_size
< trytry
)
4432 make_gap (total
- gap_size
);
4433 gap_size
= GAP_SIZE
;
4436 /* Read from the file, capturing `quit'. When an
4437 error occurs, end the loop, and arrange for a quit
4438 to be signaled after decoding the text we read. */
4439 non_regular_fd
= fd
;
4440 non_regular_inserted
= inserted
;
4441 non_regular_nbytes
= trytry
;
4442 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4443 read_non_regular_quit
);
4454 /* Allow quitting out of the actual I/O. We don't make text
4455 part of the buffer until all the reading is done, so a C-g
4456 here doesn't do any harm. */
4459 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4471 /* For a regular file, where TOTAL is the real size,
4472 count HOW_MUCH to compare with it.
4473 For a special file, where TOTAL is just a buffer size,
4474 so don't bother counting in HOW_MUCH.
4475 (INSERTED is where we count the number of characters inserted.) */
4482 /* Now we have read all the file data into the gap.
4483 If it was empty, undo marking the buffer modified. */
4487 #ifdef CLASH_DETECTION
4489 unlock_file (current_buffer
->file_truename
);
4491 Vdeactivate_mark
= old_Vdeactivate_mark
;
4494 Vdeactivate_mark
= Qt
;
4496 /* Make the text read part of the buffer. */
4497 GAP_SIZE
-= inserted
;
4499 GPT_BYTE
+= inserted
;
4501 ZV_BYTE
+= inserted
;
4506 /* Put an anchor to ensure multi-byte form ends at gap. */
4511 /* Discard the unwind protect for closing the file. */
4515 error ("IO error reading %s: %s",
4516 SDATA (orig_filename
), emacs_strerror (errno
));
4520 if (NILP (coding_system
))
4522 /* The coding system is not yet decided. Decide it by an
4523 optimized method for handling `coding:' tag.
4525 Note that we can get here only if the buffer was empty
4526 before the insertion. */
4528 if (!NILP (Vcoding_system_for_read
))
4529 coding_system
= Vcoding_system_for_read
;
4532 /* Since we are sure that the current buffer was empty
4533 before the insertion, we can toggle
4534 enable-multibyte-characters directly here without taking
4535 care of marker adjustment. By this way, we can run Lisp
4536 program safely before decoding the inserted text. */
4537 Lisp_Object unwind_data
;
4538 int count
= SPECPDL_INDEX ();
4540 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4541 Fcons (current_buffer
->undo_list
,
4542 Fcurrent_buffer ()));
4543 current_buffer
->enable_multibyte_characters
= Qnil
;
4544 current_buffer
->undo_list
= Qt
;
4545 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4547 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4549 coding_system
= call2 (Vset_auto_coding_function
,
4550 filename
, make_number (inserted
));
4553 if (NILP (coding_system
))
4555 /* If the coding system is not yet decided, check
4556 file-coding-system-alist. */
4557 Lisp_Object args
[6];
4559 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4560 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4561 coding_system
= Ffind_operation_coding_system (6, args
);
4562 if (CONSP (coding_system
))
4563 coding_system
= XCAR (coding_system
);
4565 unbind_to (count
, Qnil
);
4566 inserted
= Z_BYTE
- BEG_BYTE
;
4569 if (NILP (coding_system
))
4570 coding_system
= Qundecided
;
4572 CHECK_CODING_SYSTEM (coding_system
);
4574 if (NILP (current_buffer
->enable_multibyte_characters
))
4575 /* We must suppress all character code conversion except for
4576 end-of-line conversion. */
4577 coding_system
= raw_text_coding_system (coding_system
);
4578 setup_coding_system (coding_system
, &coding
);
4579 /* Ensure we set Vlast_coding_system_used. */
4580 set_coding_system
= 1;
4585 /* When we visit a file by raw-text, we change the buffer to
4587 if (CODING_FOR_UNIBYTE (&coding
)
4588 /* Can't do this if part of the buffer might be preserved. */
4590 /* Visiting a file with these coding system makes the buffer
4592 current_buffer
->enable_multibyte_characters
= Qnil
;
4595 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4596 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4597 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4599 move_gap_both (PT
, PT_BYTE
);
4600 GAP_SIZE
+= inserted
;
4601 ZV_BYTE
-= inserted
;
4605 decode_coding_gap (&coding
, inserted
, inserted
);
4606 inserted
= coding
.produced_char
;
4607 coding_system
= CODING_ID_NAME (coding
.id
);
4609 else if (inserted
> 0)
4610 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4613 /* Now INSERTED is measured in characters. */
4616 /* Use the conversion type to determine buffer-file-type
4617 (find-buffer-file-type is now used to help determine the
4619 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4620 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4621 && ! CODING_REQUIRE_DECODING (&coding
))
4622 current_buffer
->buffer_file_type
= Qt
;
4624 current_buffer
->buffer_file_type
= Qnil
;
4631 if (!EQ (current_buffer
->undo_list
, Qt
))
4632 current_buffer
->undo_list
= Qnil
;
4636 current_buffer
->modtime
= st
.st_mtime
;
4637 current_buffer
->filename
= orig_filename
;
4640 SAVE_MODIFF
= MODIFF
;
4641 current_buffer
->auto_save_modified
= MODIFF
;
4642 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4643 #ifdef CLASH_DETECTION
4646 if (!NILP (current_buffer
->file_truename
))
4647 unlock_file (current_buffer
->file_truename
);
4648 unlock_file (filename
);
4650 #endif /* CLASH_DETECTION */
4652 xsignal2 (Qfile_error
,
4653 build_string ("not a regular file"), orig_filename
);
4656 if (set_coding_system
)
4657 Vlast_coding_system_used
= coding_system
;
4659 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4661 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4663 if (! NILP (insval
))
4665 CHECK_NUMBER (insval
);
4666 inserted
= XFASTINT (insval
);
4670 /* Decode file format */
4673 /* Don't run point motion or modification hooks when decoding. */
4674 int count
= SPECPDL_INDEX ();
4675 specbind (Qinhibit_point_motion_hooks
, Qt
);
4676 specbind (Qinhibit_modification_hooks
, Qt
);
4678 /* Save old undo list and don't record undo for decoding. */
4679 old_undo
= current_buffer
->undo_list
;
4680 current_buffer
->undo_list
= Qt
;
4684 insval
= call3 (Qformat_decode
,
4685 Qnil
, make_number (inserted
), visit
);
4686 CHECK_NUMBER (insval
);
4687 inserted
= XFASTINT (insval
);
4691 /* If REPLACE is non-nil and we succeeded in not replacing the
4692 beginning or end of the buffer text with the file's contents,
4693 call format-decode with `point' positioned at the beginning of
4694 the buffer and `inserted' equalling the number of characters
4695 in the buffer. Otherwise, format-decode might fail to
4696 correctly analyze the beginning or end of the buffer. Hence
4697 we temporarily save `point' and `inserted' here and restore
4698 `point' iff format-decode did not insert or delete any text.
4699 Otherwise we leave `point' at point-min. */
4701 int opoint_byte
= PT_BYTE
;
4702 int oinserted
= ZV
- BEGV
;
4703 int ochars_modiff
= CHARS_MODIFF
;
4705 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4706 insval
= call3 (Qformat_decode
,
4707 Qnil
, make_number (oinserted
), visit
);
4708 CHECK_NUMBER (insval
);
4709 if (ochars_modiff
== CHARS_MODIFF
)
4710 /* format_decode didn't modify buffer's characters => move
4711 point back to position before inserted text and leave
4712 value of inserted alone. */
4713 SET_PT_BOTH (opoint
, opoint_byte
);
4715 /* format_decode modified buffer's characters => consider
4716 entire buffer changed and leave point at point-min. */
4717 inserted
= XFASTINT (insval
);
4720 /* For consistency with format-decode call these now iff inserted > 0
4721 (martin 2007-06-28) */
4722 p
= Vafter_insert_file_functions
;
4727 insval
= call1 (XCAR (p
), make_number (inserted
));
4730 CHECK_NUMBER (insval
);
4731 inserted
= XFASTINT (insval
);
4736 /* For the rationale of this see the comment on format-decode above. */
4738 int opoint_byte
= PT_BYTE
;
4739 int oinserted
= ZV
- BEGV
;
4740 int ochars_modiff
= CHARS_MODIFF
;
4742 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4743 insval
= call1 (XCAR (p
), make_number (oinserted
));
4746 CHECK_NUMBER (insval
);
4747 if (ochars_modiff
== CHARS_MODIFF
)
4748 /* after_insert_file_functions didn't modify
4749 buffer's characters => move point back to
4750 position before inserted text and leave value of
4752 SET_PT_BOTH (opoint
, opoint_byte
);
4754 /* after_insert_file_functions did modify buffer's
4755 characters => consider entire buffer changed and
4756 leave point at point-min. */
4757 inserted
= XFASTINT (insval
);
4767 Lisp_Object lbeg
, lend
;
4769 XSETINT (lend
, PT
+ inserted
);
4770 if (CONSP (old_undo
))
4772 Lisp_Object tem
= XCAR (old_undo
);
4773 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4774 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4775 /* In the non-visiting case record only the final insertion. */
4776 current_buffer
->undo_list
=
4777 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4781 /* If undo_list was Qt before, keep it that way.
4782 Otherwise start with an empty undo_list. */
4783 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4785 unbind_to (count
, Qnil
);
4788 /* Call after-change hooks for the inserted text, aside from the case
4789 of normal visiting (not with REPLACE), which is done in a new buffer
4790 "before" the buffer is changed. */
4791 if (inserted
> 0 && total
> 0
4792 && (NILP (visit
) || !NILP (replace
)))
4794 signal_after_change (PT
, 0, inserted
);
4795 update_compositions (PT
, PT
, CHECK_BORDER
);
4799 && current_buffer
->modtime
== -1)
4801 /* If visiting nonexistent file, return nil. */
4802 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4806 Fsignal (Qquit
, Qnil
);
4808 /* ??? Retval needs to be dealt with in all cases consistently. */
4810 val
= Fcons (orig_filename
,
4811 Fcons (make_number (inserted
),
4814 RETURN_UNGCPRO (unbind_to (count
, val
));
4817 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4819 /* If build_annotations switched buffers, switch back to BUF.
4820 Kill the temporary buffer that was selected in the meantime.
4822 Since this kill only the last temporary buffer, some buffers remain
4823 not killed if build_annotations switched buffers more than once.
4827 build_annotations_unwind (buf
)
4832 if (XBUFFER (buf
) == current_buffer
)
4834 tembuf
= Fcurrent_buffer ();
4836 Fkill_buffer (tembuf
);
4840 /* Decide the coding-system to encode the data with. */
4843 choose_write_coding_system (start
, end
, filename
,
4844 append
, visit
, lockname
, coding
)
4845 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4846 struct coding_system
*coding
;
4849 Lisp_Object eol_parent
= Qnil
;
4852 && NILP (Fstring_equal (current_buffer
->filename
,
4853 current_buffer
->auto_save_file_name
)))
4858 else if (!NILP (Vcoding_system_for_write
))
4860 val
= Vcoding_system_for_write
;
4861 if (coding_system_require_warning
4862 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4863 /* Confirm that VAL can surely encode the current region. */
4864 val
= call5 (Vselect_safe_coding_system_function
,
4865 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4870 /* If the variable `buffer-file-coding-system' is set locally,
4871 it means that the file was read with some kind of code
4872 conversion or the variable is explicitly set by users. We
4873 had better write it out with the same coding system even if
4874 `enable-multibyte-characters' is nil.
4876 If it is not set locally, we anyway have to convert EOL
4877 format if the default value of `buffer-file-coding-system'
4878 tells that it is not Unix-like (LF only) format. */
4879 int using_default_coding
= 0;
4880 int force_raw_text
= 0;
4882 val
= current_buffer
->buffer_file_coding_system
;
4884 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4887 if (NILP (current_buffer
->enable_multibyte_characters
))
4893 /* Check file-coding-system-alist. */
4894 Lisp_Object args
[7], coding_systems
;
4896 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4897 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4899 coding_systems
= Ffind_operation_coding_system (7, args
);
4900 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4901 val
= XCDR (coding_systems
);
4906 /* If we still have not decided a coding system, use the
4907 default value of buffer-file-coding-system. */
4908 val
= current_buffer
->buffer_file_coding_system
;
4909 using_default_coding
= 1;
4912 if (! NILP (val
) && ! force_raw_text
)
4914 Lisp_Object spec
, attrs
;
4916 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4917 attrs
= AREF (spec
, 0);
4918 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4923 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4924 /* Confirm that VAL can surely encode the current region. */
4925 val
= call5 (Vselect_safe_coding_system_function
,
4926 start
, end
, val
, Qnil
, filename
);
4928 /* If the decided coding-system doesn't specify end-of-line
4929 format, we use that of
4930 `default-buffer-file-coding-system'. */
4931 if (! using_default_coding
4932 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4933 val
= (coding_inherit_eol_type
4934 (val
, buffer_defaults
.buffer_file_coding_system
));
4936 /* If we decide not to encode text, use `raw-text' or one of its
4939 val
= raw_text_coding_system (val
);
4942 val
= coding_inherit_eol_type (val
, eol_parent
);
4943 setup_coding_system (val
, coding
);
4945 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4946 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4950 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4951 "r\nFWrite region to file: \ni\ni\ni\np",
4952 doc
: /* Write current region into specified file.
4953 When called from a program, requires three arguments:
4954 START, END and FILENAME. START and END are normally buffer positions
4955 specifying the part of the buffer to write.
4956 If START is nil, that means to use the entire buffer contents.
4957 If START is a string, then output that string to the file
4958 instead of any buffer contents; END is ignored.
4960 Optional fourth argument APPEND if non-nil means
4961 append to existing file contents (if any). If it is an integer,
4962 seek to that offset in the file before writing.
4963 Optional fifth argument VISIT, if t or a string, means
4964 set the last-save-file-modtime of buffer to this file's modtime
4965 and mark buffer not modified.
4966 If VISIT is a string, it is a second file name;
4967 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4968 VISIT is also the file name to lock and unlock for clash detection.
4969 If VISIT is neither t nor nil nor a string,
4970 that means do not display the \"Wrote file\" message.
4971 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4972 use for locking and unlocking, overriding FILENAME and VISIT.
4973 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4974 for an existing file with the same name. If MUSTBENEW is `excl',
4975 that means to get an error if the file already exists; never overwrite.
4976 If MUSTBENEW is neither nil nor `excl', that means ask for
4977 confirmation before overwriting, but do go ahead and overwrite the file
4978 if the user confirms.
4980 This does code conversion according to the value of
4981 `coding-system-for-write', `buffer-file-coding-system', or
4982 `file-coding-system-alist', and sets the variable
4983 `last-coding-system-used' to the coding system actually used. */)
4984 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4985 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4990 const unsigned char *fn
;
4992 int count
= SPECPDL_INDEX ();
4995 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4997 Lisp_Object handler
;
4998 Lisp_Object visit_file
;
4999 Lisp_Object annotations
;
5000 Lisp_Object encoded_filename
;
5001 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5002 int quietly
= !NILP (visit
);
5003 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5004 struct buffer
*given_buffer
;
5006 int buffer_file_type
= O_BINARY
;
5008 struct coding_system coding
;
5010 if (current_buffer
->base_buffer
&& visiting
)
5011 error ("Cannot do file visiting in an indirect buffer");
5013 if (!NILP (start
) && !STRINGP (start
))
5014 validate_region (&start
, &end
);
5017 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5019 filename
= Fexpand_file_name (filename
, Qnil
);
5021 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5022 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5024 if (STRINGP (visit
))
5025 visit_file
= Fexpand_file_name (visit
, Qnil
);
5027 visit_file
= filename
;
5029 if (NILP (lockname
))
5030 lockname
= visit_file
;
5034 /* If the file name has special constructs in it,
5035 call the corresponding file handler. */
5036 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5037 /* If FILENAME has no handler, see if VISIT has one. */
5038 if (NILP (handler
) && STRINGP (visit
))
5039 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5041 if (!NILP (handler
))
5044 val
= call6 (handler
, Qwrite_region
, start
, end
,
5045 filename
, append
, visit
);
5049 SAVE_MODIFF
= MODIFF
;
5050 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5051 current_buffer
->filename
= visit_file
;
5057 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5059 /* Special kludge to simplify auto-saving. */
5062 XSETFASTINT (start
, BEG
);
5063 XSETFASTINT (end
, Z
);
5067 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5068 count1
= SPECPDL_INDEX ();
5070 given_buffer
= current_buffer
;
5072 if (!STRINGP (start
))
5074 annotations
= build_annotations (start
, end
);
5076 if (current_buffer
!= given_buffer
)
5078 XSETFASTINT (start
, BEGV
);
5079 XSETFASTINT (end
, ZV
);
5085 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5087 /* Decide the coding-system to encode the data with.
5088 We used to make this choice before calling build_annotations, but that
5089 leads to problems when a write-annotate-function takes care of
5090 unsavable chars (as was the case with X-Symbol). */
5091 Vlast_coding_system_used
5092 = choose_write_coding_system (start
, end
, filename
,
5093 append
, visit
, lockname
, &coding
);
5095 #ifdef CLASH_DETECTION
5098 #if 0 /* This causes trouble for GNUS. */
5099 /* If we've locked this file for some other buffer,
5100 query before proceeding. */
5101 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5102 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5105 lock_file (lockname
);
5107 #endif /* CLASH_DETECTION */
5109 encoded_filename
= ENCODE_FILE (filename
);
5111 fn
= SDATA (encoded_filename
);
5115 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5116 #else /* not DOS_NT */
5117 desc
= emacs_open (fn
, O_WRONLY
, 0);
5118 #endif /* not DOS_NT */
5120 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5122 if (auto_saving
) /* Overwrite any previous version of autosave file */
5124 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5125 desc
= emacs_open (fn
, O_RDWR
, 0);
5127 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5128 ? SDATA (current_buffer
->filename
) : 0,
5131 else /* Write to temporary name and rename if no errors */
5133 Lisp_Object temp_name
;
5134 temp_name
= Ffile_name_directory (filename
);
5136 if (!NILP (temp_name
))
5138 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5139 build_string ("$$SAVE$$")));
5140 fname
= SDATA (filename
);
5141 fn
= SDATA (temp_name
);
5142 desc
= creat_copy_attrs (fname
, fn
);
5145 /* If we can't open the temporary file, try creating a new
5146 version of the original file. VMS "creat" creates a
5147 new version rather than truncating an existing file. */
5150 desc
= creat (fn
, 0666);
5151 #if 0 /* This can clobber an existing file and fail to replace it,
5152 if the user runs out of space. */
5155 /* We can't make a new version;
5156 try to truncate and rewrite existing version if any. */
5158 desc
= emacs_open (fn
, O_RDWR
, 0);
5164 desc
= creat (fn
, 0666);
5168 desc
= emacs_open (fn
,
5169 O_WRONLY
| O_CREAT
| buffer_file_type
5170 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5171 S_IREAD
| S_IWRITE
);
5172 #else /* not DOS_NT */
5173 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5174 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5175 auto_saving
? auto_save_mode_bits
: 0666);
5176 #endif /* not DOS_NT */
5177 #endif /* not VMS */
5181 #ifdef CLASH_DETECTION
5183 if (!auto_saving
) unlock_file (lockname
);
5185 #endif /* CLASH_DETECTION */
5187 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5190 record_unwind_protect (close_file_unwind
, make_number (desc
));
5192 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5196 if (NUMBERP (append
))
5197 ret
= lseek (desc
, XINT (append
), 1);
5199 ret
= lseek (desc
, 0, 2);
5202 #ifdef CLASH_DETECTION
5203 if (!auto_saving
) unlock_file (lockname
);
5204 #endif /* CLASH_DETECTION */
5206 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5214 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5215 * if we do writes that don't end with a carriage return. Furthermore
5216 * it cannot handle writes of more then 16K. The modified
5217 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5218 * this EXCEPT for the last record (if it doesn't end with a carriage
5219 * return). This implies that if your buffer doesn't end with a carriage
5220 * return, you get one free... tough. However it also means that if
5221 * we make two calls to sys_write (a la the following code) you can
5222 * get one at the gap as well. The easiest way to fix this (honest)
5223 * is to move the gap to the next newline (or the end of the buffer).
5228 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5229 move_gap (find_next_newline (GPT
, 1));
5232 /* The new encoding routine doesn't require the following. */
5234 /* Whether VMS or not, we must move the gap to the next of newline
5235 when we must put designation sequences at beginning of line. */
5236 if (INTEGERP (start
)
5237 && coding
.type
== coding_type_iso2022
5238 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5239 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5241 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5242 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5243 move_gap_both (PT
, PT_BYTE
);
5244 SET_PT_BOTH (opoint
, opoint_byte
);
5252 if (STRINGP (start
))
5254 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5255 &annotations
, &coding
);
5258 else if (XINT (start
) != XINT (end
))
5260 failure
= 0 > a_write (desc
, Qnil
,
5261 XINT (start
), XINT (end
) - XINT (start
),
5262 &annotations
, &coding
);
5267 /* If file was empty, still need to write the annotations */
5268 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5269 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5273 if (CODING_REQUIRE_FLUSHING (&coding
)
5274 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5277 /* We have to flush out a data. */
5278 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5279 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5286 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5287 Disk full in NFS may be reported here. */
5288 /* mib says that closing the file will try to write as fast as NFS can do
5289 it, and that means the fsync here is not crucial for autosave files. */
5290 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5292 /* If fsync fails with EINTR, don't treat that as serious. Also
5293 ignore EINVAL which happens when fsync is not supported on this
5295 if (errno
!= EINTR
&& errno
!= EINVAL
)
5296 failure
= 1, save_errno
= errno
;
5300 /* Spurious "file has changed on disk" warnings have been
5301 observed on Suns as well.
5302 It seems that `close' can change the modtime, under nfs.
5304 (This has supposedly been fixed in Sunos 4,
5305 but who knows about all the other machines with NFS?) */
5308 /* On VMS, must do the stat after the close
5309 since closing changes the modtime. */
5311 /* Recall that #if defined does not work on VMS. */
5317 /* NFS can report a write failure now. */
5318 if (emacs_close (desc
) < 0)
5319 failure
= 1, save_errno
= errno
;
5322 /* If we wrote to a temporary name and had no errors, rename to real name. */
5326 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5334 /* Discard the unwind protect for close_file_unwind. */
5335 specpdl_ptr
= specpdl
+ count1
;
5336 /* Restore the original current buffer. */
5337 visit_file
= unbind_to (count
, visit_file
);
5339 #ifdef CLASH_DETECTION
5341 unlock_file (lockname
);
5342 #endif /* CLASH_DETECTION */
5344 /* Do this before reporting IO error
5345 to avoid a "file has changed on disk" warning on
5346 next attempt to save. */
5348 current_buffer
->modtime
= st
.st_mtime
;
5351 error ("IO error writing %s: %s", SDATA (filename
),
5352 emacs_strerror (save_errno
));
5356 SAVE_MODIFF
= MODIFF
;
5357 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5358 current_buffer
->filename
= visit_file
;
5359 update_mode_lines
++;
5364 && ! NILP (Fstring_equal (current_buffer
->filename
,
5365 current_buffer
->auto_save_file_name
)))
5366 SAVE_MODIFF
= MODIFF
;
5372 message_with_string ((INTEGERP (append
)
5382 Lisp_Object
merge ();
5384 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5385 doc
: /* Return t if (car A) is numerically less than (car B). */)
5389 return Flss (Fcar (a
), Fcar (b
));
5392 /* Build the complete list of annotations appropriate for writing out
5393 the text between START and END, by calling all the functions in
5394 write-region-annotate-functions and merging the lists they return.
5395 If one of these functions switches to a different buffer, we assume
5396 that buffer contains altered text. Therefore, the caller must
5397 make sure to restore the current buffer in all cases,
5398 as save-excursion would do. */
5401 build_annotations (start
, end
)
5402 Lisp_Object start
, end
;
5404 Lisp_Object annotations
;
5406 struct gcpro gcpro1
, gcpro2
;
5407 Lisp_Object original_buffer
;
5408 int i
, used_global
= 0;
5410 XSETBUFFER (original_buffer
, current_buffer
);
5413 p
= Vwrite_region_annotate_functions
;
5414 GCPRO2 (annotations
, p
);
5417 struct buffer
*given_buffer
= current_buffer
;
5418 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5419 { /* Use the global value of the hook. */
5422 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5424 p
= Fappend (2, arg
);
5427 Vwrite_region_annotations_so_far
= annotations
;
5428 res
= call2 (XCAR (p
), start
, end
);
5429 /* If the function makes a different buffer current,
5430 assume that means this buffer contains altered text to be output.
5431 Reset START and END from the buffer bounds
5432 and discard all previous annotations because they should have
5433 been dealt with by this function. */
5434 if (current_buffer
!= given_buffer
)
5436 XSETFASTINT (start
, BEGV
);
5437 XSETFASTINT (end
, ZV
);
5440 Flength (res
); /* Check basic validity of return value */
5441 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5445 /* Now do the same for annotation functions implied by the file-format */
5446 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5447 p
= current_buffer
->auto_save_file_format
;
5449 p
= current_buffer
->file_format
;
5450 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5452 struct buffer
*given_buffer
= current_buffer
;
5454 Vwrite_region_annotations_so_far
= annotations
;
5456 /* Value is either a list of annotations or nil if the function
5457 has written annotations to a temporary buffer, which is now
5459 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5460 original_buffer
, make_number (i
));
5461 if (current_buffer
!= given_buffer
)
5463 XSETFASTINT (start
, BEGV
);
5464 XSETFASTINT (end
, ZV
);
5469 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5477 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5478 If STRING is nil, POS is the character position in the current buffer.
5479 Intersperse with them the annotations from *ANNOT
5480 which fall within the range of POS to POS + NCHARS,
5481 each at its appropriate position.
5483 We modify *ANNOT by discarding elements as we use them up.
5485 The return value is negative in case of system call failure. */
5488 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5491 register int nchars
;
5494 struct coding_system
*coding
;
5498 int lastpos
= pos
+ nchars
;
5500 while (NILP (*annot
) || CONSP (*annot
))
5502 tem
= Fcar_safe (Fcar (*annot
));
5505 nextpos
= XFASTINT (tem
);
5507 /* If there are no more annotations in this range,
5508 output the rest of the range all at once. */
5509 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5510 return e_write (desc
, string
, pos
, lastpos
, coding
);
5512 /* Output buffer text up to the next annotation's position. */
5515 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5519 /* Output the annotation. */
5520 tem
= Fcdr (Fcar (*annot
));
5523 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5526 *annot
= Fcdr (*annot
);
5532 /* Write text in the range START and END into descriptor DESC,
5533 encoding them with coding system CODING. If STRING is nil, START
5534 and END are character positions of the current buffer, else they
5535 are indexes to the string STRING. */
5538 e_write (desc
, string
, start
, end
, coding
)
5542 struct coding_system
*coding
;
5544 if (STRINGP (string
))
5547 end
= SCHARS (string
);
5550 /* We used to have a code for handling selective display here. But,
5551 now it is handled within encode_coding. */
5555 if (STRINGP (string
))
5557 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5558 if (CODING_REQUIRE_ENCODING (coding
))
5560 encode_coding_object (coding
, string
,
5561 start
, string_char_to_byte (string
, start
),
5562 end
, string_char_to_byte (string
, end
), Qt
);
5566 coding
->dst_object
= string
;
5567 coding
->consumed_char
= SCHARS (string
);
5568 coding
->produced
= SBYTES (string
);
5573 int start_byte
= CHAR_TO_BYTE (start
);
5574 int end_byte
= CHAR_TO_BYTE (end
);
5576 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5577 if (CODING_REQUIRE_ENCODING (coding
))
5579 encode_coding_object (coding
, Fcurrent_buffer (),
5580 start
, start_byte
, end
, end_byte
, Qt
);
5584 coding
->dst_object
= Qnil
;
5585 coding
->dst_pos_byte
= start_byte
;
5586 if (start
>= GPT
|| end
<= GPT
)
5588 coding
->consumed_char
= end
- start
;
5589 coding
->produced
= end_byte
- start_byte
;
5593 coding
->consumed_char
= GPT
- start
;
5594 coding
->produced
= GPT_BYTE
- start_byte
;
5599 if (coding
->produced
> 0)
5603 STRINGP (coding
->dst_object
)
5604 ? SDATA (coding
->dst_object
)
5605 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5608 if (coding
->produced
)
5611 start
+= coding
->consumed_char
;
5617 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5618 Sverify_visited_file_modtime
, 1, 1, 0,
5619 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5620 This means that the file has not been changed since it was visited or saved.
5621 See Info node `(elisp)Modification Time' for more details. */)
5627 Lisp_Object handler
;
5628 Lisp_Object filename
;
5633 if (!STRINGP (b
->filename
)) return Qt
;
5634 if (b
->modtime
== 0) return Qt
;
5636 /* If the file name has special constructs in it,
5637 call the corresponding file handler. */
5638 handler
= Ffind_file_name_handler (b
->filename
,
5639 Qverify_visited_file_modtime
);
5640 if (!NILP (handler
))
5641 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5643 filename
= ENCODE_FILE (b
->filename
);
5645 if (stat (SDATA (filename
), &st
) < 0)
5647 /* If the file doesn't exist now and didn't exist before,
5648 we say that it isn't modified, provided the error is a tame one. */
5649 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5654 if (st
.st_mtime
== b
->modtime
5655 /* If both are positive, accept them if they are off by one second. */
5656 || (st
.st_mtime
> 0 && b
->modtime
> 0
5657 && (st
.st_mtime
== b
->modtime
+ 1
5658 || st
.st_mtime
== b
->modtime
- 1)))
5663 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5664 Sclear_visited_file_modtime
, 0, 0, 0,
5665 doc
: /* Clear out records of last mod time of visited file.
5666 Next attempt to save will certainly not complain of a discrepancy. */)
5669 current_buffer
->modtime
= 0;
5673 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5674 Svisited_file_modtime
, 0, 0, 0,
5675 doc
: /* Return the current buffer's recorded visited file modification time.
5676 The value is a list of the form (HIGH LOW), like the time values
5677 that `file-attributes' returns. If the current buffer has no recorded
5678 file modification time, this function returns 0.
5679 See Info node `(elisp)Modification Time' for more details. */)
5682 if (! current_buffer
->modtime
)
5683 return make_number (0);
5684 return make_time ((time_t) current_buffer
->modtime
);
5687 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5688 Sset_visited_file_modtime
, 0, 1, 0,
5689 doc
: /* Update buffer's recorded modification time from the visited file's time.
5690 Useful if the buffer was not read from the file normally
5691 or if the file itself has been changed for some known benign reason.
5692 An argument specifies the modification time value to use
5693 \(instead of that of the visited file), in the form of a list
5694 \(HIGH . LOW) or (HIGH LOW). */)
5696 Lisp_Object time_list
;
5698 if (!NILP (time_list
))
5699 current_buffer
->modtime
= cons_to_long (time_list
);
5702 register Lisp_Object filename
;
5704 Lisp_Object handler
;
5706 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5708 /* If the file name has special constructs in it,
5709 call the corresponding file handler. */
5710 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5711 if (!NILP (handler
))
5712 /* The handler can find the file name the same way we did. */
5713 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5715 filename
= ENCODE_FILE (filename
);
5717 if (stat (SDATA (filename
), &st
) >= 0)
5718 current_buffer
->modtime
= st
.st_mtime
;
5725 auto_save_error (error
)
5728 Lisp_Object args
[3], msg
;
5730 struct gcpro gcpro1
;
5734 auto_save_error_occurred
= 1;
5736 ring_bell (XFRAME (selected_frame
));
5738 args
[0] = build_string ("Auto-saving %s: %s");
5739 args
[1] = current_buffer
->name
;
5740 args
[2] = Ferror_message_string (error
);
5741 msg
= Fformat (3, args
);
5743 nbytes
= SBYTES (msg
);
5744 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5745 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5747 for (i
= 0; i
< 3; ++i
)
5750 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5752 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5753 Fsleep_for (make_number (1), Qnil
);
5767 auto_save_mode_bits
= 0666;
5769 /* Get visited file's mode to become the auto save file's mode. */
5770 if (! NILP (current_buffer
->filename
))
5772 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5773 /* But make sure we can overwrite it later! */
5774 auto_save_mode_bits
= st
.st_mode
| 0600;
5775 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5777 /* Remote files don't cooperate with stat. */
5778 auto_save_mode_bits
= XINT (modes
) | 0600;
5782 Fwrite_region (Qnil
, Qnil
,
5783 current_buffer
->auto_save_file_name
,
5784 Qnil
, Qlambda
, Qnil
, Qnil
);
5788 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5791 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5803 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5806 minibuffer_auto_raise
= XINT (value
);
5811 do_auto_save_make_dir (dir
)
5816 call2 (Qmake_directory
, dir
, Qt
);
5817 XSETFASTINT (mode
, 0700);
5818 return Fset_file_modes (dir
, mode
);
5822 do_auto_save_eh (ignore
)
5828 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5829 doc
: /* Auto-save all buffers that need it.
5830 This is all buffers that have auto-saving enabled
5831 and are changed since last auto-saved.
5832 Auto-saving writes the buffer into a file
5833 so that your editing is not lost if the system crashes.
5834 This file is not the file you visited; that changes only when you save.
5835 Normally we run the normal hook `auto-save-hook' before saving.
5837 A non-nil NO-MESSAGE argument means do not print any message if successful.
5838 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5839 (no_message
, current_only
)
5840 Lisp_Object no_message
, current_only
;
5842 struct buffer
*old
= current_buffer
, *b
;
5843 Lisp_Object tail
, buf
;
5845 int do_handled_files
;
5847 FILE *stream
= NULL
;
5848 int count
= SPECPDL_INDEX ();
5849 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5850 int old_message_p
= 0;
5851 struct gcpro gcpro1
, gcpro2
;
5853 if (max_specpdl_size
< specpdl_size
+ 40)
5854 max_specpdl_size
= specpdl_size
+ 40;
5859 if (NILP (no_message
))
5861 old_message_p
= push_message ();
5862 record_unwind_protect (pop_message_unwind
, Qnil
);
5865 /* Ordinarily don't quit within this function,
5866 but don't make it impossible to quit (in case we get hung in I/O). */
5870 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5871 point to non-strings reached from Vbuffer_alist. */
5873 if (!NILP (Vrun_hooks
))
5874 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5876 if (STRINGP (Vauto_save_list_file_name
))
5878 Lisp_Object listfile
;
5880 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5882 /* Don't try to create the directory when shutting down Emacs,
5883 because creating the directory might signal an error, and
5884 that would leave Emacs in a strange state. */
5885 if (!NILP (Vrun_hooks
))
5889 GCPRO2 (dir
, listfile
);
5890 dir
= Ffile_name_directory (listfile
);
5891 if (NILP (Ffile_directory_p (dir
)))
5892 internal_condition_case_1 (do_auto_save_make_dir
,
5893 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5898 stream
= fopen (SDATA (listfile
), "w");
5901 record_unwind_protect (do_auto_save_unwind
,
5902 make_save_value (stream
, 0));
5903 record_unwind_protect (do_auto_save_unwind_1
,
5904 make_number (minibuffer_auto_raise
));
5905 minibuffer_auto_raise
= 0;
5907 auto_save_error_occurred
= 0;
5909 /* On first pass, save all files that don't have handlers.
5910 On second pass, save all files that do have handlers.
5912 If Emacs is crashing, the handlers may tweak what is causing
5913 Emacs to crash in the first place, and it would be a shame if
5914 Emacs failed to autosave perfectly ordinary files because it
5915 couldn't handle some ange-ftp'd file. */
5917 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5918 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5920 buf
= XCDR (XCAR (tail
));
5923 /* Record all the buffers that have auto save mode
5924 in the special file that lists them. For each of these buffers,
5925 Record visited name (if any) and auto save name. */
5926 if (STRINGP (b
->auto_save_file_name
)
5927 && stream
!= NULL
&& do_handled_files
== 0)
5930 if (!NILP (b
->filename
))
5932 fwrite (SDATA (b
->filename
), 1,
5933 SBYTES (b
->filename
), stream
);
5935 putc ('\n', stream
);
5936 fwrite (SDATA (b
->auto_save_file_name
), 1,
5937 SBYTES (b
->auto_save_file_name
), stream
);
5938 putc ('\n', stream
);
5942 if (!NILP (current_only
)
5943 && b
!= current_buffer
)
5946 /* Don't auto-save indirect buffers.
5947 The base buffer takes care of it. */
5951 /* Check for auto save enabled
5952 and file changed since last auto save
5953 and file changed since last real save. */
5954 if (STRINGP (b
->auto_save_file_name
)
5955 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5956 && b
->auto_save_modified
< BUF_MODIFF (b
)
5957 /* -1 means we've turned off autosaving for a while--see below. */
5958 && XINT (b
->save_length
) >= 0
5959 && (do_handled_files
5960 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5963 EMACS_TIME before_time
, after_time
;
5965 EMACS_GET_TIME (before_time
);
5967 /* If we had a failure, don't try again for 20 minutes. */
5968 if (b
->auto_save_failure_time
>= 0
5969 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5972 if ((XFASTINT (b
->save_length
) * 10
5973 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5974 /* A short file is likely to change a large fraction;
5975 spare the user annoying messages. */
5976 && XFASTINT (b
->save_length
) > 5000
5977 /* These messages are frequent and annoying for `*mail*'. */
5978 && !EQ (b
->filename
, Qnil
)
5979 && NILP (no_message
))
5981 /* It has shrunk too much; turn off auto-saving here. */
5982 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5983 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5985 minibuffer_auto_raise
= 0;
5986 /* Turn off auto-saving until there's a real save,
5987 and prevent any more warnings. */
5988 XSETINT (b
->save_length
, -1);
5989 Fsleep_for (make_number (1), Qnil
);
5992 set_buffer_internal (b
);
5993 if (!auto_saved
&& NILP (no_message
))
5994 message1 ("Auto-saving...");
5995 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5997 b
->auto_save_modified
= BUF_MODIFF (b
);
5998 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5999 set_buffer_internal (old
);
6001 EMACS_GET_TIME (after_time
);
6003 /* If auto-save took more than 60 seconds,
6004 assume it was an NFS failure that got a timeout. */
6005 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6006 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6010 /* Prevent another auto save till enough input events come in. */
6011 record_auto_save ();
6013 if (auto_saved
&& NILP (no_message
))
6017 /* If we are going to restore an old message,
6018 give time to read ours. */
6019 sit_for (make_number (1), 0, 0);
6022 else if (!auto_save_error_occurred
)
6023 /* Don't overwrite the error message if an error occurred. */
6024 /* If we displayed a message and then restored a state
6025 with no message, leave a "done" message on the screen. */
6026 message1 ("Auto-saving...done");
6031 /* This restores the message-stack status. */
6032 unbind_to (count
, Qnil
);
6036 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6037 Sset_buffer_auto_saved
, 0, 0, 0,
6038 doc
: /* Mark current buffer as auto-saved with its current text.
6039 No auto-save file will be written until the buffer changes again. */)
6042 current_buffer
->auto_save_modified
= MODIFF
;
6043 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6044 current_buffer
->auto_save_failure_time
= -1;
6048 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6049 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6050 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6053 current_buffer
->auto_save_failure_time
= -1;
6057 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6059 doc
: /* Return t if current buffer has been auto-saved recently.
6060 More precisely, if it has been auto-saved since last read from or saved
6061 in the visited file. If the buffer has no visited file,
6062 then any auto-save counts as "recent". */)
6065 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6068 /* Reading and completing file names */
6069 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6070 extern Lisp_Object Qcompletion_ignore_case
;
6072 /* In the string VAL, change each $ to $$ and return the result. */
6075 double_dollars (val
)
6078 register const unsigned char *old
;
6079 register unsigned char *new;
6083 osize
= SBYTES (val
);
6085 /* Count the number of $ characters. */
6086 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6087 if (*old
++ == '$') count
++;
6091 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6094 for (n
= osize
; n
> 0; n
--)
6108 read_file_name_cleanup (arg
)
6111 return (current_buffer
->directory
= arg
);
6114 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6116 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6117 (string
, dir
, action
)
6118 Lisp_Object string
, dir
, action
;
6119 /* action is nil for complete, t for return list of completions,
6120 lambda for verify final value */
6122 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6124 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6126 CHECK_STRING (string
);
6133 /* No need to protect ACTION--we only compare it with t and nil. */
6134 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6136 if (SCHARS (string
) == 0)
6138 if (EQ (action
, Qlambda
))
6146 orig_string
= string
;
6147 string
= Fsubstitute_in_file_name (string
);
6148 changed
= NILP (Fstring_equal (string
, orig_string
));
6149 name
= Ffile_name_nondirectory (string
);
6150 val
= Ffile_name_directory (string
);
6152 realdir
= Fexpand_file_name (val
, realdir
);
6157 specdir
= Ffile_name_directory (string
);
6158 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6163 return double_dollars (string
);
6167 if (!NILP (specdir
))
6168 val
= concat2 (specdir
, val
);
6170 return double_dollars (val
);
6173 #endif /* not VMS */
6177 if (EQ (action
, Qt
))
6179 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6183 if (NILP (Vread_file_name_predicate
)
6184 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6188 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6190 /* Brute-force speed up for directory checking:
6191 Discard strings which don't end in a slash. */
6192 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6194 Lisp_Object tem
= XCAR (all
);
6196 if (STRINGP (tem
) &&
6197 (len
= SBYTES (tem
), len
> 0) &&
6198 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6199 comp
= Fcons (tem
, comp
);
6205 /* Must do it the hard (and slow) way. */
6207 GCPRO3 (all
, comp
, specdir
);
6208 count
= SPECPDL_INDEX ();
6209 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6210 current_buffer
->directory
= realdir
;
6211 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6213 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6215 comp
= Fcons (XCAR (all
), comp
);
6217 unbind_to (count
, Qnil
);
6220 return Fnreverse (comp
);
6223 /* Only other case actually used is ACTION = lambda */
6225 /* Supposedly this helps commands such as `cd' that read directory names,
6226 but can someone explain how it helps them? -- RMS */
6227 if (SCHARS (name
) == 0)
6230 string
= Fexpand_file_name (string
, dir
);
6231 if (!NILP (Vread_file_name_predicate
))
6232 return call1 (Vread_file_name_predicate
, string
);
6233 return Ffile_exists_p (string
);
6236 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6237 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6238 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6239 The return value is only relevant for a call to `read-file-name' that happens
6240 before any other event (mouse or keypress) is handeled. */)
6243 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6244 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6253 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6254 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6255 Value is not expanded---you must call `expand-file-name' yourself.
6256 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6257 the same non-empty string that was inserted by this function.
6258 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6259 except that if INITIAL is specified, that combined with DIR is used.)
6260 If the user exits with an empty minibuffer, this function returns
6261 an empty string. (This can only happen if the user erased the
6262 pre-inserted contents or if `insert-default-directory' is nil.)
6263 Fourth arg MUSTMATCH non-nil means require existing file's name.
6264 Non-nil and non-t means also require confirmation after completion.
6265 Fifth arg INITIAL specifies text to start with.
6266 If optional sixth arg PREDICATE is non-nil, possible completions and
6267 the resulting file name must satisfy (funcall PREDICATE NAME).
6268 DIR should be an absolute directory name. It defaults to the value of
6269 `default-directory'.
6271 If this command was invoked with the mouse, use a file dialog box if
6272 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6273 provides a file dialog box.
6275 See also `read-file-name-completion-ignore-case'
6276 and `read-file-name-function'. */)
6277 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6278 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6280 Lisp_Object val
, insdef
, tem
;
6281 struct gcpro gcpro1
, gcpro2
;
6282 register char *homedir
;
6283 Lisp_Object decoded_homedir
;
6284 int replace_in_history
= 0;
6285 int add_to_history
= 0;
6289 dir
= current_buffer
->directory
;
6290 if (NILP (Ffile_name_absolute_p (dir
)))
6291 dir
= Fexpand_file_name (dir
, Qnil
);
6292 if (NILP (default_filename
))
6295 ? Fexpand_file_name (initial
, dir
)
6296 : current_buffer
->filename
);
6298 /* If dir starts with user's homedir, change that to ~. */
6299 homedir
= (char *) egetenv ("HOME");
6301 /* homedir can be NULL in temacs, since Vglobal_environment is not
6302 yet set up. We shouldn't crash in that case. */
6305 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6306 CORRECT_DIR_SEPS (homedir
);
6311 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6314 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6315 SBYTES (decoded_homedir
))
6316 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6318 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6319 dir
= concat2 (build_string ("~"), dir
);
6321 /* Likewise for default_filename. */
6323 && STRINGP (default_filename
)
6324 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6325 SBYTES (decoded_homedir
))
6326 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6329 = Fsubstring (default_filename
,
6330 make_number (SCHARS (decoded_homedir
)), Qnil
);
6331 default_filename
= concat2 (build_string ("~"), default_filename
);
6333 if (!NILP (default_filename
))
6335 CHECK_STRING (default_filename
);
6336 default_filename
= double_dollars (default_filename
);
6339 if (insert_default_directory
&& STRINGP (dir
))
6342 if (!NILP (initial
))
6344 Lisp_Object args
[2], pos
;
6348 insdef
= Fconcat (2, args
);
6349 pos
= make_number (SCHARS (double_dollars (dir
)));
6350 insdef
= Fcons (double_dollars (insdef
), pos
);
6353 insdef
= double_dollars (insdef
);
6355 else if (STRINGP (initial
))
6356 insdef
= Fcons (double_dollars (initial
), make_number (0));
6360 if (!NILP (Vread_file_name_function
))
6362 Lisp_Object args
[7];
6364 GCPRO2 (insdef
, default_filename
);
6365 args
[0] = Vread_file_name_function
;
6368 args
[3] = default_filename
;
6369 args
[4] = mustmatch
;
6371 args
[6] = predicate
;
6372 RETURN_UNGCPRO (Ffuncall (7, args
));
6375 count
= SPECPDL_INDEX ();
6376 specbind (Qcompletion_ignore_case
,
6377 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6378 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6379 specbind (intern ("read-file-name-predicate"),
6380 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6382 GCPRO2 (insdef
, default_filename
);
6384 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6385 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6387 /* If DIR contains a file name, split it. */
6389 file
= Ffile_name_nondirectory (dir
);
6390 if (SCHARS (file
) && NILP (default_filename
))
6392 default_filename
= file
;
6393 dir
= Ffile_name_directory (dir
);
6395 if (!NILP(default_filename
))
6396 default_filename
= Fexpand_file_name (default_filename
, dir
);
6397 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6398 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6403 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6404 dir
, mustmatch
, insdef
,
6405 Qfile_name_history
, default_filename
, Qnil
);
6407 tem
= Fsymbol_value (Qfile_name_history
);
6408 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6409 replace_in_history
= 1;
6411 /* If Fcompleting_read returned the inserted default string itself
6412 (rather than a new string with the same contents),
6413 it has to mean that the user typed RET with the minibuffer empty.
6414 In that case, we really want to return ""
6415 so that commands such as set-visited-file-name can distinguish. */
6416 if (EQ (val
, default_filename
))
6418 /* In this case, Fcompleting_read has not added an element
6419 to the history. Maybe we should. */
6420 if (! replace_in_history
)
6423 val
= empty_unibyte_string
;
6426 unbind_to (count
, Qnil
);
6429 error ("No file name specified");
6431 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6433 if (!NILP (tem
) && !NILP (default_filename
))
6434 val
= default_filename
;
6435 val
= Fsubstitute_in_file_name (val
);
6437 if (replace_in_history
)
6438 /* Replace what Fcompleting_read added to the history
6439 with what we will actually return. */
6441 Lisp_Object val1
= double_dollars (val
);
6442 tem
= Fsymbol_value (Qfile_name_history
);
6443 if (history_delete_duplicates
)
6444 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6445 XSETCAR (tem
, val1
);
6447 else if (add_to_history
)
6449 /* Add the value to the history--but not if it matches
6450 the last value already there. */
6451 Lisp_Object val1
= double_dollars (val
);
6452 tem
= Fsymbol_value (Qfile_name_history
);
6453 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6455 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6456 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6467 /* Must be set before any path manipulation is performed. */
6468 XSETFASTINT (Vdirectory_sep_char
, '/');
6475 Qoperations
= intern ("operations");
6476 Qexpand_file_name
= intern ("expand-file-name");
6477 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6478 Qdirectory_file_name
= intern ("directory-file-name");
6479 Qfile_name_directory
= intern ("file-name-directory");
6480 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6481 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6482 Qfile_name_as_directory
= intern ("file-name-as-directory");
6483 Qcopy_file
= intern ("copy-file");
6484 Qmake_directory_internal
= intern ("make-directory-internal");
6485 Qmake_directory
= intern ("make-directory");
6486 Qdelete_directory
= intern ("delete-directory");
6487 Qdelete_file
= intern ("delete-file");
6488 Qrename_file
= intern ("rename-file");
6489 Qadd_name_to_file
= intern ("add-name-to-file");
6490 Qmake_symbolic_link
= intern ("make-symbolic-link");
6491 Qfile_exists_p
= intern ("file-exists-p");
6492 Qfile_executable_p
= intern ("file-executable-p");
6493 Qfile_readable_p
= intern ("file-readable-p");
6494 Qfile_writable_p
= intern ("file-writable-p");
6495 Qfile_symlink_p
= intern ("file-symlink-p");
6496 Qaccess_file
= intern ("access-file");
6497 Qfile_directory_p
= intern ("file-directory-p");
6498 Qfile_regular_p
= intern ("file-regular-p");
6499 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6500 Qfile_modes
= intern ("file-modes");
6501 Qset_file_modes
= intern ("set-file-modes");
6502 Qset_file_times
= intern ("set-file-times");
6503 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6504 Qinsert_file_contents
= intern ("insert-file-contents");
6505 Qwrite_region
= intern ("write-region");
6506 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6507 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6508 Qauto_save_coding
= intern ("auto-save-coding");
6510 staticpro (&Qoperations
);
6511 staticpro (&Qexpand_file_name
);
6512 staticpro (&Qsubstitute_in_file_name
);
6513 staticpro (&Qdirectory_file_name
);
6514 staticpro (&Qfile_name_directory
);
6515 staticpro (&Qfile_name_nondirectory
);
6516 staticpro (&Qunhandled_file_name_directory
);
6517 staticpro (&Qfile_name_as_directory
);
6518 staticpro (&Qcopy_file
);
6519 staticpro (&Qmake_directory_internal
);
6520 staticpro (&Qmake_directory
);
6521 staticpro (&Qdelete_directory
);
6522 staticpro (&Qdelete_file
);
6523 staticpro (&Qrename_file
);
6524 staticpro (&Qadd_name_to_file
);
6525 staticpro (&Qmake_symbolic_link
);
6526 staticpro (&Qfile_exists_p
);
6527 staticpro (&Qfile_executable_p
);
6528 staticpro (&Qfile_readable_p
);
6529 staticpro (&Qfile_writable_p
);
6530 staticpro (&Qaccess_file
);
6531 staticpro (&Qfile_symlink_p
);
6532 staticpro (&Qfile_directory_p
);
6533 staticpro (&Qfile_regular_p
);
6534 staticpro (&Qfile_accessible_directory_p
);
6535 staticpro (&Qfile_modes
);
6536 staticpro (&Qset_file_modes
);
6537 staticpro (&Qset_file_times
);
6538 staticpro (&Qfile_newer_than_file_p
);
6539 staticpro (&Qinsert_file_contents
);
6540 staticpro (&Qwrite_region
);
6541 staticpro (&Qverify_visited_file_modtime
);
6542 staticpro (&Qset_visited_file_modtime
);
6543 staticpro (&Qauto_save_coding
);
6545 Qfile_name_history
= intern ("file-name-history");
6546 Fset (Qfile_name_history
, Qnil
);
6547 staticpro (&Qfile_name_history
);
6549 Qfile_error
= intern ("file-error");
6550 staticpro (&Qfile_error
);
6551 Qfile_already_exists
= intern ("file-already-exists");
6552 staticpro (&Qfile_already_exists
);
6553 Qfile_date_error
= intern ("file-date-error");
6554 staticpro (&Qfile_date_error
);
6555 Qexcl
= intern ("excl");
6559 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6560 staticpro (&Qfind_buffer_file_type
);
6563 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6564 doc
: /* *Coding system for encoding file names.
6565 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6566 Vfile_name_coding_system
= Qnil
;
6568 DEFVAR_LISP ("default-file-name-coding-system",
6569 &Vdefault_file_name_coding_system
,
6570 doc
: /* Default coding system for encoding file names.
6571 This variable is used only when `file-name-coding-system' is nil.
6573 This variable is set/changed by the command `set-language-environment'.
6574 User should not set this variable manually,
6575 instead use `file-name-coding-system' to get a constant encoding
6576 of file names regardless of the current language environment. */);
6577 Vdefault_file_name_coding_system
= Qnil
;
6579 Qformat_decode
= intern ("format-decode");
6580 staticpro (&Qformat_decode
);
6581 Qformat_annotate_function
= intern ("format-annotate-function");
6582 staticpro (&Qformat_annotate_function
);
6583 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6584 staticpro (&Qafter_insert_file_set_coding
);
6586 Qcar_less_than_car
= intern ("car-less-than-car");
6587 staticpro (&Qcar_less_than_car
);
6589 Fput (Qfile_error
, Qerror_conditions
,
6590 list2 (Qfile_error
, Qerror
));
6591 Fput (Qfile_error
, Qerror_message
,
6592 build_string ("File error"));
6594 Fput (Qfile_already_exists
, Qerror_conditions
,
6595 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6596 Fput (Qfile_already_exists
, Qerror_message
,
6597 build_string ("File already exists"));
6599 Fput (Qfile_date_error
, Qerror_conditions
,
6600 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6601 Fput (Qfile_date_error
, Qerror_message
,
6602 build_string ("Cannot set file date"));
6604 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6605 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6606 Vread_file_name_function
= Qnil
;
6608 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6609 doc
: /* Current predicate used by `read-file-name-internal'. */);
6610 Vread_file_name_predicate
= Qnil
;
6612 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6613 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6614 #if defined VMS || defined DOS_NT || defined MAC_OS
6615 read_file_name_completion_ignore_case
= 1;
6617 read_file_name_completion_ignore_case
= 0;
6620 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6621 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6622 If the initial minibuffer contents are non-empty, you can usually
6623 request a default filename by typing RETURN without editing. For some
6624 commands, exiting with an empty minibuffer has a special meaning,
6625 such as making the current buffer visit no file in the case of
6626 `set-visited-file-name'.
6627 If this variable is non-nil, the minibuffer contents are always
6628 initially non-empty and typing RETURN without editing will fetch the
6629 default name, if one is provided. Note however that this default name
6630 is not necessarily the name originally inserted in the minibuffer, if
6631 that is just the default directory.
6632 If this variable is nil, the minibuffer often starts out empty. In
6633 that case you may have to explicitly fetch the next history element to
6634 request the default name. */);
6635 insert_default_directory
= 1;
6637 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6638 doc
: /* *Non-nil means write new files with record format `stmlf'.
6639 nil means use format `var'. This variable is meaningful only on VMS. */);
6640 vms_stmlf_recfm
= 0;
6642 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6643 doc
: /* Directory separator character for built-in functions that return file names.
6644 The value is always ?/. Don't use this variable, just use `/'. */);
6646 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6647 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6648 If a file name matches REGEXP, then all I/O on that file is done by calling
6651 The first argument given to HANDLER is the name of the I/O primitive
6652 to be handled; the remaining arguments are the arguments that were
6653 passed to that primitive. For example, if you do
6654 (file-exists-p FILENAME)
6655 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6656 (funcall HANDLER 'file-exists-p FILENAME)
6657 The function `find-file-name-handler' checks this list for a handler
6658 for its argument. */);
6659 Vfile_name_handler_alist
= Qnil
;
6661 DEFVAR_LISP ("set-auto-coding-function",
6662 &Vset_auto_coding_function
,
6663 doc
: /* If non-nil, a function to call to decide a coding system of file.
6664 Two arguments are passed to this function: the file name
6665 and the length of a file contents following the point.
6666 This function should return a coding system to decode the file contents.
6667 It should check the file name against `auto-coding-alist'.
6668 If no coding system is decided, it should check a coding system
6669 specified in the heading lines with the format:
6670 -*- ... coding: CODING-SYSTEM; ... -*-
6671 or local variable spec of the tailing lines with `coding:' tag. */);
6672 Vset_auto_coding_function
= Qnil
;
6674 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6675 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6676 Each is passed one argument, the number of characters inserted,
6677 with point at the start of the inserted text. Each function
6678 should leave point the same, and return the new character count.
6679 If `insert-file-contents' is intercepted by a handler from
6680 `file-name-handler-alist', that handler is responsible for calling the
6681 functions in `after-insert-file-functions' if appropriate. */);
6682 Vafter_insert_file_functions
= Qnil
;
6684 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6685 doc
: /* A list of functions to be called at the start of `write-region'.
6686 Each is passed two arguments, START and END as for `write-region'.
6687 These are usually two numbers but not always; see the documentation
6688 for `write-region'. The function should return a list of pairs
6689 of the form (POSITION . STRING), consisting of strings to be effectively
6690 inserted at the specified positions of the file being written (1 means to
6691 insert before the first byte written). The POSITIONs must be sorted into
6692 increasing order. If there are several functions in the list, the several
6693 lists are merged destructively. Alternatively, the function can return
6694 with a different buffer current; in that case it should pay attention
6695 to the annotations returned by previous functions and listed in
6696 `write-region-annotations-so-far'.*/);
6697 Vwrite_region_annotate_functions
= Qnil
;
6698 staticpro (&Qwrite_region_annotate_functions
);
6699 Qwrite_region_annotate_functions
6700 = intern ("write-region-annotate-functions");
6702 DEFVAR_LISP ("write-region-annotations-so-far",
6703 &Vwrite_region_annotations_so_far
,
6704 doc
: /* When an annotation function is called, this holds the previous annotations.
6705 These are the annotations made by other annotation functions
6706 that were already called. See also `write-region-annotate-functions'. */);
6707 Vwrite_region_annotations_so_far
= Qnil
;
6709 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6710 doc
: /* A list of file name handlers that temporarily should not be used.
6711 This applies only to the operation `inhibit-file-name-operation'. */);
6712 Vinhibit_file_name_handlers
= Qnil
;
6714 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6715 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6716 Vinhibit_file_name_operation
= Qnil
;
6718 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6719 doc
: /* File name in which we write a list of all auto save file names.
6720 This variable is initialized automatically from `auto-save-list-file-prefix'
6721 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6722 a non-nil value. */);
6723 Vauto_save_list_file_name
= Qnil
;
6726 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6727 doc
: /* *Non-nil means don't call fsync in `write-region'.
6728 This variable affects calls to `write-region' as well as save commands.
6729 A non-nil value may result in data loss! */);
6730 write_region_inhibit_fsync
= 0;
6733 defsubr (&Sfind_file_name_handler
);
6734 defsubr (&Sfile_name_directory
);
6735 defsubr (&Sfile_name_nondirectory
);
6736 defsubr (&Sunhandled_file_name_directory
);
6737 defsubr (&Sfile_name_as_directory
);
6738 defsubr (&Sdirectory_file_name
);
6739 defsubr (&Smake_temp_name
);
6740 defsubr (&Sexpand_file_name
);
6741 defsubr (&Ssubstitute_in_file_name
);
6742 defsubr (&Scopy_file
);
6743 defsubr (&Smake_directory_internal
);
6744 defsubr (&Sdelete_directory
);
6745 defsubr (&Sdelete_file
);
6746 defsubr (&Srename_file
);
6747 defsubr (&Sadd_name_to_file
);
6749 defsubr (&Smake_symbolic_link
);
6750 #endif /* S_IFLNK */
6752 defsubr (&Sdefine_logical_name
);
6755 defsubr (&Ssysnetunam
);
6756 #endif /* HPUX_NET */
6757 defsubr (&Sfile_name_absolute_p
);
6758 defsubr (&Sfile_exists_p
);
6759 defsubr (&Sfile_executable_p
);
6760 defsubr (&Sfile_readable_p
);
6761 defsubr (&Sfile_writable_p
);
6762 defsubr (&Saccess_file
);
6763 defsubr (&Sfile_symlink_p
);
6764 defsubr (&Sfile_directory_p
);
6765 defsubr (&Sfile_accessible_directory_p
);
6766 defsubr (&Sfile_regular_p
);
6767 defsubr (&Sfile_modes
);
6768 defsubr (&Sset_file_modes
);
6769 defsubr (&Sset_file_times
);
6770 defsubr (&Sset_default_file_modes
);
6771 defsubr (&Sdefault_file_modes
);
6772 defsubr (&Sfile_newer_than_file_p
);
6773 defsubr (&Sinsert_file_contents
);
6774 defsubr (&Swrite_region
);
6775 defsubr (&Scar_less_than_car
);
6776 defsubr (&Sverify_visited_file_modtime
);
6777 defsubr (&Sclear_visited_file_modtime
);
6778 defsubr (&Svisited_file_modtime
);
6779 defsubr (&Sset_visited_file_modtime
);
6780 defsubr (&Sdo_auto_save
);
6781 defsubr (&Sset_buffer_auto_saved
);
6782 defsubr (&Sclear_buffer_auto_save_failure
);
6783 defsubr (&Srecent_auto_save_p
);
6785 defsubr (&Sread_file_name_internal
);
6786 defsubr (&Sread_file_name
);
6787 defsubr (&Snext_read_file_uses_dialog_p
);
6790 defsubr (&Sunix_sync
);
6794 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6795 (do not change this comment) */