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 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
77 #include "character.h"
80 #include "blockinput.h"
82 #include "dispextern.h"
89 #endif /* not WINDOWSNT */
93 #include <sys/param.h>
101 #define CORRECT_DIR_SEPS(s) \
102 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
103 else unixtodos_filename (s); \
105 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
106 redirector allows the six letters between 'Z' and 'a' as well. */
108 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
111 #define IS_DRIVE(x) isalpha (x)
113 /* Need to lower-case the drive letter, or else expanded
114 filenames will sometimes compare inequal, because
115 `expand-file-name' doesn't always down-case the drive letter. */
116 #define DRIVE_LETTER(x) (tolower (x))
137 #include "commands.h"
138 extern int use_dialog_box
;
139 extern int use_file_dialog
;
153 #ifndef FILE_SYSTEM_CASE
154 #define FILE_SYSTEM_CASE(filename) (filename)
157 /* Nonzero during writing of auto-save files */
160 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
161 a new file with the same mode as the original */
162 int auto_save_mode_bits
;
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 spec.
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 The `call-process' and `start-process' functions use this function to
539 get a current directory to run processes in. */)
541 Lisp_Object filename
;
545 /* If the file name has special constructs in it,
546 call the corresponding file handler. */
547 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
549 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
551 return Ffile_name_directory (filename
);
556 file_name_as_directory (out
, in
)
559 int size
= strlen (in
) - 1;
572 /* Is it already a directory string? */
573 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
575 /* Is it a VMS directory file name? If so, hack VMS syntax. */
576 else if (! index (in
, '/')
577 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
578 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
579 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
580 || ! strncmp (&in
[size
- 5], ".dir", 4))
581 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
582 && in
[size
] == '1')))
584 register char *p
, *dot
;
588 dir:x.dir --> dir:[x]
589 dir:[x]y.dir --> dir:[x.y] */
591 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
594 strncpy (out
, in
, p
- in
);
613 dot
= index (p
, '.');
616 /* blindly remove any extension */
617 size
= strlen (out
) + (dot
- p
);
618 strncat (out
, p
, dot
- p
);
629 /* For Unix syntax, Append a slash if necessary */
630 if (!IS_DIRECTORY_SEP (out
[size
]))
632 /* Cannot use DIRECTORY_SEP, which could have any value */
634 out
[size
+ 2] = '\0';
637 CORRECT_DIR_SEPS (out
);
643 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
644 Sfile_name_as_directory
, 1, 1, 0,
645 doc
: /* Return a string representing the file name FILE interpreted as a directory.
646 This operation exists because a directory is also a file, but its name as
647 a directory is different from its name as a file.
648 The result can be used as the value of `default-directory'
649 or passed as second argument to `expand-file-name'.
650 For a Unix-syntax file name, just appends a slash.
651 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
662 /* If the file name has special constructs in it,
663 call the corresponding file handler. */
664 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
666 return call2 (handler
, Qfile_name_as_directory
, file
);
668 buf
= (char *) alloca (SBYTES (file
) + 10);
669 file_name_as_directory (buf
, SDATA (file
));
670 return make_specified_string (buf
, -1, strlen (buf
),
671 STRING_MULTIBYTE (file
));
675 * Convert from directory name to filename.
677 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
678 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
679 * On UNIX, it's simple: just make sure there isn't a terminating /
681 * Value is nonzero if the string output is different from the input.
685 directory_file_name (src
, dst
)
693 struct FAB fab
= cc$rms_fab
;
694 struct NAM nam
= cc$rms_nam
;
695 char esa
[NAM$C_MAXRSS
];
700 if (! index (src
, '/')
701 && (src
[slen
- 1] == ']'
702 || src
[slen
- 1] == ':'
703 || src
[slen
- 1] == '>'))
705 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
707 fab
.fab$b_fns
= slen
;
708 fab
.fab$l_nam
= &nam
;
709 fab
.fab$l_fop
= FAB$M_NAM
;
712 nam
.nam$b_ess
= sizeof esa
;
713 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
715 /* We call SYS$PARSE to handle such things as [--] for us. */
716 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
718 slen
= nam
.nam$b_esl
;
719 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
724 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
726 /* what about when we have logical_name:???? */
727 if (src
[slen
- 1] == ':')
728 { /* Xlate logical name and see what we get */
729 ptr
= strcpy (dst
, src
); /* upper case for getenv */
732 if ('a' <= *ptr
&& *ptr
<= 'z')
736 dst
[slen
- 1] = 0; /* remove colon */
737 if (!(src
= egetenv (dst
)))
739 /* should we jump to the beginning of this procedure?
740 Good points: allows us to use logical names that xlate
742 Bad points: can be a problem if we just translated to a device
744 For now, I'll punt and always expect VMS names, and hope for
747 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
748 { /* no recursion here! */
754 { /* not a directory spec */
759 bracket
= src
[slen
- 1];
761 /* If bracket is ']' or '>', bracket - 2 is the corresponding
763 ptr
= index (src
, bracket
- 2);
765 { /* no opening bracket */
769 if (!(rptr
= rindex (src
, '.')))
772 strncpy (dst
, src
, slen
);
776 dst
[slen
++] = bracket
;
781 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
782 then translate the device and recurse. */
783 if (dst
[slen
- 1] == ':'
784 && dst
[slen
- 2] != ':' /* skip decnet nodes */
785 && strcmp (src
+ slen
, "[000000]") == 0)
787 dst
[slen
- 1] = '\0';
788 if ((ptr
= egetenv (dst
))
789 && (rlen
= strlen (ptr
) - 1) > 0
790 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
791 && ptr
[rlen
- 1] == '.')
793 char * buf
= (char *) alloca (strlen (ptr
) + 1);
797 return directory_file_name (buf
, dst
);
802 strcat (dst
, "[000000]");
806 rlen
= strlen (rptr
) - 1;
807 strncat (dst
, rptr
, rlen
);
808 dst
[slen
+ rlen
] = '\0';
809 strcat (dst
, ".DIR.1");
813 /* Process as Unix format: just remove any final slash.
814 But leave "/" unchanged; do not change it to "". */
817 /* Handle // as root for apollo's. */
818 if ((slen
> 2 && dst
[slen
- 1] == '/')
819 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
823 && IS_DIRECTORY_SEP (dst
[slen
- 1])
825 && !IS_ANY_SEP (dst
[slen
- 2])
831 CORRECT_DIR_SEPS (dst
);
836 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
838 doc
: /* Returns the file name of the directory named DIRECTORY.
839 This is the name of the file that holds the data for the directory DIRECTORY.
840 This operation exists because a directory is also a file, but its name as
841 a directory is different from its name as a file.
842 In Unix-syntax, this function just removes the final slash.
843 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
844 it returns a file name such as \"[X]Y.DIR.1\". */)
846 Lisp_Object directory
;
851 CHECK_STRING (directory
);
853 if (NILP (directory
))
856 /* If the file name has special constructs in it,
857 call the corresponding file handler. */
858 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
860 return call2 (handler
, Qdirectory_file_name
, directory
);
863 /* 20 extra chars is insufficient for VMS, since we might perform a
864 logical name translation. an equivalence string can be up to 255
865 chars long, so grab that much extra space... - sss */
866 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
868 buf
= (char *) alloca (SBYTES (directory
) + 20);
870 directory_file_name (SDATA (directory
), buf
);
871 return make_specified_string (buf
, -1, strlen (buf
),
872 STRING_MULTIBYTE (directory
));
875 static char make_temp_name_tbl
[64] =
877 'A','B','C','D','E','F','G','H',
878 'I','J','K','L','M','N','O','P',
879 'Q','R','S','T','U','V','W','X',
880 'Y','Z','a','b','c','d','e','f',
881 'g','h','i','j','k','l','m','n',
882 'o','p','q','r','s','t','u','v',
883 'w','x','y','z','0','1','2','3',
884 '4','5','6','7','8','9','-','_'
887 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
889 /* Value is a temporary file name starting with PREFIX, a string.
891 The Emacs process number forms part of the result, so there is
892 no danger of generating a name being used by another process.
893 In addition, this function makes an attempt to choose a name
894 which has no existing file. To make this work, PREFIX should be
895 an absolute file name.
897 BASE64_P non-zero means add the pid as 3 characters in base64
898 encoding. In this case, 6 characters will be added to PREFIX to
899 form the file name. Otherwise, if Emacs is running on a system
900 with long file names, add the pid as a decimal number.
902 This function signals an error if no unique file name could be
906 make_temp_name (prefix
, base64_p
)
913 unsigned char *p
, *data
;
917 CHECK_STRING (prefix
);
919 /* VAL is created by adding 6 characters to PREFIX. The first
920 three are the PID of this process, in base 64, and the second
921 three are incremented if the file already exists. This ensures
922 262144 unique file names per PID per PREFIX. */
924 pid
= (int) getpid ();
928 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
929 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
930 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
935 #ifdef HAVE_LONG_FILE_NAMES
936 sprintf (pidbuf
, "%d", pid
);
937 pidlen
= strlen (pidbuf
);
939 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
940 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
941 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
946 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
947 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
948 if (!STRING_MULTIBYTE (prefix
))
949 STRING_SET_UNIBYTE (val
);
951 bcopy(SDATA (prefix
), data
, len
);
954 bcopy (pidbuf
, p
, pidlen
);
957 /* Here we try to minimize useless stat'ing when this function is
958 invoked many times successively with the same PREFIX. We achieve
959 this by initializing count to a random value, and incrementing it
962 We don't want make-temp-name to be called while dumping,
963 because then make_temp_name_count_initialized_p would get set
964 and then make_temp_name_count would not be set when Emacs starts. */
966 if (!make_temp_name_count_initialized_p
)
968 make_temp_name_count
= (unsigned) time (NULL
);
969 make_temp_name_count_initialized_p
= 1;
975 unsigned num
= make_temp_name_count
;
977 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
978 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
979 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
981 /* Poor man's congruential RN generator. Replace with
982 ++make_temp_name_count for debugging. */
983 make_temp_name_count
+= 25229;
984 make_temp_name_count
%= 225307;
986 if (stat (data
, &ignored
) < 0)
988 /* We want to return only if errno is ENOENT. */
992 /* The error here is dubious, but there is little else we
993 can do. The alternatives are to return nil, which is
994 as bad as (and in many cases worse than) throwing the
995 error, or to ignore the error, which will likely result
996 in looping through 225307 stat's, which is not only
997 dog-slow, but also useless since it will fallback to
998 the errow below, anyway. */
999 report_file_error ("Cannot create temporary name for prefix",
1000 Fcons (prefix
, Qnil
));
1005 error ("Cannot create temporary name for prefix `%s'",
1011 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1012 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1013 The Emacs process number forms part of the result,
1014 so there is no danger of generating a name being used by another process.
1016 In addition, this function makes an attempt to choose a name
1017 which has no existing file. To make this work,
1018 PREFIX should be an absolute file name.
1020 There is a race condition between calling `make-temp-name' and creating the
1021 file which opens all kinds of security holes. For that reason, you should
1022 probably use `make-temp-file' instead, except in three circumstances:
1024 * If you are creating the file in the user's home directory.
1025 * If you are creating a directory rather than an ordinary file.
1026 * If you are taking special precautions as `make-temp-file' does. */)
1030 return make_temp_name (prefix
, 0);
1035 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1036 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1037 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1038 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1039 the current buffer's value of `default-directory' is used.
1040 File name components that are `.' are removed, and
1041 so are file name components followed by `..', along with the `..' itself;
1042 note that these simplifications are done without checking the resulting
1043 file names in the file system.
1044 An initial `~/' expands to your home directory.
1045 An initial `~USER/' expands to USER's home directory.
1046 See also the function `substitute-in-file-name'. */)
1047 (name
, default_directory
)
1048 Lisp_Object name
, default_directory
;
1052 register unsigned char *newdir
, *p
, *o
;
1054 unsigned char *target
;
1057 unsigned char * colon
= 0;
1058 unsigned char * close
= 0;
1059 unsigned char * slash
= 0;
1060 unsigned char * brack
= 0;
1061 int lbrack
= 0, rbrack
= 0;
1066 int collapse_newdir
= 1;
1070 Lisp_Object handler
, result
;
1073 CHECK_STRING (name
);
1075 /* If the file name has special constructs in it,
1076 call the corresponding file handler. */
1077 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1078 if (!NILP (handler
))
1079 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1081 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1082 if (NILP (default_directory
))
1083 default_directory
= current_buffer
->directory
;
1084 if (! STRINGP (default_directory
))
1087 /* "/" is not considered a root directory on DOS_NT, so using "/"
1088 here causes an infinite recursion in, e.g., the following:
1090 (let (default-directory)
1091 (expand-file-name "a"))
1093 To avoid this, we set default_directory to the root of the
1095 extern char *emacs_root_dir (void);
1097 default_directory
= build_string (emacs_root_dir ());
1099 default_directory
= build_string ("/");
1103 if (!NILP (default_directory
))
1105 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1106 if (!NILP (handler
))
1107 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1110 o
= SDATA (default_directory
);
1112 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1113 It would be better to do this down below where we actually use
1114 default_directory. Unfortunately, calling Fexpand_file_name recursively
1115 could invoke GC, and the strings might be relocated. This would
1116 be annoying because we have pointers into strings lying around
1117 that would need adjusting, and people would add new pointers to
1118 the code and forget to adjust them, resulting in intermittent bugs.
1119 Putting this call here avoids all that crud.
1121 The EQ test avoids infinite recursion. */
1122 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1123 /* Save time in some common cases - as long as default_directory
1124 is not relative, it can be canonicalized with name below (if it
1125 is needed at all) without requiring it to be expanded now. */
1127 /* Detect MSDOS file names with drive specifiers. */
1128 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1130 /* Detect Windows file names in UNC format. */
1131 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1133 #else /* not DOS_NT */
1134 /* Detect Unix absolute file names (/... alone is not absolute on
1136 && ! (IS_DIRECTORY_SEP (o
[0]))
1137 #endif /* not DOS_NT */
1140 struct gcpro gcpro1
;
1143 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1147 name
= FILE_SYSTEM_CASE (name
);
1149 multibyte
= STRING_MULTIBYTE (name
);
1152 /* We will force directory separators to be either all \ or /, so make
1153 a local copy to modify, even if there ends up being no change. */
1154 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1156 /* Note if special escape prefix is present, but remove for now. */
1157 if (nm
[0] == '/' && nm
[1] == ':')
1163 /* Find and remove drive specifier if present; this makes nm absolute
1164 even if the rest of the name appears to be relative. Only look for
1165 drive specifier at the beginning. */
1166 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1173 /* If we see "c://somedir", we want to strip the first slash after the
1174 colon when stripping the drive letter. Otherwise, this expands to
1176 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1178 #endif /* WINDOWSNT */
1182 /* Discard any previous drive specifier if nm is now in UNC format. */
1183 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1189 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1190 none are found, we can probably return right away. We will avoid
1191 allocating a new string if name is already fully expanded. */
1193 IS_DIRECTORY_SEP (nm
[0])
1195 && drive
&& !is_escaped
1198 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1205 /* If it turns out that the filename we want to return is just a
1206 suffix of FILENAME, we don't need to go through and edit
1207 things; we just need to construct a new string using data
1208 starting at the middle of FILENAME. If we set lose to a
1209 non-zero value, that means we've discovered that we can't do
1216 /* Since we know the name is absolute, we can assume that each
1217 element starts with a "/". */
1219 /* "." and ".." are hairy. */
1220 if (IS_DIRECTORY_SEP (p
[0])
1222 && (IS_DIRECTORY_SEP (p
[2])
1224 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1227 /* We want to replace multiple `/' in a row with a single
1230 && IS_DIRECTORY_SEP (p
[0])
1231 && IS_DIRECTORY_SEP (p
[1]))
1238 /* if dev:[dir]/, move nm to / */
1239 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1240 nm
= (brack
? brack
+ 1 : colon
+ 1);
1241 lbrack
= rbrack
= 0;
1248 #ifdef NO_HYPHENS_IN_FILENAMES
1249 if (lbrack
== rbrack
)
1251 /* Avoid clobbering negative version numbers. */
1256 #endif /* NO_HYPHENS_IN_FILENAMES */
1258 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1259 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1261 #ifdef NO_HYPHENS_IN_FILENAMES
1264 #endif /* NO_HYPHENS_IN_FILENAMES */
1265 /* count open brackets, reset close bracket pointer */
1266 if (p
[0] == '[' || p
[0] == '<')
1267 lbrack
++, brack
= 0;
1268 /* count close brackets, set close bracket pointer */
1269 if (p
[0] == ']' || p
[0] == '>')
1270 rbrack
++, brack
= p
;
1271 /* detect ][ or >< */
1272 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1274 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1275 nm
= p
+ 1, lose
= 1;
1276 if (p
[0] == ':' && (colon
|| slash
))
1277 /* if dev1:[dir]dev2:, move nm to dev2: */
1283 /* if /name/dev:, move nm to dev: */
1286 /* if node::dev:, move colon following dev */
1287 else if (colon
&& colon
[-1] == ':')
1289 /* if dev1:dev2:, move nm to dev2: */
1290 else if (colon
&& colon
[-1] != ':')
1295 if (p
[0] == ':' && !colon
)
1301 if (lbrack
== rbrack
)
1304 else if (p
[0] == '.')
1312 if (index (nm
, '/'))
1314 nm
= sys_translate_unix (nm
);
1315 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1319 /* Make sure directories are all separated with / or \ as
1320 desired, but avoid allocation of a new string when not
1322 CORRECT_DIR_SEPS (nm
);
1324 if (IS_DIRECTORY_SEP (nm
[1]))
1326 if (strcmp (nm
, SDATA (name
)) != 0)
1327 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1331 /* drive must be set, so this is okay */
1332 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1336 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1337 temp
[0] = DRIVE_LETTER (drive
);
1338 name
= concat2 (build_string (temp
), name
);
1341 #else /* not DOS_NT */
1342 if (nm
== SDATA (name
))
1344 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1345 #endif /* not DOS_NT */
1349 /* At this point, nm might or might not be an absolute file name. We
1350 need to expand ~ or ~user if present, otherwise prefix nm with
1351 default_directory if nm is not absolute, and finally collapse /./
1352 and /foo/../ sequences.
1354 We set newdir to be the appropriate prefix if one is needed:
1355 - the relevant user directory if nm starts with ~ or ~user
1356 - the specified drive's working dir (DOS/NT only) if nm does not
1358 - the value of default_directory.
1360 Note that these prefixes are not guaranteed to be absolute (except
1361 for the working dir of a drive). Therefore, to ensure we always
1362 return an absolute name, if the final prefix is not absolute we
1363 append it to the current working directory. */
1367 if (nm
[0] == '~') /* prefix ~ */
1369 if (IS_DIRECTORY_SEP (nm
[1])
1373 || nm
[1] == 0) /* ~ by itself */
1375 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1376 newdir
= (unsigned char *) "";
1379 collapse_newdir
= 0;
1382 nm
++; /* Don't leave the slash in nm. */
1385 else /* ~user/filename */
1387 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1392 o
= (unsigned char *) alloca (p
- nm
+ 1);
1393 bcopy ((char *) nm
, o
, p
- nm
);
1397 pw
= (struct passwd
*) getpwnam (o
+ 1);
1401 newdir
= (unsigned char *) pw
-> pw_dir
;
1403 nm
= p
+ 1; /* skip the terminator */
1407 collapse_newdir
= 0;
1412 /* If we don't find a user of that name, leave the name
1413 unchanged; don't move nm forward to p. */
1418 /* On DOS and Windows, nm is absolute if a drive name was specified;
1419 use the drive's current directory as the prefix if needed. */
1420 if (!newdir
&& drive
)
1422 /* Get default directory if needed to make nm absolute. */
1423 if (!IS_DIRECTORY_SEP (nm
[0]))
1425 newdir
= alloca (MAXPATHLEN
+ 1);
1426 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1431 /* Either nm starts with /, or drive isn't mounted. */
1432 newdir
= alloca (4);
1433 newdir
[0] = DRIVE_LETTER (drive
);
1441 /* Finally, if no prefix has been specified and nm is not absolute,
1442 then it must be expanded relative to default_directory. */
1446 /* /... alone is not absolute on DOS and Windows. */
1447 && !IS_DIRECTORY_SEP (nm
[0])
1450 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1457 newdir
= SDATA (default_directory
);
1458 multibyte
|= STRING_MULTIBYTE (default_directory
);
1460 /* Note if special escape prefix is present, but remove for now. */
1461 if (newdir
[0] == '/' && newdir
[1] == ':')
1472 /* First ensure newdir is an absolute name. */
1474 /* Detect MSDOS file names with drive specifiers. */
1475 ! (IS_DRIVE (newdir
[0])
1476 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1478 /* Detect Windows file names in UNC format. */
1479 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1483 /* Effectively, let newdir be (expand-file-name newdir cwd).
1484 Because of the admonition against calling expand-file-name
1485 when we have pointers into lisp strings, we accomplish this
1486 indirectly by prepending newdir to nm if necessary, and using
1487 cwd (or the wd of newdir's drive) as the new newdir. */
1489 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1494 if (!IS_DIRECTORY_SEP (nm
[0]))
1496 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1497 file_name_as_directory (tmp
, newdir
);
1501 newdir
= alloca (MAXPATHLEN
+ 1);
1504 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1511 /* Strip off drive name from prefix, if present. */
1512 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1518 /* Keep only a prefix from newdir if nm starts with slash
1519 (//server/share for UNC, nothing otherwise). */
1520 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1523 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1525 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1527 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1529 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1541 /* Get rid of any slash at the end of newdir, unless newdir is
1542 just / or // (an incomplete UNC name). */
1543 length
= strlen (newdir
);
1544 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1546 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1550 unsigned char *temp
= (unsigned char *) alloca (length
);
1551 bcopy (newdir
, temp
, length
- 1);
1552 temp
[length
- 1] = 0;
1560 /* Now concatenate the directory and name to new space in the stack frame */
1561 tlen
+= strlen (nm
) + 1;
1563 /* Reserve space for drive specifier and escape prefix, since either
1564 or both may need to be inserted. (The Microsoft x86 compiler
1565 produces incorrect code if the following two lines are combined.) */
1566 target
= (unsigned char *) alloca (tlen
+ 4);
1568 #else /* not DOS_NT */
1569 target
= (unsigned char *) alloca (tlen
);
1570 #endif /* not DOS_NT */
1576 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1579 /* If newdir is effectively "C:/", then the drive letter will have
1580 been stripped and newdir will be "/". Concatenating with an
1581 absolute directory in nm produces "//", which will then be
1582 incorrectly treated as a network share. Ignore newdir in
1583 this case (keeping the drive letter). */
1584 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1585 && newdir
[1] == '\0'))
1587 strcpy (target
, newdir
);
1591 file_name_as_directory (target
, newdir
);
1594 strcat (target
, nm
);
1596 if (index (target
, '/'))
1597 strcpy (target
, sys_translate_unix (target
));
1600 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1602 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1611 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1617 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1618 /* brackets are offset from each other by 2 */
1621 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1622 /* convert [foo][bar] to [bar] */
1623 while (o
[-1] != '[' && o
[-1] != '<')
1625 else if (*p
== '-' && *o
!= '.')
1628 else if (p
[0] == '-' && o
[-1] == '.'
1629 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1630 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1634 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1635 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1637 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1639 /* else [foo.-] ==> [-] */
1643 #ifdef NO_HYPHENS_IN_FILENAMES
1645 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1646 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1648 #endif /* NO_HYPHENS_IN_FILENAMES */
1652 if (!IS_DIRECTORY_SEP (*p
))
1656 else if (p
[1] == '.'
1657 && (IS_DIRECTORY_SEP (p
[2])
1660 /* If "/." is the entire filename, keep the "/". Otherwise,
1661 just delete the whole "/.". */
1662 if (o
== target
&& p
[2] == '\0')
1666 else if (p
[1] == '.' && p
[2] == '.'
1667 /* `/../' is the "superroot" on certain file systems.
1668 Turned off on DOS_NT systems because they have no
1669 "superroot" and because this causes us to produce
1670 file names like "d:/../foo" which fail file-related
1671 functions of the underlying OS. (To reproduce, try a
1672 long series of "../../" in default_directory, longer
1673 than the number of levels from the root.) */
1677 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1679 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1681 /* Keep initial / only if this is the whole name. */
1682 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1686 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1687 /* Collapse multiple `/' in a row. */
1693 #endif /* not VMS */
1697 /* At last, set drive name. */
1699 /* Except for network file name. */
1700 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1701 #endif /* WINDOWSNT */
1703 if (!drive
) abort ();
1705 target
[0] = DRIVE_LETTER (drive
);
1708 /* Reinsert the escape prefix if required. */
1715 CORRECT_DIR_SEPS (target
);
1718 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1720 /* Again look to see if the file name has special constructs in it
1721 and perhaps call the corresponding file handler. This is needed
1722 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1723 the ".." component gives us "/user@host:/bar/../baz" which needs
1724 to be expanded again. */
1725 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1726 if (!NILP (handler
))
1727 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1733 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1734 This is the old version of expand-file-name, before it was thoroughly
1735 rewritten for Emacs 10.31. We leave this version here commented-out,
1736 because the code is very complex and likely to have subtle bugs. If
1737 bugs _are_ found, it might be of interest to look at the old code and
1738 see what did it do in the relevant situation.
1740 Don't remove this code: it's true that it will be accessible via CVS,
1741 but a few years from deletion, people will forget it is there. */
1743 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1744 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1745 "Convert FILENAME to absolute, and canonicalize it.\n\
1746 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1747 \(does not start with slash); if DEFAULT is nil or missing,\n\
1748 the current buffer's value of default-directory is used.\n\
1749 Filenames containing `.' or `..' as components are simplified;\n\
1750 initial `~/' expands to your home directory.\n\
1751 See also the function `substitute-in-file-name'.")
1753 Lisp_Object name
, defalt
;
1757 register unsigned char *newdir
, *p
, *o
;
1759 unsigned char *target
;
1763 unsigned char * colon
= 0;
1764 unsigned char * close
= 0;
1765 unsigned char * slash
= 0;
1766 unsigned char * brack
= 0;
1767 int lbrack
= 0, rbrack
= 0;
1771 CHECK_STRING (name
);
1774 /* Filenames on VMS are always upper case. */
1775 name
= Fupcase (name
);
1780 /* If nm is absolute, flush ...// and detect /./ and /../.
1781 If no /./ or /../ we can return right away. */
1793 if (p
[0] == '/' && p
[1] == '/'
1795 /* // at start of filename is meaningful on Apollo system. */
1800 if (p
[0] == '/' && p
[1] == '~')
1801 nm
= p
+ 1, lose
= 1;
1802 if (p
[0] == '/' && p
[1] == '.'
1803 && (p
[2] == '/' || p
[2] == 0
1804 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1810 /* if dev:[dir]/, move nm to / */
1811 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1812 nm
= (brack
? brack
+ 1 : colon
+ 1);
1813 lbrack
= rbrack
= 0;
1821 /* VMS pre V4.4,convert '-'s in filenames. */
1822 if (lbrack
== rbrack
)
1824 if (dots
< 2) /* this is to allow negative version numbers */
1830 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1831 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1837 /* count open brackets, reset close bracket pointer */
1838 if (p
[0] == '[' || p
[0] == '<')
1839 lbrack
++, brack
= 0;
1840 /* count close brackets, set close bracket pointer */
1841 if (p
[0] == ']' || p
[0] == '>')
1842 rbrack
++, brack
= p
;
1843 /* detect ][ or >< */
1844 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1846 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1847 nm
= p
+ 1, lose
= 1;
1848 if (p
[0] == ':' && (colon
|| slash
))
1849 /* if dev1:[dir]dev2:, move nm to dev2: */
1855 /* If /name/dev:, move nm to dev: */
1858 /* If node::dev:, move colon following dev */
1859 else if (colon
&& colon
[-1] == ':')
1861 /* If dev1:dev2:, move nm to dev2: */
1862 else if (colon
&& colon
[-1] != ':')
1867 if (p
[0] == ':' && !colon
)
1873 if (lbrack
== rbrack
)
1876 else if (p
[0] == '.')
1884 if (index (nm
, '/'))
1885 return build_string (sys_translate_unix (nm
));
1887 if (nm
== SDATA (name
))
1889 return build_string (nm
);
1893 /* Now determine directory to start with and put it in NEWDIR */
1897 if (nm
[0] == '~') /* prefix ~ */
1902 || nm
[1] == 0)/* ~/filename */
1904 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1905 newdir
= (unsigned char *) "";
1908 nm
++; /* Don't leave the slash in nm. */
1911 else /* ~user/filename */
1913 /* Get past ~ to user */
1914 unsigned char *user
= nm
+ 1;
1915 /* Find end of name. */
1916 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1917 int len
= ptr
? ptr
- user
: strlen (user
);
1919 unsigned char *ptr1
= index (user
, ':');
1920 if (ptr1
!= 0 && ptr1
- user
< len
)
1923 /* Copy the user name into temp storage. */
1924 o
= (unsigned char *) alloca (len
+ 1);
1925 bcopy ((char *) user
, o
, len
);
1928 /* Look up the user name. */
1930 pw
= (struct passwd
*) getpwnam (o
+ 1);
1933 error ("\"%s\" isn't a registered user", o
+ 1);
1935 newdir
= (unsigned char *) pw
->pw_dir
;
1937 /* Discard the user name from NM. */
1944 #endif /* not VMS */
1948 defalt
= current_buffer
->directory
;
1949 CHECK_STRING (defalt
);
1950 newdir
= SDATA (defalt
);
1953 /* Now concatenate the directory and name to new space in the stack frame */
1955 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1956 target
= (unsigned char *) alloca (tlen
);
1962 if (nm
[0] == 0 || nm
[0] == '/')
1963 strcpy (target
, newdir
);
1966 file_name_as_directory (target
, newdir
);
1969 strcat (target
, nm
);
1971 if (index (target
, '/'))
1972 strcpy (target
, sys_translate_unix (target
));
1975 /* Now canonicalize by removing /. and /foo/.. if they appear */
1983 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1989 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1990 /* brackets are offset from each other by 2 */
1993 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1994 /* convert [foo][bar] to [bar] */
1995 while (o
[-1] != '[' && o
[-1] != '<')
1997 else if (*p
== '-' && *o
!= '.')
2000 else if (p
[0] == '-' && o
[-1] == '.'
2001 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2002 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2006 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2007 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2009 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2011 /* else [foo.-] ==> [-] */
2017 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2018 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2028 else if (!strncmp (p
, "//", 2)
2030 /* // at start of filename is meaningful in Apollo system. */
2038 else if (p
[0] == '/' && p
[1] == '.'
2039 && (p
[2] == '/' || p
[2] == 0))
2041 else if (!strncmp (p
, "/..", 3)
2042 /* `/../' is the "superroot" on certain file systems. */
2044 && (p
[3] == '/' || p
[3] == 0))
2046 while (o
!= target
&& *--o
!= '/')
2049 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2053 if (o
== target
&& *o
== '/')
2061 #endif /* not VMS */
2064 return make_string (target
, o
- target
);
2068 /* If /~ or // appears, discard everything through first slash. */
2070 file_name_absolute_p (filename
)
2071 const unsigned char *filename
;
2074 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2076 /* ??? This criterion is probably wrong for '<'. */
2077 || index (filename
, ':') || index (filename
, '<')
2078 || (*filename
== '[' && (filename
[1] != '-'
2079 || (filename
[2] != '.' && filename
[2] != ']'))
2080 && filename
[1] != '.')
2083 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2084 && IS_DIRECTORY_SEP (filename
[2]))
2089 static unsigned char *
2090 search_embedded_absfilename (nm
, endp
)
2091 unsigned char *nm
, *endp
;
2093 unsigned char *p
, *s
;
2095 for (p
= nm
+ 1; p
< endp
; p
++)
2099 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2101 || IS_DIRECTORY_SEP (p
[-1]))
2102 && file_name_absolute_p (p
)
2103 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2104 /* // at start of file name is meaningful in Apollo,
2105 WindowsNT and Cygwin systems. */
2106 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2107 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2110 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2115 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2117 unsigned char *o
= alloca (s
- p
+ 1);
2119 bcopy (p
, o
, s
- p
);
2122 /* If we have ~user and `user' exists, discard
2123 everything up to ~. But if `user' does not exist, leave
2124 ~user alone, it might be a literal file name. */
2126 pw
= getpwnam (o
+ 1);
2138 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2139 Ssubstitute_in_file_name
, 1, 1, 0,
2140 doc
: /* Substitute environment variables referred to in FILENAME.
2141 `$FOO' where FOO is an environment variable name means to substitute
2142 the value of that variable. The variable name should be terminated
2143 with a character not a letter, digit or underscore; otherwise, enclose
2144 the entire variable name in braces.
2145 If `/~' appears, all of FILENAME through that `/' is discarded.
2147 On VMS, `$' substitution is not done; this function does little and only
2148 duplicates what `expand-file-name' does. */)
2150 Lisp_Object filename
;
2154 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2155 unsigned char *target
= NULL
;
2157 int substituted
= 0;
2159 Lisp_Object handler
;
2161 CHECK_STRING (filename
);
2163 /* If the file name has special constructs in it,
2164 call the corresponding file handler. */
2165 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2166 if (!NILP (handler
))
2167 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2169 nm
= SDATA (filename
);
2171 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2172 CORRECT_DIR_SEPS (nm
);
2173 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2175 endp
= nm
+ SBYTES (filename
);
2177 /* If /~ or // appears, discard everything through first slash. */
2178 p
= search_embedded_absfilename (nm
, endp
);
2180 /* Start over with the new string, so we check the file-name-handler
2181 again. Important with filenames like "/home/foo//:/hello///there"
2182 which whould substitute to "/:/hello///there" rather than "/there". */
2183 return Fsubstitute_in_file_name
2184 (make_specified_string (p
, -1, endp
- p
,
2185 STRING_MULTIBYTE (filename
)));
2191 /* See if any variables are substituted into the string
2192 and find the total length of their values in `total' */
2194 for (p
= nm
; p
!= endp
;)
2204 /* "$$" means a single "$" */
2213 while (p
!= endp
&& *p
!= '}') p
++;
2214 if (*p
!= '}') goto missingclose
;
2220 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2224 /* Copy out the variable name */
2225 target
= (unsigned char *) alloca (s
- o
+ 1);
2226 strncpy (target
, o
, s
- o
);
2229 strupr (target
); /* $home == $HOME etc. */
2232 /* Get variable value */
2233 o
= (unsigned char *) egetenv (target
);
2236 total
+= strlen (o
);
2246 /* If substitution required, recopy the string and do it */
2247 /* Make space in stack frame for the new copy */
2248 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2251 /* Copy the rest of the name through, replacing $ constructs with values */
2268 while (p
!= endp
&& *p
!= '}') p
++;
2269 if (*p
!= '}') goto missingclose
;
2275 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2279 /* Copy out the variable name */
2280 target
= (unsigned char *) alloca (s
- o
+ 1);
2281 strncpy (target
, o
, s
- o
);
2284 strupr (target
); /* $home == $HOME etc. */
2287 /* Get variable value */
2288 o
= (unsigned char *) egetenv (target
);
2292 strcpy (x
, target
); x
+= strlen (target
);
2294 else if (STRING_MULTIBYTE (filename
))
2296 /* If the original string is multibyte,
2297 convert what we substitute into multibyte. */
2301 c
= unibyte_char_to_multibyte (c
);
2302 x
+= CHAR_STRING (c
, x
);
2314 /* If /~ or // appears, discard everything through first slash. */
2315 while ((p
= search_embedded_absfilename (xnm
, x
)))
2316 /* This time we do not start over because we've already expanded envvars
2317 and replaced $$ with $. Maybe we should start over as well, but we'd
2318 need to quote some $ to $$ first. */
2321 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2324 error ("Bad format environment-variable substitution");
2326 error ("Missing \"}\" in environment-variable substitution");
2328 error ("Substituting nonexistent environment variable \"%s\"", target
);
2331 #endif /* not VMS */
2335 /* A slightly faster and more convenient way to get
2336 (directory-file-name (expand-file-name FOO)). */
2339 expand_and_dir_to_file (filename
, defdir
)
2340 Lisp_Object filename
, defdir
;
2342 register Lisp_Object absname
;
2344 absname
= Fexpand_file_name (filename
, defdir
);
2347 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2348 if (c
== ':' || c
== ']' || c
== '>')
2349 absname
= Fdirectory_file_name (absname
);
2352 /* Remove final slash, if any (unless this is the root dir).
2353 stat behaves differently depending! */
2354 if (SCHARS (absname
) > 1
2355 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2356 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2357 /* We cannot take shortcuts; they might be wrong for magic file names. */
2358 absname
= Fdirectory_file_name (absname
);
2363 /* Signal an error if the file ABSNAME already exists.
2364 If INTERACTIVE is nonzero, ask the user whether to proceed,
2365 and bypass the error if the user says to go ahead.
2366 QUERYSTRING is a name for the action that is being considered
2369 *STATPTR is used to store the stat information if the file exists.
2370 If the file does not exist, STATPTR->st_mode is set to 0.
2371 If STATPTR is null, we don't store into it.
2373 If QUICK is nonzero, we ask for y or n, not yes or no. */
2376 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2377 Lisp_Object absname
;
2378 unsigned char *querystring
;
2380 struct stat
*statptr
;
2383 register Lisp_Object tem
, encoded_filename
;
2384 struct stat statbuf
;
2385 struct gcpro gcpro1
;
2387 encoded_filename
= ENCODE_FILE (absname
);
2389 /* stat is a good way to tell whether the file exists,
2390 regardless of what access permissions it has. */
2391 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2394 xsignal2 (Qfile_already_exists
,
2395 build_string ("File already exists"), absname
);
2397 tem
= format2 ("File %s already exists; %s anyway? ",
2398 absname
, build_string (querystring
));
2400 tem
= Fy_or_n_p (tem
);
2402 tem
= do_yes_or_no_p (tem
);
2405 xsignal2 (Qfile_already_exists
,
2406 build_string ("File already exists"), absname
);
2413 statptr
->st_mode
= 0;
2418 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2419 "fCopy file: \nGCopy %s to file: \np\nP",
2420 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2421 If NEWNAME names a directory, copy FILE there.
2423 This function always sets the file modes of the output file to match
2426 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2427 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2428 signal a `file-already-exists' error without overwriting. If
2429 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2430 about overwriting; this is what happens in interactive use with M-x.
2431 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2434 Fourth arg KEEP-TIME non-nil means give the output file the same
2435 last-modified time as the old one. (This works on only some systems.)
2437 A prefix arg makes KEEP-TIME non-nil.
2439 If PRESERVE-UID-GID is non-nil, we try to transfer the
2440 uid and gid of FILE to NEWNAME. */)
2441 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2442 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2443 Lisp_Object preserve_uid_gid
;
2446 char buf
[16 * 1024];
2447 struct stat st
, out_st
;
2448 Lisp_Object handler
;
2449 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2450 int count
= SPECPDL_INDEX ();
2451 int input_file_statable_p
;
2452 Lisp_Object encoded_file
, encoded_newname
;
2454 encoded_file
= encoded_newname
= Qnil
;
2455 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2456 CHECK_STRING (file
);
2457 CHECK_STRING (newname
);
2459 if (!NILP (Ffile_directory_p (newname
)))
2460 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2462 newname
= Fexpand_file_name (newname
, Qnil
);
2464 file
= Fexpand_file_name (file
, Qnil
);
2466 /* If the input file name has special constructs in it,
2467 call the corresponding file handler. */
2468 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2469 /* Likewise for output file name. */
2471 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2472 if (!NILP (handler
))
2473 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
2474 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
2476 encoded_file
= ENCODE_FILE (file
);
2477 encoded_newname
= ENCODE_FILE (newname
);
2479 if (NILP (ok_if_already_exists
)
2480 || INTEGERP (ok_if_already_exists
))
2481 barf_or_query_if_file_exists (newname
, "copy to it",
2482 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2483 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2487 if (!CopyFile (SDATA (encoded_file
),
2488 SDATA (encoded_newname
),
2490 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2491 /* CopyFile retains the timestamp by default. */
2492 else if (NILP (keep_time
))
2498 EMACS_GET_TIME (now
);
2499 filename
= SDATA (encoded_newname
);
2501 /* Ensure file is writable while its modified time is set. */
2502 attributes
= GetFileAttributes (filename
);
2503 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2504 if (set_file_times (filename
, now
, now
))
2506 /* Restore original attributes. */
2507 SetFileAttributes (filename
, attributes
);
2508 xsignal2 (Qfile_date_error
,
2509 build_string ("Cannot set file date"), newname
);
2511 /* Restore original attributes. */
2512 SetFileAttributes (filename
, attributes
);
2514 #else /* not WINDOWSNT */
2516 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2520 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2522 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2524 /* We can only copy regular files and symbolic links. Other files are not
2526 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2528 #if !defined (MSDOS) || __DJGPP__ > 1
2529 if (out_st
.st_mode
!= 0
2530 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2533 report_file_error ("Input and output files are the same",
2534 Fcons (file
, Fcons (newname
, Qnil
)));
2538 #if defined (S_ISREG) && defined (S_ISLNK)
2539 if (input_file_statable_p
)
2541 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2543 #if defined (EISDIR)
2544 /* Get a better looking error message. */
2547 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2550 #endif /* S_ISREG && S_ISLNK */
2553 /* Create the copy file with the same record format as the input file */
2554 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2557 /* System's default file type was set to binary by _fmode in emacs.c. */
2558 ofd
= emacs_open (SDATA (encoded_newname
),
2559 O_WRONLY
| O_TRUNC
| O_CREAT
2560 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2561 S_IREAD
| S_IWRITE
);
2562 #else /* not MSDOS */
2563 ofd
= emacs_open (SDATA (encoded_newname
),
2564 O_WRONLY
| O_TRUNC
| O_CREAT
2565 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2567 #endif /* not MSDOS */
2570 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2572 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2576 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2577 if (emacs_write (ofd
, buf
, n
) != n
)
2578 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2582 /* Preserve the original file modes, and if requested, also its
2584 if (input_file_statable_p
)
2586 if (! NILP (preserve_uid_gid
))
2587 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2588 fchmod (ofd
, st
.st_mode
& 07777);
2590 #endif /* not MSDOS */
2592 /* Closing the output clobbers the file times on some systems. */
2593 if (emacs_close (ofd
) < 0)
2594 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2596 if (input_file_statable_p
)
2598 if (!NILP (keep_time
))
2600 EMACS_TIME atime
, mtime
;
2601 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2602 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2603 if (set_file_times (SDATA (encoded_newname
),
2605 xsignal2 (Qfile_date_error
,
2606 build_string ("Cannot set file date"), newname
);
2612 #if defined (__DJGPP__) && __DJGPP__ > 1
2613 if (input_file_statable_p
)
2615 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2616 and if it can't, it tells so. Otherwise, under MSDOS we usually
2617 get only the READ bit, which will make the copied file read-only,
2618 so it's better not to chmod at all. */
2619 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2620 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2622 #endif /* DJGPP version 2 or newer */
2623 #endif /* not WINDOWSNT */
2625 /* Discard the unwind protects. */
2626 specpdl_ptr
= specpdl
+ count
;
2632 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2633 Smake_directory_internal
, 1, 1, 0,
2634 doc
: /* Create a new directory named DIRECTORY. */)
2636 Lisp_Object directory
;
2638 const unsigned char *dir
;
2639 Lisp_Object handler
;
2640 Lisp_Object encoded_dir
;
2642 CHECK_STRING (directory
);
2643 directory
= Fexpand_file_name (directory
, Qnil
);
2645 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2646 if (!NILP (handler
))
2647 return call2 (handler
, Qmake_directory_internal
, directory
);
2649 encoded_dir
= ENCODE_FILE (directory
);
2651 dir
= SDATA (encoded_dir
);
2654 if (mkdir (dir
) != 0)
2656 if (mkdir (dir
, 0777) != 0)
2658 report_file_error ("Creating directory", list1 (directory
));
2663 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2664 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2666 Lisp_Object directory
;
2668 const unsigned char *dir
;
2669 Lisp_Object handler
;
2670 Lisp_Object encoded_dir
;
2672 CHECK_STRING (directory
);
2673 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2675 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2676 if (!NILP (handler
))
2677 return call2 (handler
, Qdelete_directory
, directory
);
2679 encoded_dir
= ENCODE_FILE (directory
);
2681 dir
= SDATA (encoded_dir
);
2683 if (rmdir (dir
) != 0)
2684 report_file_error ("Removing directory", list1 (directory
));
2689 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2690 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2691 If file has multiple names, it continues to exist with the other names. */)
2693 Lisp_Object filename
;
2695 Lisp_Object handler
;
2696 Lisp_Object encoded_file
;
2697 struct gcpro gcpro1
;
2700 if (!NILP (Ffile_directory_p (filename
))
2701 && NILP (Ffile_symlink_p (filename
)))
2702 xsignal2 (Qfile_error
,
2703 build_string ("Removing old name: is a directory"),
2706 filename
= Fexpand_file_name (filename
, Qnil
);
2708 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2709 if (!NILP (handler
))
2710 return call2 (handler
, Qdelete_file
, filename
);
2712 encoded_file
= ENCODE_FILE (filename
);
2714 if (0 > unlink (SDATA (encoded_file
)))
2715 report_file_error ("Removing old name", list1 (filename
));
2720 internal_delete_file_1 (ignore
)
2726 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2729 internal_delete_file (filename
)
2730 Lisp_Object filename
;
2733 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2734 Qt
, internal_delete_file_1
);
2738 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2739 "fRename file: \nGRename %s to file: \np",
2740 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2741 If file has names other than FILE, it continues to have those names.
2742 Signals a `file-already-exists' error if a file NEWNAME already exists
2743 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2744 A number as third arg means request confirmation if NEWNAME already exists.
2745 This is what happens in interactive use with M-x. */)
2746 (file
, newname
, ok_if_already_exists
)
2747 Lisp_Object file
, newname
, ok_if_already_exists
;
2749 Lisp_Object handler
;
2750 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2751 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2753 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2754 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2755 CHECK_STRING (file
);
2756 CHECK_STRING (newname
);
2757 file
= Fexpand_file_name (file
, Qnil
);
2759 if ((!NILP (Ffile_directory_p (newname
)))
2761 /* If the file names are identical but for the case,
2762 don't attempt to move directory to itself. */
2763 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2766 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2768 newname
= Fexpand_file_name (newname
, Qnil
);
2770 /* If the file name has special constructs in it,
2771 call the corresponding file handler. */
2772 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2774 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2775 if (!NILP (handler
))
2776 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2777 file
, newname
, ok_if_already_exists
));
2779 encoded_file
= ENCODE_FILE (file
);
2780 encoded_newname
= ENCODE_FILE (newname
);
2783 /* If the file names are identical but for the case, don't ask for
2784 confirmation: they simply want to change the letter-case of the
2786 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2788 if (NILP (ok_if_already_exists
)
2789 || INTEGERP (ok_if_already_exists
))
2790 barf_or_query_if_file_exists (newname
, "rename to it",
2791 INTEGERP (ok_if_already_exists
), 0, 0);
2793 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2795 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2796 || 0 > unlink (SDATA (encoded_file
)))
2802 symlink_target
= Ffile_symlink_p (file
);
2803 if (! NILP (symlink_target
))
2804 Fmake_symbolic_link (symlink_target
, newname
,
2805 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2808 Fcopy_file (file
, newname
,
2809 /* We have already prompted if it was an integer,
2810 so don't have copy-file prompt again. */
2811 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2814 Fdelete_file (file
);
2817 report_file_error ("Renaming", list2 (file
, newname
));
2823 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2824 "fAdd name to file: \nGName to add to %s: \np",
2825 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2826 Signals a `file-already-exists' error if a file NEWNAME already exists
2827 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2828 A number as third arg means request confirmation if NEWNAME already exists.
2829 This is what happens in interactive use with M-x. */)
2830 (file
, newname
, ok_if_already_exists
)
2831 Lisp_Object file
, newname
, ok_if_already_exists
;
2833 Lisp_Object handler
;
2834 Lisp_Object encoded_file
, encoded_newname
;
2835 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2837 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2838 encoded_file
= encoded_newname
= Qnil
;
2839 CHECK_STRING (file
);
2840 CHECK_STRING (newname
);
2841 file
= Fexpand_file_name (file
, Qnil
);
2843 if (!NILP (Ffile_directory_p (newname
)))
2844 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2846 newname
= Fexpand_file_name (newname
, Qnil
);
2848 /* If the file name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2851 if (!NILP (handler
))
2852 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2853 newname
, ok_if_already_exists
));
2855 /* If the new name has special constructs in it,
2856 call the corresponding file handler. */
2857 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2858 if (!NILP (handler
))
2859 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2860 newname
, ok_if_already_exists
));
2862 encoded_file
= ENCODE_FILE (file
);
2863 encoded_newname
= ENCODE_FILE (newname
);
2865 if (NILP (ok_if_already_exists
)
2866 || INTEGERP (ok_if_already_exists
))
2867 barf_or_query_if_file_exists (newname
, "make it a new name",
2868 INTEGERP (ok_if_already_exists
), 0, 0);
2870 unlink (SDATA (newname
));
2871 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2872 report_file_error ("Adding new name", list2 (file
, newname
));
2879 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2880 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2881 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2882 Both args must be strings.
2883 Signals a `file-already-exists' error if a file LINKNAME already exists
2884 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2885 A number as third arg means request confirmation if LINKNAME already exists.
2886 This happens for interactive use with M-x. */)
2887 (filename
, linkname
, ok_if_already_exists
)
2888 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2890 Lisp_Object handler
;
2891 Lisp_Object encoded_filename
, encoded_linkname
;
2892 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2894 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2895 encoded_filename
= encoded_linkname
= Qnil
;
2896 CHECK_STRING (filename
);
2897 CHECK_STRING (linkname
);
2898 /* If the link target has a ~, we must expand it to get
2899 a truly valid file name. Otherwise, do not expand;
2900 we want to permit links to relative file names. */
2901 if (SREF (filename
, 0) == '~')
2902 filename
= Fexpand_file_name (filename
, Qnil
);
2904 if (!NILP (Ffile_directory_p (linkname
)))
2905 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2907 linkname
= Fexpand_file_name (linkname
, Qnil
);
2909 /* If the file name has special constructs in it,
2910 call the corresponding file handler. */
2911 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2912 if (!NILP (handler
))
2913 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2914 linkname
, ok_if_already_exists
));
2916 /* If the new link name has special constructs in it,
2917 call the corresponding file handler. */
2918 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2919 if (!NILP (handler
))
2920 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2921 linkname
, ok_if_already_exists
));
2923 encoded_filename
= ENCODE_FILE (filename
);
2924 encoded_linkname
= ENCODE_FILE (linkname
);
2926 if (NILP (ok_if_already_exists
)
2927 || INTEGERP (ok_if_already_exists
))
2928 barf_or_query_if_file_exists (linkname
, "make it a link",
2929 INTEGERP (ok_if_already_exists
), 0, 0);
2930 if (0 > symlink (SDATA (encoded_filename
),
2931 SDATA (encoded_linkname
)))
2933 /* If we didn't complain already, silently delete existing file. */
2934 if (errno
== EEXIST
)
2936 unlink (SDATA (encoded_linkname
));
2937 if (0 <= symlink (SDATA (encoded_filename
),
2938 SDATA (encoded_linkname
)))
2945 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2950 #endif /* S_IFLNK */
2954 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2955 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2956 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2957 If STRING is nil or a null string, the logical name NAME is deleted. */)
2962 CHECK_STRING (name
);
2964 delete_logical_name (SDATA (name
));
2967 CHECK_STRING (string
);
2969 if (SCHARS (string
) == 0)
2970 delete_logical_name (SDATA (name
));
2972 define_logical_name (SDATA (name
), SDATA (string
));
2981 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2982 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2984 Lisp_Object path
, login
;
2988 CHECK_STRING (path
);
2989 CHECK_STRING (login
);
2991 netresult
= netunam (SDATA (path
), SDATA (login
));
2993 if (netresult
== -1)
2998 #endif /* HPUX_NET */
3000 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3002 doc
: /* Return t if file FILENAME specifies an absolute file name.
3003 On Unix, this is a name starting with a `/' or a `~'. */)
3005 Lisp_Object filename
;
3007 CHECK_STRING (filename
);
3008 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3011 /* Return nonzero if file FILENAME exists and can be executed. */
3014 check_executable (filename
)
3018 int len
= strlen (filename
);
3021 if (stat (filename
, &st
) < 0)
3023 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3024 return ((st
.st_mode
& S_IEXEC
) != 0);
3026 return (S_ISREG (st
.st_mode
)
3028 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3029 || stricmp (suffix
, ".exe") == 0
3030 || stricmp (suffix
, ".bat") == 0)
3031 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3032 #endif /* not WINDOWSNT */
3033 #else /* not DOS_NT */
3034 #ifdef HAVE_EUIDACCESS
3035 return (euidaccess (filename
, 1) >= 0);
3037 /* Access isn't quite right because it uses the real uid
3038 and we really want to test with the effective uid.
3039 But Unix doesn't give us a right way to do it. */
3040 return (access (filename
, 1) >= 0);
3042 #endif /* not DOS_NT */
3045 /* Return nonzero if file FILENAME exists and can be written. */
3048 check_writable (filename
)
3053 if (stat (filename
, &st
) < 0)
3055 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3056 #else /* not MSDOS */
3057 #ifdef HAVE_EUIDACCESS
3058 return (euidaccess (filename
, 2) >= 0);
3060 /* Access isn't quite right because it uses the real uid
3061 and we really want to test with the effective uid.
3062 But Unix doesn't give us a right way to do it.
3063 Opening with O_WRONLY could work for an ordinary file,
3064 but would lose for directories. */
3065 return (access (filename
, 2) >= 0);
3067 #endif /* not MSDOS */
3070 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3071 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3072 See also `file-readable-p' and `file-attributes'.
3073 This returns nil for a symlink to a nonexistent file.
3074 Use `file-symlink-p' to test for such links. */)
3076 Lisp_Object filename
;
3078 Lisp_Object absname
;
3079 Lisp_Object handler
;
3080 struct stat statbuf
;
3082 CHECK_STRING (filename
);
3083 absname
= Fexpand_file_name (filename
, Qnil
);
3085 /* If the file name has special constructs in it,
3086 call the corresponding file handler. */
3087 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3088 if (!NILP (handler
))
3089 return call2 (handler
, Qfile_exists_p
, absname
);
3091 absname
= ENCODE_FILE (absname
);
3093 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3096 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3097 doc
: /* Return t if FILENAME can be executed by you.
3098 For a directory, this means you can access files in that directory. */)
3100 Lisp_Object filename
;
3102 Lisp_Object absname
;
3103 Lisp_Object handler
;
3105 CHECK_STRING (filename
);
3106 absname
= Fexpand_file_name (filename
, Qnil
);
3108 /* If the file name has special constructs in it,
3109 call the corresponding file handler. */
3110 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3111 if (!NILP (handler
))
3112 return call2 (handler
, Qfile_executable_p
, absname
);
3114 absname
= ENCODE_FILE (absname
);
3116 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3119 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3120 doc
: /* Return t if file FILENAME exists and you can read it.
3121 See also `file-exists-p' and `file-attributes'. */)
3123 Lisp_Object filename
;
3125 Lisp_Object absname
;
3126 Lisp_Object handler
;
3129 struct stat statbuf
;
3131 CHECK_STRING (filename
);
3132 absname
= Fexpand_file_name (filename
, Qnil
);
3134 /* If the file name has special constructs in it,
3135 call the corresponding file handler. */
3136 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3137 if (!NILP (handler
))
3138 return call2 (handler
, Qfile_readable_p
, absname
);
3140 absname
= ENCODE_FILE (absname
);
3142 #if defined(DOS_NT) || defined(macintosh)
3143 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3145 if (access (SDATA (absname
), 0) == 0)
3148 #else /* not DOS_NT and not macintosh */
3150 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3151 /* Opening a fifo without O_NONBLOCK can wait.
3152 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3153 except in the case of a fifo, on a system which handles it. */
3154 desc
= stat (SDATA (absname
), &statbuf
);
3157 if (S_ISFIFO (statbuf
.st_mode
))
3158 flags
|= O_NONBLOCK
;
3160 desc
= emacs_open (SDATA (absname
), flags
, 0);
3165 #endif /* not DOS_NT and not macintosh */
3168 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3170 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3171 doc
: /* Return t if file FILENAME can be written or created by you. */)
3173 Lisp_Object filename
;
3175 Lisp_Object absname
, dir
, encoded
;
3176 Lisp_Object handler
;
3177 struct stat statbuf
;
3179 CHECK_STRING (filename
);
3180 absname
= Fexpand_file_name (filename
, Qnil
);
3182 /* If the file name has special constructs in it,
3183 call the corresponding file handler. */
3184 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3185 if (!NILP (handler
))
3186 return call2 (handler
, Qfile_writable_p
, absname
);
3188 encoded
= ENCODE_FILE (absname
);
3189 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3190 return (check_writable (SDATA (encoded
))
3193 dir
= Ffile_name_directory (absname
);
3196 dir
= Fdirectory_file_name (dir
);
3200 dir
= Fdirectory_file_name (dir
);
3203 dir
= ENCODE_FILE (dir
);
3205 /* The read-only attribute of the parent directory doesn't affect
3206 whether a file or directory can be created within it. Some day we
3207 should check ACLs though, which do affect this. */
3208 if (stat (SDATA (dir
), &statbuf
) < 0)
3210 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3212 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3217 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3218 doc
: /* Access file FILENAME, and get an error if that does not work.
3219 The second argument STRING is used in the error message.
3220 If there is no error, returns nil. */)
3222 Lisp_Object filename
, string
;
3224 Lisp_Object handler
, encoded_filename
, absname
;
3227 CHECK_STRING (filename
);
3228 absname
= Fexpand_file_name (filename
, Qnil
);
3230 CHECK_STRING (string
);
3232 /* If the file name has special constructs in it,
3233 call the corresponding file handler. */
3234 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3235 if (!NILP (handler
))
3236 return call3 (handler
, Qaccess_file
, absname
, string
);
3238 encoded_filename
= ENCODE_FILE (absname
);
3240 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3242 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3248 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3249 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3250 The value is the link target, as a string.
3251 Otherwise it returns nil.
3253 This function returns t when given the name of a symlink that
3254 points to a nonexistent file. */)
3256 Lisp_Object filename
;
3258 Lisp_Object handler
;
3260 CHECK_STRING (filename
);
3261 filename
= Fexpand_file_name (filename
, Qnil
);
3263 /* If the file name has special constructs in it,
3264 call the corresponding file handler. */
3265 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3266 if (!NILP (handler
))
3267 return call2 (handler
, Qfile_symlink_p
, filename
);
3276 filename
= ENCODE_FILE (filename
);
3283 buf
= (char *) xrealloc (buf
, bufsize
);
3284 bzero (buf
, bufsize
);
3287 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3291 /* HP-UX reports ERANGE if buffer is too small. */
3292 if (errno
== ERANGE
)
3302 while (valsize
>= bufsize
);
3304 val
= make_string (buf
, valsize
);
3305 if (buf
[0] == '/' && index (buf
, ':'))
3306 val
= concat2 (build_string ("/:"), val
);
3308 val
= DECODE_FILE (val
);
3311 #else /* not S_IFLNK */
3313 #endif /* not S_IFLNK */
3316 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3317 doc
: /* Return t if FILENAME names an existing directory.
3318 Symbolic links to directories count as directories.
3319 See `file-symlink-p' to distinguish symlinks. */)
3321 Lisp_Object filename
;
3323 register Lisp_Object absname
;
3325 Lisp_Object handler
;
3327 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3329 /* If the file name has special constructs in it,
3330 call the corresponding file handler. */
3331 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3332 if (!NILP (handler
))
3333 return call2 (handler
, Qfile_directory_p
, absname
);
3335 absname
= ENCODE_FILE (absname
);
3337 if (stat (SDATA (absname
), &st
) < 0)
3339 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3342 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3343 doc
: /* Return t if file FILENAME names a directory you can open.
3344 For the value to be t, FILENAME must specify the name of a directory as a file,
3345 and the directory must allow you to open files in it. In order to use a
3346 directory as a buffer's current directory, this predicate must return true.
3347 A directory name spec may be given instead; then the value is t
3348 if the directory so specified exists and really is a readable and
3349 searchable directory. */)
3351 Lisp_Object filename
;
3353 Lisp_Object handler
;
3355 struct gcpro gcpro1
;
3357 /* If the file name has special constructs in it,
3358 call the corresponding file handler. */
3359 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3360 if (!NILP (handler
))
3361 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3364 tem
= (NILP (Ffile_directory_p (filename
))
3365 || NILP (Ffile_executable_p (filename
)));
3367 return tem
? Qnil
: Qt
;
3370 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3371 doc
: /* Return t if FILENAME names a regular file.
3372 This is the sort of file that holds an ordinary stream of data bytes.
3373 Symbolic links to regular files count as regular files.
3374 See `file-symlink-p' to distinguish symlinks. */)
3376 Lisp_Object filename
;
3378 register Lisp_Object absname
;
3380 Lisp_Object handler
;
3382 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3384 /* If the file name has special constructs in it,
3385 call the corresponding file handler. */
3386 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3387 if (!NILP (handler
))
3388 return call2 (handler
, Qfile_regular_p
, absname
);
3390 absname
= ENCODE_FILE (absname
);
3395 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3397 /* Tell stat to use expensive method to get accurate info. */
3398 Vw32_get_true_file_attributes
= Qt
;
3399 result
= stat (SDATA (absname
), &st
);
3400 Vw32_get_true_file_attributes
= tem
;
3404 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3407 if (stat (SDATA (absname
), &st
) < 0)
3409 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3413 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3414 doc
: /* Return mode bits of file named FILENAME, as an integer.
3415 Return nil, if file does not exist or is not accessible. */)
3417 Lisp_Object filename
;
3419 Lisp_Object absname
;
3421 Lisp_Object handler
;
3423 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3425 /* If the file name has special constructs in it,
3426 call the corresponding file handler. */
3427 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3428 if (!NILP (handler
))
3429 return call2 (handler
, Qfile_modes
, absname
);
3431 absname
= ENCODE_FILE (absname
);
3433 if (stat (SDATA (absname
), &st
) < 0)
3435 #if defined (MSDOS) && __DJGPP__ < 2
3436 if (check_executable (SDATA (absname
)))
3437 st
.st_mode
|= S_IEXEC
;
3438 #endif /* MSDOS && __DJGPP__ < 2 */
3440 return make_number (st
.st_mode
& 07777);
3443 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3444 "(let ((file (read-file-name \"File: \"))) \
3445 (list file (read-file-modes nil file)))",
3446 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3447 Only the 12 low bits of MODE are used. */)
3449 Lisp_Object filename
, mode
;
3451 Lisp_Object absname
, encoded_absname
;
3452 Lisp_Object handler
;
3454 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3455 CHECK_NUMBER (mode
);
3457 /* If the file name has special constructs in it,
3458 call the corresponding file handler. */
3459 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3460 if (!NILP (handler
))
3461 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3463 encoded_absname
= ENCODE_FILE (absname
);
3465 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3466 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3471 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3472 doc
: /* Set the file permission bits for newly created files.
3473 The argument MODE should be an integer; only the low 9 bits are used.
3474 This setting is inherited by subprocesses. */)
3478 CHECK_NUMBER (mode
);
3480 umask ((~ XINT (mode
)) & 0777);
3485 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3486 doc
: /* Return the default file protection for created files.
3487 The value is an integer. */)
3493 realmask
= umask (0);
3496 XSETINT (value
, (~ realmask
) & 0777);
3500 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3502 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3503 doc
: /* Set times of file FILENAME to TIME.
3504 Set both access and modification times.
3505 Return t on success, else nil.
3506 Use the current time if TIME is nil. TIME is in the format of
3509 Lisp_Object filename
, time
;
3511 Lisp_Object absname
, encoded_absname
;
3512 Lisp_Object handler
;
3516 if (! lisp_time_argument (time
, &sec
, &usec
))
3517 error ("Invalid time specification");
3519 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3521 /* If the file name has special constructs in it,
3522 call the corresponding file handler. */
3523 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3524 if (!NILP (handler
))
3525 return call3 (handler
, Qset_file_times
, absname
, time
);
3527 encoded_absname
= ENCODE_FILE (absname
);
3532 EMACS_SET_SECS (t
, sec
);
3533 EMACS_SET_USECS (t
, usec
);
3535 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3540 /* Setting times on a directory always fails. */
3541 if (stat (SDATA (encoded_absname
), &st
) == 0
3542 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3545 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3554 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3555 doc
: /* Tell Unix to finish all pending disk updates. */)
3562 #endif /* HAVE_SYNC */
3564 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3565 doc
: /* Return t if file FILE1 is newer than file FILE2.
3566 If FILE1 does not exist, the answer is nil;
3567 otherwise, if FILE2 does not exist, the answer is t. */)
3569 Lisp_Object file1
, file2
;
3571 Lisp_Object absname1
, absname2
;
3574 Lisp_Object handler
;
3575 struct gcpro gcpro1
, gcpro2
;
3577 CHECK_STRING (file1
);
3578 CHECK_STRING (file2
);
3581 GCPRO2 (absname1
, file2
);
3582 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3583 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3586 /* If the file name has special constructs in it,
3587 call the corresponding file handler. */
3588 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3590 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3591 if (!NILP (handler
))
3592 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3594 GCPRO2 (absname1
, absname2
);
3595 absname1
= ENCODE_FILE (absname1
);
3596 absname2
= ENCODE_FILE (absname2
);
3599 if (stat (SDATA (absname1
), &st
) < 0)
3602 mtime1
= st
.st_mtime
;
3604 if (stat (SDATA (absname2
), &st
) < 0)
3607 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3611 Lisp_Object Qfind_buffer_file_type
;
3614 #ifndef READ_BUF_SIZE
3615 #define READ_BUF_SIZE (64 << 10)
3618 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3620 /* This function is called after Lisp functions to decide a coding
3621 system are called, or when they cause an error. Before they are
3622 called, the current buffer is set unibyte and it contains only a
3623 newly inserted text (thus the buffer was empty before the
3626 The functions may set markers, overlays, text properties, or even
3627 alter the buffer contents, change the current buffer.
3629 Here, we reset all those changes by:
3630 o set back the current buffer.
3631 o move all markers and overlays to BEG.
3632 o remove all text properties.
3633 o set back the buffer multibyteness. */
3636 decide_coding_unwind (unwind_data
)
3637 Lisp_Object unwind_data
;
3639 Lisp_Object multibyte
, undo_list
, buffer
;
3641 multibyte
= XCAR (unwind_data
);
3642 unwind_data
= XCDR (unwind_data
);
3643 undo_list
= XCAR (unwind_data
);
3644 buffer
= XCDR (unwind_data
);
3646 if (current_buffer
!= XBUFFER (buffer
))
3647 set_buffer_internal (XBUFFER (buffer
));
3648 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3649 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3650 BUF_INTERVALS (current_buffer
) = 0;
3651 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3653 /* Now we are safe to change the buffer's multibyteness directly. */
3654 current_buffer
->enable_multibyte_characters
= multibyte
;
3655 current_buffer
->undo_list
= undo_list
;
3661 /* Used to pass values from insert-file-contents to read_non_regular. */
3663 static int non_regular_fd
;
3664 static int non_regular_inserted
;
3665 static int non_regular_nbytes
;
3668 /* Read from a non-regular file.
3669 Read non_regular_trytry bytes max from non_regular_fd.
3670 Non_regular_inserted specifies where to put the read bytes.
3671 Value is the number of bytes read. */
3680 nbytes
= emacs_read (non_regular_fd
,
3681 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3682 non_regular_nbytes
);
3684 return make_number (nbytes
);
3688 /* Condition-case handler used when reading from non-regular files
3689 in insert-file-contents. */
3692 read_non_regular_quit ()
3698 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3700 doc
: /* Insert contents of file FILENAME after point.
3701 Returns list of absolute file name and number of characters inserted.
3702 If second argument VISIT is non-nil, the buffer's visited filename and
3703 last save file modtime are set, and it is marked unmodified. If
3704 visiting and the file does not exist, visiting is completed before the
3707 The optional third and fourth arguments BEG and END specify what portion
3708 of the file to insert. These arguments count bytes in the file, not
3709 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3711 If optional fifth argument REPLACE is non-nil, replace the current
3712 buffer contents (in the accessible portion) with the file contents.
3713 This is better than simply deleting and inserting the whole thing
3714 because (1) it preserves some marker positions and (2) it puts less data
3715 in the undo list. When REPLACE is non-nil, the second return value is
3716 the number of characters that replace previous buffer contents.
3718 This function does code conversion according to the value of
3719 `coding-system-for-read' or `file-coding-system-alist', and sets the
3720 variable `last-coding-system-used' to the coding system actually used. */)
3721 (filename
, visit
, beg
, end
, replace
)
3722 Lisp_Object filename
, visit
, beg
, end
, replace
;
3727 register int how_much
;
3728 register int unprocessed
;
3729 int count
= SPECPDL_INDEX ();
3730 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3731 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3734 int not_regular
= 0;
3735 unsigned char read_buf
[READ_BUF_SIZE
];
3736 struct coding_system coding
;
3737 unsigned char buffer
[1 << 14];
3738 int replace_handled
= 0;
3739 int set_coding_system
= 0;
3740 Lisp_Object coding_system
;
3742 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3743 int we_locked_file
= 0;
3745 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3746 error ("Cannot do file visiting in an indirect buffer");
3748 if (!NILP (current_buffer
->read_only
))
3749 Fbarf_if_buffer_read_only ();
3753 orig_filename
= Qnil
;
3756 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3758 CHECK_STRING (filename
);
3759 filename
= Fexpand_file_name (filename
, Qnil
);
3761 /* The value Qnil means that the coding system is not yet
3763 coding_system
= Qnil
;
3765 /* If the file name has special constructs in it,
3766 call the corresponding file handler. */
3767 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3768 if (!NILP (handler
))
3770 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3771 visit
, beg
, end
, replace
);
3772 if (CONSP (val
) && CONSP (XCDR (val
)))
3773 inserted
= XINT (XCAR (XCDR (val
)));
3777 orig_filename
= filename
;
3778 filename
= ENCODE_FILE (filename
);
3784 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3786 /* Tell stat to use expensive method to get accurate info. */
3787 Vw32_get_true_file_attributes
= Qt
;
3788 total
= stat (SDATA (filename
), &st
);
3789 Vw32_get_true_file_attributes
= tem
;
3794 if (stat (SDATA (filename
), &st
) < 0)
3796 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3797 || fstat (fd
, &st
) < 0)
3798 #endif /* not APOLLO */
3799 #endif /* WINDOWSNT */
3801 if (fd
>= 0) emacs_close (fd
);
3804 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3807 if (!NILP (Vcoding_system_for_read
))
3808 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3813 /* This code will need to be changed in order to work on named
3814 pipes, and it's probably just not worth it. So we should at
3815 least signal an error. */
3816 if (!S_ISREG (st
.st_mode
))
3823 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3824 xsignal2 (Qfile_error
,
3825 build_string ("not a regular file"), orig_filename
);
3830 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3833 /* Replacement should preserve point as it preserves markers. */
3834 if (!NILP (replace
))
3835 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3837 record_unwind_protect (close_file_unwind
, make_number (fd
));
3839 /* Supposedly happens on VMS. */
3840 /* Can happen on any platform that uses long as type of off_t, but allows
3841 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3842 give a message suitable for the latter case. */
3843 if (! not_regular
&& st
.st_size
< 0)
3844 error ("Maximum buffer size exceeded");
3846 /* Prevent redisplay optimizations. */
3847 current_buffer
->clip_changed
= 1;
3851 if (!NILP (beg
) || !NILP (end
))
3852 error ("Attempt to visit less than an entire file");
3853 if (BEG
< Z
&& NILP (replace
))
3854 error ("Cannot do file visiting in a non-empty buffer");
3860 XSETFASTINT (beg
, 0);
3868 XSETINT (end
, st
.st_size
);
3870 /* Arithmetic overflow can occur if an Emacs integer cannot
3871 represent the file size, or if the calculations below
3872 overflow. The calculations below double the file size
3873 twice, so check that it can be multiplied by 4 safely. */
3874 if (XINT (end
) != st
.st_size
3875 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3876 error ("Maximum buffer size exceeded");
3878 /* The file size returned from stat may be zero, but data
3879 may be readable nonetheless, for example when this is a
3880 file in the /proc filesystem. */
3881 if (st
.st_size
== 0)
3882 XSETINT (end
, READ_BUF_SIZE
);
3886 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3888 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3889 setup_coding_system (coding_system
, &coding
);
3890 /* Ensure we set Vlast_coding_system_used. */
3891 set_coding_system
= 1;
3895 /* Decide the coding system to use for reading the file now
3896 because we can't use an optimized method for handling
3897 `coding:' tag if the current buffer is not empty. */
3898 if (!NILP (Vcoding_system_for_read
))
3899 coding_system
= Vcoding_system_for_read
;
3902 /* Don't try looking inside a file for a coding system
3903 specification if it is not seekable. */
3904 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3906 /* Find a coding system specified in the heading two
3907 lines or in the tailing several lines of the file.
3908 We assume that the 1K-byte and 3K-byte for heading
3909 and tailing respectively are sufficient for this
3913 if (st
.st_size
<= (1024 * 4))
3914 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3917 nread
= emacs_read (fd
, read_buf
, 1024);
3920 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3921 report_file_error ("Setting file position",
3922 Fcons (orig_filename
, Qnil
));
3923 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3928 error ("IO error reading %s: %s",
3929 SDATA (orig_filename
), emacs_strerror (errno
));
3932 struct buffer
*prev
= current_buffer
;
3936 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3938 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3939 buf
= XBUFFER (buffer
);
3941 delete_all_overlays (buf
);
3942 buf
->directory
= current_buffer
->directory
;
3943 buf
->read_only
= Qnil
;
3944 buf
->filename
= Qnil
;
3945 buf
->undo_list
= Qt
;
3946 eassert (buf
->overlays_before
== NULL
);
3947 eassert (buf
->overlays_after
== NULL
);
3949 set_buffer_internal (buf
);
3951 buf
->enable_multibyte_characters
= Qnil
;
3953 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3954 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3955 coding_system
= call2 (Vset_auto_coding_function
,
3956 filename
, make_number (nread
));
3957 set_buffer_internal (prev
);
3959 /* Discard the unwind protect for recovering the
3963 /* Rewind the file for the actual read done later. */
3964 if (lseek (fd
, 0, 0) < 0)
3965 report_file_error ("Setting file position",
3966 Fcons (orig_filename
, Qnil
));
3970 if (NILP (coding_system
))
3972 /* If we have not yet decided a coding system, check
3973 file-coding-system-alist. */
3974 Lisp_Object args
[6];
3976 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3977 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3978 coding_system
= Ffind_operation_coding_system (6, args
);
3979 if (CONSP (coding_system
))
3980 coding_system
= XCAR (coding_system
);
3984 if (NILP (coding_system
))
3985 coding_system
= Qundecided
;
3987 CHECK_CODING_SYSTEM (coding_system
);
3989 if (NILP (current_buffer
->enable_multibyte_characters
))
3990 /* We must suppress all character code conversion except for
3991 end-of-line conversion. */
3992 coding_system
= raw_text_coding_system (coding_system
);
3994 setup_coding_system (coding_system
, &coding
);
3995 /* Ensure we set Vlast_coding_system_used. */
3996 set_coding_system
= 1;
3999 /* If requested, replace the accessible part of the buffer
4000 with the file contents. Avoid replacing text at the
4001 beginning or end of the buffer that matches the file contents;
4002 that preserves markers pointing to the unchanged parts.
4004 Here we implement this feature in an optimized way
4005 for the case where code conversion is NOT needed.
4006 The following if-statement handles the case of conversion
4007 in a less optimal way.
4009 If the code conversion is "automatic" then we try using this
4010 method and hope for the best.
4011 But if we discover the need for conversion, we give up on this method
4012 and let the following if-statement handle the replace job. */
4015 && (NILP (coding_system
)
4016 || ! CODING_REQUIRE_DECODING (&coding
)))
4018 /* same_at_start and same_at_end count bytes,
4019 because file access counts bytes
4020 and BEG and END count bytes. */
4021 int same_at_start
= BEGV_BYTE
;
4022 int same_at_end
= ZV_BYTE
;
4024 /* There is still a possibility we will find the need to do code
4025 conversion. If that happens, we set this variable to 1 to
4026 give up on handling REPLACE in the optimized way. */
4027 int giveup_match_end
= 0;
4029 if (XINT (beg
) != 0)
4031 if (lseek (fd
, XINT (beg
), 0) < 0)
4032 report_file_error ("Setting file position",
4033 Fcons (orig_filename
, Qnil
));
4038 /* Count how many chars at the start of the file
4039 match the text at the beginning of the buffer. */
4044 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4046 error ("IO error reading %s: %s",
4047 SDATA (orig_filename
), emacs_strerror (errno
));
4048 else if (nread
== 0)
4051 if (CODING_REQUIRE_DETECTION (&coding
))
4053 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4055 setup_coding_system (coding_system
, &coding
);
4058 if (CODING_REQUIRE_DECODING (&coding
))
4059 /* We found that the file should be decoded somehow.
4060 Let's give up here. */
4062 giveup_match_end
= 1;
4067 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4068 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4069 same_at_start
++, bufpos
++;
4070 /* If we found a discrepancy, stop the scan.
4071 Otherwise loop around and scan the next bufferful. */
4072 if (bufpos
!= nread
)
4076 /* If the file matches the buffer completely,
4077 there's no need to replace anything. */
4078 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4082 /* Truncate the buffer to the size of the file. */
4083 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4088 /* Count how many chars at the end of the file
4089 match the text at the end of the buffer. But, if we have
4090 already found that decoding is necessary, don't waste time. */
4091 while (!giveup_match_end
)
4093 int total_read
, nread
, bufpos
, curpos
, trial
;
4095 /* At what file position are we now scanning? */
4096 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4097 /* If the entire file matches the buffer tail, stop the scan. */
4100 /* How much can we scan in the next step? */
4101 trial
= min (curpos
, sizeof buffer
);
4102 if (lseek (fd
, curpos
- trial
, 0) < 0)
4103 report_file_error ("Setting file position",
4104 Fcons (orig_filename
, Qnil
));
4106 total_read
= nread
= 0;
4107 while (total_read
< trial
)
4109 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4111 error ("IO error reading %s: %s",
4112 SDATA (orig_filename
), emacs_strerror (errno
));
4113 else if (nread
== 0)
4115 total_read
+= nread
;
4118 /* Scan this bufferful from the end, comparing with
4119 the Emacs buffer. */
4120 bufpos
= total_read
;
4122 /* Compare with same_at_start to avoid counting some buffer text
4123 as matching both at the file's beginning and at the end. */
4124 while (bufpos
> 0 && same_at_end
> same_at_start
4125 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4126 same_at_end
--, bufpos
--;
4128 /* If we found a discrepancy, stop the scan.
4129 Otherwise loop around and scan the preceding bufferful. */
4132 /* If this discrepancy is because of code conversion,
4133 we cannot use this method; giveup and try the other. */
4134 if (same_at_end
> same_at_start
4135 && FETCH_BYTE (same_at_end
- 1) >= 0200
4136 && ! NILP (current_buffer
->enable_multibyte_characters
)
4137 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4138 giveup_match_end
= 1;
4147 if (! giveup_match_end
)
4151 /* We win! We can handle REPLACE the optimized way. */
4153 /* Extend the start of non-matching text area to multibyte
4154 character boundary. */
4155 if (! NILP (current_buffer
->enable_multibyte_characters
))
4156 while (same_at_start
> BEGV_BYTE
4157 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4160 /* Extend the end of non-matching text area to multibyte
4161 character boundary. */
4162 if (! NILP (current_buffer
->enable_multibyte_characters
))
4163 while (same_at_end
< ZV_BYTE
4164 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4167 /* Don't try to reuse the same piece of text twice. */
4168 overlap
= (same_at_start
- BEGV_BYTE
4169 - (same_at_end
+ st
.st_size
- ZV
));
4171 same_at_end
+= overlap
;
4173 /* Arrange to read only the nonmatching middle part of the file. */
4174 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4175 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4177 del_range_byte (same_at_start
, same_at_end
, 0);
4178 /* Insert from the file at the proper position. */
4179 temp
= BYTE_TO_CHAR (same_at_start
);
4180 SET_PT_BOTH (temp
, same_at_start
);
4182 /* If display currently starts at beginning of line,
4183 keep it that way. */
4184 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4185 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4187 replace_handled
= 1;
4191 /* If requested, replace the accessible part of the buffer
4192 with the file contents. Avoid replacing text at the
4193 beginning or end of the buffer that matches the file contents;
4194 that preserves markers pointing to the unchanged parts.
4196 Here we implement this feature for the case where code conversion
4197 is needed, in a simple way that needs a lot of memory.
4198 The preceding if-statement handles the case of no conversion
4199 in a more optimized way. */
4200 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4202 int same_at_start
= BEGV_BYTE
;
4203 int same_at_end
= ZV_BYTE
;
4204 int same_at_start_charpos
;
4208 unsigned char *decoded
;
4210 int this_count
= SPECPDL_INDEX ();
4211 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4212 Lisp_Object conversion_buffer
;
4214 conversion_buffer
= code_conversion_save (1, multibyte
);
4216 /* First read the whole file, performing code conversion into
4217 CONVERSION_BUFFER. */
4219 if (lseek (fd
, XINT (beg
), 0) < 0)
4220 report_file_error ("Setting file position",
4221 Fcons (orig_filename
, Qnil
));
4223 total
= st
.st_size
; /* Total bytes in the file. */
4224 how_much
= 0; /* Bytes read from file so far. */
4225 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4226 unprocessed
= 0; /* Bytes not processed in previous loop. */
4228 GCPRO1 (conversion_buffer
);
4229 while (how_much
< total
)
4231 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4232 quitting while reading a huge while. */
4233 /* try is reserved in some compilers (Microsoft C) */
4234 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4237 /* Allow quitting out of the actual I/O. */
4240 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4252 BUF_SET_PT (XBUFFER (conversion_buffer
),
4253 BUF_Z (XBUFFER (conversion_buffer
)));
4254 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4256 unprocessed
= coding
.carryover_bytes
;
4257 if (coding
.carryover_bytes
> 0)
4258 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4263 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4264 if we couldn't read the file. */
4267 error ("IO error reading %s: %s",
4268 SDATA (orig_filename
), emacs_strerror (errno
));
4270 if (unprocessed
> 0)
4272 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4273 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4275 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4278 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4279 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4280 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4282 /* Compare the beginning of the converted string with the buffer
4286 while (bufpos
< inserted
&& same_at_start
< same_at_end
4287 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4288 same_at_start
++, bufpos
++;
4290 /* If the file matches the head of buffer completely,
4291 there's no need to replace anything. */
4293 if (bufpos
== inserted
)
4296 /* Truncate the buffer to the size of the file. */
4297 del_range_byte (same_at_start
, same_at_end
, 0);
4300 unbind_to (this_count
, Qnil
);
4304 /* Extend the start of non-matching text area to the previous
4305 multibyte character boundary. */
4306 if (! NILP (current_buffer
->enable_multibyte_characters
))
4307 while (same_at_start
> BEGV_BYTE
4308 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4311 /* Scan this bufferful from the end, comparing with
4312 the Emacs buffer. */
4315 /* Compare with same_at_start to avoid counting some buffer text
4316 as matching both at the file's beginning and at the end. */
4317 while (bufpos
> 0 && same_at_end
> same_at_start
4318 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4319 same_at_end
--, bufpos
--;
4321 /* Extend the end of non-matching text area to the next
4322 multibyte character boundary. */
4323 if (! NILP (current_buffer
->enable_multibyte_characters
))
4324 while (same_at_end
< ZV_BYTE
4325 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4328 /* Don't try to reuse the same piece of text twice. */
4329 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4331 same_at_end
+= overlap
;
4333 /* If display currently starts at beginning of line,
4334 keep it that way. */
4335 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4336 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4338 /* Replace the chars that we need to replace,
4339 and update INSERTED to equal the number of bytes
4340 we are taking from the decoded string. */
4341 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4343 if (same_at_end
!= same_at_start
)
4345 del_range_byte (same_at_start
, same_at_end
, 0);
4347 same_at_start
= GPT_BYTE
;
4351 temp
= BYTE_TO_CHAR (same_at_start
);
4353 /* Insert from the file at the proper position. */
4354 SET_PT_BOTH (temp
, same_at_start
);
4355 same_at_start_charpos
4356 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4359 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4360 same_at_start
+ inserted
)
4361 - same_at_start_charpos
);
4362 /* This binding is to avoid ask-user-about-supersession-threat
4363 being called in insert_from_buffer (via in
4364 prepare_to_modify_buffer). */
4365 specbind (intern ("buffer-file-name"), Qnil
);
4366 insert_from_buffer (XBUFFER (conversion_buffer
),
4367 same_at_start_charpos
, inserted_chars
, 0);
4368 /* Set `inserted' to the number of inserted characters. */
4369 inserted
= PT
- temp
;
4370 /* Set point before the inserted characters. */
4371 SET_PT_BOTH (temp
, same_at_start
);
4373 unbind_to (this_count
, Qnil
);
4380 register Lisp_Object temp
;
4382 total
= XINT (end
) - XINT (beg
);
4384 /* Make sure point-max won't overflow after this insertion. */
4385 XSETINT (temp
, total
);
4386 if (total
!= XINT (temp
))
4387 error ("Maximum buffer size exceeded");
4390 /* For a special file, all we can do is guess. */
4391 total
= READ_BUF_SIZE
;
4393 if (NILP (visit
) && inserted
> 0)
4395 #ifdef CLASH_DETECTION
4396 if (!NILP (current_buffer
->file_truename
)
4397 /* Make binding buffer-file-name to nil effective. */
4398 && !NILP (current_buffer
->filename
)
4399 && SAVE_MODIFF
>= MODIFF
)
4401 #endif /* CLASH_DETECTION */
4402 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4406 if (GAP_SIZE
< total
)
4407 make_gap (total
- GAP_SIZE
);
4409 if (XINT (beg
) != 0 || !NILP (replace
))
4411 if (lseek (fd
, XINT (beg
), 0) < 0)
4412 report_file_error ("Setting file position",
4413 Fcons (orig_filename
, Qnil
));
4416 /* In the following loop, HOW_MUCH contains the total bytes read so
4417 far for a regular file, and not changed for a special file. But,
4418 before exiting the loop, it is set to a negative value if I/O
4422 /* Total bytes inserted. */
4425 /* Here, we don't do code conversion in the loop. It is done by
4426 decode_coding_gap after all data are read into the buffer. */
4428 int gap_size
= GAP_SIZE
;
4430 while (how_much
< total
)
4432 /* try is reserved in some compilers (Microsoft C) */
4433 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4440 /* Maybe make more room. */
4441 if (gap_size
< trytry
)
4443 make_gap (total
- gap_size
);
4444 gap_size
= GAP_SIZE
;
4447 /* Read from the file, capturing `quit'. When an
4448 error occurs, end the loop, and arrange for a quit
4449 to be signaled after decoding the text we read. */
4450 non_regular_fd
= fd
;
4451 non_regular_inserted
= inserted
;
4452 non_regular_nbytes
= trytry
;
4453 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4454 read_non_regular_quit
);
4465 /* Allow quitting out of the actual I/O. We don't make text
4466 part of the buffer until all the reading is done, so a C-g
4467 here doesn't do any harm. */
4470 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4482 /* For a regular file, where TOTAL is the real size,
4483 count HOW_MUCH to compare with it.
4484 For a special file, where TOTAL is just a buffer size,
4485 so don't bother counting in HOW_MUCH.
4486 (INSERTED is where we count the number of characters inserted.) */
4493 /* Now we have read all the file data into the gap.
4494 If it was empty, undo marking the buffer modified. */
4498 #ifdef CLASH_DETECTION
4500 unlock_file (current_buffer
->file_truename
);
4502 Vdeactivate_mark
= old_Vdeactivate_mark
;
4505 Vdeactivate_mark
= Qt
;
4507 /* Make the text read part of the buffer. */
4508 GAP_SIZE
-= inserted
;
4510 GPT_BYTE
+= inserted
;
4512 ZV_BYTE
+= inserted
;
4517 /* Put an anchor to ensure multi-byte form ends at gap. */
4522 /* Discard the unwind protect for closing the file. */
4526 error ("IO error reading %s: %s",
4527 SDATA (orig_filename
), emacs_strerror (errno
));
4531 if (NILP (coding_system
))
4533 /* The coding system is not yet decided. Decide it by an
4534 optimized method for handling `coding:' tag.
4536 Note that we can get here only if the buffer was empty
4537 before the insertion. */
4539 if (!NILP (Vcoding_system_for_read
))
4540 coding_system
= Vcoding_system_for_read
;
4543 /* Since we are sure that the current buffer was empty
4544 before the insertion, we can toggle
4545 enable-multibyte-characters directly here without taking
4546 care of marker adjustment. By this way, we can run Lisp
4547 program safely before decoding the inserted text. */
4548 Lisp_Object unwind_data
;
4549 int count
= SPECPDL_INDEX ();
4551 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4552 Fcons (current_buffer
->undo_list
,
4553 Fcurrent_buffer ()));
4554 current_buffer
->enable_multibyte_characters
= Qnil
;
4555 current_buffer
->undo_list
= Qt
;
4556 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4558 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4560 coding_system
= call2 (Vset_auto_coding_function
,
4561 filename
, make_number (inserted
));
4564 if (NILP (coding_system
))
4566 /* If the coding system is not yet decided, check
4567 file-coding-system-alist. */
4568 Lisp_Object args
[6];
4570 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4571 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4572 coding_system
= Ffind_operation_coding_system (6, args
);
4573 if (CONSP (coding_system
))
4574 coding_system
= XCAR (coding_system
);
4576 unbind_to (count
, Qnil
);
4577 inserted
= Z_BYTE
- BEG_BYTE
;
4580 if (NILP (coding_system
))
4581 coding_system
= Qundecided
;
4583 CHECK_CODING_SYSTEM (coding_system
);
4585 if (NILP (current_buffer
->enable_multibyte_characters
))
4586 /* We must suppress all character code conversion except for
4587 end-of-line conversion. */
4588 coding_system
= raw_text_coding_system (coding_system
);
4589 setup_coding_system (coding_system
, &coding
);
4590 /* Ensure we set Vlast_coding_system_used. */
4591 set_coding_system
= 1;
4596 /* When we visit a file by raw-text, we change the buffer to
4598 if (CODING_FOR_UNIBYTE (&coding
)
4599 /* Can't do this if part of the buffer might be preserved. */
4601 /* Visiting a file with these coding system makes the buffer
4603 current_buffer
->enable_multibyte_characters
= Qnil
;
4606 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4607 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4608 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4610 move_gap_both (PT
, PT_BYTE
);
4611 GAP_SIZE
+= inserted
;
4612 ZV_BYTE
-= inserted
;
4616 decode_coding_gap (&coding
, inserted
, inserted
);
4617 inserted
= coding
.produced_char
;
4618 coding_system
= CODING_ID_NAME (coding
.id
);
4620 else if (inserted
> 0)
4621 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4624 /* Now INSERTED is measured in characters. */
4627 /* Use the conversion type to determine buffer-file-type
4628 (find-buffer-file-type is now used to help determine the
4630 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4631 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4632 && ! CODING_REQUIRE_DECODING (&coding
))
4633 current_buffer
->buffer_file_type
= Qt
;
4635 current_buffer
->buffer_file_type
= Qnil
;
4642 if (!EQ (current_buffer
->undo_list
, Qt
))
4643 current_buffer
->undo_list
= Qnil
;
4645 stat (SDATA (filename
), &st
);
4650 current_buffer
->modtime
= st
.st_mtime
;
4651 current_buffer
->filename
= orig_filename
;
4654 SAVE_MODIFF
= MODIFF
;
4655 current_buffer
->auto_save_modified
= MODIFF
;
4656 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4657 #ifdef CLASH_DETECTION
4660 if (!NILP (current_buffer
->file_truename
))
4661 unlock_file (current_buffer
->file_truename
);
4662 unlock_file (filename
);
4664 #endif /* CLASH_DETECTION */
4666 xsignal2 (Qfile_error
,
4667 build_string ("not a regular file"), orig_filename
);
4670 if (set_coding_system
)
4671 Vlast_coding_system_used
= coding_system
;
4673 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4675 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4677 if (! NILP (insval
))
4679 CHECK_NUMBER (insval
);
4680 inserted
= XFASTINT (insval
);
4684 /* Decode file format */
4687 /* Don't run point motion or modification hooks when decoding. */
4688 int count
= SPECPDL_INDEX ();
4689 specbind (Qinhibit_point_motion_hooks
, Qt
);
4690 specbind (Qinhibit_modification_hooks
, Qt
);
4692 /* Save old undo list and don't record undo for decoding. */
4693 old_undo
= current_buffer
->undo_list
;
4694 current_buffer
->undo_list
= Qt
;
4698 insval
= call3 (Qformat_decode
,
4699 Qnil
, make_number (inserted
), visit
);
4700 CHECK_NUMBER (insval
);
4701 inserted
= XFASTINT (insval
);
4705 /* If REPLACE is non-nil and we succeeded in not replacing the
4706 beginning or end of the buffer text with the file's contents,
4707 call format-decode with `point' positioned at the beginning of
4708 the buffer and `inserted' equalling the number of characters
4709 in the buffer. Otherwise, format-decode might fail to
4710 correctly analyze the beginning or end of the buffer. Hence
4711 we temporarily save `point' and `inserted' here and restore
4712 `point' iff format-decode did not insert or delete any text.
4713 Otherwise we leave `point' at point-min. */
4715 int opoint_byte
= PT_BYTE
;
4716 int oinserted
= ZV
- BEGV
;
4717 int ochars_modiff
= CHARS_MODIFF
;
4719 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4720 insval
= call3 (Qformat_decode
,
4721 Qnil
, make_number (oinserted
), visit
);
4722 CHECK_NUMBER (insval
);
4723 if (ochars_modiff
== CHARS_MODIFF
)
4724 /* format_decode didn't modify buffer's characters => move
4725 point back to position before inserted text and leave
4726 value of inserted alone. */
4727 SET_PT_BOTH (opoint
, opoint_byte
);
4729 /* format_decode modified buffer's characters => consider
4730 entire buffer changed and leave point at point-min. */
4731 inserted
= XFASTINT (insval
);
4734 /* For consistency with format-decode call these now iff inserted > 0
4735 (martin 2007-06-28) */
4736 p
= Vafter_insert_file_functions
;
4741 insval
= call1 (XCAR (p
), make_number (inserted
));
4744 CHECK_NUMBER (insval
);
4745 inserted
= XFASTINT (insval
);
4750 /* For the rationale of this see the comment on format-decode above. */
4752 int opoint_byte
= PT_BYTE
;
4753 int oinserted
= ZV
- BEGV
;
4754 int ochars_modiff
= CHARS_MODIFF
;
4756 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4757 insval
= call1 (XCAR (p
), make_number (oinserted
));
4760 CHECK_NUMBER (insval
);
4761 if (ochars_modiff
== CHARS_MODIFF
)
4762 /* after_insert_file_functions didn't modify
4763 buffer's characters => move point back to
4764 position before inserted text and leave value of
4766 SET_PT_BOTH (opoint
, opoint_byte
);
4768 /* after_insert_file_functions did modify buffer's
4769 characters => consider entire buffer changed and
4770 leave point at point-min. */
4771 inserted
= XFASTINT (insval
);
4781 Lisp_Object lbeg
, lend
;
4783 XSETINT (lend
, PT
+ inserted
);
4784 if (CONSP (old_undo
))
4786 Lisp_Object tem
= XCAR (old_undo
);
4787 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4788 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4789 /* In the non-visiting case record only the final insertion. */
4790 current_buffer
->undo_list
=
4791 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4795 /* If undo_list was Qt before, keep it that way.
4796 Otherwise start with an empty undo_list. */
4797 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4799 unbind_to (count
, Qnil
);
4802 /* Call after-change hooks for the inserted text, aside from the case
4803 of normal visiting (not with REPLACE), which is done in a new buffer
4804 "before" the buffer is changed. */
4805 if (inserted
> 0 && total
> 0
4806 && (NILP (visit
) || !NILP (replace
)))
4808 signal_after_change (PT
, 0, inserted
);
4809 update_compositions (PT
, PT
, CHECK_BORDER
);
4813 && current_buffer
->modtime
== -1)
4815 /* If visiting nonexistent file, return nil. */
4816 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4820 Fsignal (Qquit
, Qnil
);
4822 /* ??? Retval needs to be dealt with in all cases consistently. */
4824 val
= Fcons (orig_filename
,
4825 Fcons (make_number (inserted
),
4828 RETURN_UNGCPRO (unbind_to (count
, val
));
4831 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4833 /* If build_annotations switched buffers, switch back to BUF.
4834 Kill the temporary buffer that was selected in the meantime.
4836 Since this kill only the last temporary buffer, some buffers remain
4837 not killed if build_annotations switched buffers more than once.
4841 build_annotations_unwind (buf
)
4846 if (XBUFFER (buf
) == current_buffer
)
4848 tembuf
= Fcurrent_buffer ();
4850 Fkill_buffer (tembuf
);
4854 /* Decide the coding-system to encode the data with. */
4857 choose_write_coding_system (start
, end
, filename
,
4858 append
, visit
, lockname
, coding
)
4859 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4860 struct coding_system
*coding
;
4863 Lisp_Object eol_parent
= Qnil
;
4866 && NILP (Fstring_equal (current_buffer
->filename
,
4867 current_buffer
->auto_save_file_name
)))
4872 else if (!NILP (Vcoding_system_for_write
))
4874 val
= Vcoding_system_for_write
;
4875 if (coding_system_require_warning
4876 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4877 /* Confirm that VAL can surely encode the current region. */
4878 val
= call5 (Vselect_safe_coding_system_function
,
4879 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4884 /* If the variable `buffer-file-coding-system' is set locally,
4885 it means that the file was read with some kind of code
4886 conversion or the variable is explicitly set by users. We
4887 had better write it out with the same coding system even if
4888 `enable-multibyte-characters' is nil.
4890 If it is not set locally, we anyway have to convert EOL
4891 format if the default value of `buffer-file-coding-system'
4892 tells that it is not Unix-like (LF only) format. */
4893 int using_default_coding
= 0;
4894 int force_raw_text
= 0;
4896 val
= current_buffer
->buffer_file_coding_system
;
4898 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4901 if (NILP (current_buffer
->enable_multibyte_characters
))
4907 /* Check file-coding-system-alist. */
4908 Lisp_Object args
[7], coding_systems
;
4910 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4911 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4913 coding_systems
= Ffind_operation_coding_system (7, args
);
4914 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4915 val
= XCDR (coding_systems
);
4920 /* If we still have not decided a coding system, use the
4921 default value of buffer-file-coding-system. */
4922 val
= current_buffer
->buffer_file_coding_system
;
4923 using_default_coding
= 1;
4926 if (! NILP (val
) && ! force_raw_text
)
4928 Lisp_Object spec
, attrs
;
4930 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4931 attrs
= AREF (spec
, 0);
4932 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4937 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4938 /* Confirm that VAL can surely encode the current region. */
4939 val
= call5 (Vselect_safe_coding_system_function
,
4940 start
, end
, val
, Qnil
, filename
);
4942 /* If the decided coding-system doesn't specify end-of-line
4943 format, we use that of
4944 `default-buffer-file-coding-system'. */
4945 if (! using_default_coding
4946 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4947 val
= (coding_inherit_eol_type
4948 (val
, buffer_defaults
.buffer_file_coding_system
));
4950 /* If we decide not to encode text, use `raw-text' or one of its
4953 val
= raw_text_coding_system (val
);
4956 val
= coding_inherit_eol_type (val
, eol_parent
);
4957 setup_coding_system (val
, coding
);
4959 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4960 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4964 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4965 "r\nFWrite region to file: \ni\ni\ni\np",
4966 doc
: /* Write current region into specified file.
4967 When called from a program, requires three arguments:
4968 START, END and FILENAME. START and END are normally buffer positions
4969 specifying the part of the buffer to write.
4970 If START is nil, that means to use the entire buffer contents.
4971 If START is a string, then output that string to the file
4972 instead of any buffer contents; END is ignored.
4974 Optional fourth argument APPEND if non-nil means
4975 append to existing file contents (if any). If it is an integer,
4976 seek to that offset in the file before writing.
4977 Optional fifth argument VISIT, if t or a string, means
4978 set the last-save-file-modtime of buffer to this file's modtime
4979 and mark buffer not modified.
4980 If VISIT is a string, it is a second file name;
4981 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4982 VISIT is also the file name to lock and unlock for clash detection.
4983 If VISIT is neither t nor nil nor a string,
4984 that means do not display the \"Wrote file\" message.
4985 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4986 use for locking and unlocking, overriding FILENAME and VISIT.
4987 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4988 for an existing file with the same name. If MUSTBENEW is `excl',
4989 that means to get an error if the file already exists; never overwrite.
4990 If MUSTBENEW is neither nil nor `excl', that means ask for
4991 confirmation before overwriting, but do go ahead and overwrite the file
4992 if the user confirms.
4994 This does code conversion according to the value of
4995 `coding-system-for-write', `buffer-file-coding-system', or
4996 `file-coding-system-alist', and sets the variable
4997 `last-coding-system-used' to the coding system actually used. */)
4998 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4999 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
5004 const unsigned char *fn
;
5006 int count
= SPECPDL_INDEX ();
5009 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
5011 Lisp_Object handler
;
5012 Lisp_Object visit_file
;
5013 Lisp_Object annotations
;
5014 Lisp_Object encoded_filename
;
5015 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5016 int quietly
= !NILP (visit
);
5017 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5018 struct buffer
*given_buffer
;
5020 int buffer_file_type
= O_BINARY
;
5022 struct coding_system coding
;
5024 if (current_buffer
->base_buffer
&& visiting
)
5025 error ("Cannot do file visiting in an indirect buffer");
5027 if (!NILP (start
) && !STRINGP (start
))
5028 validate_region (&start
, &end
);
5031 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5033 filename
= Fexpand_file_name (filename
, Qnil
);
5035 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5036 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5038 if (STRINGP (visit
))
5039 visit_file
= Fexpand_file_name (visit
, Qnil
);
5041 visit_file
= filename
;
5043 if (NILP (lockname
))
5044 lockname
= visit_file
;
5048 /* If the file name has special constructs in it,
5049 call the corresponding file handler. */
5050 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5051 /* If FILENAME has no handler, see if VISIT has one. */
5052 if (NILP (handler
) && STRINGP (visit
))
5053 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5055 if (!NILP (handler
))
5058 val
= call6 (handler
, Qwrite_region
, start
, end
,
5059 filename
, append
, visit
);
5063 SAVE_MODIFF
= MODIFF
;
5064 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5065 current_buffer
->filename
= visit_file
;
5071 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5073 /* Special kludge to simplify auto-saving. */
5076 XSETFASTINT (start
, BEG
);
5077 XSETFASTINT (end
, Z
);
5081 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5082 count1
= SPECPDL_INDEX ();
5084 given_buffer
= current_buffer
;
5086 if (!STRINGP (start
))
5088 annotations
= build_annotations (start
, end
);
5090 if (current_buffer
!= given_buffer
)
5092 XSETFASTINT (start
, BEGV
);
5093 XSETFASTINT (end
, ZV
);
5099 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5101 /* Decide the coding-system to encode the data with.
5102 We used to make this choice before calling build_annotations, but that
5103 leads to problems when a write-annotate-function takes care of
5104 unsavable chars (as was the case with X-Symbol). */
5105 Vlast_coding_system_used
5106 = choose_write_coding_system (start
, end
, filename
,
5107 append
, visit
, lockname
, &coding
);
5109 #ifdef CLASH_DETECTION
5112 #if 0 /* This causes trouble for GNUS. */
5113 /* If we've locked this file for some other buffer,
5114 query before proceeding. */
5115 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5116 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5119 lock_file (lockname
);
5121 #endif /* CLASH_DETECTION */
5123 encoded_filename
= ENCODE_FILE (filename
);
5125 fn
= SDATA (encoded_filename
);
5129 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5130 #else /* not DOS_NT */
5131 desc
= emacs_open (fn
, O_WRONLY
, 0);
5132 #endif /* not DOS_NT */
5134 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5136 if (auto_saving
) /* Overwrite any previous version of autosave file */
5138 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5139 desc
= emacs_open (fn
, O_RDWR
, 0);
5141 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5142 ? SDATA (current_buffer
->filename
) : 0,
5145 else /* Write to temporary name and rename if no errors */
5147 Lisp_Object temp_name
;
5148 temp_name
= Ffile_name_directory (filename
);
5150 if (!NILP (temp_name
))
5152 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5153 build_string ("$$SAVE$$")));
5154 fname
= SDATA (filename
);
5155 fn
= SDATA (temp_name
);
5156 desc
= creat_copy_attrs (fname
, fn
);
5159 /* If we can't open the temporary file, try creating a new
5160 version of the original file. VMS "creat" creates a
5161 new version rather than truncating an existing file. */
5164 desc
= creat (fn
, 0666);
5165 #if 0 /* This can clobber an existing file and fail to replace it,
5166 if the user runs out of space. */
5169 /* We can't make a new version;
5170 try to truncate and rewrite existing version if any. */
5172 desc
= emacs_open (fn
, O_RDWR
, 0);
5178 desc
= creat (fn
, 0666);
5182 desc
= emacs_open (fn
,
5183 O_WRONLY
| O_CREAT
| buffer_file_type
5184 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5185 S_IREAD
| S_IWRITE
);
5186 #else /* not DOS_NT */
5187 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5188 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5189 auto_saving
? auto_save_mode_bits
: 0666);
5190 #endif /* not DOS_NT */
5191 #endif /* not VMS */
5195 #ifdef CLASH_DETECTION
5197 if (!auto_saving
) unlock_file (lockname
);
5199 #endif /* CLASH_DETECTION */
5201 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5204 record_unwind_protect (close_file_unwind
, make_number (desc
));
5206 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5210 if (NUMBERP (append
))
5211 ret
= lseek (desc
, XINT (append
), 1);
5213 ret
= lseek (desc
, 0, 2);
5216 #ifdef CLASH_DETECTION
5217 if (!auto_saving
) unlock_file (lockname
);
5218 #endif /* CLASH_DETECTION */
5220 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5228 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5229 * if we do writes that don't end with a carriage return. Furthermore
5230 * it cannot handle writes of more then 16K. The modified
5231 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5232 * this EXCEPT for the last record (if it doesn't end with a carriage
5233 * return). This implies that if your buffer doesn't end with a carriage
5234 * return, you get one free... tough. However it also means that if
5235 * we make two calls to sys_write (a la the following code) you can
5236 * get one at the gap as well. The easiest way to fix this (honest)
5237 * is to move the gap to the next newline (or the end of the buffer).
5242 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5243 move_gap (find_next_newline (GPT
, 1));
5246 /* The new encoding routine doesn't require the following. */
5248 /* Whether VMS or not, we must move the gap to the next of newline
5249 when we must put designation sequences at beginning of line. */
5250 if (INTEGERP (start
)
5251 && coding
.type
== coding_type_iso2022
5252 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5253 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5255 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5256 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5257 move_gap_both (PT
, PT_BYTE
);
5258 SET_PT_BOTH (opoint
, opoint_byte
);
5266 if (STRINGP (start
))
5268 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5269 &annotations
, &coding
);
5272 else if (XINT (start
) != XINT (end
))
5274 failure
= 0 > a_write (desc
, Qnil
,
5275 XINT (start
), XINT (end
) - XINT (start
),
5276 &annotations
, &coding
);
5281 /* If file was empty, still need to write the annotations */
5282 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5283 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5287 if (CODING_REQUIRE_FLUSHING (&coding
)
5288 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5291 /* We have to flush out a data. */
5292 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5293 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5300 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5301 Disk full in NFS may be reported here. */
5302 /* mib says that closing the file will try to write as fast as NFS can do
5303 it, and that means the fsync here is not crucial for autosave files. */
5304 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5306 /* If fsync fails with EINTR, don't treat that as serious. Also
5307 ignore EINVAL which happens when fsync is not supported on this
5309 if (errno
!= EINTR
&& errno
!= EINVAL
)
5310 failure
= 1, save_errno
= errno
;
5314 /* Spurious "file has changed on disk" warnings have been
5315 observed on Suns as well.
5316 It seems that `close' can change the modtime, under nfs.
5318 (This has supposedly been fixed in Sunos 4,
5319 but who knows about all the other machines with NFS?) */
5322 /* On VMS and APOLLO, must do the stat after the close
5323 since closing changes the modtime. */
5326 /* Recall that #if defined does not work on VMS. */
5333 /* NFS can report a write failure now. */
5334 if (emacs_close (desc
) < 0)
5335 failure
= 1, save_errno
= errno
;
5338 /* If we wrote to a temporary name and had no errors, rename to real name. */
5342 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5350 /* Discard the unwind protect for close_file_unwind. */
5351 specpdl_ptr
= specpdl
+ count1
;
5352 /* Restore the original current buffer. */
5353 visit_file
= unbind_to (count
, visit_file
);
5355 #ifdef CLASH_DETECTION
5357 unlock_file (lockname
);
5358 #endif /* CLASH_DETECTION */
5360 /* Do this before reporting IO error
5361 to avoid a "file has changed on disk" warning on
5362 next attempt to save. */
5364 current_buffer
->modtime
= st
.st_mtime
;
5367 error ("IO error writing %s: %s", SDATA (filename
),
5368 emacs_strerror (save_errno
));
5372 SAVE_MODIFF
= MODIFF
;
5373 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5374 current_buffer
->filename
= visit_file
;
5375 update_mode_lines
++;
5380 && ! NILP (Fstring_equal (current_buffer
->filename
,
5381 current_buffer
->auto_save_file_name
)))
5382 SAVE_MODIFF
= MODIFF
;
5388 message_with_string ((INTEGERP (append
)
5398 Lisp_Object
merge ();
5400 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5401 doc
: /* Return t if (car A) is numerically less than (car B). */)
5405 return Flss (Fcar (a
), Fcar (b
));
5408 /* Build the complete list of annotations appropriate for writing out
5409 the text between START and END, by calling all the functions in
5410 write-region-annotate-functions and merging the lists they return.
5411 If one of these functions switches to a different buffer, we assume
5412 that buffer contains altered text. Therefore, the caller must
5413 make sure to restore the current buffer in all cases,
5414 as save-excursion would do. */
5417 build_annotations (start
, end
)
5418 Lisp_Object start
, end
;
5420 Lisp_Object annotations
;
5422 struct gcpro gcpro1
, gcpro2
;
5423 Lisp_Object original_buffer
;
5424 int i
, used_global
= 0;
5426 XSETBUFFER (original_buffer
, current_buffer
);
5429 p
= Vwrite_region_annotate_functions
;
5430 GCPRO2 (annotations
, p
);
5433 struct buffer
*given_buffer
= current_buffer
;
5434 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5435 { /* Use the global value of the hook. */
5438 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5440 p
= Fappend (2, arg
);
5443 Vwrite_region_annotations_so_far
= annotations
;
5444 res
= call2 (XCAR (p
), start
, end
);
5445 /* If the function makes a different buffer current,
5446 assume that means this buffer contains altered text to be output.
5447 Reset START and END from the buffer bounds
5448 and discard all previous annotations because they should have
5449 been dealt with by this function. */
5450 if (current_buffer
!= given_buffer
)
5452 XSETFASTINT (start
, BEGV
);
5453 XSETFASTINT (end
, ZV
);
5456 Flength (res
); /* Check basic validity of return value */
5457 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5461 /* Now do the same for annotation functions implied by the file-format */
5462 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5463 p
= current_buffer
->auto_save_file_format
;
5465 p
= current_buffer
->file_format
;
5466 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5468 struct buffer
*given_buffer
= current_buffer
;
5470 Vwrite_region_annotations_so_far
= annotations
;
5472 /* Value is either a list of annotations or nil if the function
5473 has written annotations to a temporary buffer, which is now
5475 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5476 original_buffer
, make_number (i
));
5477 if (current_buffer
!= given_buffer
)
5479 XSETFASTINT (start
, BEGV
);
5480 XSETFASTINT (end
, ZV
);
5485 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5493 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5494 If STRING is nil, POS is the character position in the current buffer.
5495 Intersperse with them the annotations from *ANNOT
5496 which fall within the range of POS to POS + NCHARS,
5497 each at its appropriate position.
5499 We modify *ANNOT by discarding elements as we use them up.
5501 The return value is negative in case of system call failure. */
5504 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5507 register int nchars
;
5510 struct coding_system
*coding
;
5514 int lastpos
= pos
+ nchars
;
5516 while (NILP (*annot
) || CONSP (*annot
))
5518 tem
= Fcar_safe (Fcar (*annot
));
5521 nextpos
= XFASTINT (tem
);
5523 /* If there are no more annotations in this range,
5524 output the rest of the range all at once. */
5525 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5526 return e_write (desc
, string
, pos
, lastpos
, coding
);
5528 /* Output buffer text up to the next annotation's position. */
5531 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5535 /* Output the annotation. */
5536 tem
= Fcdr (Fcar (*annot
));
5539 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5542 *annot
= Fcdr (*annot
);
5548 /* Write text in the range START and END into descriptor DESC,
5549 encoding them with coding system CODING. If STRING is nil, START
5550 and END are character positions of the current buffer, else they
5551 are indexes to the string STRING. */
5554 e_write (desc
, string
, start
, end
, coding
)
5558 struct coding_system
*coding
;
5560 if (STRINGP (string
))
5563 end
= SCHARS (string
);
5566 /* We used to have a code for handling selective display here. But,
5567 now it is handled within encode_coding. */
5571 if (STRINGP (string
))
5573 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5574 if (CODING_REQUIRE_ENCODING (coding
))
5576 encode_coding_object (coding
, string
,
5577 start
, string_char_to_byte (string
, start
),
5578 end
, string_char_to_byte (string
, end
), Qt
);
5582 coding
->dst_object
= string
;
5583 coding
->consumed_char
= SCHARS (string
);
5584 coding
->produced
= SBYTES (string
);
5589 int start_byte
= CHAR_TO_BYTE (start
);
5590 int end_byte
= CHAR_TO_BYTE (end
);
5592 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5593 if (CODING_REQUIRE_ENCODING (coding
))
5595 encode_coding_object (coding
, Fcurrent_buffer (),
5596 start
, start_byte
, end
, end_byte
, Qt
);
5600 coding
->dst_object
= Qnil
;
5601 coding
->dst_pos_byte
= start_byte
;
5602 if (start
>= GPT
|| end
<= GPT
)
5604 coding
->consumed_char
= end
- start
;
5605 coding
->produced
= end_byte
- start_byte
;
5609 coding
->consumed_char
= GPT
- start
;
5610 coding
->produced
= GPT_BYTE
- start_byte
;
5615 if (coding
->produced
> 0)
5619 STRINGP (coding
->dst_object
)
5620 ? SDATA (coding
->dst_object
)
5621 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5624 if (coding
->produced
)
5627 start
+= coding
->consumed_char
;
5633 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5634 Sverify_visited_file_modtime
, 1, 1, 0,
5635 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5636 This means that the file has not been changed since it was visited or saved.
5637 See Info node `(elisp)Modification Time' for more details. */)
5643 Lisp_Object handler
;
5644 Lisp_Object filename
;
5649 if (!STRINGP (b
->filename
)) return Qt
;
5650 if (b
->modtime
== 0) return Qt
;
5652 /* If the file name has special constructs in it,
5653 call the corresponding file handler. */
5654 handler
= Ffind_file_name_handler (b
->filename
,
5655 Qverify_visited_file_modtime
);
5656 if (!NILP (handler
))
5657 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5659 filename
= ENCODE_FILE (b
->filename
);
5661 if (stat (SDATA (filename
), &st
) < 0)
5663 /* If the file doesn't exist now and didn't exist before,
5664 we say that it isn't modified, provided the error is a tame one. */
5665 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5670 if (st
.st_mtime
== b
->modtime
5671 /* If both are positive, accept them if they are off by one second. */
5672 || (st
.st_mtime
> 0 && b
->modtime
> 0
5673 && (st
.st_mtime
== b
->modtime
+ 1
5674 || st
.st_mtime
== b
->modtime
- 1)))
5679 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5680 Sclear_visited_file_modtime
, 0, 0, 0,
5681 doc
: /* Clear out records of last mod time of visited file.
5682 Next attempt to save will certainly not complain of a discrepancy. */)
5685 current_buffer
->modtime
= 0;
5689 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5690 Svisited_file_modtime
, 0, 0, 0,
5691 doc
: /* Return the current buffer's recorded visited file modification time.
5692 The value is a list of the form (HIGH LOW), like the time values
5693 that `file-attributes' returns. If the current buffer has no recorded
5694 file modification time, this function returns 0.
5695 See Info node `(elisp)Modification Time' for more details. */)
5698 if (! current_buffer
->modtime
)
5699 return make_number (0);
5700 return make_time ((time_t) current_buffer
->modtime
);
5703 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5704 Sset_visited_file_modtime
, 0, 1, 0,
5705 doc
: /* Update buffer's recorded modification time from the visited file's time.
5706 Useful if the buffer was not read from the file normally
5707 or if the file itself has been changed for some known benign reason.
5708 An argument specifies the modification time value to use
5709 \(instead of that of the visited file), in the form of a list
5710 \(HIGH . LOW) or (HIGH LOW). */)
5712 Lisp_Object time_list
;
5714 if (!NILP (time_list
))
5715 current_buffer
->modtime
= cons_to_long (time_list
);
5718 register Lisp_Object filename
;
5720 Lisp_Object handler
;
5722 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5724 /* If the file name has special constructs in it,
5725 call the corresponding file handler. */
5726 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5727 if (!NILP (handler
))
5728 /* The handler can find the file name the same way we did. */
5729 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5731 filename
= ENCODE_FILE (filename
);
5733 if (stat (SDATA (filename
), &st
) >= 0)
5734 current_buffer
->modtime
= st
.st_mtime
;
5741 auto_save_error (error
)
5744 Lisp_Object args
[3], msg
;
5746 struct gcpro gcpro1
;
5750 ring_bell (XFRAME (selected_frame
));
5752 args
[0] = build_string ("Auto-saving %s: %s");
5753 args
[1] = current_buffer
->name
;
5754 args
[2] = Ferror_message_string (error
);
5755 msg
= Fformat (3, args
);
5757 nbytes
= SBYTES (msg
);
5758 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5759 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5761 for (i
= 0; i
< 3; ++i
)
5764 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5766 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5767 Fsleep_for (make_number (1), Qnil
);
5781 auto_save_mode_bits
= 0666;
5783 /* Get visited file's mode to become the auto save file's mode. */
5784 if (! NILP (current_buffer
->filename
))
5786 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5787 /* But make sure we can overwrite it later! */
5788 auto_save_mode_bits
= st
.st_mode
| 0600;
5789 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5791 /* Remote files don't cooperate with stat. */
5792 auto_save_mode_bits
= XINT (modes
) | 0600;
5796 Fwrite_region (Qnil
, Qnil
,
5797 current_buffer
->auto_save_file_name
,
5798 Qnil
, Qlambda
, Qnil
, Qnil
);
5802 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5805 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5817 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5820 minibuffer_auto_raise
= XINT (value
);
5825 do_auto_save_make_dir (dir
)
5830 call2 (Qmake_directory
, dir
, Qt
);
5831 XSETFASTINT (mode
, 0700);
5832 return Fset_file_modes (dir
, mode
);
5836 do_auto_save_eh (ignore
)
5842 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5843 doc
: /* Auto-save all buffers that need it.
5844 This is all buffers that have auto-saving enabled
5845 and are changed since last auto-saved.
5846 Auto-saving writes the buffer into a file
5847 so that your editing is not lost if the system crashes.
5848 This file is not the file you visited; that changes only when you save.
5849 Normally we run the normal hook `auto-save-hook' before saving.
5851 A non-nil NO-MESSAGE argument means do not print any message if successful.
5852 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5853 (no_message
, current_only
)
5854 Lisp_Object no_message
, current_only
;
5856 struct buffer
*old
= current_buffer
, *b
;
5857 Lisp_Object tail
, buf
;
5859 int do_handled_files
;
5861 FILE *stream
= NULL
;
5862 int count
= SPECPDL_INDEX ();
5863 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5864 int old_message_p
= 0;
5865 struct gcpro gcpro1
, gcpro2
;
5867 if (max_specpdl_size
< specpdl_size
+ 40)
5868 max_specpdl_size
= specpdl_size
+ 40;
5873 if (NILP (no_message
))
5875 old_message_p
= push_message ();
5876 record_unwind_protect (pop_message_unwind
, Qnil
);
5879 /* Ordinarily don't quit within this function,
5880 but don't make it impossible to quit (in case we get hung in I/O). */
5884 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5885 point to non-strings reached from Vbuffer_alist. */
5887 if (!NILP (Vrun_hooks
))
5888 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5890 if (STRINGP (Vauto_save_list_file_name
))
5892 Lisp_Object listfile
;
5894 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5896 /* Don't try to create the directory when shutting down Emacs,
5897 because creating the directory might signal an error, and
5898 that would leave Emacs in a strange state. */
5899 if (!NILP (Vrun_hooks
))
5903 GCPRO2 (dir
, listfile
);
5904 dir
= Ffile_name_directory (listfile
);
5905 if (NILP (Ffile_directory_p (dir
)))
5906 internal_condition_case_1 (do_auto_save_make_dir
,
5907 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5912 stream
= fopen (SDATA (listfile
), "w");
5915 record_unwind_protect (do_auto_save_unwind
,
5916 make_save_value (stream
, 0));
5917 record_unwind_protect (do_auto_save_unwind_1
,
5918 make_number (minibuffer_auto_raise
));
5919 minibuffer_auto_raise
= 0;
5922 /* On first pass, save all files that don't have handlers.
5923 On second pass, save all files that do have handlers.
5925 If Emacs is crashing, the handlers may tweak what is causing
5926 Emacs to crash in the first place, and it would be a shame if
5927 Emacs failed to autosave perfectly ordinary files because it
5928 couldn't handle some ange-ftp'd file. */
5930 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5931 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5933 buf
= XCDR (XCAR (tail
));
5936 /* Record all the buffers that have auto save mode
5937 in the special file that lists them. For each of these buffers,
5938 Record visited name (if any) and auto save name. */
5939 if (STRINGP (b
->auto_save_file_name
)
5940 && stream
!= NULL
&& do_handled_files
== 0)
5943 if (!NILP (b
->filename
))
5945 fwrite (SDATA (b
->filename
), 1,
5946 SBYTES (b
->filename
), stream
);
5948 putc ('\n', stream
);
5949 fwrite (SDATA (b
->auto_save_file_name
), 1,
5950 SBYTES (b
->auto_save_file_name
), stream
);
5951 putc ('\n', stream
);
5955 if (!NILP (current_only
)
5956 && b
!= current_buffer
)
5959 /* Don't auto-save indirect buffers.
5960 The base buffer takes care of it. */
5964 /* Check for auto save enabled
5965 and file changed since last auto save
5966 and file changed since last real save. */
5967 if (STRINGP (b
->auto_save_file_name
)
5968 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5969 && b
->auto_save_modified
< BUF_MODIFF (b
)
5970 /* -1 means we've turned off autosaving for a while--see below. */
5971 && XINT (b
->save_length
) >= 0
5972 && (do_handled_files
5973 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5976 EMACS_TIME before_time
, after_time
;
5978 EMACS_GET_TIME (before_time
);
5980 /* If we had a failure, don't try again for 20 minutes. */
5981 if (b
->auto_save_failure_time
>= 0
5982 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5985 if ((XFASTINT (b
->save_length
) * 10
5986 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5987 /* A short file is likely to change a large fraction;
5988 spare the user annoying messages. */
5989 && XFASTINT (b
->save_length
) > 5000
5990 /* These messages are frequent and annoying for `*mail*'. */
5991 && !EQ (b
->filename
, Qnil
)
5992 && NILP (no_message
))
5994 /* It has shrunk too much; turn off auto-saving here. */
5995 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5996 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5998 minibuffer_auto_raise
= 0;
5999 /* Turn off auto-saving until there's a real save,
6000 and prevent any more warnings. */
6001 XSETINT (b
->save_length
, -1);
6002 Fsleep_for (make_number (1), Qnil
);
6005 set_buffer_internal (b
);
6006 if (!auto_saved
&& NILP (no_message
))
6007 message1 ("Auto-saving...");
6008 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6010 b
->auto_save_modified
= BUF_MODIFF (b
);
6011 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6012 set_buffer_internal (old
);
6014 EMACS_GET_TIME (after_time
);
6016 /* If auto-save took more than 60 seconds,
6017 assume it was an NFS failure that got a timeout. */
6018 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6019 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6023 /* Prevent another auto save till enough input events come in. */
6024 record_auto_save ();
6026 if (auto_saved
&& NILP (no_message
))
6030 /* If we are going to restore an old message,
6031 give time to read ours. */
6032 sit_for (make_number (1), 0, 0);
6036 /* If we displayed a message and then restored a state
6037 with no message, leave a "done" message on the screen. */
6038 message1 ("Auto-saving...done");
6043 /* This restores the message-stack status. */
6044 unbind_to (count
, Qnil
);
6048 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6049 Sset_buffer_auto_saved
, 0, 0, 0,
6050 doc
: /* Mark current buffer as auto-saved with its current text.
6051 No auto-save file will be written until the buffer changes again. */)
6054 current_buffer
->auto_save_modified
= MODIFF
;
6055 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6056 current_buffer
->auto_save_failure_time
= -1;
6060 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6061 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6062 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6065 current_buffer
->auto_save_failure_time
= -1;
6069 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6071 doc
: /* Return t if current buffer has been auto-saved recently.
6072 More precisely, if it has been auto-saved since last read from or saved
6073 in the visited file. If the buffer has no visited file,
6074 then any auto-save counts as "recent". */)
6077 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6080 /* Reading and completing file names */
6081 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6082 extern Lisp_Object Qcompletion_ignore_case
;
6084 /* In the string VAL, change each $ to $$ and return the result. */
6087 double_dollars (val
)
6090 register const unsigned char *old
;
6091 register unsigned char *new;
6095 osize
= SBYTES (val
);
6097 /* Count the number of $ characters. */
6098 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6099 if (*old
++ == '$') count
++;
6103 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6106 for (n
= osize
; n
> 0; n
--)
6120 read_file_name_cleanup (arg
)
6123 return (current_buffer
->directory
= arg
);
6126 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6128 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6129 (string
, dir
, action
)
6130 Lisp_Object string
, dir
, action
;
6131 /* action is nil for complete, t for return list of completions,
6132 lambda for verify final value */
6134 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6136 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6138 CHECK_STRING (string
);
6145 /* No need to protect ACTION--we only compare it with t and nil. */
6146 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6148 if (SCHARS (string
) == 0)
6150 if (EQ (action
, Qlambda
))
6158 orig_string
= string
;
6159 string
= Fsubstitute_in_file_name (string
);
6160 changed
= NILP (Fstring_equal (string
, orig_string
));
6161 name
= Ffile_name_nondirectory (string
);
6162 val
= Ffile_name_directory (string
);
6164 realdir
= Fexpand_file_name (val
, realdir
);
6169 specdir
= Ffile_name_directory (string
);
6170 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6175 return double_dollars (string
);
6179 if (!NILP (specdir
))
6180 val
= concat2 (specdir
, val
);
6182 return double_dollars (val
);
6185 #endif /* not VMS */
6189 if (EQ (action
, Qt
))
6191 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6195 if (NILP (Vread_file_name_predicate
)
6196 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6200 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6202 /* Brute-force speed up for directory checking:
6203 Discard strings which don't end in a slash. */
6204 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6206 Lisp_Object tem
= XCAR (all
);
6208 if (STRINGP (tem
) &&
6209 (len
= SBYTES (tem
), len
> 0) &&
6210 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6211 comp
= Fcons (tem
, comp
);
6217 /* Must do it the hard (and slow) way. */
6219 GCPRO3 (all
, comp
, specdir
);
6220 count
= SPECPDL_INDEX ();
6221 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6222 current_buffer
->directory
= realdir
;
6223 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6225 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6227 comp
= Fcons (XCAR (all
), comp
);
6229 unbind_to (count
, Qnil
);
6232 return Fnreverse (comp
);
6235 /* Only other case actually used is ACTION = lambda */
6237 /* Supposedly this helps commands such as `cd' that read directory names,
6238 but can someone explain how it helps them? -- RMS */
6239 if (SCHARS (name
) == 0)
6242 string
= Fexpand_file_name (string
, dir
);
6243 if (!NILP (Vread_file_name_predicate
))
6244 return call1 (Vread_file_name_predicate
, string
);
6245 return Ffile_exists_p (string
);
6248 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6249 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6250 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6251 The return value is only relevant for a call to `read-file-name' that happens
6252 before any other event (mouse or keypress) is handeled. */)
6255 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6256 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6265 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6266 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6267 Value is not expanded---you must call `expand-file-name' yourself.
6268 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6269 the same non-empty string that was inserted by this function.
6270 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6271 except that if INITIAL is specified, that combined with DIR is used.)
6272 If the user exits with an empty minibuffer, this function returns
6273 an empty string. (This can only happen if the user erased the
6274 pre-inserted contents or if `insert-default-directory' is nil.)
6275 Fourth arg MUSTMATCH non-nil means require existing file's name.
6276 Non-nil and non-t means also require confirmation after completion.
6277 Fifth arg INITIAL specifies text to start with.
6278 If optional sixth arg PREDICATE is non-nil, possible completions and
6279 the resulting file name must satisfy (funcall PREDICATE NAME).
6280 DIR should be an absolute directory name. It defaults to the value of
6281 `default-directory'.
6283 If this command was invoked with the mouse, use a file dialog box if
6284 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6285 provides a file dialog box.
6287 See also `read-file-name-completion-ignore-case'
6288 and `read-file-name-function'. */)
6289 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6290 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6292 Lisp_Object val
, insdef
, tem
;
6293 struct gcpro gcpro1
, gcpro2
;
6294 register char *homedir
;
6295 Lisp_Object decoded_homedir
;
6296 int replace_in_history
= 0;
6297 int add_to_history
= 0;
6301 dir
= current_buffer
->directory
;
6302 if (NILP (Ffile_name_absolute_p (dir
)))
6303 dir
= Fexpand_file_name (dir
, Qnil
);
6304 if (NILP (default_filename
))
6307 ? Fexpand_file_name (initial
, dir
)
6308 : current_buffer
->filename
);
6310 /* If dir starts with user's homedir, change that to ~. */
6311 homedir
= (char *) egetenv ("HOME");
6313 /* homedir can be NULL in temacs, since Vglobal_environment is not
6314 yet set up. We shouldn't crash in that case. */
6317 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6318 CORRECT_DIR_SEPS (homedir
);
6323 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6326 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6327 SBYTES (decoded_homedir
))
6328 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6330 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6331 dir
= concat2 (build_string ("~"), dir
);
6333 /* Likewise for default_filename. */
6335 && STRINGP (default_filename
)
6336 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6337 SBYTES (decoded_homedir
))
6338 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6341 = Fsubstring (default_filename
,
6342 make_number (SCHARS (decoded_homedir
)), Qnil
);
6343 default_filename
= concat2 (build_string ("~"), default_filename
);
6345 if (!NILP (default_filename
))
6347 CHECK_STRING (default_filename
);
6348 default_filename
= double_dollars (default_filename
);
6351 if (insert_default_directory
&& STRINGP (dir
))
6354 if (!NILP (initial
))
6356 Lisp_Object args
[2], pos
;
6360 insdef
= Fconcat (2, args
);
6361 pos
= make_number (SCHARS (double_dollars (dir
)));
6362 insdef
= Fcons (double_dollars (insdef
), pos
);
6365 insdef
= double_dollars (insdef
);
6367 else if (STRINGP (initial
))
6368 insdef
= Fcons (double_dollars (initial
), make_number (0));
6372 if (!NILP (Vread_file_name_function
))
6374 Lisp_Object args
[7];
6376 GCPRO2 (insdef
, default_filename
);
6377 args
[0] = Vread_file_name_function
;
6380 args
[3] = default_filename
;
6381 args
[4] = mustmatch
;
6383 args
[6] = predicate
;
6384 RETURN_UNGCPRO (Ffuncall (7, args
));
6387 count
= SPECPDL_INDEX ();
6388 specbind (Qcompletion_ignore_case
,
6389 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6390 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6391 specbind (intern ("read-file-name-predicate"),
6392 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6394 GCPRO2 (insdef
, default_filename
);
6396 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6397 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6399 /* If DIR contains a file name, split it. */
6401 file
= Ffile_name_nondirectory (dir
);
6402 if (SCHARS (file
) && NILP (default_filename
))
6404 default_filename
= file
;
6405 dir
= Ffile_name_directory (dir
);
6407 if (!NILP(default_filename
))
6408 default_filename
= Fexpand_file_name (default_filename
, dir
);
6409 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6410 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6415 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6416 dir
, mustmatch
, insdef
,
6417 Qfile_name_history
, default_filename
, Qnil
);
6419 tem
= Fsymbol_value (Qfile_name_history
);
6420 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6421 replace_in_history
= 1;
6423 /* If Fcompleting_read returned the inserted default string itself
6424 (rather than a new string with the same contents),
6425 it has to mean that the user typed RET with the minibuffer empty.
6426 In that case, we really want to return ""
6427 so that commands such as set-visited-file-name can distinguish. */
6428 if (EQ (val
, default_filename
))
6430 /* In this case, Fcompleting_read has not added an element
6431 to the history. Maybe we should. */
6432 if (! replace_in_history
)
6435 val
= empty_unibyte_string
;
6438 unbind_to (count
, Qnil
);
6441 error ("No file name specified");
6443 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6445 if (!NILP (tem
) && !NILP (default_filename
))
6446 val
= default_filename
;
6447 val
= Fsubstitute_in_file_name (val
);
6449 if (replace_in_history
)
6450 /* Replace what Fcompleting_read added to the history
6451 with what we will actually return. */
6453 Lisp_Object val1
= double_dollars (val
);
6454 tem
= Fsymbol_value (Qfile_name_history
);
6455 if (history_delete_duplicates
)
6456 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6457 XSETCAR (tem
, val1
);
6459 else if (add_to_history
)
6461 /* Add the value to the history--but not if it matches
6462 the last value already there. */
6463 Lisp_Object val1
= double_dollars (val
);
6464 tem
= Fsymbol_value (Qfile_name_history
);
6465 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6467 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6468 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6479 /* Must be set before any path manipulation is performed. */
6480 XSETFASTINT (Vdirectory_sep_char
, '/');
6487 Qoperations
= intern ("operations");
6488 Qexpand_file_name
= intern ("expand-file-name");
6489 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6490 Qdirectory_file_name
= intern ("directory-file-name");
6491 Qfile_name_directory
= intern ("file-name-directory");
6492 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6493 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6494 Qfile_name_as_directory
= intern ("file-name-as-directory");
6495 Qcopy_file
= intern ("copy-file");
6496 Qmake_directory_internal
= intern ("make-directory-internal");
6497 Qmake_directory
= intern ("make-directory");
6498 Qdelete_directory
= intern ("delete-directory");
6499 Qdelete_file
= intern ("delete-file");
6500 Qrename_file
= intern ("rename-file");
6501 Qadd_name_to_file
= intern ("add-name-to-file");
6502 Qmake_symbolic_link
= intern ("make-symbolic-link");
6503 Qfile_exists_p
= intern ("file-exists-p");
6504 Qfile_executable_p
= intern ("file-executable-p");
6505 Qfile_readable_p
= intern ("file-readable-p");
6506 Qfile_writable_p
= intern ("file-writable-p");
6507 Qfile_symlink_p
= intern ("file-symlink-p");
6508 Qaccess_file
= intern ("access-file");
6509 Qfile_directory_p
= intern ("file-directory-p");
6510 Qfile_regular_p
= intern ("file-regular-p");
6511 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6512 Qfile_modes
= intern ("file-modes");
6513 Qset_file_modes
= intern ("set-file-modes");
6514 Qset_file_times
= intern ("set-file-times");
6515 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6516 Qinsert_file_contents
= intern ("insert-file-contents");
6517 Qwrite_region
= intern ("write-region");
6518 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6519 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6520 Qauto_save_coding
= intern ("auto-save-coding");
6522 staticpro (&Qoperations
);
6523 staticpro (&Qexpand_file_name
);
6524 staticpro (&Qsubstitute_in_file_name
);
6525 staticpro (&Qdirectory_file_name
);
6526 staticpro (&Qfile_name_directory
);
6527 staticpro (&Qfile_name_nondirectory
);
6528 staticpro (&Qunhandled_file_name_directory
);
6529 staticpro (&Qfile_name_as_directory
);
6530 staticpro (&Qcopy_file
);
6531 staticpro (&Qmake_directory_internal
);
6532 staticpro (&Qmake_directory
);
6533 staticpro (&Qdelete_directory
);
6534 staticpro (&Qdelete_file
);
6535 staticpro (&Qrename_file
);
6536 staticpro (&Qadd_name_to_file
);
6537 staticpro (&Qmake_symbolic_link
);
6538 staticpro (&Qfile_exists_p
);
6539 staticpro (&Qfile_executable_p
);
6540 staticpro (&Qfile_readable_p
);
6541 staticpro (&Qfile_writable_p
);
6542 staticpro (&Qaccess_file
);
6543 staticpro (&Qfile_symlink_p
);
6544 staticpro (&Qfile_directory_p
);
6545 staticpro (&Qfile_regular_p
);
6546 staticpro (&Qfile_accessible_directory_p
);
6547 staticpro (&Qfile_modes
);
6548 staticpro (&Qset_file_modes
);
6549 staticpro (&Qset_file_times
);
6550 staticpro (&Qfile_newer_than_file_p
);
6551 staticpro (&Qinsert_file_contents
);
6552 staticpro (&Qwrite_region
);
6553 staticpro (&Qverify_visited_file_modtime
);
6554 staticpro (&Qset_visited_file_modtime
);
6555 staticpro (&Qauto_save_coding
);
6557 Qfile_name_history
= intern ("file-name-history");
6558 Fset (Qfile_name_history
, Qnil
);
6559 staticpro (&Qfile_name_history
);
6561 Qfile_error
= intern ("file-error");
6562 staticpro (&Qfile_error
);
6563 Qfile_already_exists
= intern ("file-already-exists");
6564 staticpro (&Qfile_already_exists
);
6565 Qfile_date_error
= intern ("file-date-error");
6566 staticpro (&Qfile_date_error
);
6567 Qexcl
= intern ("excl");
6571 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6572 staticpro (&Qfind_buffer_file_type
);
6575 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6576 doc
: /* *Coding system for encoding file names.
6577 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6578 Vfile_name_coding_system
= Qnil
;
6580 DEFVAR_LISP ("default-file-name-coding-system",
6581 &Vdefault_file_name_coding_system
,
6582 doc
: /* Default coding system for encoding file names.
6583 This variable is used only when `file-name-coding-system' is nil.
6585 This variable is set/changed by the command `set-language-environment'.
6586 User should not set this variable manually,
6587 instead use `file-name-coding-system' to get a constant encoding
6588 of file names regardless of the current language environment. */);
6589 Vdefault_file_name_coding_system
= Qnil
;
6591 Qformat_decode
= intern ("format-decode");
6592 staticpro (&Qformat_decode
);
6593 Qformat_annotate_function
= intern ("format-annotate-function");
6594 staticpro (&Qformat_annotate_function
);
6595 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6596 staticpro (&Qafter_insert_file_set_coding
);
6598 Qcar_less_than_car
= intern ("car-less-than-car");
6599 staticpro (&Qcar_less_than_car
);
6601 Fput (Qfile_error
, Qerror_conditions
,
6602 list2 (Qfile_error
, Qerror
));
6603 Fput (Qfile_error
, Qerror_message
,
6604 build_string ("File error"));
6606 Fput (Qfile_already_exists
, Qerror_conditions
,
6607 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6608 Fput (Qfile_already_exists
, Qerror_message
,
6609 build_string ("File already exists"));
6611 Fput (Qfile_date_error
, Qerror_conditions
,
6612 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6613 Fput (Qfile_date_error
, Qerror_message
,
6614 build_string ("Cannot set file date"));
6616 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6617 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6618 Vread_file_name_function
= Qnil
;
6620 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6621 doc
: /* Current predicate used by `read-file-name-internal'. */);
6622 Vread_file_name_predicate
= Qnil
;
6624 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6625 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6626 #if defined VMS || defined DOS_NT || defined MAC_OS
6627 read_file_name_completion_ignore_case
= 1;
6629 read_file_name_completion_ignore_case
= 0;
6632 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6633 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6634 If the initial minibuffer contents are non-empty, you can usually
6635 request a default filename by typing RETURN without editing. For some
6636 commands, exiting with an empty minibuffer has a special meaning,
6637 such as making the current buffer visit no file in the case of
6638 `set-visited-file-name'.
6639 If this variable is non-nil, the minibuffer contents are always
6640 initially non-empty and typing RETURN without editing will fetch the
6641 default name, if one is provided. Note however that this default name
6642 is not necessarily the name originally inserted in the minibuffer, if
6643 that is just the default directory.
6644 If this variable is nil, the minibuffer often starts out empty. In
6645 that case you may have to explicitly fetch the next history element to
6646 request the default name. */);
6647 insert_default_directory
= 1;
6649 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6650 doc
: /* *Non-nil means write new files with record format `stmlf'.
6651 nil means use format `var'. This variable is meaningful only on VMS. */);
6652 vms_stmlf_recfm
= 0;
6654 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6655 doc
: /* Directory separator character for built-in functions that return file names.
6656 The value is always ?/. Don't use this variable, just use `/'. */);
6658 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6659 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6660 If a file name matches REGEXP, then all I/O on that file is done by calling
6663 The first argument given to HANDLER is the name of the I/O primitive
6664 to be handled; the remaining arguments are the arguments that were
6665 passed to that primitive. For example, if you do
6666 (file-exists-p FILENAME)
6667 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6668 (funcall HANDLER 'file-exists-p FILENAME)
6669 The function `find-file-name-handler' checks this list for a handler
6670 for its argument. */);
6671 Vfile_name_handler_alist
= Qnil
;
6673 DEFVAR_LISP ("set-auto-coding-function",
6674 &Vset_auto_coding_function
,
6675 doc
: /* If non-nil, a function to call to decide a coding system of file.
6676 Two arguments are passed to this function: the file name
6677 and the length of a file contents following the point.
6678 This function should return a coding system to decode the file contents.
6679 It should check the file name against `auto-coding-alist'.
6680 If no coding system is decided, it should check a coding system
6681 specified in the heading lines with the format:
6682 -*- ... coding: CODING-SYSTEM; ... -*-
6683 or local variable spec of the tailing lines with `coding:' tag. */);
6684 Vset_auto_coding_function
= Qnil
;
6686 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6687 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6688 Each is passed one argument, the number of characters inserted,
6689 with point at the start of the inserted text. Each function
6690 should leave point the same, and return the new character count.
6691 If `insert-file-contents' is intercepted by a handler from
6692 `file-name-handler-alist', that handler is responsible for calling the
6693 functions in `after-insert-file-functions' if appropriate. */);
6694 Vafter_insert_file_functions
= Qnil
;
6696 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6697 doc
: /* A list of functions to be called at the start of `write-region'.
6698 Each is passed two arguments, START and END as for `write-region'.
6699 These are usually two numbers but not always; see the documentation
6700 for `write-region'. The function should return a list of pairs
6701 of the form (POSITION . STRING), consisting of strings to be effectively
6702 inserted at the specified positions of the file being written (1 means to
6703 insert before the first byte written). The POSITIONs must be sorted into
6704 increasing order. If there are several functions in the list, the several
6705 lists are merged destructively. Alternatively, the function can return
6706 with a different buffer current; in that case it should pay attention
6707 to the annotations returned by previous functions and listed in
6708 `write-region-annotations-so-far'.*/);
6709 Vwrite_region_annotate_functions
= Qnil
;
6710 staticpro (&Qwrite_region_annotate_functions
);
6711 Qwrite_region_annotate_functions
6712 = intern ("write-region-annotate-functions");
6714 DEFVAR_LISP ("write-region-annotations-so-far",
6715 &Vwrite_region_annotations_so_far
,
6716 doc
: /* When an annotation function is called, this holds the previous annotations.
6717 These are the annotations made by other annotation functions
6718 that were already called. See also `write-region-annotate-functions'. */);
6719 Vwrite_region_annotations_so_far
= Qnil
;
6721 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6722 doc
: /* A list of file name handlers that temporarily should not be used.
6723 This applies only to the operation `inhibit-file-name-operation'. */);
6724 Vinhibit_file_name_handlers
= Qnil
;
6726 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6727 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6728 Vinhibit_file_name_operation
= Qnil
;
6730 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6731 doc
: /* File name in which we write a list of all auto save file names.
6732 This variable is initialized automatically from `auto-save-list-file-prefix'
6733 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6734 a non-nil value. */);
6735 Vauto_save_list_file_name
= Qnil
;
6738 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6739 doc
: /* *Non-nil means don't call fsync in `write-region'.
6740 This variable affects calls to `write-region' as well as save commands.
6741 A non-nil value may result in data loss! */);
6742 write_region_inhibit_fsync
= 0;
6745 defsubr (&Sfind_file_name_handler
);
6746 defsubr (&Sfile_name_directory
);
6747 defsubr (&Sfile_name_nondirectory
);
6748 defsubr (&Sunhandled_file_name_directory
);
6749 defsubr (&Sfile_name_as_directory
);
6750 defsubr (&Sdirectory_file_name
);
6751 defsubr (&Smake_temp_name
);
6752 defsubr (&Sexpand_file_name
);
6753 defsubr (&Ssubstitute_in_file_name
);
6754 defsubr (&Scopy_file
);
6755 defsubr (&Smake_directory_internal
);
6756 defsubr (&Sdelete_directory
);
6757 defsubr (&Sdelete_file
);
6758 defsubr (&Srename_file
);
6759 defsubr (&Sadd_name_to_file
);
6761 defsubr (&Smake_symbolic_link
);
6762 #endif /* S_IFLNK */
6764 defsubr (&Sdefine_logical_name
);
6767 defsubr (&Ssysnetunam
);
6768 #endif /* HPUX_NET */
6769 defsubr (&Sfile_name_absolute_p
);
6770 defsubr (&Sfile_exists_p
);
6771 defsubr (&Sfile_executable_p
);
6772 defsubr (&Sfile_readable_p
);
6773 defsubr (&Sfile_writable_p
);
6774 defsubr (&Saccess_file
);
6775 defsubr (&Sfile_symlink_p
);
6776 defsubr (&Sfile_directory_p
);
6777 defsubr (&Sfile_accessible_directory_p
);
6778 defsubr (&Sfile_regular_p
);
6779 defsubr (&Sfile_modes
);
6780 defsubr (&Sset_file_modes
);
6781 defsubr (&Sset_file_times
);
6782 defsubr (&Sset_default_file_modes
);
6783 defsubr (&Sdefault_file_modes
);
6784 defsubr (&Sfile_newer_than_file_p
);
6785 defsubr (&Sinsert_file_contents
);
6786 defsubr (&Swrite_region
);
6787 defsubr (&Scar_less_than_car
);
6788 defsubr (&Sverify_visited_file_modtime
);
6789 defsubr (&Sclear_visited_file_modtime
);
6790 defsubr (&Svisited_file_modtime
);
6791 defsubr (&Sset_visited_file_modtime
);
6792 defsubr (&Sdo_auto_save
);
6793 defsubr (&Sset_buffer_auto_saved
);
6794 defsubr (&Sclear_buffer_auto_save_failure
);
6795 defsubr (&Srecent_auto_save_p
);
6797 defsubr (&Sread_file_name_internal
);
6798 defsubr (&Sread_file_name
);
6799 defsubr (&Snext_read_file_uses_dialog_p
);
6802 defsubr (&Sunix_sync
);
6806 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6807 (do not change this comment) */