1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* The symbol bound to coding-system-for-read when
163 insert-file-contents is called for recovering a file. This is not
164 an actual coding system name, but just an indicator to tell
165 insert-file-contents to use `emacs-mule' with a special flag for
166 auto saving and recovering a file. */
167 Lisp_Object Qauto_save_coding
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Lisp functions for translating file formats */
181 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
183 /* Function to be called to decide a coding system of a reading file. */
184 Lisp_Object Vset_auto_coding_function
;
186 /* Functions to be called to process text properties in inserted file. */
187 Lisp_Object Vafter_insert_file_functions
;
189 /* Lisp function for setting buffer-file-coding-system and the
190 multibyteness of the current buffer after inserting a file. */
191 Lisp_Object Qafter_insert_file_set_coding
;
193 /* Functions to be called to create text property annotations for file. */
194 Lisp_Object Vwrite_region_annotate_functions
;
195 Lisp_Object Qwrite_region_annotate_functions
;
197 /* During build_annotations, each time an annotation function is called,
198 this holds the annotations made by the previous functions. */
199 Lisp_Object Vwrite_region_annotations_so_far
;
201 /* File name in which we write a list of all our auto save files. */
202 Lisp_Object Vauto_save_list_file_name
;
204 /* Function to call to read a file name. */
205 Lisp_Object Vread_file_name_function
;
207 /* Current predicate used by read_file_name_internal. */
208 Lisp_Object Vread_file_name_predicate
;
210 /* Nonzero means completion ignores case when reading file name. */
211 int read_file_name_completion_ignore_case
;
213 /* Nonzero means, when reading a filename in the minibuffer,
214 start out by inserting the default directory into the minibuffer. */
215 int insert_default_directory
;
217 /* On VMS, nonzero means write new files with record format stmlf.
218 Zero means use var format. */
221 /* On NT, specifies the directory separator character, used (eg.) when
222 expanding file names. This can be bound to / or \. */
223 Lisp_Object Vdirectory_sep_char
;
225 extern Lisp_Object Vuser_login_name
;
228 extern Lisp_Object Vw32_get_true_file_attributes
;
231 extern int minibuf_level
;
233 extern int minibuffer_auto_raise
;
235 extern int history_delete_duplicates
;
237 /* These variables describe handlers that have "already" had a chance
238 to handle the current operation.
240 Vinhibit_file_name_handlers is a list of file name handlers.
241 Vinhibit_file_name_operation is the operation being handled.
242 If we try to handle that operation, we ignore those handlers. */
244 static Lisp_Object Vinhibit_file_name_handlers
;
245 static Lisp_Object Vinhibit_file_name_operation
;
247 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
249 Lisp_Object Qfile_name_history
;
251 Lisp_Object Qcar_less_than_car
;
253 static int a_write
P_ ((int, Lisp_Object
, int, int,
254 Lisp_Object
*, struct coding_system
*));
255 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
259 report_file_error (string
, data
)
263 Lisp_Object errstring
;
266 synchronize_system_messages_locale ();
267 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
268 Vlocale_coding_system
, 0);
274 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
277 /* System error messages are capitalized. Downcase the initial
278 unless it is followed by a slash. */
279 if (SREF (errstring
, 1) != '/')
280 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
282 Fsignal (Qfile_error
,
283 Fcons (build_string (string
), Fcons (errstring
, data
)));
288 close_file_unwind (fd
)
291 emacs_close (XFASTINT (fd
));
295 /* Restore point, having saved it as a marker. */
298 restore_point_unwind (location
)
299 Lisp_Object location
;
301 Fgoto_char (location
);
302 Fset_marker (location
, Qnil
, Qnil
);
306 Lisp_Object Qexpand_file_name
;
307 Lisp_Object Qsubstitute_in_file_name
;
308 Lisp_Object Qdirectory_file_name
;
309 Lisp_Object Qfile_name_directory
;
310 Lisp_Object Qfile_name_nondirectory
;
311 Lisp_Object Qunhandled_file_name_directory
;
312 Lisp_Object Qfile_name_as_directory
;
313 Lisp_Object Qcopy_file
;
314 Lisp_Object Qmake_directory_internal
;
315 Lisp_Object Qmake_directory
;
316 Lisp_Object Qdelete_directory
;
317 Lisp_Object Qdelete_file
;
318 Lisp_Object Qrename_file
;
319 Lisp_Object Qadd_name_to_file
;
320 Lisp_Object Qmake_symbolic_link
;
321 Lisp_Object Qfile_exists_p
;
322 Lisp_Object Qfile_executable_p
;
323 Lisp_Object Qfile_readable_p
;
324 Lisp_Object Qfile_writable_p
;
325 Lisp_Object Qfile_symlink_p
;
326 Lisp_Object Qaccess_file
;
327 Lisp_Object Qfile_directory_p
;
328 Lisp_Object Qfile_regular_p
;
329 Lisp_Object Qfile_accessible_directory_p
;
330 Lisp_Object Qfile_modes
;
331 Lisp_Object Qset_file_modes
;
332 Lisp_Object Qset_file_times
;
333 Lisp_Object Qfile_newer_than_file_p
;
334 Lisp_Object Qinsert_file_contents
;
335 Lisp_Object Qwrite_region
;
336 Lisp_Object Qverify_visited_file_modtime
;
337 Lisp_Object Qset_visited_file_modtime
;
339 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
340 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
341 Otherwise, return nil.
342 A file name is handled if one of the regular expressions in
343 `file-name-handler-alist' matches it.
345 If OPERATION equals `inhibit-file-name-operation', then we ignore
346 any handlers that are members of `inhibit-file-name-handlers',
347 but we still do run any other handlers. This lets handlers
348 use the standard functions without calling themselves recursively. */)
349 (filename
, operation
)
350 Lisp_Object filename
, operation
;
352 /* This function must not munge the match data. */
353 Lisp_Object chain
, inhibited_handlers
, result
;
357 CHECK_STRING (filename
);
359 if (EQ (operation
, Vinhibit_file_name_operation
))
360 inhibited_handlers
= Vinhibit_file_name_handlers
;
362 inhibited_handlers
= Qnil
;
364 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
365 chain
= XCDR (chain
))
375 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
377 Lisp_Object handler
, tem
;
379 handler
= XCDR (elt
);
380 tem
= Fmemq (handler
, inhibited_handlers
);
394 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
396 doc
: /* Return the directory component in file name FILENAME.
397 Return nil if FILENAME does not include a directory.
398 Otherwise return a directory spec.
399 Given a Unix syntax file name, returns a string ending in slash;
400 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
402 Lisp_Object filename
;
405 register const unsigned char *beg
;
407 register unsigned char *beg
;
409 register const unsigned char *p
;
412 CHECK_STRING (filename
);
414 /* If the file name has special constructs in it,
415 call the corresponding file handler. */
416 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
418 return call2 (handler
, Qfile_name_directory
, filename
);
420 filename
= FILE_SYSTEM_CASE (filename
);
421 beg
= SDATA (filename
);
423 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
425 p
= beg
+ SBYTES (filename
);
427 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
429 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
432 /* only recognise drive specifier at the beginning */
434 /* handle the "/:d:foo" and "/:foo" cases correctly */
435 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
436 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
443 /* Expansion of "c:" to drive and default directory. */
446 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
447 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
448 unsigned char *r
= res
;
450 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
452 strncpy (res
, beg
, 2);
457 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
459 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
462 p
= beg
+ strlen (beg
);
465 CORRECT_DIR_SEPS (beg
);
468 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
471 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
472 Sfile_name_nondirectory
, 1, 1, 0,
473 doc
: /* Return file name FILENAME sans its directory.
474 For example, in a Unix-syntax file name,
475 this is everything after the last slash,
476 or the entire name if it contains no slash. */)
478 Lisp_Object filename
;
480 register const unsigned char *beg
, *p
, *end
;
483 CHECK_STRING (filename
);
485 /* If the file name has special constructs in it,
486 call the corresponding file handler. */
487 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
489 return call2 (handler
, Qfile_name_nondirectory
, filename
);
491 beg
= SDATA (filename
);
492 end
= p
= beg
+ SBYTES (filename
);
494 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
496 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
499 /* only recognise drive specifier at beginning */
501 /* handle the "/:d:foo" case correctly */
502 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
507 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
510 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
511 Sunhandled_file_name_directory
, 1, 1, 0,
512 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
513 A `directly usable' directory name is one that may be used without the
514 intervention of any file handler.
515 If FILENAME is a directly usable file itself, return
516 \(file-name-directory FILENAME).
517 The `call-process' and `start-process' functions use this function to
518 get a current directory to run processes in. */)
520 Lisp_Object filename
;
524 /* If the file name has special constructs in it,
525 call the corresponding file handler. */
526 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
528 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
530 return Ffile_name_directory (filename
);
535 file_name_as_directory (out
, in
)
538 int size
= strlen (in
) - 1;
551 /* Is it already a directory string? */
552 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
554 /* Is it a VMS directory file name? If so, hack VMS syntax. */
555 else if (! index (in
, '/')
556 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
557 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
558 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
559 || ! strncmp (&in
[size
- 5], ".dir", 4))
560 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
561 && in
[size
] == '1')))
563 register char *p
, *dot
;
567 dir:x.dir --> dir:[x]
568 dir:[x]y.dir --> dir:[x.y] */
570 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
573 strncpy (out
, in
, p
- in
);
592 dot
= index (p
, '.');
595 /* blindly remove any extension */
596 size
= strlen (out
) + (dot
- p
);
597 strncat (out
, p
, dot
- p
);
608 /* For Unix syntax, Append a slash if necessary */
609 if (!IS_DIRECTORY_SEP (out
[size
]))
611 /* Cannot use DIRECTORY_SEP, which could have any value */
613 out
[size
+ 2] = '\0';
616 CORRECT_DIR_SEPS (out
);
622 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
623 Sfile_name_as_directory
, 1, 1, 0,
624 doc
: /* Return a string representing the file name FILE interpreted as a directory.
625 This operation exists because a directory is also a file, but its name as
626 a directory is different from its name as a file.
627 The result can be used as the value of `default-directory'
628 or passed as second argument to `expand-file-name'.
629 For a Unix-syntax file name, just appends a slash.
630 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
641 /* If the file name has special constructs in it,
642 call the corresponding file handler. */
643 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
645 return call2 (handler
, Qfile_name_as_directory
, file
);
647 buf
= (char *) alloca (SBYTES (file
) + 10);
648 file_name_as_directory (buf
, SDATA (file
));
649 return make_specified_string (buf
, -1, strlen (buf
),
650 STRING_MULTIBYTE (file
));
654 * Convert from directory name to filename.
656 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
657 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
658 * On UNIX, it's simple: just make sure there isn't a terminating /
660 * Value is nonzero if the string output is different from the input.
664 directory_file_name (src
, dst
)
672 struct FAB fab
= cc$rms_fab
;
673 struct NAM nam
= cc$rms_nam
;
674 char esa
[NAM$C_MAXRSS
];
679 if (! index (src
, '/')
680 && (src
[slen
- 1] == ']'
681 || src
[slen
- 1] == ':'
682 || src
[slen
- 1] == '>'))
684 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
686 fab
.fab$b_fns
= slen
;
687 fab
.fab$l_nam
= &nam
;
688 fab
.fab$l_fop
= FAB$M_NAM
;
691 nam
.nam$b_ess
= sizeof esa
;
692 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
694 /* We call SYS$PARSE to handle such things as [--] for us. */
695 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
697 slen
= nam
.nam$b_esl
;
698 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
703 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
705 /* what about when we have logical_name:???? */
706 if (src
[slen
- 1] == ':')
707 { /* Xlate logical name and see what we get */
708 ptr
= strcpy (dst
, src
); /* upper case for getenv */
711 if ('a' <= *ptr
&& *ptr
<= 'z')
715 dst
[slen
- 1] = 0; /* remove colon */
716 if (!(src
= egetenv (dst
)))
718 /* should we jump to the beginning of this procedure?
719 Good points: allows us to use logical names that xlate
721 Bad points: can be a problem if we just translated to a device
723 For now, I'll punt and always expect VMS names, and hope for
726 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
727 { /* no recursion here! */
733 { /* not a directory spec */
738 bracket
= src
[slen
- 1];
740 /* If bracket is ']' or '>', bracket - 2 is the corresponding
742 ptr
= index (src
, bracket
- 2);
744 { /* no opening bracket */
748 if (!(rptr
= rindex (src
, '.')))
751 strncpy (dst
, src
, slen
);
755 dst
[slen
++] = bracket
;
760 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
761 then translate the device and recurse. */
762 if (dst
[slen
- 1] == ':'
763 && dst
[slen
- 2] != ':' /* skip decnet nodes */
764 && strcmp (src
+ slen
, "[000000]") == 0)
766 dst
[slen
- 1] = '\0';
767 if ((ptr
= egetenv (dst
))
768 && (rlen
= strlen (ptr
) - 1) > 0
769 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
770 && ptr
[rlen
- 1] == '.')
772 char * buf
= (char *) alloca (strlen (ptr
) + 1);
776 return directory_file_name (buf
, dst
);
781 strcat (dst
, "[000000]");
785 rlen
= strlen (rptr
) - 1;
786 strncat (dst
, rptr
, rlen
);
787 dst
[slen
+ rlen
] = '\0';
788 strcat (dst
, ".DIR.1");
792 /* Process as Unix format: just remove any final slash.
793 But leave "/" unchanged; do not change it to "". */
796 /* Handle // as root for apollo's. */
797 if ((slen
> 2 && dst
[slen
- 1] == '/')
798 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
802 && IS_DIRECTORY_SEP (dst
[slen
- 1])
804 && !IS_ANY_SEP (dst
[slen
- 2])
810 CORRECT_DIR_SEPS (dst
);
815 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
817 doc
: /* Returns the file name of the directory named DIRECTORY.
818 This is the name of the file that holds the data for the directory DIRECTORY.
819 This operation exists because a directory is also a file, but its name as
820 a directory is different from its name as a file.
821 In Unix-syntax, this function just removes the final slash.
822 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
823 it returns a file name such as \"[X]Y.DIR.1\". */)
825 Lisp_Object directory
;
830 CHECK_STRING (directory
);
832 if (NILP (directory
))
835 /* If the file name has special constructs in it,
836 call the corresponding file handler. */
837 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
839 return call2 (handler
, Qdirectory_file_name
, directory
);
842 /* 20 extra chars is insufficient for VMS, since we might perform a
843 logical name translation. an equivalence string can be up to 255
844 chars long, so grab that much extra space... - sss */
845 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
847 buf
= (char *) alloca (SBYTES (directory
) + 20);
849 directory_file_name (SDATA (directory
), buf
);
850 return make_specified_string (buf
, -1, strlen (buf
),
851 STRING_MULTIBYTE (directory
));
854 static char make_temp_name_tbl
[64] =
856 'A','B','C','D','E','F','G','H',
857 'I','J','K','L','M','N','O','P',
858 'Q','R','S','T','U','V','W','X',
859 'Y','Z','a','b','c','d','e','f',
860 'g','h','i','j','k','l','m','n',
861 'o','p','q','r','s','t','u','v',
862 'w','x','y','z','0','1','2','3',
863 '4','5','6','7','8','9','-','_'
866 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
868 /* Value is a temporary file name starting with PREFIX, a string.
870 The Emacs process number forms part of the result, so there is
871 no danger of generating a name being used by another process.
872 In addition, this function makes an attempt to choose a name
873 which has no existing file. To make this work, PREFIX should be
874 an absolute file name.
876 BASE64_P non-zero means add the pid as 3 characters in base64
877 encoding. In this case, 6 characters will be added to PREFIX to
878 form the file name. Otherwise, if Emacs is running on a system
879 with long file names, add the pid as a decimal number.
881 This function signals an error if no unique file name could be
885 make_temp_name (prefix
, base64_p
)
892 unsigned char *p
, *data
;
896 CHECK_STRING (prefix
);
898 /* VAL is created by adding 6 characters to PREFIX. The first
899 three are the PID of this process, in base 64, and the second
900 three are incremented if the file already exists. This ensures
901 262144 unique file names per PID per PREFIX. */
903 pid
= (int) getpid ();
907 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
908 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
909 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
914 #ifdef HAVE_LONG_FILE_NAMES
915 sprintf (pidbuf
, "%d", pid
);
916 pidlen
= strlen (pidbuf
);
918 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
919 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
920 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
925 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
926 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
927 if (!STRING_MULTIBYTE (prefix
))
928 STRING_SET_UNIBYTE (val
);
930 bcopy(SDATA (prefix
), data
, len
);
933 bcopy (pidbuf
, p
, pidlen
);
936 /* Here we try to minimize useless stat'ing when this function is
937 invoked many times successively with the same PREFIX. We achieve
938 this by initializing count to a random value, and incrementing it
941 We don't want make-temp-name to be called while dumping,
942 because then make_temp_name_count_initialized_p would get set
943 and then make_temp_name_count would not be set when Emacs starts. */
945 if (!make_temp_name_count_initialized_p
)
947 make_temp_name_count
= (unsigned) time (NULL
);
948 make_temp_name_count_initialized_p
= 1;
954 unsigned num
= make_temp_name_count
;
956 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
957 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
960 /* Poor man's congruential RN generator. Replace with
961 ++make_temp_name_count for debugging. */
962 make_temp_name_count
+= 25229;
963 make_temp_name_count
%= 225307;
965 if (stat (data
, &ignored
) < 0)
967 /* We want to return only if errno is ENOENT. */
971 /* The error here is dubious, but there is little else we
972 can do. The alternatives are to return nil, which is
973 as bad as (and in many cases worse than) throwing the
974 error, or to ignore the error, which will likely result
975 in looping through 225307 stat's, which is not only
976 dog-slow, but also useless since it will fallback to
977 the errow below, anyway. */
978 report_file_error ("Cannot create temporary name for prefix",
979 Fcons (prefix
, Qnil
));
984 error ("Cannot create temporary name for prefix `%s'",
990 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
991 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
992 The Emacs process number forms part of the result,
993 so there is no danger of generating a name being used by another process.
995 In addition, this function makes an attempt to choose a name
996 which has no existing file. To make this work,
997 PREFIX should be an absolute file name.
999 There is a race condition between calling `make-temp-name' and creating the
1000 file which opens all kinds of security holes. For that reason, you should
1001 probably use `make-temp-file' instead, except in three circumstances:
1003 * If you are creating the file in the user's home directory.
1004 * If you are creating a directory rather than an ordinary file.
1005 * If you are taking special precautions as `make-temp-file' does. */)
1009 return make_temp_name (prefix
, 0);
1014 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1015 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1016 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1017 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1018 the current buffer's value of default-directory is used.
1019 File name components that are `.' are removed, and
1020 so are file name components followed by `..', along with the `..' itself;
1021 note that these simplifications are done without checking the resulting
1022 file names in the file system.
1023 An initial `~/' expands to your home directory.
1024 An initial `~USER/' expands to USER's home directory.
1025 See also the function `substitute-in-file-name'. */)
1026 (name
, default_directory
)
1027 Lisp_Object name
, default_directory
;
1031 register unsigned char *newdir
, *p
, *o
;
1033 unsigned char *target
;
1036 unsigned char * colon
= 0;
1037 unsigned char * close
= 0;
1038 unsigned char * slash
= 0;
1039 unsigned char * brack
= 0;
1040 int lbrack
= 0, rbrack
= 0;
1045 int collapse_newdir
= 1;
1049 Lisp_Object handler
, result
;
1051 CHECK_STRING (name
);
1053 /* If the file name has special constructs in it,
1054 call the corresponding file handler. */
1055 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1056 if (!NILP (handler
))
1057 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1059 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1060 if (NILP (default_directory
))
1061 default_directory
= current_buffer
->directory
;
1062 if (! STRINGP (default_directory
))
1065 /* "/" is not considered a root directory on DOS_NT, so using "/"
1066 here causes an infinite recursion in, e.g., the following:
1068 (let (default-directory)
1069 (expand-file-name "a"))
1071 To avoid this, we set default_directory to the root of the
1073 extern char *emacs_root_dir (void);
1075 default_directory
= build_string (emacs_root_dir ());
1077 default_directory
= build_string ("/");
1081 if (!NILP (default_directory
))
1083 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1084 if (!NILP (handler
))
1085 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1088 o
= SDATA (default_directory
);
1090 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1091 It would be better to do this down below where we actually use
1092 default_directory. Unfortunately, calling Fexpand_file_name recursively
1093 could invoke GC, and the strings might be relocated. This would
1094 be annoying because we have pointers into strings lying around
1095 that would need adjusting, and people would add new pointers to
1096 the code and forget to adjust them, resulting in intermittent bugs.
1097 Putting this call here avoids all that crud.
1099 The EQ test avoids infinite recursion. */
1100 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1101 /* Save time in some common cases - as long as default_directory
1102 is not relative, it can be canonicalized with name below (if it
1103 is needed at all) without requiring it to be expanded now. */
1105 /* Detect MSDOS file names with drive specifiers. */
1106 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1108 /* Detect Windows file names in UNC format. */
1109 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1111 #else /* not DOS_NT */
1112 /* Detect Unix absolute file names (/... alone is not absolute on
1114 && ! (IS_DIRECTORY_SEP (o
[0]))
1115 #endif /* not DOS_NT */
1118 struct gcpro gcpro1
;
1121 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1125 name
= FILE_SYSTEM_CASE (name
);
1129 /* We will force directory separators to be either all \ or /, so make
1130 a local copy to modify, even if there ends up being no change. */
1131 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1133 /* Note if special escape prefix is present, but remove for now. */
1134 if (nm
[0] == '/' && nm
[1] == ':')
1140 /* Find and remove drive specifier if present; this makes nm absolute
1141 even if the rest of the name appears to be relative. Only look for
1142 drive specifier at the beginning. */
1143 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1150 /* If we see "c://somedir", we want to strip the first slash after the
1151 colon when stripping the drive letter. Otherwise, this expands to
1153 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1155 #endif /* WINDOWSNT */
1159 /* Discard any previous drive specifier if nm is now in UNC format. */
1160 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1166 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1167 none are found, we can probably return right away. We will avoid
1168 allocating a new string if name is already fully expanded. */
1170 IS_DIRECTORY_SEP (nm
[0])
1172 && drive
&& !is_escaped
1175 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1182 /* If it turns out that the filename we want to return is just a
1183 suffix of FILENAME, we don't need to go through and edit
1184 things; we just need to construct a new string using data
1185 starting at the middle of FILENAME. If we set lose to a
1186 non-zero value, that means we've discovered that we can't do
1193 /* Since we know the name is absolute, we can assume that each
1194 element starts with a "/". */
1196 /* "." and ".." are hairy. */
1197 if (IS_DIRECTORY_SEP (p
[0])
1199 && (IS_DIRECTORY_SEP (p
[2])
1201 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1204 /* We want to replace multiple `/' in a row with a single
1207 && IS_DIRECTORY_SEP (p
[0])
1208 && IS_DIRECTORY_SEP (p
[1]))
1215 /* if dev:[dir]/, move nm to / */
1216 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1217 nm
= (brack
? brack
+ 1 : colon
+ 1);
1218 lbrack
= rbrack
= 0;
1225 #ifdef NO_HYPHENS_IN_FILENAMES
1226 if (lbrack
== rbrack
)
1228 /* Avoid clobbering negative version numbers. */
1233 #endif /* NO_HYPHENS_IN_FILENAMES */
1234 if (lbrack
> rbrack
&&
1235 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1236 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1238 #ifdef NO_HYPHENS_IN_FILENAMES
1241 #endif /* NO_HYPHENS_IN_FILENAMES */
1242 /* count open brackets, reset close bracket pointer */
1243 if (p
[0] == '[' || p
[0] == '<')
1244 lbrack
++, brack
= 0;
1245 /* count close brackets, set close bracket pointer */
1246 if (p
[0] == ']' || p
[0] == '>')
1247 rbrack
++, brack
= p
;
1248 /* detect ][ or >< */
1249 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1251 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1252 nm
= p
+ 1, lose
= 1;
1253 if (p
[0] == ':' && (colon
|| slash
))
1254 /* if dev1:[dir]dev2:, move nm to dev2: */
1260 /* if /name/dev:, move nm to dev: */
1263 /* if node::dev:, move colon following dev */
1264 else if (colon
&& colon
[-1] == ':')
1266 /* if dev1:dev2:, move nm to dev2: */
1267 else if (colon
&& colon
[-1] != ':')
1272 if (p
[0] == ':' && !colon
)
1278 if (lbrack
== rbrack
)
1281 else if (p
[0] == '.')
1289 if (index (nm
, '/'))
1291 nm
= sys_translate_unix (nm
);
1292 return make_specified_string (nm
, -1, strlen (nm
),
1293 STRING_MULTIBYTE (name
));
1297 /* Make sure directories are all separated with / or \ as
1298 desired, but avoid allocation of a new string when not
1300 CORRECT_DIR_SEPS (nm
);
1302 if (IS_DIRECTORY_SEP (nm
[1]))
1304 if (strcmp (nm
, SDATA (name
)) != 0)
1305 name
= make_specified_string (nm
, -1, strlen (nm
),
1306 STRING_MULTIBYTE (name
));
1310 /* drive must be set, so this is okay */
1311 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1315 name
= make_specified_string (nm
, -1, p
- nm
,
1316 STRING_MULTIBYTE (name
));
1317 temp
[0] = DRIVE_LETTER (drive
);
1318 name
= concat2 (build_string (temp
), name
);
1321 #else /* not DOS_NT */
1322 if (nm
== SDATA (name
))
1324 return make_specified_string (nm
, -1, strlen (nm
),
1325 STRING_MULTIBYTE (name
));
1326 #endif /* not DOS_NT */
1330 /* At this point, nm might or might not be an absolute file name. We
1331 need to expand ~ or ~user if present, otherwise prefix nm with
1332 default_directory if nm is not absolute, and finally collapse /./
1333 and /foo/../ sequences.
1335 We set newdir to be the appropriate prefix if one is needed:
1336 - the relevant user directory if nm starts with ~ or ~user
1337 - the specified drive's working dir (DOS/NT only) if nm does not
1339 - the value of default_directory.
1341 Note that these prefixes are not guaranteed to be absolute (except
1342 for the working dir of a drive). Therefore, to ensure we always
1343 return an absolute name, if the final prefix is not absolute we
1344 append it to the current working directory. */
1348 if (nm
[0] == '~') /* prefix ~ */
1350 if (IS_DIRECTORY_SEP (nm
[1])
1354 || nm
[1] == 0) /* ~ by itself */
1356 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1357 newdir
= (unsigned char *) "";
1360 collapse_newdir
= 0;
1363 nm
++; /* Don't leave the slash in nm. */
1366 else /* ~user/filename */
1368 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1373 o
= (unsigned char *) alloca (p
- nm
+ 1);
1374 bcopy ((char *) nm
, o
, p
- nm
);
1377 pw
= (struct passwd
*) getpwnam (o
+ 1);
1380 newdir
= (unsigned char *) pw
-> pw_dir
;
1382 nm
= p
+ 1; /* skip the terminator */
1386 collapse_newdir
= 0;
1391 /* If we don't find a user of that name, leave the name
1392 unchanged; don't move nm forward to p. */
1397 /* On DOS and Windows, nm is absolute if a drive name was specified;
1398 use the drive's current directory as the prefix if needed. */
1399 if (!newdir
&& drive
)
1401 /* Get default directory if needed to make nm absolute. */
1402 if (!IS_DIRECTORY_SEP (nm
[0]))
1404 newdir
= alloca (MAXPATHLEN
+ 1);
1405 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1410 /* Either nm starts with /, or drive isn't mounted. */
1411 newdir
= alloca (4);
1412 newdir
[0] = DRIVE_LETTER (drive
);
1420 /* Finally, if no prefix has been specified and nm is not absolute,
1421 then it must be expanded relative to default_directory. */
1425 /* /... alone is not absolute on DOS and Windows. */
1426 && !IS_DIRECTORY_SEP (nm
[0])
1429 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1436 newdir
= SDATA (default_directory
);
1438 /* Note if special escape prefix is present, but remove for now. */
1439 if (newdir
[0] == '/' && newdir
[1] == ':')
1450 /* First ensure newdir is an absolute name. */
1452 /* Detect MSDOS file names with drive specifiers. */
1453 ! (IS_DRIVE (newdir
[0])
1454 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1456 /* Detect Windows file names in UNC format. */
1457 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1461 /* Effectively, let newdir be (expand-file-name newdir cwd).
1462 Because of the admonition against calling expand-file-name
1463 when we have pointers into lisp strings, we accomplish this
1464 indirectly by prepending newdir to nm if necessary, and using
1465 cwd (or the wd of newdir's drive) as the new newdir. */
1467 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1472 if (!IS_DIRECTORY_SEP (nm
[0]))
1474 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1475 file_name_as_directory (tmp
, newdir
);
1479 newdir
= alloca (MAXPATHLEN
+ 1);
1482 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1489 /* Strip off drive name from prefix, if present. */
1490 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1496 /* Keep only a prefix from newdir if nm starts with slash
1497 (//server/share for UNC, nothing otherwise). */
1498 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1501 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1503 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1505 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1507 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1519 /* Get rid of any slash at the end of newdir, unless newdir is
1520 just / or // (an incomplete UNC name). */
1521 length
= strlen (newdir
);
1522 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1524 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1528 unsigned char *temp
= (unsigned char *) alloca (length
);
1529 bcopy (newdir
, temp
, length
- 1);
1530 temp
[length
- 1] = 0;
1538 /* Now concatenate the directory and name to new space in the stack frame */
1539 tlen
+= strlen (nm
) + 1;
1541 /* Reserve space for drive specifier and escape prefix, since either
1542 or both may need to be inserted. (The Microsoft x86 compiler
1543 produces incorrect code if the following two lines are combined.) */
1544 target
= (unsigned char *) alloca (tlen
+ 4);
1546 #else /* not DOS_NT */
1547 target
= (unsigned char *) alloca (tlen
);
1548 #endif /* not DOS_NT */
1554 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1557 /* If newdir is effectively "C:/", then the drive letter will have
1558 been stripped and newdir will be "/". Concatenating with an
1559 absolute directory in nm produces "//", which will then be
1560 incorrectly treated as a network share. Ignore newdir in
1561 this case (keeping the drive letter). */
1562 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1563 && newdir
[1] == '\0'))
1565 strcpy (target
, newdir
);
1569 file_name_as_directory (target
, newdir
);
1572 strcat (target
, nm
);
1574 if (index (target
, '/'))
1575 strcpy (target
, sys_translate_unix (target
));
1578 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1580 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1589 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1595 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1596 /* brackets are offset from each other by 2 */
1599 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1600 /* convert [foo][bar] to [bar] */
1601 while (o
[-1] != '[' && o
[-1] != '<')
1603 else if (*p
== '-' && *o
!= '.')
1606 else if (p
[0] == '-' && o
[-1] == '.' &&
1607 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1608 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1612 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1613 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1615 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1617 /* else [foo.-] ==> [-] */
1621 #ifdef NO_HYPHENS_IN_FILENAMES
1623 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1624 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1626 #endif /* NO_HYPHENS_IN_FILENAMES */
1630 if (!IS_DIRECTORY_SEP (*p
))
1634 else if (IS_DIRECTORY_SEP (p
[0])
1636 && (IS_DIRECTORY_SEP (p
[2])
1639 /* If "/." is the entire filename, keep the "/". Otherwise,
1640 just delete the whole "/.". */
1641 if (o
== target
&& p
[2] == '\0')
1645 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1646 /* `/../' is the "superroot" on certain file systems. */
1648 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1650 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1652 /* Keep initial / only if this is the whole name. */
1653 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1658 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1660 /* Collapse multiple `/' in a row. */
1662 while (IS_DIRECTORY_SEP (*p
))
1669 #endif /* not VMS */
1673 /* At last, set drive name. */
1675 /* Except for network file name. */
1676 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1677 #endif /* WINDOWSNT */
1679 if (!drive
) abort ();
1681 target
[0] = DRIVE_LETTER (drive
);
1684 /* Reinsert the escape prefix if required. */
1691 CORRECT_DIR_SEPS (target
);
1694 result
= make_specified_string (target
, -1, o
- target
,
1695 STRING_MULTIBYTE (name
));
1697 /* Again look to see if the file name has special constructs in it
1698 and perhaps call the corresponding file handler. This is needed
1699 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1700 the ".." component gives us "/user@host:/bar/../baz" which needs
1701 to be expanded again. */
1702 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1703 if (!NILP (handler
))
1704 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1710 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1711 This is the old version of expand-file-name, before it was thoroughly
1712 rewritten for Emacs 10.31. We leave this version here commented-out,
1713 because the code is very complex and likely to have subtle bugs. If
1714 bugs _are_ found, it might be of interest to look at the old code and
1715 see what did it do in the relevant situation.
1717 Don't remove this code: it's true that it will be accessible via CVS,
1718 but a few years from deletion, people will forget it is there. */
1720 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1721 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1722 "Convert FILENAME to absolute, and canonicalize it.\n\
1723 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1724 \(does not start with slash); if DEFAULT is nil or missing,\n\
1725 the current buffer's value of default-directory is used.\n\
1726 Filenames containing `.' or `..' as components are simplified;\n\
1727 initial `~/' expands to your home directory.\n\
1728 See also the function `substitute-in-file-name'.")
1730 Lisp_Object name
, defalt
;
1734 register unsigned char *newdir
, *p
, *o
;
1736 unsigned char *target
;
1740 unsigned char * colon
= 0;
1741 unsigned char * close
= 0;
1742 unsigned char * slash
= 0;
1743 unsigned char * brack
= 0;
1744 int lbrack
= 0, rbrack
= 0;
1748 CHECK_STRING (name
);
1751 /* Filenames on VMS are always upper case. */
1752 name
= Fupcase (name
);
1757 /* If nm is absolute, flush ...// and detect /./ and /../.
1758 If no /./ or /../ we can return right away. */
1770 if (p
[0] == '/' && p
[1] == '/'
1772 /* // at start of filename is meaningful on Apollo system. */
1777 if (p
[0] == '/' && p
[1] == '~')
1778 nm
= p
+ 1, lose
= 1;
1779 if (p
[0] == '/' && p
[1] == '.'
1780 && (p
[2] == '/' || p
[2] == 0
1781 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1787 /* if dev:[dir]/, move nm to / */
1788 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1789 nm
= (brack
? brack
+ 1 : colon
+ 1);
1790 lbrack
= rbrack
= 0;
1798 /* VMS pre V4.4,convert '-'s in filenames. */
1799 if (lbrack
== rbrack
)
1801 if (dots
< 2) /* this is to allow negative version numbers */
1806 if (lbrack
> rbrack
&&
1807 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1808 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1814 /* count open brackets, reset close bracket pointer */
1815 if (p
[0] == '[' || p
[0] == '<')
1816 lbrack
++, brack
= 0;
1817 /* count close brackets, set close bracket pointer */
1818 if (p
[0] == ']' || p
[0] == '>')
1819 rbrack
++, brack
= p
;
1820 /* detect ][ or >< */
1821 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1823 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1824 nm
= p
+ 1, lose
= 1;
1825 if (p
[0] == ':' && (colon
|| slash
))
1826 /* if dev1:[dir]dev2:, move nm to dev2: */
1832 /* If /name/dev:, move nm to dev: */
1835 /* If node::dev:, move colon following dev */
1836 else if (colon
&& colon
[-1] == ':')
1838 /* If dev1:dev2:, move nm to dev2: */
1839 else if (colon
&& colon
[-1] != ':')
1844 if (p
[0] == ':' && !colon
)
1850 if (lbrack
== rbrack
)
1853 else if (p
[0] == '.')
1861 if (index (nm
, '/'))
1862 return build_string (sys_translate_unix (nm
));
1864 if (nm
== SDATA (name
))
1866 return build_string (nm
);
1870 /* Now determine directory to start with and put it in NEWDIR */
1874 if (nm
[0] == '~') /* prefix ~ */
1879 || nm
[1] == 0)/* ~/filename */
1881 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1882 newdir
= (unsigned char *) "";
1885 nm
++; /* Don't leave the slash in nm. */
1888 else /* ~user/filename */
1890 /* Get past ~ to user */
1891 unsigned char *user
= nm
+ 1;
1892 /* Find end of name. */
1893 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1894 int len
= ptr
? ptr
- user
: strlen (user
);
1896 unsigned char *ptr1
= index (user
, ':');
1897 if (ptr1
!= 0 && ptr1
- user
< len
)
1900 /* Copy the user name into temp storage. */
1901 o
= (unsigned char *) alloca (len
+ 1);
1902 bcopy ((char *) user
, o
, len
);
1905 /* Look up the user name. */
1906 pw
= (struct passwd
*) getpwnam (o
+ 1);
1908 error ("\"%s\" isn't a registered user", o
+ 1);
1910 newdir
= (unsigned char *) pw
->pw_dir
;
1912 /* Discard the user name from NM. */
1919 #endif /* not VMS */
1923 defalt
= current_buffer
->directory
;
1924 CHECK_STRING (defalt
);
1925 newdir
= SDATA (defalt
);
1928 /* Now concatenate the directory and name to new space in the stack frame */
1930 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1931 target
= (unsigned char *) alloca (tlen
);
1937 if (nm
[0] == 0 || nm
[0] == '/')
1938 strcpy (target
, newdir
);
1941 file_name_as_directory (target
, newdir
);
1944 strcat (target
, nm
);
1946 if (index (target
, '/'))
1947 strcpy (target
, sys_translate_unix (target
));
1950 /* Now canonicalize by removing /. and /foo/.. if they appear */
1958 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1964 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1965 /* brackets are offset from each other by 2 */
1968 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1969 /* convert [foo][bar] to [bar] */
1970 while (o
[-1] != '[' && o
[-1] != '<')
1972 else if (*p
== '-' && *o
!= '.')
1975 else if (p
[0] == '-' && o
[-1] == '.' &&
1976 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1977 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1981 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1982 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1984 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1986 /* else [foo.-] ==> [-] */
1992 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1993 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2003 else if (!strncmp (p
, "//", 2)
2005 /* // at start of filename is meaningful in Apollo system. */
2013 else if (p
[0] == '/' && p
[1] == '.' &&
2014 (p
[2] == '/' || p
[2] == 0))
2016 else if (!strncmp (p
, "/..", 3)
2017 /* `/../' is the "superroot" on certain file systems. */
2019 && (p
[3] == '/' || p
[3] == 0))
2021 while (o
!= target
&& *--o
!= '/')
2024 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2028 if (o
== target
&& *o
== '/')
2036 #endif /* not VMS */
2039 return make_string (target
, o
- target
);
2043 /* If /~ or // appears, discard everything through first slash. */
2045 file_name_absolute_p (filename
)
2046 const unsigned char *filename
;
2049 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2051 /* ??? This criterion is probably wrong for '<'. */
2052 || index (filename
, ':') || index (filename
, '<')
2053 || (*filename
== '[' && (filename
[1] != '-'
2054 || (filename
[2] != '.' && filename
[2] != ']'))
2055 && filename
[1] != '.')
2058 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2059 && IS_DIRECTORY_SEP (filename
[2]))
2064 static unsigned char *
2065 search_embedded_absfilename (nm
, endp
)
2066 unsigned char *nm
, *endp
;
2068 unsigned char *p
, *s
;
2070 for (p
= nm
+ 1; p
< endp
; p
++)
2074 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2076 || IS_DIRECTORY_SEP (p
[-1]))
2077 && file_name_absolute_p (p
)
2078 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2079 /* // at start of file name is meaningful in Apollo,
2080 WindowsNT and Cygwin systems. */
2081 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2082 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2085 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2090 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2092 unsigned char *o
= alloca (s
- p
+ 1);
2094 bcopy (p
, o
, s
- p
);
2097 /* If we have ~user and `user' exists, discard
2098 everything up to ~. But if `user' does not exist, leave
2099 ~user alone, it might be a literal file name. */
2100 if ((pw
= getpwnam (o
+ 1)))
2112 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2113 Ssubstitute_in_file_name
, 1, 1, 0,
2114 doc
: /* Substitute environment variables referred to in FILENAME.
2115 `$FOO' where FOO is an environment variable name means to substitute
2116 the value of that variable. The variable name should be terminated
2117 with a character not a letter, digit or underscore; otherwise, enclose
2118 the entire variable name in braces.
2119 If `/~' appears, all of FILENAME through that `/' is discarded.
2121 On VMS, `$' substitution is not done; this function does little and only
2122 duplicates what `expand-file-name' does. */)
2124 Lisp_Object filename
;
2128 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2129 unsigned char *target
= NULL
;
2131 int substituted
= 0;
2133 Lisp_Object handler
;
2135 CHECK_STRING (filename
);
2137 /* If the file name has special constructs in it,
2138 call the corresponding file handler. */
2139 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2140 if (!NILP (handler
))
2141 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2143 nm
= SDATA (filename
);
2145 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2146 CORRECT_DIR_SEPS (nm
);
2147 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2149 endp
= nm
+ SBYTES (filename
);
2151 /* If /~ or // appears, discard everything through first slash. */
2152 p
= search_embedded_absfilename (nm
, endp
);
2154 /* Start over with the new string, so we check the file-name-handler
2155 again. Important with filenames like "/home/foo//:/hello///there"
2156 which whould substitute to "/:/hello///there" rather than "/there". */
2157 return Fsubstitute_in_file_name
2158 (make_specified_string (p
, -1, endp
- p
,
2159 STRING_MULTIBYTE (filename
)));
2165 /* See if any variables are substituted into the string
2166 and find the total length of their values in `total' */
2168 for (p
= nm
; p
!= endp
;)
2178 /* "$$" means a single "$" */
2187 while (p
!= endp
&& *p
!= '}') p
++;
2188 if (*p
!= '}') goto missingclose
;
2194 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2198 /* Copy out the variable name */
2199 target
= (unsigned char *) alloca (s
- o
+ 1);
2200 strncpy (target
, o
, s
- o
);
2203 strupr (target
); /* $home == $HOME etc. */
2206 /* Get variable value */
2207 o
= (unsigned char *) egetenv (target
);
2210 total
+= strlen (o
);
2220 /* If substitution required, recopy the string and do it */
2221 /* Make space in stack frame for the new copy */
2222 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2225 /* Copy the rest of the name through, replacing $ constructs with values */
2242 while (p
!= endp
&& *p
!= '}') p
++;
2243 if (*p
!= '}') goto missingclose
;
2249 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2253 /* Copy out the variable name */
2254 target
= (unsigned char *) alloca (s
- o
+ 1);
2255 strncpy (target
, o
, s
- o
);
2258 strupr (target
); /* $home == $HOME etc. */
2261 /* Get variable value */
2262 o
= (unsigned char *) egetenv (target
);
2266 strcpy (x
, target
); x
+= strlen (target
);
2268 else if (STRING_MULTIBYTE (filename
))
2270 /* If the original string is multibyte,
2271 convert what we substitute into multibyte. */
2274 int c
= unibyte_char_to_multibyte (*o
++);
2275 x
+= CHAR_STRING (c
, x
);
2287 /* If /~ or // appears, discard everything through first slash. */
2288 while ((p
= search_embedded_absfilename (xnm
, x
)))
2289 /* This time we do not start over because we've already expanded envvars
2290 and replaced $$ with $. Maybe we should start over as well, but we'd
2291 need to quote some $ to $$ first. */
2294 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2297 error ("Bad format environment-variable substitution");
2299 error ("Missing \"}\" in environment-variable substitution");
2301 error ("Substituting nonexistent environment variable \"%s\"", target
);
2304 #endif /* not VMS */
2308 /* A slightly faster and more convenient way to get
2309 (directory-file-name (expand-file-name FOO)). */
2312 expand_and_dir_to_file (filename
, defdir
)
2313 Lisp_Object filename
, defdir
;
2315 register Lisp_Object absname
;
2317 absname
= Fexpand_file_name (filename
, defdir
);
2320 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2321 if (c
== ':' || c
== ']' || c
== '>')
2322 absname
= Fdirectory_file_name (absname
);
2325 /* Remove final slash, if any (unless this is the root dir).
2326 stat behaves differently depending! */
2327 if (SCHARS (absname
) > 1
2328 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2329 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2330 /* We cannot take shortcuts; they might be wrong for magic file names. */
2331 absname
= Fdirectory_file_name (absname
);
2336 /* Signal an error if the file ABSNAME already exists.
2337 If INTERACTIVE is nonzero, ask the user whether to proceed,
2338 and bypass the error if the user says to go ahead.
2339 QUERYSTRING is a name for the action that is being considered
2342 *STATPTR is used to store the stat information if the file exists.
2343 If the file does not exist, STATPTR->st_mode is set to 0.
2344 If STATPTR is null, we don't store into it.
2346 If QUICK is nonzero, we ask for y or n, not yes or no. */
2349 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2350 Lisp_Object absname
;
2351 unsigned char *querystring
;
2353 struct stat
*statptr
;
2356 register Lisp_Object tem
, encoded_filename
;
2357 struct stat statbuf
;
2358 struct gcpro gcpro1
;
2360 encoded_filename
= ENCODE_FILE (absname
);
2362 /* stat is a good way to tell whether the file exists,
2363 regardless of what access permissions it has. */
2364 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2367 Fsignal (Qfile_already_exists
,
2368 Fcons (build_string ("File already exists"),
2369 Fcons (absname
, Qnil
)));
2371 tem
= format2 ("File %s already exists; %s anyway? ",
2372 absname
, build_string (querystring
));
2374 tem
= Fy_or_n_p (tem
);
2376 tem
= do_yes_or_no_p (tem
);
2379 Fsignal (Qfile_already_exists
,
2380 Fcons (build_string ("File already exists"),
2381 Fcons (absname
, Qnil
)));
2388 statptr
->st_mode
= 0;
2393 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2394 "fCopy file: \nGCopy %s to file: \np\nP",
2395 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2396 If NEWNAME names a directory, copy FILE there.
2397 Signals a `file-already-exists' error if file NEWNAME already exists,
2398 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2399 A number as third arg means request confirmation if NEWNAME already exists.
2400 This is what happens in interactive use with M-x.
2401 Always sets the file modes of the output file to match the input file.
2402 Fourth arg KEEP-TIME non-nil means give the output file the same
2403 last-modified time as the old one. (This works on only some systems.)
2404 A prefix arg makes KEEP-TIME non-nil. */)
2405 (file
, newname
, ok_if_already_exists
, keep_time
)
2406 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2409 char buf
[16 * 1024];
2410 struct stat st
, out_st
;
2411 Lisp_Object handler
;
2412 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2413 int count
= SPECPDL_INDEX ();
2414 int input_file_statable_p
;
2415 Lisp_Object encoded_file
, encoded_newname
;
2417 encoded_file
= encoded_newname
= Qnil
;
2418 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2419 CHECK_STRING (file
);
2420 CHECK_STRING (newname
);
2422 if (!NILP (Ffile_directory_p (newname
)))
2423 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2425 newname
= Fexpand_file_name (newname
, Qnil
);
2427 file
= Fexpand_file_name (file
, Qnil
);
2429 /* If the input file name has special constructs in it,
2430 call the corresponding file handler. */
2431 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2432 /* Likewise for output file name. */
2434 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2435 if (!NILP (handler
))
2436 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2437 ok_if_already_exists
, keep_time
));
2439 encoded_file
= ENCODE_FILE (file
);
2440 encoded_newname
= ENCODE_FILE (newname
);
2442 if (NILP (ok_if_already_exists
)
2443 || INTEGERP (ok_if_already_exists
))
2444 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2445 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2446 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2450 if (!CopyFile (SDATA (encoded_file
),
2451 SDATA (encoded_newname
),
2453 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2454 /* CopyFile retains the timestamp by default. */
2455 else if (NILP (keep_time
))
2461 EMACS_GET_TIME (now
);
2462 filename
= SDATA (encoded_newname
);
2464 /* Ensure file is writable while its modified time is set. */
2465 attributes
= GetFileAttributes (filename
);
2466 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2467 if (set_file_times (filename
, now
, now
))
2469 /* Restore original attributes. */
2470 SetFileAttributes (filename
, attributes
);
2471 Fsignal (Qfile_date_error
,
2472 Fcons (build_string ("Cannot set file date"),
2473 Fcons (newname
, Qnil
)));
2475 /* Restore original attributes. */
2476 SetFileAttributes (filename
, attributes
);
2478 #else /* not WINDOWSNT */
2480 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2484 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2486 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2488 /* We can only copy regular files and symbolic links. Other files are not
2490 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2492 #if !defined (DOS_NT) || __DJGPP__ > 1
2493 if (out_st
.st_mode
!= 0
2494 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2497 report_file_error ("Input and output files are the same",
2498 Fcons (file
, Fcons (newname
, Qnil
)));
2502 #if defined (S_ISREG) && defined (S_ISLNK)
2503 if (input_file_statable_p
)
2505 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2507 #if defined (EISDIR)
2508 /* Get a better looking error message. */
2511 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2514 #endif /* S_ISREG && S_ISLNK */
2517 /* Create the copy file with the same record format as the input file */
2518 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2521 /* System's default file type was set to binary by _fmode in emacs.c. */
2522 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2523 #else /* not MSDOS */
2524 ofd
= creat (SDATA (encoded_newname
), 0666);
2525 #endif /* not MSDOS */
2528 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2530 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2534 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2535 if (emacs_write (ofd
, buf
, n
) != n
)
2536 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2539 /* Closing the output clobbers the file times on some systems. */
2540 if (emacs_close (ofd
) < 0)
2541 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2543 if (input_file_statable_p
)
2545 if (!NILP (keep_time
))
2547 EMACS_TIME atime
, mtime
;
2548 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2549 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2550 if (set_file_times (SDATA (encoded_newname
),
2552 Fsignal (Qfile_date_error
,
2553 Fcons (build_string ("Cannot set file date"),
2554 Fcons (newname
, Qnil
)));
2557 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2559 #if defined (__DJGPP__) && __DJGPP__ > 1
2560 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2561 and if it can't, it tells so. Otherwise, under MSDOS we usually
2562 get only the READ bit, which will make the copied file read-only,
2563 so it's better not to chmod at all. */
2564 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2565 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2566 #endif /* DJGPP version 2 or newer */
2571 #endif /* WINDOWSNT */
2573 /* Discard the unwind protects. */
2574 specpdl_ptr
= specpdl
+ count
;
2580 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2581 Smake_directory_internal
, 1, 1, 0,
2582 doc
: /* Create a new directory named DIRECTORY. */)
2584 Lisp_Object directory
;
2586 const unsigned char *dir
;
2587 Lisp_Object handler
;
2588 Lisp_Object encoded_dir
;
2590 CHECK_STRING (directory
);
2591 directory
= Fexpand_file_name (directory
, Qnil
);
2593 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2594 if (!NILP (handler
))
2595 return call2 (handler
, Qmake_directory_internal
, directory
);
2597 encoded_dir
= ENCODE_FILE (directory
);
2599 dir
= SDATA (encoded_dir
);
2602 if (mkdir (dir
) != 0)
2604 if (mkdir (dir
, 0777) != 0)
2606 report_file_error ("Creating directory", Flist (1, &directory
));
2611 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2612 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2614 Lisp_Object directory
;
2616 const unsigned char *dir
;
2617 Lisp_Object handler
;
2618 Lisp_Object encoded_dir
;
2620 CHECK_STRING (directory
);
2621 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2623 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2624 if (!NILP (handler
))
2625 return call2 (handler
, Qdelete_directory
, directory
);
2627 encoded_dir
= ENCODE_FILE (directory
);
2629 dir
= SDATA (encoded_dir
);
2631 if (rmdir (dir
) != 0)
2632 report_file_error ("Removing directory", Flist (1, &directory
));
2637 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2638 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2639 If file has multiple names, it continues to exist with the other names. */)
2641 Lisp_Object filename
;
2643 Lisp_Object handler
;
2644 Lisp_Object encoded_file
;
2645 struct gcpro gcpro1
;
2648 if (!NILP (Ffile_directory_p (filename
))
2649 && NILP (Ffile_symlink_p (filename
)))
2650 Fsignal (Qfile_error
,
2651 Fcons (build_string ("Removing old name: is a directory"),
2652 Fcons (filename
, Qnil
)));
2654 filename
= Fexpand_file_name (filename
, Qnil
);
2656 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2657 if (!NILP (handler
))
2658 return call2 (handler
, Qdelete_file
, filename
);
2660 encoded_file
= ENCODE_FILE (filename
);
2662 if (0 > unlink (SDATA (encoded_file
)))
2663 report_file_error ("Removing old name", Flist (1, &filename
));
2668 internal_delete_file_1 (ignore
)
2674 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2677 internal_delete_file (filename
)
2678 Lisp_Object filename
;
2680 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2681 Qt
, internal_delete_file_1
));
2684 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2685 "fRename file: \nGRename %s to file: \np",
2686 doc
: /* Rename FILE as NEWNAME. Both args strings.
2687 If file has names other than FILE, it continues to have those names.
2688 Signals a `file-already-exists' error if a file NEWNAME already exists
2689 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2690 A number as third arg means request confirmation if NEWNAME already exists.
2691 This is what happens in interactive use with M-x. */)
2692 (file
, newname
, ok_if_already_exists
)
2693 Lisp_Object file
, newname
, ok_if_already_exists
;
2696 Lisp_Object args
[2];
2698 Lisp_Object handler
;
2699 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2700 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2702 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2703 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2704 CHECK_STRING (file
);
2705 CHECK_STRING (newname
);
2706 file
= Fexpand_file_name (file
, Qnil
);
2708 if (!NILP (Ffile_directory_p (newname
)))
2709 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2711 newname
= Fexpand_file_name (newname
, Qnil
);
2713 /* If the file name has special constructs in it,
2714 call the corresponding file handler. */
2715 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2717 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2718 if (!NILP (handler
))
2719 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2720 file
, newname
, ok_if_already_exists
));
2722 encoded_file
= ENCODE_FILE (file
);
2723 encoded_newname
= ENCODE_FILE (newname
);
2726 /* If the file names are identical but for the case, don't ask for
2727 confirmation: they simply want to change the letter-case of the
2729 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2731 if (NILP (ok_if_already_exists
)
2732 || INTEGERP (ok_if_already_exists
))
2733 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2734 INTEGERP (ok_if_already_exists
), 0, 0);
2736 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2738 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2739 || 0 > unlink (SDATA (encoded_file
)))
2745 symlink_target
= Ffile_symlink_p (file
);
2746 if (! NILP (symlink_target
))
2747 Fmake_symbolic_link (symlink_target
, newname
,
2748 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2751 Fcopy_file (file
, newname
,
2752 /* We have already prompted if it was an integer,
2753 so don't have copy-file prompt again. */
2754 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2755 Fdelete_file (file
);
2762 report_file_error ("Renaming", Flist (2, args
));
2765 report_file_error ("Renaming", Flist (2, &file
));
2772 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2773 "fAdd name to file: \nGName to add to %s: \np",
2774 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2775 Signals a `file-already-exists' error if a file NEWNAME already exists
2776 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2777 A number as third arg means request confirmation if NEWNAME already exists.
2778 This is what happens in interactive use with M-x. */)
2779 (file
, newname
, ok_if_already_exists
)
2780 Lisp_Object file
, newname
, ok_if_already_exists
;
2783 Lisp_Object args
[2];
2785 Lisp_Object handler
;
2786 Lisp_Object encoded_file
, encoded_newname
;
2787 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2789 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2790 encoded_file
= encoded_newname
= Qnil
;
2791 CHECK_STRING (file
);
2792 CHECK_STRING (newname
);
2793 file
= Fexpand_file_name (file
, Qnil
);
2795 if (!NILP (Ffile_directory_p (newname
)))
2796 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2798 newname
= Fexpand_file_name (newname
, Qnil
);
2800 /* If the file name has special constructs in it,
2801 call the corresponding file handler. */
2802 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2803 if (!NILP (handler
))
2804 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2805 newname
, ok_if_already_exists
));
2807 /* If the new name has special constructs in it,
2808 call the corresponding file handler. */
2809 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2810 if (!NILP (handler
))
2811 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2812 newname
, ok_if_already_exists
));
2814 encoded_file
= ENCODE_FILE (file
);
2815 encoded_newname
= ENCODE_FILE (newname
);
2817 if (NILP (ok_if_already_exists
)
2818 || INTEGERP (ok_if_already_exists
))
2819 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2820 INTEGERP (ok_if_already_exists
), 0, 0);
2822 unlink (SDATA (newname
));
2823 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2828 report_file_error ("Adding new name", Flist (2, args
));
2830 report_file_error ("Adding new name", Flist (2, &file
));
2839 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2840 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2841 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2842 Signals a `file-already-exists' error if a file LINKNAME already exists
2843 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2844 A number as third arg means request confirmation if LINKNAME already exists.
2845 This happens for interactive use with M-x. */)
2846 (filename
, linkname
, ok_if_already_exists
)
2847 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2850 Lisp_Object args
[2];
2852 Lisp_Object handler
;
2853 Lisp_Object encoded_filename
, encoded_linkname
;
2854 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2856 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2857 encoded_filename
= encoded_linkname
= Qnil
;
2858 CHECK_STRING (filename
);
2859 CHECK_STRING (linkname
);
2860 /* If the link target has a ~, we must expand it to get
2861 a truly valid file name. Otherwise, do not expand;
2862 we want to permit links to relative file names. */
2863 if (SREF (filename
, 0) == '~')
2864 filename
= Fexpand_file_name (filename
, Qnil
);
2866 if (!NILP (Ffile_directory_p (linkname
)))
2867 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2869 linkname
= Fexpand_file_name (linkname
, Qnil
);
2871 /* If the file name has special constructs in it,
2872 call the corresponding file handler. */
2873 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2874 if (!NILP (handler
))
2875 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2876 linkname
, ok_if_already_exists
));
2878 /* If the new link name has special constructs in it,
2879 call the corresponding file handler. */
2880 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2881 if (!NILP (handler
))
2882 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2883 linkname
, ok_if_already_exists
));
2885 encoded_filename
= ENCODE_FILE (filename
);
2886 encoded_linkname
= ENCODE_FILE (linkname
);
2888 if (NILP (ok_if_already_exists
)
2889 || INTEGERP (ok_if_already_exists
))
2890 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2891 INTEGERP (ok_if_already_exists
), 0, 0);
2892 if (0 > symlink (SDATA (encoded_filename
),
2893 SDATA (encoded_linkname
)))
2895 /* If we didn't complain already, silently delete existing file. */
2896 if (errno
== EEXIST
)
2898 unlink (SDATA (encoded_linkname
));
2899 if (0 <= symlink (SDATA (encoded_filename
),
2900 SDATA (encoded_linkname
)))
2910 report_file_error ("Making symbolic link", Flist (2, args
));
2912 report_file_error ("Making symbolic link", Flist (2, &filename
));
2918 #endif /* S_IFLNK */
2922 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2923 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2924 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2925 If STRING is nil or a null string, the logical name NAME is deleted. */)
2930 CHECK_STRING (name
);
2932 delete_logical_name (SDATA (name
));
2935 CHECK_STRING (string
);
2937 if (SCHARS (string
) == 0)
2938 delete_logical_name (SDATA (name
));
2940 define_logical_name (SDATA (name
), SDATA (string
));
2949 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2950 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2952 Lisp_Object path
, login
;
2956 CHECK_STRING (path
);
2957 CHECK_STRING (login
);
2959 netresult
= netunam (SDATA (path
), SDATA (login
));
2961 if (netresult
== -1)
2966 #endif /* HPUX_NET */
2968 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2970 doc
: /* Return t if file FILENAME specifies an absolute file name.
2971 On Unix, this is a name starting with a `/' or a `~'. */)
2973 Lisp_Object filename
;
2975 CHECK_STRING (filename
);
2976 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2979 /* Return nonzero if file FILENAME exists and can be executed. */
2982 check_executable (filename
)
2986 int len
= strlen (filename
);
2989 if (stat (filename
, &st
) < 0)
2991 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2992 return ((st
.st_mode
& S_IEXEC
) != 0);
2994 return (S_ISREG (st
.st_mode
)
2996 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2997 || stricmp (suffix
, ".exe") == 0
2998 || stricmp (suffix
, ".bat") == 0)
2999 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3000 #endif /* not WINDOWSNT */
3001 #else /* not DOS_NT */
3002 #ifdef HAVE_EUIDACCESS
3003 return (euidaccess (filename
, 1) >= 0);
3005 /* Access isn't quite right because it uses the real uid
3006 and we really want to test with the effective uid.
3007 But Unix doesn't give us a right way to do it. */
3008 return (access (filename
, 1) >= 0);
3010 #endif /* not DOS_NT */
3013 /* Return nonzero if file FILENAME exists and can be written. */
3016 check_writable (filename
)
3021 if (stat (filename
, &st
) < 0)
3023 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3024 #else /* not MSDOS */
3025 #ifdef HAVE_EUIDACCESS
3026 return (euidaccess (filename
, 2) >= 0);
3028 /* Access isn't quite right because it uses the real uid
3029 and we really want to test with the effective uid.
3030 But Unix doesn't give us a right way to do it.
3031 Opening with O_WRONLY could work for an ordinary file,
3032 but would lose for directories. */
3033 return (access (filename
, 2) >= 0);
3035 #endif /* not MSDOS */
3038 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3039 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3040 See also `file-readable-p' and `file-attributes'. */)
3042 Lisp_Object filename
;
3044 Lisp_Object absname
;
3045 Lisp_Object handler
;
3046 struct stat statbuf
;
3048 CHECK_STRING (filename
);
3049 absname
= Fexpand_file_name (filename
, Qnil
);
3051 /* If the file name has special constructs in it,
3052 call the corresponding file handler. */
3053 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3054 if (!NILP (handler
))
3055 return call2 (handler
, Qfile_exists_p
, absname
);
3057 absname
= ENCODE_FILE (absname
);
3059 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3062 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3063 doc
: /* Return t if FILENAME can be executed by you.
3064 For a directory, this means you can access files in that directory. */)
3066 Lisp_Object filename
;
3068 Lisp_Object absname
;
3069 Lisp_Object handler
;
3071 CHECK_STRING (filename
);
3072 absname
= Fexpand_file_name (filename
, Qnil
);
3074 /* If the file name has special constructs in it,
3075 call the corresponding file handler. */
3076 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3077 if (!NILP (handler
))
3078 return call2 (handler
, Qfile_executable_p
, absname
);
3080 absname
= ENCODE_FILE (absname
);
3082 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3085 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3086 doc
: /* Return t if file FILENAME exists and you can read it.
3087 See also `file-exists-p' and `file-attributes'. */)
3089 Lisp_Object filename
;
3091 Lisp_Object absname
;
3092 Lisp_Object handler
;
3095 struct stat statbuf
;
3097 CHECK_STRING (filename
);
3098 absname
= Fexpand_file_name (filename
, Qnil
);
3100 /* If the file name has special constructs in it,
3101 call the corresponding file handler. */
3102 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3103 if (!NILP (handler
))
3104 return call2 (handler
, Qfile_readable_p
, absname
);
3106 absname
= ENCODE_FILE (absname
);
3108 #if defined(DOS_NT) || defined(macintosh)
3109 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3111 if (access (SDATA (absname
), 0) == 0)
3114 #else /* not DOS_NT and not macintosh */
3116 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3117 /* Opening a fifo without O_NONBLOCK can wait.
3118 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3119 except in the case of a fifo, on a system which handles it. */
3120 desc
= stat (SDATA (absname
), &statbuf
);
3123 if (S_ISFIFO (statbuf
.st_mode
))
3124 flags
|= O_NONBLOCK
;
3126 desc
= emacs_open (SDATA (absname
), flags
, 0);
3131 #endif /* not DOS_NT and not macintosh */
3134 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3136 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3137 doc
: /* Return t if file FILENAME can be written or created by you. */)
3139 Lisp_Object filename
;
3141 Lisp_Object absname
, dir
, encoded
;
3142 Lisp_Object handler
;
3143 struct stat statbuf
;
3145 CHECK_STRING (filename
);
3146 absname
= Fexpand_file_name (filename
, Qnil
);
3148 /* If the file name has special constructs in it,
3149 call the corresponding file handler. */
3150 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3151 if (!NILP (handler
))
3152 return call2 (handler
, Qfile_writable_p
, absname
);
3154 encoded
= ENCODE_FILE (absname
);
3155 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3156 return (check_writable (SDATA (encoded
))
3159 dir
= Ffile_name_directory (absname
);
3162 dir
= Fdirectory_file_name (dir
);
3166 dir
= Fdirectory_file_name (dir
);
3169 dir
= ENCODE_FILE (dir
);
3171 /* The read-only attribute of the parent directory doesn't affect
3172 whether a file or directory can be created within it. Some day we
3173 should check ACLs though, which do affect this. */
3174 if (stat (SDATA (dir
), &statbuf
) < 0)
3176 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3178 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3183 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3184 doc
: /* Access file FILENAME, and get an error if that does not work.
3185 The second argument STRING is used in the error message.
3186 If there is no error, we return nil. */)
3188 Lisp_Object filename
, string
;
3190 Lisp_Object handler
, encoded_filename
, absname
;
3193 CHECK_STRING (filename
);
3194 absname
= Fexpand_file_name (filename
, Qnil
);
3196 CHECK_STRING (string
);
3198 /* If the file name has special constructs in it,
3199 call the corresponding file handler. */
3200 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3201 if (!NILP (handler
))
3202 return call3 (handler
, Qaccess_file
, absname
, string
);
3204 encoded_filename
= ENCODE_FILE (absname
);
3206 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3208 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3214 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3215 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3216 The value is the link target, as a string.
3217 Otherwise returns nil. */)
3219 Lisp_Object filename
;
3221 Lisp_Object handler
;
3223 CHECK_STRING (filename
);
3224 filename
= Fexpand_file_name (filename
, Qnil
);
3226 /* If the file name has special constructs in it,
3227 call the corresponding file handler. */
3228 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3229 if (!NILP (handler
))
3230 return call2 (handler
, Qfile_symlink_p
, filename
);
3239 filename
= ENCODE_FILE (filename
);
3246 buf
= (char *) xrealloc (buf
, bufsize
);
3247 bzero (buf
, bufsize
);
3250 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3254 /* HP-UX reports ERANGE if buffer is too small. */
3255 if (errno
== ERANGE
)
3265 while (valsize
>= bufsize
);
3267 val
= make_string (buf
, valsize
);
3268 if (buf
[0] == '/' && index (buf
, ':'))
3269 val
= concat2 (build_string ("/:"), val
);
3271 val
= DECODE_FILE (val
);
3274 #else /* not S_IFLNK */
3276 #endif /* not S_IFLNK */
3279 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3280 doc
: /* Return t if FILENAME names an existing directory.
3281 Symbolic links to directories count as directories.
3282 See `file-symlink-p' to distinguish symlinks. */)
3284 Lisp_Object filename
;
3286 register Lisp_Object absname
;
3288 Lisp_Object handler
;
3290 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3292 /* If the file name has special constructs in it,
3293 call the corresponding file handler. */
3294 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3295 if (!NILP (handler
))
3296 return call2 (handler
, Qfile_directory_p
, absname
);
3298 absname
= ENCODE_FILE (absname
);
3300 if (stat (SDATA (absname
), &st
) < 0)
3302 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3305 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3306 doc
: /* Return t if file FILENAME names a directory you can open.
3307 For the value to be t, FILENAME must specify the name of a directory as a file,
3308 and the directory must allow you to open files in it. In order to use a
3309 directory as a buffer's current directory, this predicate must return true.
3310 A directory name spec may be given instead; then the value is t
3311 if the directory so specified exists and really is a readable and
3312 searchable directory. */)
3314 Lisp_Object filename
;
3316 Lisp_Object handler
;
3318 struct gcpro gcpro1
;
3320 /* If the file name has special constructs in it,
3321 call the corresponding file handler. */
3322 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3323 if (!NILP (handler
))
3324 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3327 tem
= (NILP (Ffile_directory_p (filename
))
3328 || NILP (Ffile_executable_p (filename
)));
3330 return tem
? Qnil
: Qt
;
3333 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3334 doc
: /* Return t if file FILENAME is the name of a regular file.
3335 This is the sort of file that holds an ordinary stream of data bytes. */)
3337 Lisp_Object filename
;
3339 register Lisp_Object absname
;
3341 Lisp_Object handler
;
3343 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3345 /* If the file name has special constructs in it,
3346 call the corresponding file handler. */
3347 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3348 if (!NILP (handler
))
3349 return call2 (handler
, Qfile_regular_p
, absname
);
3351 absname
= ENCODE_FILE (absname
);
3356 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3358 /* Tell stat to use expensive method to get accurate info. */
3359 Vw32_get_true_file_attributes
= Qt
;
3360 result
= stat (SDATA (absname
), &st
);
3361 Vw32_get_true_file_attributes
= tem
;
3365 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3368 if (stat (SDATA (absname
), &st
) < 0)
3370 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3374 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3375 doc
: /* Return mode bits of file named FILENAME, as an integer.
3376 Return nil, if file does not exist or is not accessible. */)
3378 Lisp_Object filename
;
3380 Lisp_Object absname
;
3382 Lisp_Object handler
;
3384 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3386 /* If the file name has special constructs in it,
3387 call the corresponding file handler. */
3388 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3389 if (!NILP (handler
))
3390 return call2 (handler
, Qfile_modes
, absname
);
3392 absname
= ENCODE_FILE (absname
);
3394 if (stat (SDATA (absname
), &st
) < 0)
3396 #if defined (MSDOS) && __DJGPP__ < 2
3397 if (check_executable (SDATA (absname
)))
3398 st
.st_mode
|= S_IEXEC
;
3399 #endif /* MSDOS && __DJGPP__ < 2 */
3401 return make_number (st
.st_mode
& 07777);
3404 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3405 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3406 Only the 12 low bits of MODE are used. */)
3408 Lisp_Object filename
, mode
;
3410 Lisp_Object absname
, encoded_absname
;
3411 Lisp_Object handler
;
3413 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3414 CHECK_NUMBER (mode
);
3416 /* If the file name has special constructs in it,
3417 call the corresponding file handler. */
3418 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3419 if (!NILP (handler
))
3420 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3422 encoded_absname
= ENCODE_FILE (absname
);
3424 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3425 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3430 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3431 doc
: /* Set the file permission bits for newly created files.
3432 The argument MODE should be an integer; only the low 9 bits are used.
3433 This setting is inherited by subprocesses. */)
3437 CHECK_NUMBER (mode
);
3439 umask ((~ XINT (mode
)) & 0777);
3444 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3445 doc
: /* Return the default file protection for created files.
3446 The value is an integer. */)
3452 realmask
= umask (0);
3455 XSETINT (value
, (~ realmask
) & 0777);
3459 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3461 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3462 doc
: /* Set times of file FILENAME to TIME.
3463 Set both access and modification times.
3464 Return t on success, else nil.
3465 Use the current time if TIME is nil. TIME is in the format of
3468 Lisp_Object filename
, time
;
3470 Lisp_Object absname
, encoded_absname
;
3471 Lisp_Object handler
;
3475 if (! lisp_time_argument (time
, &sec
, &usec
))
3476 error ("Invalid time specification");
3478 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3480 /* If the file name has special constructs in it,
3481 call the corresponding file handler. */
3482 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3483 if (!NILP (handler
))
3484 return call3 (handler
, Qset_file_times
, absname
, time
);
3486 encoded_absname
= ENCODE_FILE (absname
);
3491 EMACS_SET_SECS (t
, sec
);
3492 EMACS_SET_USECS (t
, usec
);
3494 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3499 /* Setting times on a directory always fails. */
3500 if (stat (SDATA (encoded_absname
), &st
) == 0
3501 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3504 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3517 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3518 doc
: /* Tell Unix to finish all pending disk updates. */)
3527 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3528 doc
: /* Return t if file FILE1 is newer than file FILE2.
3529 If FILE1 does not exist, the answer is nil;
3530 otherwise, if FILE2 does not exist, the answer is t. */)
3532 Lisp_Object file1
, file2
;
3534 Lisp_Object absname1
, absname2
;
3537 Lisp_Object handler
;
3538 struct gcpro gcpro1
, gcpro2
;
3540 CHECK_STRING (file1
);
3541 CHECK_STRING (file2
);
3544 GCPRO2 (absname1
, file2
);
3545 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3546 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3549 /* If the file name has special constructs in it,
3550 call the corresponding file handler. */
3551 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3553 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3554 if (!NILP (handler
))
3555 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3557 GCPRO2 (absname1
, absname2
);
3558 absname1
= ENCODE_FILE (absname1
);
3559 absname2
= ENCODE_FILE (absname2
);
3562 if (stat (SDATA (absname1
), &st
) < 0)
3565 mtime1
= st
.st_mtime
;
3567 if (stat (SDATA (absname2
), &st
) < 0)
3570 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3574 Lisp_Object Qfind_buffer_file_type
;
3577 #ifndef READ_BUF_SIZE
3578 #define READ_BUF_SIZE (64 << 10)
3581 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3583 /* This function is called after Lisp functions to decide a coding
3584 system are called, or when they cause an error. Before they are
3585 called, the current buffer is set unibyte and it contains only a
3586 newly inserted text (thus the buffer was empty before the
3589 The functions may set markers, overlays, text properties, or even
3590 alter the buffer contents, change the current buffer.
3592 Here, we reset all those changes by:
3593 o set back the current buffer.
3594 o move all markers and overlays to BEG.
3595 o remove all text properties.
3596 o set back the buffer multibyteness. */
3599 decide_coding_unwind (unwind_data
)
3600 Lisp_Object unwind_data
;
3602 Lisp_Object multibyte
, undo_list
, buffer
;
3604 multibyte
= XCAR (unwind_data
);
3605 unwind_data
= XCDR (unwind_data
);
3606 undo_list
= XCAR (unwind_data
);
3607 buffer
= XCDR (unwind_data
);
3609 if (current_buffer
!= XBUFFER (buffer
))
3610 set_buffer_internal (XBUFFER (buffer
));
3611 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3612 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3613 BUF_INTERVALS (current_buffer
) = 0;
3614 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3616 /* Now we are safe to change the buffer's multibyteness directly. */
3617 current_buffer
->enable_multibyte_characters
= multibyte
;
3618 current_buffer
->undo_list
= undo_list
;
3624 /* Used to pass values from insert-file-contents to read_non_regular. */
3626 static int non_regular_fd
;
3627 static int non_regular_inserted
;
3628 static int non_regular_nbytes
;
3631 /* Read from a non-regular file.
3632 Read non_regular_trytry bytes max from non_regular_fd.
3633 Non_regular_inserted specifies where to put the read bytes.
3634 Value is the number of bytes read. */
3643 nbytes
= emacs_read (non_regular_fd
,
3644 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3645 non_regular_nbytes
);
3647 return make_number (nbytes
);
3651 /* Condition-case handler used when reading from non-regular files
3652 in insert-file-contents. */
3655 read_non_regular_quit ()
3661 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3663 doc
: /* Insert contents of file FILENAME after point.
3664 Returns list of absolute file name and number of characters inserted.
3665 If second argument VISIT is non-nil, the buffer's visited filename
3666 and last save file modtime are set, and it is marked unmodified.
3667 If visiting and the file does not exist, visiting is completed
3668 before the error is signaled.
3669 The optional third and fourth arguments BEG and END
3670 specify what portion of the file to insert.
3671 These arguments count bytes in the file, not characters in the buffer.
3672 If VISIT is non-nil, BEG and END must be nil.
3674 If optional fifth argument REPLACE is non-nil,
3675 it means replace the current buffer contents (in the accessible portion)
3676 with the file contents. This is better than simply deleting and inserting
3677 the whole thing because (1) it preserves some marker positions
3678 and (2) it puts less data in the undo list.
3679 When REPLACE is non-nil, the value is the number of characters actually read,
3680 which is often less than the number of characters to be read.
3682 This does code conversion according to the value of
3683 `coding-system-for-read' or `file-coding-system-alist',
3684 and sets the variable `last-coding-system-used' to the coding system
3686 (filename
, visit
, beg
, end
, replace
)
3687 Lisp_Object filename
, visit
, beg
, end
, replace
;
3692 register int how_much
;
3693 register int unprocessed
;
3694 int count
= SPECPDL_INDEX ();
3695 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3696 Lisp_Object handler
, val
, insval
, orig_filename
;
3699 int not_regular
= 0;
3700 unsigned char read_buf
[READ_BUF_SIZE
];
3701 struct coding_system coding
;
3702 unsigned char buffer
[1 << 14];
3703 int replace_handled
= 0;
3704 int set_coding_system
= 0;
3705 int coding_system_decided
= 0;
3708 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3709 error ("Cannot do file visiting in an indirect buffer");
3711 if (!NILP (current_buffer
->read_only
))
3712 Fbarf_if_buffer_read_only ();
3716 orig_filename
= Qnil
;
3718 GCPRO4 (filename
, val
, p
, orig_filename
);
3720 CHECK_STRING (filename
);
3721 filename
= Fexpand_file_name (filename
, Qnil
);
3723 /* If the file name has special constructs in it,
3724 call the corresponding file handler. */
3725 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3726 if (!NILP (handler
))
3728 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3729 visit
, beg
, end
, replace
);
3730 if (CONSP (val
) && CONSP (XCDR (val
)))
3731 inserted
= XINT (XCAR (XCDR (val
)));
3735 orig_filename
= filename
;
3736 filename
= ENCODE_FILE (filename
);
3742 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3744 /* Tell stat to use expensive method to get accurate info. */
3745 Vw32_get_true_file_attributes
= Qt
;
3746 total
= stat (SDATA (filename
), &st
);
3747 Vw32_get_true_file_attributes
= tem
;
3752 if (stat (SDATA (filename
), &st
) < 0)
3754 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3755 || fstat (fd
, &st
) < 0)
3756 #endif /* not APOLLO */
3757 #endif /* WINDOWSNT */
3759 if (fd
>= 0) emacs_close (fd
);
3762 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3765 if (!NILP (Vcoding_system_for_read
))
3766 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3771 /* This code will need to be changed in order to work on named
3772 pipes, and it's probably just not worth it. So we should at
3773 least signal an error. */
3774 if (!S_ISREG (st
.st_mode
))
3781 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3782 Fsignal (Qfile_error
,
3783 Fcons (build_string ("not a regular file"),
3784 Fcons (orig_filename
, Qnil
)));
3789 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3792 /* Replacement should preserve point as it preserves markers. */
3793 if (!NILP (replace
))
3794 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3796 record_unwind_protect (close_file_unwind
, make_number (fd
));
3798 /* Supposedly happens on VMS. */
3799 /* Can happen on any platform that uses long as type of off_t, but allows
3800 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3801 give a message suitable for the latter case. */
3802 if (! not_regular
&& st
.st_size
< 0)
3803 error ("Maximum buffer size exceeded");
3805 /* Prevent redisplay optimizations. */
3806 current_buffer
->clip_changed
= 1;
3810 if (!NILP (beg
) || !NILP (end
))
3811 error ("Attempt to visit less than an entire file");
3812 if (BEG
< Z
&& NILP (replace
))
3813 error ("Cannot do file visiting in a non-empty buffer");
3819 XSETFASTINT (beg
, 0);
3827 XSETINT (end
, st
.st_size
);
3829 /* Arithmetic overflow can occur if an Emacs integer cannot
3830 represent the file size, or if the calculations below
3831 overflow. The calculations below double the file size
3832 twice, so check that it can be multiplied by 4 safely. */
3833 if (XINT (end
) != st
.st_size
3834 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3835 error ("Maximum buffer size exceeded");
3837 /* The file size returned from stat may be zero, but data
3838 may be readable nonetheless, for example when this is a
3839 file in the /proc filesystem. */
3840 if (st
.st_size
== 0)
3841 XSETINT (end
, READ_BUF_SIZE
);
3845 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3847 /* We use emacs-mule for auto saving... */
3848 setup_coding_system (Qemacs_mule
, &coding
);
3849 /* ... but with the special flag to indicate to read in a
3850 multibyte sequence for eight-bit-control char as is. */
3852 coding
.src_multibyte
= 0;
3853 coding
.dst_multibyte
3854 = !NILP (current_buffer
->enable_multibyte_characters
);
3855 coding
.eol_type
= CODING_EOL_LF
;
3856 coding_system_decided
= 1;
3860 /* Decide the coding system to use for reading the file now
3861 because we can't use an optimized method for handling
3862 `coding:' tag if the current buffer is not empty. */
3866 if (!NILP (Vcoding_system_for_read
))
3867 val
= Vcoding_system_for_read
;
3870 /* Don't try looking inside a file for a coding system
3871 specification if it is not seekable. */
3872 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3874 /* Find a coding system specified in the heading two
3875 lines or in the tailing several lines of the file.
3876 We assume that the 1K-byte and 3K-byte for heading
3877 and tailing respectively are sufficient for this
3881 if (st
.st_size
<= (1024 * 4))
3882 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3885 nread
= emacs_read (fd
, read_buf
, 1024);
3888 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3889 report_file_error ("Setting file position",
3890 Fcons (orig_filename
, Qnil
));
3891 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3896 error ("IO error reading %s: %s",
3897 SDATA (orig_filename
), emacs_strerror (errno
));
3900 struct buffer
*prev
= current_buffer
;
3904 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3906 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3907 buf
= XBUFFER (buffer
);
3909 delete_all_overlays (buf
);
3910 buf
->directory
= current_buffer
->directory
;
3911 buf
->read_only
= Qnil
;
3912 buf
->filename
= Qnil
;
3913 buf
->undo_list
= Qt
;
3914 eassert (buf
->overlays_before
== NULL
);
3915 eassert (buf
->overlays_after
== NULL
);
3917 set_buffer_internal (buf
);
3919 buf
->enable_multibyte_characters
= Qnil
;
3921 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3922 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3923 val
= call2 (Vset_auto_coding_function
,
3924 filename
, make_number (nread
));
3925 set_buffer_internal (prev
);
3927 /* Discard the unwind protect for recovering the
3931 /* Rewind the file for the actual read done later. */
3932 if (lseek (fd
, 0, 0) < 0)
3933 report_file_error ("Setting file position",
3934 Fcons (orig_filename
, Qnil
));
3940 /* If we have not yet decided a coding system, check
3941 file-coding-system-alist. */
3942 Lisp_Object args
[6], coding_systems
;
3944 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3945 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3946 coding_systems
= Ffind_operation_coding_system (6, args
);
3947 if (CONSP (coding_systems
))
3948 val
= XCAR (coding_systems
);
3952 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3953 /* Ensure we set Vlast_coding_system_used. */
3954 set_coding_system
= 1;
3956 if (NILP (current_buffer
->enable_multibyte_characters
)
3958 /* We must suppress all character code conversion except for
3959 end-of-line conversion. */
3960 setup_raw_text_coding_system (&coding
);
3962 coding
.src_multibyte
= 0;
3963 coding
.dst_multibyte
3964 = !NILP (current_buffer
->enable_multibyte_characters
);
3965 coding_system_decided
= 1;
3968 /* If requested, replace the accessible part of the buffer
3969 with the file contents. Avoid replacing text at the
3970 beginning or end of the buffer that matches the file contents;
3971 that preserves markers pointing to the unchanged parts.
3973 Here we implement this feature in an optimized way
3974 for the case where code conversion is NOT needed.
3975 The following if-statement handles the case of conversion
3976 in a less optimal way.
3978 If the code conversion is "automatic" then we try using this
3979 method and hope for the best.
3980 But if we discover the need for conversion, we give up on this method
3981 and let the following if-statement handle the replace job. */
3984 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3986 /* same_at_start and same_at_end count bytes,
3987 because file access counts bytes
3988 and BEG and END count bytes. */
3989 int same_at_start
= BEGV_BYTE
;
3990 int same_at_end
= ZV_BYTE
;
3992 /* There is still a possibility we will find the need to do code
3993 conversion. If that happens, we set this variable to 1 to
3994 give up on handling REPLACE in the optimized way. */
3995 int giveup_match_end
= 0;
3997 if (XINT (beg
) != 0)
3999 if (lseek (fd
, XINT (beg
), 0) < 0)
4000 report_file_error ("Setting file position",
4001 Fcons (orig_filename
, Qnil
));
4006 /* Count how many chars at the start of the file
4007 match the text at the beginning of the buffer. */
4012 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4014 error ("IO error reading %s: %s",
4015 SDATA (orig_filename
), emacs_strerror (errno
));
4016 else if (nread
== 0)
4019 if (coding
.type
== coding_type_undecided
)
4020 detect_coding (&coding
, buffer
, nread
);
4021 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4022 /* We found that the file should be decoded somehow.
4023 Let's give up here. */
4025 giveup_match_end
= 1;
4029 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4030 detect_eol (&coding
, buffer
, nread
);
4031 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4032 && coding
.eol_type
!= CODING_EOL_LF
)
4033 /* We found that the format of eol should be decoded.
4034 Let's give up here. */
4036 giveup_match_end
= 1;
4041 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4042 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4043 same_at_start
++, bufpos
++;
4044 /* If we found a discrepancy, stop the scan.
4045 Otherwise loop around and scan the next bufferful. */
4046 if (bufpos
!= nread
)
4050 /* If the file matches the buffer completely,
4051 there's no need to replace anything. */
4052 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4056 /* Truncate the buffer to the size of the file. */
4057 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4062 /* Count how many chars at the end of the file
4063 match the text at the end of the buffer. But, if we have
4064 already found that decoding is necessary, don't waste time. */
4065 while (!giveup_match_end
)
4067 int total_read
, nread
, bufpos
, curpos
, trial
;
4069 /* At what file position are we now scanning? */
4070 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4071 /* If the entire file matches the buffer tail, stop the scan. */
4074 /* How much can we scan in the next step? */
4075 trial
= min (curpos
, sizeof buffer
);
4076 if (lseek (fd
, curpos
- trial
, 0) < 0)
4077 report_file_error ("Setting file position",
4078 Fcons (orig_filename
, Qnil
));
4080 total_read
= nread
= 0;
4081 while (total_read
< trial
)
4083 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4085 error ("IO error reading %s: %s",
4086 SDATA (orig_filename
), emacs_strerror (errno
));
4087 else if (nread
== 0)
4089 total_read
+= nread
;
4092 /* Scan this bufferful from the end, comparing with
4093 the Emacs buffer. */
4094 bufpos
= total_read
;
4096 /* Compare with same_at_start to avoid counting some buffer text
4097 as matching both at the file's beginning and at the end. */
4098 while (bufpos
> 0 && same_at_end
> same_at_start
4099 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4100 same_at_end
--, bufpos
--;
4102 /* If we found a discrepancy, stop the scan.
4103 Otherwise loop around and scan the preceding bufferful. */
4106 /* If this discrepancy is because of code conversion,
4107 we cannot use this method; giveup and try the other. */
4108 if (same_at_end
> same_at_start
4109 && FETCH_BYTE (same_at_end
- 1) >= 0200
4110 && ! NILP (current_buffer
->enable_multibyte_characters
)
4111 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4112 giveup_match_end
= 1;
4121 if (! giveup_match_end
)
4125 /* We win! We can handle REPLACE the optimized way. */
4127 /* Extend the start of non-matching text area to multibyte
4128 character boundary. */
4129 if (! NILP (current_buffer
->enable_multibyte_characters
))
4130 while (same_at_start
> BEGV_BYTE
4131 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4134 /* Extend the end of non-matching text area to multibyte
4135 character boundary. */
4136 if (! NILP (current_buffer
->enable_multibyte_characters
))
4137 while (same_at_end
< ZV_BYTE
4138 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4141 /* Don't try to reuse the same piece of text twice. */
4142 overlap
= (same_at_start
- BEGV_BYTE
4143 - (same_at_end
+ st
.st_size
- ZV
));
4145 same_at_end
+= overlap
;
4147 /* Arrange to read only the nonmatching middle part of the file. */
4148 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4149 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4151 del_range_byte (same_at_start
, same_at_end
, 0);
4152 /* Insert from the file at the proper position. */
4153 temp
= BYTE_TO_CHAR (same_at_start
);
4154 SET_PT_BOTH (temp
, same_at_start
);
4156 /* If display currently starts at beginning of line,
4157 keep it that way. */
4158 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4159 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4161 replace_handled
= 1;
4165 /* If requested, replace the accessible part of the buffer
4166 with the file contents. Avoid replacing text at the
4167 beginning or end of the buffer that matches the file contents;
4168 that preserves markers pointing to the unchanged parts.
4170 Here we implement this feature for the case where code conversion
4171 is needed, in a simple way that needs a lot of memory.
4172 The preceding if-statement handles the case of no conversion
4173 in a more optimized way. */
4174 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4176 int same_at_start
= BEGV_BYTE
;
4177 int same_at_end
= ZV_BYTE
;
4180 /* Make sure that the gap is large enough. */
4181 int bufsize
= 2 * st
.st_size
;
4182 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4185 /* First read the whole file, performing code conversion into
4186 CONVERSION_BUFFER. */
4188 if (lseek (fd
, XINT (beg
), 0) < 0)
4190 xfree (conversion_buffer
);
4191 report_file_error ("Setting file position",
4192 Fcons (orig_filename
, Qnil
));
4195 total
= st
.st_size
; /* Total bytes in the file. */
4196 how_much
= 0; /* Bytes read from file so far. */
4197 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4198 unprocessed
= 0; /* Bytes not processed in previous loop. */
4200 while (how_much
< total
)
4202 /* try is reserved in some compilers (Microsoft C) */
4203 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4204 unsigned char *destination
= read_buf
+ unprocessed
;
4207 /* Allow quitting out of the actual I/O. */
4210 this = emacs_read (fd
, destination
, trytry
);
4213 if (this < 0 || this + unprocessed
== 0)
4221 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4223 int require
, result
;
4225 this += unprocessed
;
4227 /* If we are using more space than estimated,
4228 make CONVERSION_BUFFER bigger. */
4229 require
= decoding_buffer_size (&coding
, this);
4230 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4232 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4233 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4236 /* Convert this batch with results in CONVERSION_BUFFER. */
4237 if (how_much
>= total
) /* This is the last block. */
4238 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4239 if (coding
.composing
!= COMPOSITION_DISABLED
)
4240 coding_allocate_composition_data (&coding
, BEGV
);
4241 result
= decode_coding (&coding
, read_buf
,
4242 conversion_buffer
+ inserted
,
4243 this, bufsize
- inserted
);
4245 /* Save for next iteration whatever we didn't convert. */
4246 unprocessed
= this - coding
.consumed
;
4247 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4248 if (!NILP (current_buffer
->enable_multibyte_characters
))
4249 this = coding
.produced
;
4251 this = str_as_unibyte (conversion_buffer
+ inserted
,
4258 /* At this point, INSERTED is how many characters (i.e. bytes)
4259 are present in CONVERSION_BUFFER.
4260 HOW_MUCH should equal TOTAL,
4261 or should be <= 0 if we couldn't read the file. */
4265 xfree (conversion_buffer
);
4266 coding_free_composition_data (&coding
);
4268 error ("IO error reading %s: %s",
4269 SDATA (orig_filename
), emacs_strerror (errno
));
4270 else if (how_much
== -2)
4271 error ("maximum buffer size exceeded");
4274 /* Compare the beginning of the converted file
4275 with the buffer text. */
4278 while (bufpos
< inserted
&& same_at_start
< same_at_end
4279 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4280 same_at_start
++, bufpos
++;
4282 /* If the file matches the buffer completely,
4283 there's no need to replace anything. */
4285 if (bufpos
== inserted
)
4287 xfree (conversion_buffer
);
4288 coding_free_composition_data (&coding
);
4291 /* Truncate the buffer to the size of the file. */
4292 del_range_byte (same_at_start
, same_at_end
, 0);
4297 /* Extend the start of non-matching text area to multibyte
4298 character boundary. */
4299 if (! NILP (current_buffer
->enable_multibyte_characters
))
4300 while (same_at_start
> BEGV_BYTE
4301 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4304 /* Scan this bufferful from the end, comparing with
4305 the Emacs buffer. */
4308 /* Compare with same_at_start to avoid counting some buffer text
4309 as matching both at the file's beginning and at the end. */
4310 while (bufpos
> 0 && same_at_end
> same_at_start
4311 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4312 same_at_end
--, bufpos
--;
4314 /* Extend the end of non-matching text area to multibyte
4315 character boundary. */
4316 if (! NILP (current_buffer
->enable_multibyte_characters
))
4317 while (same_at_end
< ZV_BYTE
4318 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4321 /* Don't try to reuse the same piece of text twice. */
4322 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4324 same_at_end
+= overlap
;
4326 /* If display currently starts at beginning of line,
4327 keep it that way. */
4328 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4329 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4331 /* Replace the chars that we need to replace,
4332 and update INSERTED to equal the number of bytes
4333 we are taking from the file. */
4334 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4336 if (same_at_end
!= same_at_start
)
4338 del_range_byte (same_at_start
, same_at_end
, 0);
4340 same_at_start
= GPT_BYTE
;
4344 temp
= BYTE_TO_CHAR (same_at_start
);
4346 /* Insert from the file at the proper position. */
4347 SET_PT_BOTH (temp
, same_at_start
);
4348 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4350 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4351 coding_restore_composition (&coding
, Fcurrent_buffer ());
4352 coding_free_composition_data (&coding
);
4354 /* Set `inserted' to the number of inserted characters. */
4355 inserted
= PT
- temp
;
4357 xfree (conversion_buffer
);
4366 register Lisp_Object temp
;
4368 total
= XINT (end
) - XINT (beg
);
4370 /* Make sure point-max won't overflow after this insertion. */
4371 XSETINT (temp
, total
);
4372 if (total
!= XINT (temp
))
4373 error ("Maximum buffer size exceeded");
4376 /* For a special file, all we can do is guess. */
4377 total
= READ_BUF_SIZE
;
4379 if (NILP (visit
) && total
> 0)
4380 prepare_to_modify_buffer (PT
, PT
, NULL
);
4383 if (GAP_SIZE
< total
)
4384 make_gap (total
- GAP_SIZE
);
4386 if (XINT (beg
) != 0 || !NILP (replace
))
4388 if (lseek (fd
, XINT (beg
), 0) < 0)
4389 report_file_error ("Setting file position",
4390 Fcons (orig_filename
, Qnil
));
4393 /* In the following loop, HOW_MUCH contains the total bytes read so
4394 far for a regular file, and not changed for a special file. But,
4395 before exiting the loop, it is set to a negative value if I/O
4399 /* Total bytes inserted. */
4402 /* Here, we don't do code conversion in the loop. It is done by
4403 code_convert_region after all data are read into the buffer. */
4405 int gap_size
= GAP_SIZE
;
4407 while (how_much
< total
)
4409 /* try is reserved in some compilers (Microsoft C) */
4410 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4417 /* Maybe make more room. */
4418 if (gap_size
< trytry
)
4420 make_gap (total
- gap_size
);
4421 gap_size
= GAP_SIZE
;
4424 /* Read from the file, capturing `quit'. When an
4425 error occurs, end the loop, and arrange for a quit
4426 to be signaled after decoding the text we read. */
4427 non_regular_fd
= fd
;
4428 non_regular_inserted
= inserted
;
4429 non_regular_nbytes
= trytry
;
4430 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4431 read_non_regular_quit
);
4442 /* Allow quitting out of the actual I/O. We don't make text
4443 part of the buffer until all the reading is done, so a C-g
4444 here doesn't do any harm. */
4447 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4459 /* For a regular file, where TOTAL is the real size,
4460 count HOW_MUCH to compare with it.
4461 For a special file, where TOTAL is just a buffer size,
4462 so don't bother counting in HOW_MUCH.
4463 (INSERTED is where we count the number of characters inserted.) */
4470 /* Make the text read part of the buffer. */
4471 GAP_SIZE
-= inserted
;
4473 GPT_BYTE
+= inserted
;
4475 ZV_BYTE
+= inserted
;
4480 /* Put an anchor to ensure multi-byte form ends at gap. */
4485 /* Discard the unwind protect for closing the file. */
4489 error ("IO error reading %s: %s",
4490 SDATA (orig_filename
), emacs_strerror (errno
));
4494 if (! coding_system_decided
)
4496 /* The coding system is not yet decided. Decide it by an
4497 optimized method for handling `coding:' tag.
4499 Note that we can get here only if the buffer was empty
4500 before the insertion. */
4504 if (!NILP (Vcoding_system_for_read
))
4505 val
= Vcoding_system_for_read
;
4508 /* Since we are sure that the current buffer was empty
4509 before the insertion, we can toggle
4510 enable-multibyte-characters directly here without taking
4511 care of marker adjustment and byte combining problem. By
4512 this way, we can run Lisp program safely before decoding
4513 the inserted text. */
4514 Lisp_Object unwind_data
;
4515 int count
= SPECPDL_INDEX ();
4517 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4518 Fcons (current_buffer
->undo_list
,
4519 Fcurrent_buffer ()));
4520 current_buffer
->enable_multibyte_characters
= Qnil
;
4521 current_buffer
->undo_list
= Qt
;
4522 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4524 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4526 val
= call2 (Vset_auto_coding_function
,
4527 filename
, make_number (inserted
));
4532 /* If the coding system is not yet decided, check
4533 file-coding-system-alist. */
4534 Lisp_Object args
[6], coding_systems
;
4536 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4537 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4538 coding_systems
= Ffind_operation_coding_system (6, args
);
4539 if (CONSP (coding_systems
))
4540 val
= XCAR (coding_systems
);
4542 unbind_to (count
, Qnil
);
4543 inserted
= Z_BYTE
- BEG_BYTE
;
4546 /* The following kludgy code is to avoid some compiler bug.
4548 setup_coding_system (val, &coding);
4551 struct coding_system temp_coding
;
4552 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4553 bcopy (&temp_coding
, &coding
, sizeof coding
);
4555 /* Ensure we set Vlast_coding_system_used. */
4556 set_coding_system
= 1;
4558 if (NILP (current_buffer
->enable_multibyte_characters
)
4560 /* We must suppress all character code conversion except for
4561 end-of-line conversion. */
4562 setup_raw_text_coding_system (&coding
);
4563 coding
.src_multibyte
= 0;
4564 coding
.dst_multibyte
4565 = !NILP (current_buffer
->enable_multibyte_characters
);
4569 /* Can't do this if part of the buffer might be preserved. */
4571 && (coding
.type
== coding_type_no_conversion
4572 || coding
.type
== coding_type_raw_text
))
4574 /* Visiting a file with these coding system makes the buffer
4576 current_buffer
->enable_multibyte_characters
= Qnil
;
4577 coding
.dst_multibyte
= 0;
4580 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4582 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4584 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4586 inserted
= coding
.produced_char
;
4589 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4593 /* Now INSERTED is measured in characters. */
4596 /* Use the conversion type to determine buffer-file-type
4597 (find-buffer-file-type is now used to help determine the
4599 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4600 || coding
.eol_type
== CODING_EOL_LF
)
4601 && ! CODING_REQUIRE_DECODING (&coding
))
4602 current_buffer
->buffer_file_type
= Qt
;
4604 current_buffer
->buffer_file_type
= Qnil
;
4611 if (!EQ (current_buffer
->undo_list
, Qt
))
4612 current_buffer
->undo_list
= Qnil
;
4614 stat (SDATA (filename
), &st
);
4619 current_buffer
->modtime
= st
.st_mtime
;
4620 current_buffer
->filename
= orig_filename
;
4623 SAVE_MODIFF
= MODIFF
;
4624 current_buffer
->auto_save_modified
= MODIFF
;
4625 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4626 #ifdef CLASH_DETECTION
4629 if (!NILP (current_buffer
->file_truename
))
4630 unlock_file (current_buffer
->file_truename
);
4631 unlock_file (filename
);
4633 #endif /* CLASH_DETECTION */
4635 Fsignal (Qfile_error
,
4636 Fcons (build_string ("not a regular file"),
4637 Fcons (orig_filename
, Qnil
)));
4640 if (set_coding_system
)
4641 Vlast_coding_system_used
= coding
.symbol
;
4643 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4645 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4647 if (! NILP (insval
))
4649 CHECK_NUMBER (insval
);
4650 inserted
= XFASTINT (insval
);
4654 /* Decode file format */
4657 int empty_undo_list_p
= 0;
4659 /* If we're anyway going to discard undo information, don't
4660 record it in the first place. The buffer's undo list at this
4661 point is either nil or t when visiting a file. */
4664 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4665 current_buffer
->undo_list
= Qt
;
4668 insval
= call3 (Qformat_decode
,
4669 Qnil
, make_number (inserted
), visit
);
4670 CHECK_NUMBER (insval
);
4671 inserted
= XFASTINT (insval
);
4674 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4677 /* Call after-change hooks for the inserted text, aside from the case
4678 of normal visiting (not with REPLACE), which is done in a new buffer
4679 "before" the buffer is changed. */
4680 if (inserted
> 0 && total
> 0
4681 && (NILP (visit
) || !NILP (replace
)))
4683 signal_after_change (PT
, 0, inserted
);
4684 update_compositions (PT
, PT
, CHECK_BORDER
);
4687 p
= Vafter_insert_file_functions
;
4690 insval
= call1 (XCAR (p
), make_number (inserted
));
4693 CHECK_NUMBER (insval
);
4694 inserted
= XFASTINT (insval
);
4701 && current_buffer
->modtime
== -1)
4703 /* If visiting nonexistent file, return nil. */
4704 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4708 Fsignal (Qquit
, Qnil
);
4710 /* ??? Retval needs to be dealt with in all cases consistently. */
4712 val
= Fcons (orig_filename
,
4713 Fcons (make_number (inserted
),
4716 RETURN_UNGCPRO (unbind_to (count
, val
));
4719 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4720 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4721 Lisp_Object
, Lisp_Object
));
4723 /* If build_annotations switched buffers, switch back to BUF.
4724 Kill the temporary buffer that was selected in the meantime.
4726 Since this kill only the last temporary buffer, some buffers remain
4727 not killed if build_annotations switched buffers more than once.
4731 build_annotations_unwind (buf
)
4736 if (XBUFFER (buf
) == current_buffer
)
4738 tembuf
= Fcurrent_buffer ();
4740 Fkill_buffer (tembuf
);
4744 /* Decide the coding-system to encode the data with. */
4747 choose_write_coding_system (start
, end
, filename
,
4748 append
, visit
, lockname
, coding
)
4749 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4750 struct coding_system
*coding
;
4755 && NILP (Fstring_equal (current_buffer
->filename
,
4756 current_buffer
->auto_save_file_name
)))
4758 /* We use emacs-mule for auto saving... */
4759 setup_coding_system (Qemacs_mule
, coding
);
4760 /* ... but with the special flag to indicate not to strip off
4761 leading code of eight-bit-control chars. */
4763 goto done_setup_coding
;
4765 else if (!NILP (Vcoding_system_for_write
))
4767 val
= Vcoding_system_for_write
;
4768 if (coding_system_require_warning
4769 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4770 /* Confirm that VAL can surely encode the current region. */
4771 val
= call5 (Vselect_safe_coding_system_function
,
4772 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4777 /* If the variable `buffer-file-coding-system' is set locally,
4778 it means that the file was read with some kind of code
4779 conversion or the variable is explicitly set by users. We
4780 had better write it out with the same coding system even if
4781 `enable-multibyte-characters' is nil.
4783 If it is not set locally, we anyway have to convert EOL
4784 format if the default value of `buffer-file-coding-system'
4785 tells that it is not Unix-like (LF only) format. */
4786 int using_default_coding
= 0;
4787 int force_raw_text
= 0;
4789 val
= current_buffer
->buffer_file_coding_system
;
4791 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4794 if (NILP (current_buffer
->enable_multibyte_characters
))
4800 /* Check file-coding-system-alist. */
4801 Lisp_Object args
[7], coding_systems
;
4803 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4804 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4806 coding_systems
= Ffind_operation_coding_system (7, args
);
4807 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4808 val
= XCDR (coding_systems
);
4812 && !NILP (current_buffer
->buffer_file_coding_system
))
4814 /* If we still have not decided a coding system, use the
4815 default value of buffer-file-coding-system. */
4816 val
= current_buffer
->buffer_file_coding_system
;
4817 using_default_coding
= 1;
4821 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4822 /* Confirm that VAL can surely encode the current region. */
4823 val
= call5 (Vselect_safe_coding_system_function
,
4824 start
, end
, val
, Qnil
, filename
);
4826 setup_coding_system (Fcheck_coding_system (val
), coding
);
4827 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4828 && !using_default_coding
)
4830 if (! EQ (default_buffer_file_coding
.symbol
,
4831 buffer_defaults
.buffer_file_coding_system
))
4832 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4833 &default_buffer_file_coding
);
4834 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4836 Lisp_Object subsidiaries
;
4838 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4839 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4840 if (VECTORP (subsidiaries
)
4841 && XVECTOR (subsidiaries
)->size
== 3)
4843 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4848 setup_raw_text_coding_system (coding
);
4849 goto done_setup_coding
;
4852 setup_coding_system (Fcheck_coding_system (val
), coding
);
4855 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4856 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4859 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4860 "r\nFWrite region to file: \ni\ni\ni\np",
4861 doc
: /* Write current region into specified file.
4862 When called from a program, requires three arguments:
4863 START, END and FILENAME. START and END are normally buffer positions
4864 specifying the part of the buffer to write.
4865 If START is nil, that means to use the entire buffer contents.
4866 If START is a string, then output that string to the file
4867 instead of any buffer contents; END is ignored.
4869 Optional fourth argument APPEND if non-nil means
4870 append to existing file contents (if any). If it is an integer,
4871 seek to that offset in the file before writing.
4872 Optional fifth argument VISIT, if t or a string, means
4873 set the last-save-file-modtime of buffer to this file's modtime
4874 and mark buffer not modified.
4875 If VISIT is a string, it is a second file name;
4876 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4877 VISIT is also the file name to lock and unlock for clash detection.
4878 If VISIT is neither t nor nil nor a string,
4879 that means do not display the \"Wrote file\" message.
4880 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4881 use for locking and unlocking, overriding FILENAME and VISIT.
4882 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4883 for an existing file with the same name. If MUSTBENEW is `excl',
4884 that means to get an error if the file already exists; never overwrite.
4885 If MUSTBENEW is neither nil nor `excl', that means ask for
4886 confirmation before overwriting, but do go ahead and overwrite the file
4887 if the user confirms.
4889 This does code conversion according to the value of
4890 `coding-system-for-write', `buffer-file-coding-system', or
4891 `file-coding-system-alist', and sets the variable
4892 `last-coding-system-used' to the coding system actually used. */)
4893 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4894 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4899 const unsigned char *fn
;
4902 int count
= SPECPDL_INDEX ();
4905 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4907 Lisp_Object handler
;
4908 Lisp_Object visit_file
;
4909 Lisp_Object annotations
;
4910 Lisp_Object encoded_filename
;
4911 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4912 int quietly
= !NILP (visit
);
4913 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4914 struct buffer
*given_buffer
;
4916 int buffer_file_type
= O_BINARY
;
4918 struct coding_system coding
;
4920 if (current_buffer
->base_buffer
&& visiting
)
4921 error ("Cannot do file visiting in an indirect buffer");
4923 if (!NILP (start
) && !STRINGP (start
))
4924 validate_region (&start
, &end
);
4926 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4928 filename
= Fexpand_file_name (filename
, Qnil
);
4930 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4931 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4933 if (STRINGP (visit
))
4934 visit_file
= Fexpand_file_name (visit
, Qnil
);
4936 visit_file
= filename
;
4938 if (NILP (lockname
))
4939 lockname
= visit_file
;
4943 /* If the file name has special constructs in it,
4944 call the corresponding file handler. */
4945 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4946 /* If FILENAME has no handler, see if VISIT has one. */
4947 if (NILP (handler
) && STRINGP (visit
))
4948 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4950 if (!NILP (handler
))
4953 val
= call6 (handler
, Qwrite_region
, start
, end
,
4954 filename
, append
, visit
);
4958 SAVE_MODIFF
= MODIFF
;
4959 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4960 current_buffer
->filename
= visit_file
;
4966 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4968 /* Special kludge to simplify auto-saving. */
4971 XSETFASTINT (start
, BEG
);
4972 XSETFASTINT (end
, Z
);
4976 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4977 count1
= SPECPDL_INDEX ();
4979 given_buffer
= current_buffer
;
4981 if (!STRINGP (start
))
4983 annotations
= build_annotations (start
, end
);
4985 if (current_buffer
!= given_buffer
)
4987 XSETFASTINT (start
, BEGV
);
4988 XSETFASTINT (end
, ZV
);
4994 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4996 /* Decide the coding-system to encode the data with.
4997 We used to make this choice before calling build_annotations, but that
4998 leads to problems when a write-annotate-function takes care of
4999 unsavable chars (as was the case with X-Symbol). */
5000 choose_write_coding_system (start
, end
, filename
,
5001 append
, visit
, lockname
, &coding
);
5002 Vlast_coding_system_used
= coding
.symbol
;
5004 given_buffer
= current_buffer
;
5005 if (! STRINGP (start
))
5007 annotations
= build_annotations_2 (start
, end
,
5008 coding
.pre_write_conversion
, annotations
);
5009 if (current_buffer
!= given_buffer
)
5011 XSETFASTINT (start
, BEGV
);
5012 XSETFASTINT (end
, ZV
);
5016 #ifdef CLASH_DETECTION
5019 #if 0 /* This causes trouble for GNUS. */
5020 /* If we've locked this file for some other buffer,
5021 query before proceeding. */
5022 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5023 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5026 lock_file (lockname
);
5028 #endif /* CLASH_DETECTION */
5030 encoded_filename
= ENCODE_FILE (filename
);
5032 fn
= SDATA (encoded_filename
);
5036 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5037 #else /* not DOS_NT */
5038 desc
= emacs_open (fn
, O_WRONLY
, 0);
5039 #endif /* not DOS_NT */
5041 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5043 if (auto_saving
) /* Overwrite any previous version of autosave file */
5045 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5046 desc
= emacs_open (fn
, O_RDWR
, 0);
5048 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5049 ? SDATA (current_buffer
->filename
) : 0,
5052 else /* Write to temporary name and rename if no errors */
5054 Lisp_Object temp_name
;
5055 temp_name
= Ffile_name_directory (filename
);
5057 if (!NILP (temp_name
))
5059 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5060 build_string ("$$SAVE$$")));
5061 fname
= SDATA (filename
);
5062 fn
= SDATA (temp_name
);
5063 desc
= creat_copy_attrs (fname
, fn
);
5066 /* If we can't open the temporary file, try creating a new
5067 version of the original file. VMS "creat" creates a
5068 new version rather than truncating an existing file. */
5071 desc
= creat (fn
, 0666);
5072 #if 0 /* This can clobber an existing file and fail to replace it,
5073 if the user runs out of space. */
5076 /* We can't make a new version;
5077 try to truncate and rewrite existing version if any. */
5079 desc
= emacs_open (fn
, O_RDWR
, 0);
5085 desc
= creat (fn
, 0666);
5089 desc
= emacs_open (fn
,
5090 O_WRONLY
| O_CREAT
| buffer_file_type
5091 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5092 S_IREAD
| S_IWRITE
);
5093 #else /* not DOS_NT */
5094 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5095 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5096 auto_saving
? auto_save_mode_bits
: 0666);
5097 #endif /* not DOS_NT */
5098 #endif /* not VMS */
5102 #ifdef CLASH_DETECTION
5104 if (!auto_saving
) unlock_file (lockname
);
5106 #endif /* CLASH_DETECTION */
5108 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5111 record_unwind_protect (close_file_unwind
, make_number (desc
));
5113 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5117 if (NUMBERP (append
))
5118 ret
= lseek (desc
, XINT (append
), 1);
5120 ret
= lseek (desc
, 0, 2);
5123 #ifdef CLASH_DETECTION
5124 if (!auto_saving
) unlock_file (lockname
);
5125 #endif /* CLASH_DETECTION */
5127 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5135 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5136 * if we do writes that don't end with a carriage return. Furthermore
5137 * it cannot handle writes of more then 16K. The modified
5138 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5139 * this EXCEPT for the last record (iff it doesn't end with a carriage
5140 * return). This implies that if your buffer doesn't end with a carriage
5141 * return, you get one free... tough. However it also means that if
5142 * we make two calls to sys_write (a la the following code) you can
5143 * get one at the gap as well. The easiest way to fix this (honest)
5144 * is to move the gap to the next newline (or the end of the buffer).
5149 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5150 move_gap (find_next_newline (GPT
, 1));
5152 /* Whether VMS or not, we must move the gap to the next of newline
5153 when we must put designation sequences at beginning of line. */
5154 if (INTEGERP (start
)
5155 && coding
.type
== coding_type_iso2022
5156 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5157 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5159 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5160 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5161 move_gap_both (PT
, PT_BYTE
);
5162 SET_PT_BOTH (opoint
, opoint_byte
);
5169 if (STRINGP (start
))
5171 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5172 &annotations
, &coding
);
5175 else if (XINT (start
) != XINT (end
))
5177 tem
= CHAR_TO_BYTE (XINT (start
));
5179 if (XINT (start
) < GPT
)
5181 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5182 min (GPT
, XINT (end
)) - XINT (start
),
5183 &annotations
, &coding
);
5187 if (XINT (end
) > GPT
&& !failure
)
5189 tem
= max (XINT (start
), GPT
);
5190 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5191 &annotations
, &coding
);
5197 /* If file was empty, still need to write the annotations */
5198 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5199 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5203 if (CODING_REQUIRE_FLUSHING (&coding
)
5204 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5207 /* We have to flush out a data. */
5208 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5209 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5216 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5217 Disk full in NFS may be reported here. */
5218 /* mib says that closing the file will try to write as fast as NFS can do
5219 it, and that means the fsync here is not crucial for autosave files. */
5220 if (!auto_saving
&& fsync (desc
) < 0)
5222 /* If fsync fails with EINTR, don't treat that as serious. */
5224 failure
= 1, save_errno
= errno
;
5228 /* Spurious "file has changed on disk" warnings have been
5229 observed on Suns as well.
5230 It seems that `close' can change the modtime, under nfs.
5232 (This has supposedly been fixed in Sunos 4,
5233 but who knows about all the other machines with NFS?) */
5236 /* On VMS and APOLLO, must do the stat after the close
5237 since closing changes the modtime. */
5240 /* Recall that #if defined does not work on VMS. */
5247 /* NFS can report a write failure now. */
5248 if (emacs_close (desc
) < 0)
5249 failure
= 1, save_errno
= errno
;
5252 /* If we wrote to a temporary name and had no errors, rename to real name. */
5256 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5264 /* Discard the unwind protect for close_file_unwind. */
5265 specpdl_ptr
= specpdl
+ count1
;
5266 /* Restore the original current buffer. */
5267 visit_file
= unbind_to (count
, visit_file
);
5269 #ifdef CLASH_DETECTION
5271 unlock_file (lockname
);
5272 #endif /* CLASH_DETECTION */
5274 /* Do this before reporting IO error
5275 to avoid a "file has changed on disk" warning on
5276 next attempt to save. */
5278 current_buffer
->modtime
= st
.st_mtime
;
5281 error ("IO error writing %s: %s", SDATA (filename
),
5282 emacs_strerror (save_errno
));
5286 SAVE_MODIFF
= MODIFF
;
5287 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5288 current_buffer
->filename
= visit_file
;
5289 update_mode_lines
++;
5294 && ! NILP (Fstring_equal (current_buffer
->filename
,
5295 current_buffer
->auto_save_file_name
)))
5296 SAVE_MODIFF
= MODIFF
;
5302 message_with_string ((INTEGERP (append
)
5312 Lisp_Object
merge ();
5314 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5315 doc
: /* Return t if (car A) is numerically less than (car B). */)
5319 return Flss (Fcar (a
), Fcar (b
));
5322 /* Build the complete list of annotations appropriate for writing out
5323 the text between START and END, by calling all the functions in
5324 write-region-annotate-functions and merging the lists they return.
5325 If one of these functions switches to a different buffer, we assume
5326 that buffer contains altered text. Therefore, the caller must
5327 make sure to restore the current buffer in all cases,
5328 as save-excursion would do. */
5331 build_annotations (start
, end
)
5332 Lisp_Object start
, end
;
5334 Lisp_Object annotations
;
5336 struct gcpro gcpro1
, gcpro2
;
5337 Lisp_Object original_buffer
;
5338 int i
, used_global
= 0;
5340 XSETBUFFER (original_buffer
, current_buffer
);
5343 p
= Vwrite_region_annotate_functions
;
5344 GCPRO2 (annotations
, p
);
5347 struct buffer
*given_buffer
= current_buffer
;
5348 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5349 { /* Use the global value of the hook. */
5352 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5354 p
= Fappend (2, arg
);
5357 Vwrite_region_annotations_so_far
= annotations
;
5358 res
= call2 (XCAR (p
), start
, end
);
5359 /* If the function makes a different buffer current,
5360 assume that means this buffer contains altered text to be output.
5361 Reset START and END from the buffer bounds
5362 and discard all previous annotations because they should have
5363 been dealt with by this function. */
5364 if (current_buffer
!= given_buffer
)
5366 XSETFASTINT (start
, BEGV
);
5367 XSETFASTINT (end
, ZV
);
5370 Flength (res
); /* Check basic validity of return value */
5371 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5375 /* Now do the same for annotation functions implied by the file-format */
5376 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5377 p
= current_buffer
->auto_save_file_format
;
5379 p
= current_buffer
->file_format
;
5380 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5382 struct buffer
*given_buffer
= current_buffer
;
5384 Vwrite_region_annotations_so_far
= annotations
;
5386 /* Value is either a list of annotations or nil if the function
5387 has written annotations to a temporary buffer, which is now
5389 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5390 original_buffer
, make_number (i
));
5391 if (current_buffer
!= given_buffer
)
5393 XSETFASTINT (start
, BEGV
);
5394 XSETFASTINT (end
, ZV
);
5399 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5407 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5408 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5410 struct gcpro gcpro1
;
5413 GCPRO1 (annotations
);
5414 /* At last, do the same for the function PRE_WRITE_CONVERSION
5415 implied by the current coding-system. */
5416 if (!NILP (pre_write_conversion
))
5418 struct buffer
*given_buffer
= current_buffer
;
5419 Vwrite_region_annotations_so_far
= annotations
;
5420 res
= call2 (pre_write_conversion
, start
, end
);
5422 annotations
= (current_buffer
!= given_buffer
5424 : merge (annotations
, res
, Qcar_less_than_car
));
5431 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5432 If STRING is nil, POS is the character position in the current buffer.
5433 Intersperse with them the annotations from *ANNOT
5434 which fall within the range of POS to POS + NCHARS,
5435 each at its appropriate position.
5437 We modify *ANNOT by discarding elements as we use them up.
5439 The return value is negative in case of system call failure. */
5442 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5445 register int nchars
;
5448 struct coding_system
*coding
;
5452 int lastpos
= pos
+ nchars
;
5454 while (NILP (*annot
) || CONSP (*annot
))
5456 tem
= Fcar_safe (Fcar (*annot
));
5459 nextpos
= XFASTINT (tem
);
5461 /* If there are no more annotations in this range,
5462 output the rest of the range all at once. */
5463 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5464 return e_write (desc
, string
, pos
, lastpos
, coding
);
5466 /* Output buffer text up to the next annotation's position. */
5469 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5473 /* Output the annotation. */
5474 tem
= Fcdr (Fcar (*annot
));
5477 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5480 *annot
= Fcdr (*annot
);
5485 #ifndef WRITE_BUF_SIZE
5486 #define WRITE_BUF_SIZE (16 * 1024)
5489 /* Write text in the range START and END into descriptor DESC,
5490 encoding them with coding system CODING. If STRING is nil, START
5491 and END are character positions of the current buffer, else they
5492 are indexes to the string STRING. */
5495 e_write (desc
, string
, start
, end
, coding
)
5499 struct coding_system
*coding
;
5501 register char *addr
;
5502 register int nbytes
;
5503 char buf
[WRITE_BUF_SIZE
];
5507 coding
->composing
= COMPOSITION_DISABLED
;
5508 if (coding
->composing
!= COMPOSITION_DISABLED
)
5509 coding_save_composition (coding
, start
, end
, string
);
5511 if (STRINGP (string
))
5513 addr
= SDATA (string
);
5514 nbytes
= SBYTES (string
);
5515 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5517 else if (start
< end
)
5519 /* It is assured that the gap is not in the range START and END-1. */
5520 addr
= CHAR_POS_ADDR (start
);
5521 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5522 coding
->src_multibyte
5523 = !NILP (current_buffer
->enable_multibyte_characters
);
5529 coding
->src_multibyte
= 1;
5532 /* We used to have a code for handling selective display here. But,
5533 now it is handled within encode_coding. */
5538 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5539 if (coding
->produced
> 0)
5541 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5542 if (coding
->produced
)
5548 nbytes
-= coding
->consumed
;
5549 addr
+= coding
->consumed
;
5550 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5553 /* The source text ends by an incomplete multibyte form.
5554 There's no way other than write it out as is. */
5555 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5564 start
+= coding
->consumed_char
;
5565 if (coding
->cmp_data
)
5566 coding_adjust_composition_offset (coding
, start
);
5569 if (coding
->cmp_data
)
5570 coding_free_composition_data (coding
);
5575 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5576 Sverify_visited_file_modtime
, 1, 1, 0,
5577 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5578 This means that the file has not been changed since it was visited or saved.
5579 See Info node `(elisp)Modification Time' for more details. */)
5585 Lisp_Object handler
;
5586 Lisp_Object filename
;
5591 if (!STRINGP (b
->filename
)) return Qt
;
5592 if (b
->modtime
== 0) return Qt
;
5594 /* If the file name has special constructs in it,
5595 call the corresponding file handler. */
5596 handler
= Ffind_file_name_handler (b
->filename
,
5597 Qverify_visited_file_modtime
);
5598 if (!NILP (handler
))
5599 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5601 filename
= ENCODE_FILE (b
->filename
);
5603 if (stat (SDATA (filename
), &st
) < 0)
5605 /* If the file doesn't exist now and didn't exist before,
5606 we say that it isn't modified, provided the error is a tame one. */
5607 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5612 if (st
.st_mtime
== b
->modtime
5613 /* If both are positive, accept them if they are off by one second. */
5614 || (st
.st_mtime
> 0 && b
->modtime
> 0
5615 && (st
.st_mtime
== b
->modtime
+ 1
5616 || st
.st_mtime
== b
->modtime
- 1)))
5621 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5622 Sclear_visited_file_modtime
, 0, 0, 0,
5623 doc
: /* Clear out records of last mod time of visited file.
5624 Next attempt to save will certainly not complain of a discrepancy. */)
5627 current_buffer
->modtime
= 0;
5631 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5632 Svisited_file_modtime
, 0, 0, 0,
5633 doc
: /* Return the current buffer's recorded visited file modification time.
5634 The value is a list of the form (HIGH LOW), like the time values
5635 that `file-attributes' returns. If the current buffer has no recorded
5636 file modification time, this function returns 0.
5637 See Info node `(elisp)Modification Time' for more details. */)
5641 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5643 return list2 (XCAR (tcons
), XCDR (tcons
));
5647 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5648 Sset_visited_file_modtime
, 0, 1, 0,
5649 doc
: /* Update buffer's recorded modification time from the visited file's time.
5650 Useful if the buffer was not read from the file normally
5651 or if the file itself has been changed for some known benign reason.
5652 An argument specifies the modification time value to use
5653 \(instead of that of the visited file), in the form of a list
5654 \(HIGH . LOW) or (HIGH LOW). */)
5656 Lisp_Object time_list
;
5658 if (!NILP (time_list
))
5659 current_buffer
->modtime
= cons_to_long (time_list
);
5662 register Lisp_Object filename
;
5664 Lisp_Object handler
;
5666 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5668 /* If the file name has special constructs in it,
5669 call the corresponding file handler. */
5670 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5671 if (!NILP (handler
))
5672 /* The handler can find the file name the same way we did. */
5673 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5675 filename
= ENCODE_FILE (filename
);
5677 if (stat (SDATA (filename
), &st
) >= 0)
5678 current_buffer
->modtime
= st
.st_mtime
;
5685 auto_save_error (error
)
5688 Lisp_Object args
[3], msg
;
5690 struct gcpro gcpro1
;
5694 args
[0] = build_string ("Auto-saving %s: %s");
5695 args
[1] = current_buffer
->name
;
5696 args
[2] = Ferror_message_string (error
);
5697 msg
= Fformat (3, args
);
5699 nbytes
= SBYTES (msg
);
5701 for (i
= 0; i
< 3; ++i
)
5704 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5706 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5707 Fsleep_for (make_number (1), Qnil
);
5720 auto_save_mode_bits
= 0666;
5722 /* Get visited file's mode to become the auto save file's mode. */
5723 if (! NILP (current_buffer
->filename
))
5725 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5726 /* But make sure we can overwrite it later! */
5727 auto_save_mode_bits
= st
.st_mode
| 0600;
5728 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5730 /* Remote files don't cooperate with stat. */
5731 auto_save_mode_bits
= XINT (modes
) | 0600;
5735 Fwrite_region (Qnil
, Qnil
,
5736 current_buffer
->auto_save_file_name
,
5737 Qnil
, Qlambda
, Qnil
, Qnil
);
5741 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5746 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5747 | XFASTINT (XCDR (stream
))));
5752 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5755 minibuffer_auto_raise
= XINT (value
);
5760 do_auto_save_make_dir (dir
)
5763 return call2 (Qmake_directory
, dir
, Qt
);
5767 do_auto_save_eh (ignore
)
5773 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5774 doc
: /* Auto-save all buffers that need it.
5775 This is all buffers that have auto-saving enabled
5776 and are changed since last auto-saved.
5777 Auto-saving writes the buffer into a file
5778 so that your editing is not lost if the system crashes.
5779 This file is not the file you visited; that changes only when you save.
5780 Normally we run the normal hook `auto-save-hook' before saving.
5782 A non-nil NO-MESSAGE argument means do not print any message if successful.
5783 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5784 (no_message
, current_only
)
5785 Lisp_Object no_message
, current_only
;
5787 struct buffer
*old
= current_buffer
, *b
;
5788 Lisp_Object tail
, buf
;
5790 int do_handled_files
;
5793 Lisp_Object lispstream
;
5794 int count
= SPECPDL_INDEX ();
5795 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5796 int old_message_p
= 0;
5797 struct gcpro gcpro1
, gcpro2
;
5799 if (max_specpdl_size
< specpdl_size
+ 40)
5800 max_specpdl_size
= specpdl_size
+ 40;
5805 if (NILP (no_message
))
5807 old_message_p
= push_message ();
5808 record_unwind_protect (pop_message_unwind
, Qnil
);
5811 /* Ordinarily don't quit within this function,
5812 but don't make it impossible to quit (in case we get hung in I/O). */
5816 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5817 point to non-strings reached from Vbuffer_alist. */
5819 if (!NILP (Vrun_hooks
))
5820 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5822 if (STRINGP (Vauto_save_list_file_name
))
5824 Lisp_Object listfile
;
5826 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5828 /* Don't try to create the directory when shutting down Emacs,
5829 because creating the directory might signal an error, and
5830 that would leave Emacs in a strange state. */
5831 if (!NILP (Vrun_hooks
))
5835 GCPRO2 (dir
, listfile
);
5836 dir
= Ffile_name_directory (listfile
);
5837 if (NILP (Ffile_directory_p (dir
)))
5838 internal_condition_case_1 (do_auto_save_make_dir
,
5839 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5844 stream
= fopen (SDATA (listfile
), "w");
5847 /* Arrange to close that file whether or not we get an error.
5848 Also reset auto_saving to 0. */
5849 lispstream
= Fcons (Qnil
, Qnil
);
5850 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5851 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5862 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5863 record_unwind_protect (do_auto_save_unwind_1
,
5864 make_number (minibuffer_auto_raise
));
5865 minibuffer_auto_raise
= 0;
5868 /* On first pass, save all files that don't have handlers.
5869 On second pass, save all files that do have handlers.
5871 If Emacs is crashing, the handlers may tweak what is causing
5872 Emacs to crash in the first place, and it would be a shame if
5873 Emacs failed to autosave perfectly ordinary files because it
5874 couldn't handle some ange-ftp'd file. */
5876 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5877 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5879 buf
= XCDR (XCAR (tail
));
5882 /* Record all the buffers that have auto save mode
5883 in the special file that lists them. For each of these buffers,
5884 Record visited name (if any) and auto save name. */
5885 if (STRINGP (b
->auto_save_file_name
)
5886 && stream
!= NULL
&& do_handled_files
== 0)
5888 if (!NILP (b
->filename
))
5890 fwrite (SDATA (b
->filename
), 1,
5891 SBYTES (b
->filename
), stream
);
5893 putc ('\n', stream
);
5894 fwrite (SDATA (b
->auto_save_file_name
), 1,
5895 SBYTES (b
->auto_save_file_name
), stream
);
5896 putc ('\n', stream
);
5899 if (!NILP (current_only
)
5900 && b
!= current_buffer
)
5903 /* Don't auto-save indirect buffers.
5904 The base buffer takes care of it. */
5908 /* Check for auto save enabled
5909 and file changed since last auto save
5910 and file changed since last real save. */
5911 if (STRINGP (b
->auto_save_file_name
)
5912 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5913 && b
->auto_save_modified
< BUF_MODIFF (b
)
5914 /* -1 means we've turned off autosaving for a while--see below. */
5915 && XINT (b
->save_length
) >= 0
5916 && (do_handled_files
5917 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5920 EMACS_TIME before_time
, after_time
;
5922 EMACS_GET_TIME (before_time
);
5924 /* If we had a failure, don't try again for 20 minutes. */
5925 if (b
->auto_save_failure_time
>= 0
5926 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5929 if ((XFASTINT (b
->save_length
) * 10
5930 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5931 /* A short file is likely to change a large fraction;
5932 spare the user annoying messages. */
5933 && XFASTINT (b
->save_length
) > 5000
5934 /* These messages are frequent and annoying for `*mail*'. */
5935 && !EQ (b
->filename
, Qnil
)
5936 && NILP (no_message
))
5938 /* It has shrunk too much; turn off auto-saving here. */
5939 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5940 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5942 minibuffer_auto_raise
= 0;
5943 /* Turn off auto-saving until there's a real save,
5944 and prevent any more warnings. */
5945 XSETINT (b
->save_length
, -1);
5946 Fsleep_for (make_number (1), Qnil
);
5949 set_buffer_internal (b
);
5950 if (!auto_saved
&& NILP (no_message
))
5951 message1 ("Auto-saving...");
5952 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5954 b
->auto_save_modified
= BUF_MODIFF (b
);
5955 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5956 set_buffer_internal (old
);
5958 EMACS_GET_TIME (after_time
);
5960 /* If auto-save took more than 60 seconds,
5961 assume it was an NFS failure that got a timeout. */
5962 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5963 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5967 /* Prevent another auto save till enough input events come in. */
5968 record_auto_save ();
5970 if (auto_saved
&& NILP (no_message
))
5974 /* If we are going to restore an old message,
5975 give time to read ours. */
5976 sit_for (1, 0, 0, 0, 0);
5980 /* If we displayed a message and then restored a state
5981 with no message, leave a "done" message on the screen. */
5982 message1 ("Auto-saving...done");
5987 /* This restores the message-stack status. */
5988 unbind_to (count
, Qnil
);
5992 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5993 Sset_buffer_auto_saved
, 0, 0, 0,
5994 doc
: /* Mark current buffer as auto-saved with its current text.
5995 No auto-save file will be written until the buffer changes again. */)
5998 current_buffer
->auto_save_modified
= MODIFF
;
5999 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6000 current_buffer
->auto_save_failure_time
= -1;
6004 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6005 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6006 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6009 current_buffer
->auto_save_failure_time
= -1;
6013 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6015 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6018 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6021 /* Reading and completing file names */
6022 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6024 /* In the string VAL, change each $ to $$ and return the result. */
6027 double_dollars (val
)
6030 register const unsigned char *old
;
6031 register unsigned char *new;
6035 osize
= SBYTES (val
);
6037 /* Count the number of $ characters. */
6038 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6039 if (*old
++ == '$') count
++;
6043 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6046 for (n
= osize
; n
> 0; n
--)
6060 read_file_name_cleanup (arg
)
6063 return (current_buffer
->directory
= arg
);
6066 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6068 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6069 (string
, dir
, action
)
6070 Lisp_Object string
, dir
, action
;
6071 /* action is nil for complete, t for return list of completions,
6072 lambda for verify final value */
6074 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6076 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6078 CHECK_STRING (string
);
6085 /* No need to protect ACTION--we only compare it with t and nil. */
6086 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6088 if (SCHARS (string
) == 0)
6090 if (EQ (action
, Qlambda
))
6098 orig_string
= string
;
6099 string
= Fsubstitute_in_file_name (string
);
6100 changed
= NILP (Fstring_equal (string
, orig_string
));
6101 name
= Ffile_name_nondirectory (string
);
6102 val
= Ffile_name_directory (string
);
6104 realdir
= Fexpand_file_name (val
, realdir
);
6109 specdir
= Ffile_name_directory (string
);
6110 val
= Ffile_name_completion (name
, realdir
);
6115 return double_dollars (string
);
6119 if (!NILP (specdir
))
6120 val
= concat2 (specdir
, val
);
6122 return double_dollars (val
);
6125 #endif /* not VMS */
6129 if (EQ (action
, Qt
))
6131 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6135 if (NILP (Vread_file_name_predicate
)
6136 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6140 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6142 /* Brute-force speed up for directory checking:
6143 Discard strings which don't end in a slash. */
6144 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6146 Lisp_Object tem
= XCAR (all
);
6148 if (STRINGP (tem
) &&
6149 (len
= SCHARS (tem
), len
> 0) &&
6150 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6151 comp
= Fcons (tem
, comp
);
6157 /* Must do it the hard (and slow) way. */
6158 GCPRO3 (all
, comp
, specdir
);
6159 count
= SPECPDL_INDEX ();
6160 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6161 current_buffer
->directory
= realdir
;
6162 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6163 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6164 comp
= Fcons (XCAR (all
), comp
);
6165 unbind_to (count
, Qnil
);
6168 return Fnreverse (comp
);
6171 /* Only other case actually used is ACTION = lambda */
6173 /* Supposedly this helps commands such as `cd' that read directory names,
6174 but can someone explain how it helps them? -- RMS */
6175 if (SCHARS (name
) == 0)
6178 string
= Fexpand_file_name (string
, dir
);
6179 if (!NILP (Vread_file_name_predicate
))
6180 return call1 (Vread_file_name_predicate
, string
);
6181 return Ffile_exists_p (string
);
6184 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6185 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6186 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6187 The return value is only relevant for a call to `read-file-name' that happens
6188 before any other event (mouse or keypress) is handeled. */)
6191 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6192 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6201 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6202 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6203 Value is not expanded---you must call `expand-file-name' yourself.
6204 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6205 the same non-empty string that was inserted by this function.
6206 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6207 except that if INITIAL is specified, that combined with DIR is used.)
6208 If the user exits with an empty minibuffer, this function returns
6209 an empty string. (This can only happen if the user erased the
6210 pre-inserted contents or if `insert-default-directory' is nil.)
6211 Fourth arg MUSTMATCH non-nil means require existing file's name.
6212 Non-nil and non-t means also require confirmation after completion.
6213 Fifth arg INITIAL specifies text to start with.
6214 If optional sixth arg PREDICATE is non-nil, possible completions and
6215 the resulting file name must satisfy (funcall PREDICATE NAME).
6216 DIR should be an absolute directory name. It defaults to the value of
6217 `default-directory'.
6219 If this command was invoked with the mouse, use a file dialog box if
6220 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6221 provides a file dialog box.
6223 See also `read-file-name-completion-ignore-case'
6224 and `read-file-name-function'. */)
6225 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6226 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6228 Lisp_Object val
, insdef
, tem
;
6229 struct gcpro gcpro1
, gcpro2
;
6230 register char *homedir
;
6231 Lisp_Object decoded_homedir
;
6232 int replace_in_history
= 0;
6233 int add_to_history
= 0;
6237 dir
= current_buffer
->directory
;
6238 if (NILP (Ffile_name_absolute_p (dir
)))
6239 dir
= Fexpand_file_name (dir
, Qnil
);
6240 if (NILP (default_filename
))
6243 ? Fexpand_file_name (initial
, dir
)
6244 : current_buffer
->filename
);
6246 /* If dir starts with user's homedir, change that to ~. */
6247 homedir
= (char *) egetenv ("HOME");
6249 /* homedir can be NULL in temacs, since Vprocess_environment is not
6250 yet set up. We shouldn't crash in that case. */
6253 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6254 CORRECT_DIR_SEPS (homedir
);
6259 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6262 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6263 SBYTES (decoded_homedir
))
6264 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6266 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6267 dir
= concat2 (build_string ("~"), dir
);
6269 /* Likewise for default_filename. */
6271 && STRINGP (default_filename
)
6272 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6273 SBYTES (decoded_homedir
))
6274 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6277 = Fsubstring (default_filename
,
6278 make_number (SCHARS (decoded_homedir
)), Qnil
);
6279 default_filename
= concat2 (build_string ("~"), default_filename
);
6281 if (!NILP (default_filename
))
6283 CHECK_STRING (default_filename
);
6284 default_filename
= double_dollars (default_filename
);
6287 if (insert_default_directory
&& STRINGP (dir
))
6290 if (!NILP (initial
))
6292 Lisp_Object args
[2], pos
;
6296 insdef
= Fconcat (2, args
);
6297 pos
= make_number (SCHARS (double_dollars (dir
)));
6298 insdef
= Fcons (double_dollars (insdef
), pos
);
6301 insdef
= double_dollars (insdef
);
6303 else if (STRINGP (initial
))
6304 insdef
= Fcons (double_dollars (initial
), make_number (0));
6308 if (!NILP (Vread_file_name_function
))
6310 Lisp_Object args
[7];
6312 GCPRO2 (insdef
, default_filename
);
6313 args
[0] = Vread_file_name_function
;
6316 args
[3] = default_filename
;
6317 args
[4] = mustmatch
;
6319 args
[6] = predicate
;
6320 RETURN_UNGCPRO (Ffuncall (7, args
));
6323 count
= SPECPDL_INDEX ();
6324 specbind (intern ("completion-ignore-case"),
6325 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6326 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6327 specbind (intern ("read-file-name-predicate"),
6328 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6330 GCPRO2 (insdef
, default_filename
);
6332 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6333 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6335 /* If DIR contains a file name, split it. */
6337 file
= Ffile_name_nondirectory (dir
);
6338 if (SCHARS (file
) && NILP (default_filename
))
6340 default_filename
= file
;
6341 dir
= Ffile_name_directory (dir
);
6343 if (!NILP(default_filename
))
6344 default_filename
= Fexpand_file_name (default_filename
, dir
);
6345 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6346 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6351 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6352 dir
, mustmatch
, insdef
,
6353 Qfile_name_history
, default_filename
, Qnil
);
6355 tem
= Fsymbol_value (Qfile_name_history
);
6356 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6357 replace_in_history
= 1;
6359 /* If Fcompleting_read returned the inserted default string itself
6360 (rather than a new string with the same contents),
6361 it has to mean that the user typed RET with the minibuffer empty.
6362 In that case, we really want to return ""
6363 so that commands such as set-visited-file-name can distinguish. */
6364 if (EQ (val
, default_filename
))
6366 /* In this case, Fcompleting_read has not added an element
6367 to the history. Maybe we should. */
6368 if (! replace_in_history
)
6374 unbind_to (count
, Qnil
);
6377 error ("No file name specified");
6379 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6381 if (!NILP (tem
) && !NILP (default_filename
))
6382 val
= default_filename
;
6383 val
= Fsubstitute_in_file_name (val
);
6385 if (replace_in_history
)
6386 /* Replace what Fcompleting_read added to the history
6387 with what we will actually return. */
6389 Lisp_Object val1
= double_dollars (val
);
6390 tem
= Fsymbol_value (Qfile_name_history
);
6391 if (history_delete_duplicates
)
6392 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6393 XSETCAR (tem
, val1
);
6395 else if (add_to_history
)
6397 /* Add the value to the history--but not if it matches
6398 the last value already there. */
6399 Lisp_Object val1
= double_dollars (val
);
6400 tem
= Fsymbol_value (Qfile_name_history
);
6401 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6403 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6404 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6415 /* Must be set before any path manipulation is performed. */
6416 XSETFASTINT (Vdirectory_sep_char
, '/');
6423 Qexpand_file_name
= intern ("expand-file-name");
6424 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6425 Qdirectory_file_name
= intern ("directory-file-name");
6426 Qfile_name_directory
= intern ("file-name-directory");
6427 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6428 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6429 Qfile_name_as_directory
= intern ("file-name-as-directory");
6430 Qcopy_file
= intern ("copy-file");
6431 Qmake_directory_internal
= intern ("make-directory-internal");
6432 Qmake_directory
= intern ("make-directory");
6433 Qdelete_directory
= intern ("delete-directory");
6434 Qdelete_file
= intern ("delete-file");
6435 Qrename_file
= intern ("rename-file");
6436 Qadd_name_to_file
= intern ("add-name-to-file");
6437 Qmake_symbolic_link
= intern ("make-symbolic-link");
6438 Qfile_exists_p
= intern ("file-exists-p");
6439 Qfile_executable_p
= intern ("file-executable-p");
6440 Qfile_readable_p
= intern ("file-readable-p");
6441 Qfile_writable_p
= intern ("file-writable-p");
6442 Qfile_symlink_p
= intern ("file-symlink-p");
6443 Qaccess_file
= intern ("access-file");
6444 Qfile_directory_p
= intern ("file-directory-p");
6445 Qfile_regular_p
= intern ("file-regular-p");
6446 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6447 Qfile_modes
= intern ("file-modes");
6448 Qset_file_modes
= intern ("set-file-modes");
6449 Qset_file_times
= intern ("set-file-times");
6450 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6451 Qinsert_file_contents
= intern ("insert-file-contents");
6452 Qwrite_region
= intern ("write-region");
6453 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6454 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6455 Qauto_save_coding
= intern ("auto-save-coding");
6457 staticpro (&Qexpand_file_name
);
6458 staticpro (&Qsubstitute_in_file_name
);
6459 staticpro (&Qdirectory_file_name
);
6460 staticpro (&Qfile_name_directory
);
6461 staticpro (&Qfile_name_nondirectory
);
6462 staticpro (&Qunhandled_file_name_directory
);
6463 staticpro (&Qfile_name_as_directory
);
6464 staticpro (&Qcopy_file
);
6465 staticpro (&Qmake_directory_internal
);
6466 staticpro (&Qmake_directory
);
6467 staticpro (&Qdelete_directory
);
6468 staticpro (&Qdelete_file
);
6469 staticpro (&Qrename_file
);
6470 staticpro (&Qadd_name_to_file
);
6471 staticpro (&Qmake_symbolic_link
);
6472 staticpro (&Qfile_exists_p
);
6473 staticpro (&Qfile_executable_p
);
6474 staticpro (&Qfile_readable_p
);
6475 staticpro (&Qfile_writable_p
);
6476 staticpro (&Qaccess_file
);
6477 staticpro (&Qfile_symlink_p
);
6478 staticpro (&Qfile_directory_p
);
6479 staticpro (&Qfile_regular_p
);
6480 staticpro (&Qfile_accessible_directory_p
);
6481 staticpro (&Qfile_modes
);
6482 staticpro (&Qset_file_modes
);
6483 staticpro (&Qset_file_times
);
6484 staticpro (&Qfile_newer_than_file_p
);
6485 staticpro (&Qinsert_file_contents
);
6486 staticpro (&Qwrite_region
);
6487 staticpro (&Qverify_visited_file_modtime
);
6488 staticpro (&Qset_visited_file_modtime
);
6489 staticpro (&Qauto_save_coding
);
6491 Qfile_name_history
= intern ("file-name-history");
6492 Fset (Qfile_name_history
, Qnil
);
6493 staticpro (&Qfile_name_history
);
6495 Qfile_error
= intern ("file-error");
6496 staticpro (&Qfile_error
);
6497 Qfile_already_exists
= intern ("file-already-exists");
6498 staticpro (&Qfile_already_exists
);
6499 Qfile_date_error
= intern ("file-date-error");
6500 staticpro (&Qfile_date_error
);
6501 Qexcl
= intern ("excl");
6505 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6506 staticpro (&Qfind_buffer_file_type
);
6509 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6510 doc
: /* *Coding system for encoding file names.
6511 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6512 Vfile_name_coding_system
= Qnil
;
6514 DEFVAR_LISP ("default-file-name-coding-system",
6515 &Vdefault_file_name_coding_system
,
6516 doc
: /* Default coding system for encoding file names.
6517 This variable is used only when `file-name-coding-system' is nil.
6519 This variable is set/changed by the command `set-language-environment'.
6520 User should not set this variable manually,
6521 instead use `file-name-coding-system' to get a constant encoding
6522 of file names regardless of the current language environment. */);
6523 Vdefault_file_name_coding_system
= Qnil
;
6525 Qformat_decode
= intern ("format-decode");
6526 staticpro (&Qformat_decode
);
6527 Qformat_annotate_function
= intern ("format-annotate-function");
6528 staticpro (&Qformat_annotate_function
);
6529 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6530 staticpro (&Qafter_insert_file_set_coding
);
6532 Qcar_less_than_car
= intern ("car-less-than-car");
6533 staticpro (&Qcar_less_than_car
);
6535 Fput (Qfile_error
, Qerror_conditions
,
6536 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6537 Fput (Qfile_error
, Qerror_message
,
6538 build_string ("File error"));
6540 Fput (Qfile_already_exists
, Qerror_conditions
,
6541 Fcons (Qfile_already_exists
,
6542 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6543 Fput (Qfile_already_exists
, Qerror_message
,
6544 build_string ("File already exists"));
6546 Fput (Qfile_date_error
, Qerror_conditions
,
6547 Fcons (Qfile_date_error
,
6548 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6549 Fput (Qfile_date_error
, Qerror_message
,
6550 build_string ("Cannot set file date"));
6552 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6553 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6554 Vread_file_name_function
= Qnil
;
6556 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6557 doc
: /* Current predicate used by `read-file-name-internal'. */);
6558 Vread_file_name_predicate
= Qnil
;
6560 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6561 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6562 #if defined VMS || defined DOS_NT || defined MAC_OS
6563 read_file_name_completion_ignore_case
= 1;
6565 read_file_name_completion_ignore_case
= 0;
6568 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6569 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6570 If the initial minibuffer contents are non-empty, you can usually
6571 request a default filename by typing RETURN without editing. For some
6572 commands, exiting with an empty minibuffer has a special meaning,
6573 such as making the current buffer visit no file in the case of
6574 `set-visited-file-name'.
6575 If this variable is non-nil, the minibuffer contents are always
6576 initially non-empty and typing RETURN without editing will fetch the
6577 default name, if one is provided. Note however that this default name
6578 is not necessarily the name originally inserted in the minibuffer, if
6579 that is just the default directory.
6580 If this variable is nil, the minibuffer often starts out empty. In
6581 that case you may have to explicitly fetch the next history element to
6582 request the default name. */);
6583 insert_default_directory
= 1;
6585 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6586 doc
: /* *Non-nil means write new files with record format `stmlf'.
6587 nil means use format `var'. This variable is meaningful only on VMS. */);
6588 vms_stmlf_recfm
= 0;
6590 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6591 doc
: /* Directory separator character for built-in functions that return file names.
6592 The value is always ?/. Don't use this variable, just use `/'. */);
6594 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6595 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6596 If a file name matches REGEXP, then all I/O on that file is done by calling
6599 The first argument given to HANDLER is the name of the I/O primitive
6600 to be handled; the remaining arguments are the arguments that were
6601 passed to that primitive. For example, if you do
6602 (file-exists-p FILENAME)
6603 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6604 (funcall HANDLER 'file-exists-p FILENAME)
6605 The function `find-file-name-handler' checks this list for a handler
6606 for its argument. */);
6607 Vfile_name_handler_alist
= Qnil
;
6609 DEFVAR_LISP ("set-auto-coding-function",
6610 &Vset_auto_coding_function
,
6611 doc
: /* If non-nil, a function to call to decide a coding system of file.
6612 Two arguments are passed to this function: the file name
6613 and the length of a file contents following the point.
6614 This function should return a coding system to decode the file contents.
6615 It should check the file name against `auto-coding-alist'.
6616 If no coding system is decided, it should check a coding system
6617 specified in the heading lines with the format:
6618 -*- ... coding: CODING-SYSTEM; ... -*-
6619 or local variable spec of the tailing lines with `coding:' tag. */);
6620 Vset_auto_coding_function
= Qnil
;
6622 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6623 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6624 Each is passed one argument, the number of characters inserted.
6625 It should return the new character count, and leave point the same.
6626 If `insert-file-contents' is intercepted by a handler from
6627 `file-name-handler-alist', that handler is responsible for calling the
6628 functions in `after-insert-file-functions' if appropriate. */);
6629 Vafter_insert_file_functions
= Qnil
;
6631 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6632 doc
: /* A list of functions to be called at the start of `write-region'.
6633 Each is passed two arguments, START and END as for `write-region'.
6634 These are usually two numbers but not always; see the documentation
6635 for `write-region'. The function should return a list of pairs
6636 of the form (POSITION . STRING), consisting of strings to be effectively
6637 inserted at the specified positions of the file being written (1 means to
6638 insert before the first byte written). The POSITIONs must be sorted into
6639 increasing order. If there are several functions in the list, the several
6640 lists are merged destructively. Alternatively, the function can return
6641 with a different buffer current; in that case it should pay attention
6642 to the annotations returned by previous functions and listed in
6643 `write-region-annotations-so-far'.*/);
6644 Vwrite_region_annotate_functions
= Qnil
;
6645 staticpro (&Qwrite_region_annotate_functions
);
6646 Qwrite_region_annotate_functions
6647 = intern ("write-region-annotate-functions");
6649 DEFVAR_LISP ("write-region-annotations-so-far",
6650 &Vwrite_region_annotations_so_far
,
6651 doc
: /* When an annotation function is called, this holds the previous annotations.
6652 These are the annotations made by other annotation functions
6653 that were already called. See also `write-region-annotate-functions'. */);
6654 Vwrite_region_annotations_so_far
= Qnil
;
6656 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6657 doc
: /* A list of file name handlers that temporarily should not be used.
6658 This applies only to the operation `inhibit-file-name-operation'. */);
6659 Vinhibit_file_name_handlers
= Qnil
;
6661 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6662 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6663 Vinhibit_file_name_operation
= Qnil
;
6665 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6666 doc
: /* File name in which we write a list of all auto save file names.
6667 This variable is initialized automatically from `auto-save-list-file-prefix'
6668 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6669 a non-nil value. */);
6670 Vauto_save_list_file_name
= Qnil
;
6672 defsubr (&Sfind_file_name_handler
);
6673 defsubr (&Sfile_name_directory
);
6674 defsubr (&Sfile_name_nondirectory
);
6675 defsubr (&Sunhandled_file_name_directory
);
6676 defsubr (&Sfile_name_as_directory
);
6677 defsubr (&Sdirectory_file_name
);
6678 defsubr (&Smake_temp_name
);
6679 defsubr (&Sexpand_file_name
);
6680 defsubr (&Ssubstitute_in_file_name
);
6681 defsubr (&Scopy_file
);
6682 defsubr (&Smake_directory_internal
);
6683 defsubr (&Sdelete_directory
);
6684 defsubr (&Sdelete_file
);
6685 defsubr (&Srename_file
);
6686 defsubr (&Sadd_name_to_file
);
6688 defsubr (&Smake_symbolic_link
);
6689 #endif /* S_IFLNK */
6691 defsubr (&Sdefine_logical_name
);
6694 defsubr (&Ssysnetunam
);
6695 #endif /* HPUX_NET */
6696 defsubr (&Sfile_name_absolute_p
);
6697 defsubr (&Sfile_exists_p
);
6698 defsubr (&Sfile_executable_p
);
6699 defsubr (&Sfile_readable_p
);
6700 defsubr (&Sfile_writable_p
);
6701 defsubr (&Saccess_file
);
6702 defsubr (&Sfile_symlink_p
);
6703 defsubr (&Sfile_directory_p
);
6704 defsubr (&Sfile_accessible_directory_p
);
6705 defsubr (&Sfile_regular_p
);
6706 defsubr (&Sfile_modes
);
6707 defsubr (&Sset_file_modes
);
6708 defsubr (&Sset_file_times
);
6709 defsubr (&Sset_default_file_modes
);
6710 defsubr (&Sdefault_file_modes
);
6711 defsubr (&Sfile_newer_than_file_p
);
6712 defsubr (&Sinsert_file_contents
);
6713 defsubr (&Swrite_region
);
6714 defsubr (&Scar_less_than_car
);
6715 defsubr (&Sverify_visited_file_modtime
);
6716 defsubr (&Sclear_visited_file_modtime
);
6717 defsubr (&Svisited_file_modtime
);
6718 defsubr (&Sset_visited_file_modtime
);
6719 defsubr (&Sdo_auto_save
);
6720 defsubr (&Sset_buffer_auto_saved
);
6721 defsubr (&Sclear_buffer_auto_save_failure
);
6722 defsubr (&Srecent_auto_save_p
);
6724 defsubr (&Sread_file_name_internal
);
6725 defsubr (&Sread_file_name
);
6726 defsubr (&Snext_read_file_uses_dialog_p
);
6729 defsubr (&Sunix_sync
);
6733 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6734 (do not change this comment) */