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)
74 #include "intervals.h"
85 #endif /* not WINDOWSNT */
89 #include <sys/param.h>
97 #define CORRECT_DIR_SEPS(s) \
98 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
99 else unixtodos_filename (s); \
101 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
102 redirector allows the six letters between 'Z' and 'a' as well. */
104 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
107 #define IS_DRIVE(x) isalpha (x)
109 /* Need to lower-case the drive letter, or else expanded
110 filenames will sometimes compare inequal, because
111 `expand-file-name' doesn't always down-case the drive letter. */
112 #define DRIVE_LETTER(x) (tolower (x))
133 #include "commands.h"
134 extern int use_dialog_box
;
135 extern int use_file_dialog
;
149 #ifndef FILE_SYSTEM_CASE
150 #define FILE_SYSTEM_CASE(filename) (filename)
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Lisp functions for translating file formats */
179 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
181 /* Function to be called to decide a coding system of a reading file. */
182 Lisp_Object Vset_auto_coding_function
;
184 /* Functions to be called to process text properties in inserted file. */
185 Lisp_Object Vafter_insert_file_functions
;
187 /* Lisp function for setting buffer-file-coding-system and the
188 multibyteness of the current buffer after inserting a file. */
189 Lisp_Object Qafter_insert_file_set_coding
;
191 /* Functions to be called to create text property annotations for file. */
192 Lisp_Object Vwrite_region_annotate_functions
;
193 Lisp_Object Qwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Function to call to read a file name. */
203 Lisp_Object Vread_file_name_function
;
205 /* Current predicate used by read_file_name_internal. */
206 Lisp_Object Vread_file_name_predicate
;
208 /* Nonzero means completion ignores case when reading file name. */
209 int read_file_name_completion_ignore_case
;
211 /* Nonzero means, when reading a filename in the minibuffer,
212 start out by inserting the default directory into the minibuffer. */
213 int insert_default_directory
;
215 /* On VMS, nonzero means write new files with record format stmlf.
216 Zero means use var format. */
219 /* On NT, specifies the directory separator character, used (eg.) when
220 expanding file names. This can be bound to / or \. */
221 Lisp_Object Vdirectory_sep_char
;
223 extern Lisp_Object Vuser_login_name
;
226 extern Lisp_Object Vw32_get_true_file_attributes
;
229 extern int minibuf_level
;
231 extern int minibuffer_auto_raise
;
233 extern int history_delete_duplicates
;
235 /* These variables describe handlers that have "already" had a chance
236 to handle the current operation.
238 Vinhibit_file_name_handlers is a list of file name handlers.
239 Vinhibit_file_name_operation is the operation being handled.
240 If we try to handle that operation, we ignore those handlers. */
242 static Lisp_Object Vinhibit_file_name_handlers
;
243 static Lisp_Object Vinhibit_file_name_operation
;
245 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
247 Lisp_Object Qfile_name_history
;
249 Lisp_Object Qcar_less_than_car
;
251 static int a_write
P_ ((int, Lisp_Object
, int, int,
252 Lisp_Object
*, struct coding_system
*));
253 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
257 report_file_error (string
, data
)
261 Lisp_Object errstring
;
264 synchronize_system_messages_locale ();
265 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
266 Vlocale_coding_system
, 0);
272 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
275 /* System error messages are capitalized. Downcase the initial
276 unless it is followed by a slash. */
277 if (SREF (errstring
, 1) != '/')
278 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
280 Fsignal (Qfile_error
,
281 Fcons (build_string (string
), Fcons (errstring
, data
)));
286 close_file_unwind (fd
)
289 emacs_close (XFASTINT (fd
));
293 /* Restore point, having saved it as a marker. */
296 restore_point_unwind (location
)
297 Lisp_Object location
;
299 Fgoto_char (location
);
300 Fset_marker (location
, Qnil
, Qnil
);
304 Lisp_Object Qexpand_file_name
;
305 Lisp_Object Qsubstitute_in_file_name
;
306 Lisp_Object Qdirectory_file_name
;
307 Lisp_Object Qfile_name_directory
;
308 Lisp_Object Qfile_name_nondirectory
;
309 Lisp_Object Qunhandled_file_name_directory
;
310 Lisp_Object Qfile_name_as_directory
;
311 Lisp_Object Qcopy_file
;
312 Lisp_Object Qmake_directory_internal
;
313 Lisp_Object Qmake_directory
;
314 Lisp_Object Qdelete_directory
;
315 Lisp_Object Qdelete_file
;
316 Lisp_Object Qrename_file
;
317 Lisp_Object Qadd_name_to_file
;
318 Lisp_Object Qmake_symbolic_link
;
319 Lisp_Object Qfile_exists_p
;
320 Lisp_Object Qfile_executable_p
;
321 Lisp_Object Qfile_readable_p
;
322 Lisp_Object Qfile_writable_p
;
323 Lisp_Object Qfile_symlink_p
;
324 Lisp_Object Qaccess_file
;
325 Lisp_Object Qfile_directory_p
;
326 Lisp_Object Qfile_regular_p
;
327 Lisp_Object Qfile_accessible_directory_p
;
328 Lisp_Object Qfile_modes
;
329 Lisp_Object Qset_file_modes
;
330 Lisp_Object Qset_file_times
;
331 Lisp_Object Qfile_newer_than_file_p
;
332 Lisp_Object Qinsert_file_contents
;
333 Lisp_Object Qwrite_region
;
334 Lisp_Object Qverify_visited_file_modtime
;
335 Lisp_Object Qset_visited_file_modtime
;
337 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
338 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
339 Otherwise, return nil.
340 A file name is handled if one of the regular expressions in
341 `file-name-handler-alist' matches it.
343 If OPERATION equals `inhibit-file-name-operation', then we ignore
344 any handlers that are members of `inhibit-file-name-handlers',
345 but we still do run any other handlers. This lets handlers
346 use the standard functions without calling themselves recursively. */)
347 (filename
, operation
)
348 Lisp_Object filename
, operation
;
350 /* This function must not munge the match data. */
351 Lisp_Object chain
, inhibited_handlers
, result
;
355 CHECK_STRING (filename
);
357 if (EQ (operation
, Vinhibit_file_name_operation
))
358 inhibited_handlers
= Vinhibit_file_name_handlers
;
360 inhibited_handlers
= Qnil
;
362 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
363 chain
= XCDR (chain
))
373 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
375 Lisp_Object handler
, tem
;
377 handler
= XCDR (elt
);
378 tem
= Fmemq (handler
, inhibited_handlers
);
392 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
394 doc
: /* Return the directory component in file name FILENAME.
395 Return nil if FILENAME does not include a directory.
396 Otherwise return a directory spec.
397 Given a Unix syntax file name, returns a string ending in slash;
398 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
400 Lisp_Object filename
;
403 register const unsigned char *beg
;
405 register unsigned char *beg
;
407 register const unsigned char *p
;
410 CHECK_STRING (filename
);
412 /* If the file name has special constructs in it,
413 call the corresponding file handler. */
414 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
416 return call2 (handler
, Qfile_name_directory
, filename
);
418 filename
= FILE_SYSTEM_CASE (filename
);
419 beg
= SDATA (filename
);
421 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
423 p
= beg
+ SBYTES (filename
);
425 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
427 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
430 /* only recognise drive specifier at the beginning */
432 /* handle the "/:d:foo" and "/:foo" cases correctly */
433 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
434 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
441 /* Expansion of "c:" to drive and default directory. */
444 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
445 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
446 unsigned char *r
= res
;
448 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
450 strncpy (res
, beg
, 2);
455 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
457 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
460 p
= beg
+ strlen (beg
);
463 CORRECT_DIR_SEPS (beg
);
466 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
469 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
470 Sfile_name_nondirectory
, 1, 1, 0,
471 doc
: /* Return file name FILENAME sans its directory.
472 For example, in a Unix-syntax file name,
473 this is everything after the last slash,
474 or the entire name if it contains no slash. */)
476 Lisp_Object filename
;
478 register const unsigned char *beg
, *p
, *end
;
481 CHECK_STRING (filename
);
483 /* If the file name has special constructs in it,
484 call the corresponding file handler. */
485 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
487 return call2 (handler
, Qfile_name_nondirectory
, filename
);
489 beg
= SDATA (filename
);
490 end
= p
= beg
+ SBYTES (filename
);
492 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
494 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
497 /* only recognise drive specifier at beginning */
499 /* handle the "/:d:foo" case correctly */
500 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
505 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
508 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
509 Sunhandled_file_name_directory
, 1, 1, 0,
510 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
511 A `directly usable' directory name is one that may be used without the
512 intervention of any file handler.
513 If FILENAME is a directly usable file itself, return
514 \(file-name-directory FILENAME).
515 The `call-process' and `start-process' functions use this function to
516 get a current directory to run processes in. */)
518 Lisp_Object filename
;
522 /* If the file name has special constructs in it,
523 call the corresponding file handler. */
524 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
526 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
528 return Ffile_name_directory (filename
);
533 file_name_as_directory (out
, in
)
536 int size
= strlen (in
) - 1;
549 /* Is it already a directory string? */
550 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
552 /* Is it a VMS directory file name? If so, hack VMS syntax. */
553 else if (! index (in
, '/')
554 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
555 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
556 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
557 || ! strncmp (&in
[size
- 5], ".dir", 4))
558 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
559 && in
[size
] == '1')))
561 register char *p
, *dot
;
565 dir:x.dir --> dir:[x]
566 dir:[x]y.dir --> dir:[x.y] */
568 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
571 strncpy (out
, in
, p
- in
);
590 dot
= index (p
, '.');
593 /* blindly remove any extension */
594 size
= strlen (out
) + (dot
- p
);
595 strncat (out
, p
, dot
- p
);
606 /* For Unix syntax, Append a slash if necessary */
607 if (!IS_DIRECTORY_SEP (out
[size
]))
609 /* Cannot use DIRECTORY_SEP, which could have any value */
611 out
[size
+ 2] = '\0';
614 CORRECT_DIR_SEPS (out
);
620 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
621 Sfile_name_as_directory
, 1, 1, 0,
622 doc
: /* Return a string representing the file name FILE interpreted as a directory.
623 This operation exists because a directory is also a file, but its name as
624 a directory is different from its name as a file.
625 The result can be used as the value of `default-directory'
626 or passed as second argument to `expand-file-name'.
627 For a Unix-syntax file name, just appends a slash.
628 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
639 /* If the file name has special constructs in it,
640 call the corresponding file handler. */
641 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
643 return call2 (handler
, Qfile_name_as_directory
, file
);
645 buf
= (char *) alloca (SBYTES (file
) + 10);
646 file_name_as_directory (buf
, SDATA (file
));
647 return make_specified_string (buf
, -1, strlen (buf
),
648 STRING_MULTIBYTE (file
));
652 * Convert from directory name to filename.
654 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
655 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
656 * On UNIX, it's simple: just make sure there isn't a terminating /
658 * Value is nonzero if the string output is different from the input.
662 directory_file_name (src
, dst
)
670 struct FAB fab
= cc$rms_fab
;
671 struct NAM nam
= cc$rms_nam
;
672 char esa
[NAM$C_MAXRSS
];
677 if (! index (src
, '/')
678 && (src
[slen
- 1] == ']'
679 || src
[slen
- 1] == ':'
680 || src
[slen
- 1] == '>'))
682 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
684 fab
.fab$b_fns
= slen
;
685 fab
.fab$l_nam
= &nam
;
686 fab
.fab$l_fop
= FAB$M_NAM
;
689 nam
.nam$b_ess
= sizeof esa
;
690 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
692 /* We call SYS$PARSE to handle such things as [--] for us. */
693 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
695 slen
= nam
.nam$b_esl
;
696 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
701 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
703 /* what about when we have logical_name:???? */
704 if (src
[slen
- 1] == ':')
705 { /* Xlate logical name and see what we get */
706 ptr
= strcpy (dst
, src
); /* upper case for getenv */
709 if ('a' <= *ptr
&& *ptr
<= 'z')
713 dst
[slen
- 1] = 0; /* remove colon */
714 if (!(src
= egetenv (dst
)))
716 /* should we jump to the beginning of this procedure?
717 Good points: allows us to use logical names that xlate
719 Bad points: can be a problem if we just translated to a device
721 For now, I'll punt and always expect VMS names, and hope for
724 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
725 { /* no recursion here! */
731 { /* not a directory spec */
736 bracket
= src
[slen
- 1];
738 /* If bracket is ']' or '>', bracket - 2 is the corresponding
740 ptr
= index (src
, bracket
- 2);
742 { /* no opening bracket */
746 if (!(rptr
= rindex (src
, '.')))
749 strncpy (dst
, src
, slen
);
753 dst
[slen
++] = bracket
;
758 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
759 then translate the device and recurse. */
760 if (dst
[slen
- 1] == ':'
761 && dst
[slen
- 2] != ':' /* skip decnet nodes */
762 && strcmp (src
+ slen
, "[000000]") == 0)
764 dst
[slen
- 1] = '\0';
765 if ((ptr
= egetenv (dst
))
766 && (rlen
= strlen (ptr
) - 1) > 0
767 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
768 && ptr
[rlen
- 1] == '.')
770 char * buf
= (char *) alloca (strlen (ptr
) + 1);
774 return directory_file_name (buf
, dst
);
779 strcat (dst
, "[000000]");
783 rlen
= strlen (rptr
) - 1;
784 strncat (dst
, rptr
, rlen
);
785 dst
[slen
+ rlen
] = '\0';
786 strcat (dst
, ".DIR.1");
790 /* Process as Unix format: just remove any final slash.
791 But leave "/" unchanged; do not change it to "". */
794 /* Handle // as root for apollo's. */
795 if ((slen
> 2 && dst
[slen
- 1] == '/')
796 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
800 && IS_DIRECTORY_SEP (dst
[slen
- 1])
802 && !IS_ANY_SEP (dst
[slen
- 2])
808 CORRECT_DIR_SEPS (dst
);
813 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
815 doc
: /* Returns the file name of the directory named DIRECTORY.
816 This is the name of the file that holds the data for the directory DIRECTORY.
817 This operation exists because a directory is also a file, but its name as
818 a directory is different from its name as a file.
819 In Unix-syntax, this function just removes the final slash.
820 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
821 it returns a file name such as \"[X]Y.DIR.1\". */)
823 Lisp_Object directory
;
828 CHECK_STRING (directory
);
830 if (NILP (directory
))
833 /* If the file name has special constructs in it,
834 call the corresponding file handler. */
835 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
837 return call2 (handler
, Qdirectory_file_name
, directory
);
840 /* 20 extra chars is insufficient for VMS, since we might perform a
841 logical name translation. an equivalence string can be up to 255
842 chars long, so grab that much extra space... - sss */
843 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
845 buf
= (char *) alloca (SBYTES (directory
) + 20);
847 directory_file_name (SDATA (directory
), buf
);
848 return make_specified_string (buf
, -1, strlen (buf
),
849 STRING_MULTIBYTE (directory
));
852 static char make_temp_name_tbl
[64] =
854 'A','B','C','D','E','F','G','H',
855 'I','J','K','L','M','N','O','P',
856 'Q','R','S','T','U','V','W','X',
857 'Y','Z','a','b','c','d','e','f',
858 'g','h','i','j','k','l','m','n',
859 'o','p','q','r','s','t','u','v',
860 'w','x','y','z','0','1','2','3',
861 '4','5','6','7','8','9','-','_'
864 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
866 /* Value is a temporary file name starting with PREFIX, a string.
868 The Emacs process number forms part of the result, so there is
869 no danger of generating a name being used by another process.
870 In addition, this function makes an attempt to choose a name
871 which has no existing file. To make this work, PREFIX should be
872 an absolute file name.
874 BASE64_P non-zero means add the pid as 3 characters in base64
875 encoding. In this case, 6 characters will be added to PREFIX to
876 form the file name. Otherwise, if Emacs is running on a system
877 with long file names, add the pid as a decimal number.
879 This function signals an error if no unique file name could be
883 make_temp_name (prefix
, base64_p
)
890 unsigned char *p
, *data
;
894 CHECK_STRING (prefix
);
896 /* VAL is created by adding 6 characters to PREFIX. The first
897 three are the PID of this process, in base 64, and the second
898 three are incremented if the file already exists. This ensures
899 262144 unique file names per PID per PREFIX. */
901 pid
= (int) getpid ();
905 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
907 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
912 #ifdef HAVE_LONG_FILE_NAMES
913 sprintf (pidbuf
, "%d", pid
);
914 pidlen
= strlen (pidbuf
);
916 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
918 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
924 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
925 if (!STRING_MULTIBYTE (prefix
))
926 STRING_SET_UNIBYTE (val
);
928 bcopy(SDATA (prefix
), data
, len
);
931 bcopy (pidbuf
, p
, pidlen
);
934 /* Here we try to minimize useless stat'ing when this function is
935 invoked many times successively with the same PREFIX. We achieve
936 this by initializing count to a random value, and incrementing it
939 We don't want make-temp-name to be called while dumping,
940 because then make_temp_name_count_initialized_p would get set
941 and then make_temp_name_count would not be set when Emacs starts. */
943 if (!make_temp_name_count_initialized_p
)
945 make_temp_name_count
= (unsigned) time (NULL
);
946 make_temp_name_count_initialized_p
= 1;
952 unsigned num
= make_temp_name_count
;
954 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
955 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 /* Poor man's congruential RN generator. Replace with
959 ++make_temp_name_count for debugging. */
960 make_temp_name_count
+= 25229;
961 make_temp_name_count
%= 225307;
963 if (stat (data
, &ignored
) < 0)
965 /* We want to return only if errno is ENOENT. */
969 /* The error here is dubious, but there is little else we
970 can do. The alternatives are to return nil, which is
971 as bad as (and in many cases worse than) throwing the
972 error, or to ignore the error, which will likely result
973 in looping through 225307 stat's, which is not only
974 dog-slow, but also useless since it will fallback to
975 the errow below, anyway. */
976 report_file_error ("Cannot create temporary name for prefix",
977 Fcons (prefix
, Qnil
));
982 error ("Cannot create temporary name for prefix `%s'",
988 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
989 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
990 The Emacs process number forms part of the result,
991 so there is no danger of generating a name being used by another process.
993 In addition, this function makes an attempt to choose a name
994 which has no existing file. To make this work,
995 PREFIX should be an absolute file name.
997 There is a race condition between calling `make-temp-name' and creating the
998 file which opens all kinds of security holes. For that reason, you should
999 probably use `make-temp-file' instead, except in three circumstances:
1001 * If you are creating the file in the user's home directory.
1002 * If you are creating a directory rather than an ordinary file.
1003 * If you are taking special precautions as `make-temp-file' does. */)
1007 return make_temp_name (prefix
, 0);
1012 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1013 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1014 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1015 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1016 the current buffer's value of default-directory is used.
1017 File name components that are `.' are removed, and
1018 so are file name components followed by `..', along with the `..' itself;
1019 note that these simplifications are done without checking the resulting
1020 file names in the file system.
1021 An initial `~/' expands to your home directory.
1022 An initial `~USER/' expands to USER's home directory.
1023 See also the function `substitute-in-file-name'. */)
1024 (name
, default_directory
)
1025 Lisp_Object name
, default_directory
;
1029 register unsigned char *newdir
, *p
, *o
;
1031 unsigned char *target
;
1034 unsigned char * colon
= 0;
1035 unsigned char * close
= 0;
1036 unsigned char * slash
= 0;
1037 unsigned char * brack
= 0;
1038 int lbrack
= 0, rbrack
= 0;
1043 int collapse_newdir
= 1;
1047 Lisp_Object handler
, result
;
1049 CHECK_STRING (name
);
1051 /* If the file name has special constructs in it,
1052 call the corresponding file handler. */
1053 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1054 if (!NILP (handler
))
1055 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1057 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1058 if (NILP (default_directory
))
1059 default_directory
= current_buffer
->directory
;
1060 if (! STRINGP (default_directory
))
1063 /* "/" is not considered a root directory on DOS_NT, so using "/"
1064 here causes an infinite recursion in, e.g., the following:
1066 (let (default-directory)
1067 (expand-file-name "a"))
1069 To avoid this, we set default_directory to the root of the
1071 extern char *emacs_root_dir (void);
1073 default_directory
= build_string (emacs_root_dir ());
1075 default_directory
= build_string ("/");
1079 if (!NILP (default_directory
))
1081 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1082 if (!NILP (handler
))
1083 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1086 o
= SDATA (default_directory
);
1088 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1089 It would be better to do this down below where we actually use
1090 default_directory. Unfortunately, calling Fexpand_file_name recursively
1091 could invoke GC, and the strings might be relocated. This would
1092 be annoying because we have pointers into strings lying around
1093 that would need adjusting, and people would add new pointers to
1094 the code and forget to adjust them, resulting in intermittent bugs.
1095 Putting this call here avoids all that crud.
1097 The EQ test avoids infinite recursion. */
1098 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1099 /* Save time in some common cases - as long as default_directory
1100 is not relative, it can be canonicalized with name below (if it
1101 is needed at all) without requiring it to be expanded now. */
1103 /* Detect MSDOS file names with drive specifiers. */
1104 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1106 /* Detect Windows file names in UNC format. */
1107 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1109 #else /* not DOS_NT */
1110 /* Detect Unix absolute file names (/... alone is not absolute on
1112 && ! (IS_DIRECTORY_SEP (o
[0]))
1113 #endif /* not DOS_NT */
1116 struct gcpro gcpro1
;
1119 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1123 name
= FILE_SYSTEM_CASE (name
);
1127 /* We will force directory separators to be either all \ or /, so make
1128 a local copy to modify, even if there ends up being no change. */
1129 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1131 /* Note if special escape prefix is present, but remove for now. */
1132 if (nm
[0] == '/' && nm
[1] == ':')
1138 /* Find and remove drive specifier if present; this makes nm absolute
1139 even if the rest of the name appears to be relative. Only look for
1140 drive specifier at the beginning. */
1141 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1148 /* If we see "c://somedir", we want to strip the first slash after the
1149 colon when stripping the drive letter. Otherwise, this expands to
1151 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1153 #endif /* WINDOWSNT */
1157 /* Discard any previous drive specifier if nm is now in UNC format. */
1158 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1164 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1165 none are found, we can probably return right away. We will avoid
1166 allocating a new string if name is already fully expanded. */
1168 IS_DIRECTORY_SEP (nm
[0])
1170 && drive
&& !is_escaped
1173 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1180 /* If it turns out that the filename we want to return is just a
1181 suffix of FILENAME, we don't need to go through and edit
1182 things; we just need to construct a new string using data
1183 starting at the middle of FILENAME. If we set lose to a
1184 non-zero value, that means we've discovered that we can't do
1191 /* Since we know the name is absolute, we can assume that each
1192 element starts with a "/". */
1194 /* "." and ".." are hairy. */
1195 if (IS_DIRECTORY_SEP (p
[0])
1197 && (IS_DIRECTORY_SEP (p
[2])
1199 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1202 /* We want to replace multiple `/' in a row with a single
1205 && IS_DIRECTORY_SEP (p
[0])
1206 && IS_DIRECTORY_SEP (p
[1]))
1213 /* if dev:[dir]/, move nm to / */
1214 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1215 nm
= (brack
? brack
+ 1 : colon
+ 1);
1216 lbrack
= rbrack
= 0;
1223 #ifdef NO_HYPHENS_IN_FILENAMES
1224 if (lbrack
== rbrack
)
1226 /* Avoid clobbering negative version numbers. */
1231 #endif /* NO_HYPHENS_IN_FILENAMES */
1232 if (lbrack
> rbrack
&&
1233 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1234 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1236 #ifdef NO_HYPHENS_IN_FILENAMES
1239 #endif /* NO_HYPHENS_IN_FILENAMES */
1240 /* count open brackets, reset close bracket pointer */
1241 if (p
[0] == '[' || p
[0] == '<')
1242 lbrack
++, brack
= 0;
1243 /* count close brackets, set close bracket pointer */
1244 if (p
[0] == ']' || p
[0] == '>')
1245 rbrack
++, brack
= p
;
1246 /* detect ][ or >< */
1247 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1249 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1250 nm
= p
+ 1, lose
= 1;
1251 if (p
[0] == ':' && (colon
|| slash
))
1252 /* if dev1:[dir]dev2:, move nm to dev2: */
1258 /* if /name/dev:, move nm to dev: */
1261 /* if node::dev:, move colon following dev */
1262 else if (colon
&& colon
[-1] == ':')
1264 /* if dev1:dev2:, move nm to dev2: */
1265 else if (colon
&& colon
[-1] != ':')
1270 if (p
[0] == ':' && !colon
)
1276 if (lbrack
== rbrack
)
1279 else if (p
[0] == '.')
1287 if (index (nm
, '/'))
1289 nm
= sys_translate_unix (nm
);
1290 return make_specified_string (nm
, -1, strlen (nm
),
1291 STRING_MULTIBYTE (name
));
1295 /* Make sure directories are all separated with / or \ as
1296 desired, but avoid allocation of a new string when not
1298 CORRECT_DIR_SEPS (nm
);
1300 if (IS_DIRECTORY_SEP (nm
[1]))
1302 if (strcmp (nm
, SDATA (name
)) != 0)
1303 name
= make_specified_string (nm
, -1, strlen (nm
),
1304 STRING_MULTIBYTE (name
));
1308 /* drive must be set, so this is okay */
1309 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1313 name
= make_specified_string (nm
, -1, p
- nm
,
1314 STRING_MULTIBYTE (name
));
1315 temp
[0] = DRIVE_LETTER (drive
);
1316 name
= concat2 (build_string (temp
), name
);
1319 #else /* not DOS_NT */
1320 if (nm
== SDATA (name
))
1322 return make_specified_string (nm
, -1, strlen (nm
),
1323 STRING_MULTIBYTE (name
));
1324 #endif /* not DOS_NT */
1328 /* At this point, nm might or might not be an absolute file name. We
1329 need to expand ~ or ~user if present, otherwise prefix nm with
1330 default_directory if nm is not absolute, and finally collapse /./
1331 and /foo/../ sequences.
1333 We set newdir to be the appropriate prefix if one is needed:
1334 - the relevant user directory if nm starts with ~ or ~user
1335 - the specified drive's working dir (DOS/NT only) if nm does not
1337 - the value of default_directory.
1339 Note that these prefixes are not guaranteed to be absolute (except
1340 for the working dir of a drive). Therefore, to ensure we always
1341 return an absolute name, if the final prefix is not absolute we
1342 append it to the current working directory. */
1346 if (nm
[0] == '~') /* prefix ~ */
1348 if (IS_DIRECTORY_SEP (nm
[1])
1352 || nm
[1] == 0) /* ~ by itself */
1354 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1355 newdir
= (unsigned char *) "";
1358 collapse_newdir
= 0;
1361 nm
++; /* Don't leave the slash in nm. */
1364 else /* ~user/filename */
1366 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1371 o
= (unsigned char *) alloca (p
- nm
+ 1);
1372 bcopy ((char *) nm
, o
, p
- nm
);
1375 pw
= (struct passwd
*) getpwnam (o
+ 1);
1378 newdir
= (unsigned char *) pw
-> pw_dir
;
1380 nm
= p
+ 1; /* skip the terminator */
1384 collapse_newdir
= 0;
1389 /* If we don't find a user of that name, leave the name
1390 unchanged; don't move nm forward to p. */
1395 /* On DOS and Windows, nm is absolute if a drive name was specified;
1396 use the drive's current directory as the prefix if needed. */
1397 if (!newdir
&& drive
)
1399 /* Get default directory if needed to make nm absolute. */
1400 if (!IS_DIRECTORY_SEP (nm
[0]))
1402 newdir
= alloca (MAXPATHLEN
+ 1);
1403 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1408 /* Either nm starts with /, or drive isn't mounted. */
1409 newdir
= alloca (4);
1410 newdir
[0] = DRIVE_LETTER (drive
);
1418 /* Finally, if no prefix has been specified and nm is not absolute,
1419 then it must be expanded relative to default_directory. */
1423 /* /... alone is not absolute on DOS and Windows. */
1424 && !IS_DIRECTORY_SEP (nm
[0])
1427 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1434 newdir
= SDATA (default_directory
);
1436 /* Note if special escape prefix is present, but remove for now. */
1437 if (newdir
[0] == '/' && newdir
[1] == ':')
1448 /* First ensure newdir is an absolute name. */
1450 /* Detect MSDOS file names with drive specifiers. */
1451 ! (IS_DRIVE (newdir
[0])
1452 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1454 /* Detect Windows file names in UNC format. */
1455 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1459 /* Effectively, let newdir be (expand-file-name newdir cwd).
1460 Because of the admonition against calling expand-file-name
1461 when we have pointers into lisp strings, we accomplish this
1462 indirectly by prepending newdir to nm if necessary, and using
1463 cwd (or the wd of newdir's drive) as the new newdir. */
1465 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1470 if (!IS_DIRECTORY_SEP (nm
[0]))
1472 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1473 file_name_as_directory (tmp
, newdir
);
1477 newdir
= alloca (MAXPATHLEN
+ 1);
1480 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1487 /* Strip off drive name from prefix, if present. */
1488 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1494 /* Keep only a prefix from newdir if nm starts with slash
1495 (//server/share for UNC, nothing otherwise). */
1496 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1499 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1501 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1503 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1505 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1517 /* Get rid of any slash at the end of newdir, unless newdir is
1518 just / or // (an incomplete UNC name). */
1519 length
= strlen (newdir
);
1520 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1522 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1526 unsigned char *temp
= (unsigned char *) alloca (length
);
1527 bcopy (newdir
, temp
, length
- 1);
1528 temp
[length
- 1] = 0;
1536 /* Now concatenate the directory and name to new space in the stack frame */
1537 tlen
+= strlen (nm
) + 1;
1539 /* Reserve space for drive specifier and escape prefix, since either
1540 or both may need to be inserted. (The Microsoft x86 compiler
1541 produces incorrect code if the following two lines are combined.) */
1542 target
= (unsigned char *) alloca (tlen
+ 4);
1544 #else /* not DOS_NT */
1545 target
= (unsigned char *) alloca (tlen
);
1546 #endif /* not DOS_NT */
1552 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1555 /* If newdir is effectively "C:/", then the drive letter will have
1556 been stripped and newdir will be "/". Concatenating with an
1557 absolute directory in nm produces "//", which will then be
1558 incorrectly treated as a network share. Ignore newdir in
1559 this case (keeping the drive letter). */
1560 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1561 && newdir
[1] == '\0'))
1563 strcpy (target
, newdir
);
1567 file_name_as_directory (target
, newdir
);
1570 strcat (target
, nm
);
1572 if (index (target
, '/'))
1573 strcpy (target
, sys_translate_unix (target
));
1576 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1578 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1587 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1593 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1594 /* brackets are offset from each other by 2 */
1597 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1598 /* convert [foo][bar] to [bar] */
1599 while (o
[-1] != '[' && o
[-1] != '<')
1601 else if (*p
== '-' && *o
!= '.')
1604 else if (p
[0] == '-' && o
[-1] == '.' &&
1605 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1606 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1610 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1611 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1613 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1615 /* else [foo.-] ==> [-] */
1619 #ifdef NO_HYPHENS_IN_FILENAMES
1621 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1622 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1624 #endif /* NO_HYPHENS_IN_FILENAMES */
1628 if (!IS_DIRECTORY_SEP (*p
))
1632 else if (IS_DIRECTORY_SEP (p
[0])
1634 && (IS_DIRECTORY_SEP (p
[2])
1637 /* If "/." is the entire filename, keep the "/". Otherwise,
1638 just delete the whole "/.". */
1639 if (o
== target
&& p
[2] == '\0')
1643 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1644 /* `/../' is the "superroot" on certain file systems. */
1646 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1648 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1650 /* Keep initial / only if this is the whole name. */
1651 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1656 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1658 /* Collapse multiple `/' in a row. */
1660 while (IS_DIRECTORY_SEP (*p
))
1667 #endif /* not VMS */
1671 /* At last, set drive name. */
1673 /* Except for network file name. */
1674 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1675 #endif /* WINDOWSNT */
1677 if (!drive
) abort ();
1679 target
[0] = DRIVE_LETTER (drive
);
1682 /* Reinsert the escape prefix if required. */
1689 CORRECT_DIR_SEPS (target
);
1692 result
= make_specified_string (target
, -1, o
- target
,
1693 STRING_MULTIBYTE (name
));
1695 /* Again look to see if the file name has special constructs in it
1696 and perhaps call the corresponding file handler. This is needed
1697 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1698 the ".." component gives us "/user@host:/bar/../baz" which needs
1699 to be expanded again. */
1700 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1701 if (!NILP (handler
))
1702 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1708 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1709 This is the old version of expand-file-name, before it was thoroughly
1710 rewritten for Emacs 10.31. We leave this version here commented-out,
1711 because the code is very complex and likely to have subtle bugs. If
1712 bugs _are_ found, it might be of interest to look at the old code and
1713 see what did it do in the relevant situation.
1715 Don't remove this code: it's true that it will be accessible via CVS,
1716 but a few years from deletion, people will forget it is there. */
1718 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1719 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1720 "Convert FILENAME to absolute, and canonicalize it.\n\
1721 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1722 \(does not start with slash); if DEFAULT is nil or missing,\n\
1723 the current buffer's value of default-directory is used.\n\
1724 Filenames containing `.' or `..' as components are simplified;\n\
1725 initial `~/' expands to your home directory.\n\
1726 See also the function `substitute-in-file-name'.")
1728 Lisp_Object name
, defalt
;
1732 register unsigned char *newdir
, *p
, *o
;
1734 unsigned char *target
;
1738 unsigned char * colon
= 0;
1739 unsigned char * close
= 0;
1740 unsigned char * slash
= 0;
1741 unsigned char * brack
= 0;
1742 int lbrack
= 0, rbrack
= 0;
1746 CHECK_STRING (name
);
1749 /* Filenames on VMS are always upper case. */
1750 name
= Fupcase (name
);
1755 /* If nm is absolute, flush ...// and detect /./ and /../.
1756 If no /./ or /../ we can return right away. */
1768 if (p
[0] == '/' && p
[1] == '/'
1770 /* // at start of filename is meaningful on Apollo system. */
1775 if (p
[0] == '/' && p
[1] == '~')
1776 nm
= p
+ 1, lose
= 1;
1777 if (p
[0] == '/' && p
[1] == '.'
1778 && (p
[2] == '/' || p
[2] == 0
1779 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1785 /* if dev:[dir]/, move nm to / */
1786 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1787 nm
= (brack
? brack
+ 1 : colon
+ 1);
1788 lbrack
= rbrack
= 0;
1796 /* VMS pre V4.4,convert '-'s in filenames. */
1797 if (lbrack
== rbrack
)
1799 if (dots
< 2) /* this is to allow negative version numbers */
1804 if (lbrack
> rbrack
&&
1805 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1806 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1812 /* count open brackets, reset close bracket pointer */
1813 if (p
[0] == '[' || p
[0] == '<')
1814 lbrack
++, brack
= 0;
1815 /* count close brackets, set close bracket pointer */
1816 if (p
[0] == ']' || p
[0] == '>')
1817 rbrack
++, brack
= p
;
1818 /* detect ][ or >< */
1819 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1821 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1822 nm
= p
+ 1, lose
= 1;
1823 if (p
[0] == ':' && (colon
|| slash
))
1824 /* if dev1:[dir]dev2:, move nm to dev2: */
1830 /* If /name/dev:, move nm to dev: */
1833 /* If node::dev:, move colon following dev */
1834 else if (colon
&& colon
[-1] == ':')
1836 /* If dev1:dev2:, move nm to dev2: */
1837 else if (colon
&& colon
[-1] != ':')
1842 if (p
[0] == ':' && !colon
)
1848 if (lbrack
== rbrack
)
1851 else if (p
[0] == '.')
1859 if (index (nm
, '/'))
1860 return build_string (sys_translate_unix (nm
));
1862 if (nm
== SDATA (name
))
1864 return build_string (nm
);
1868 /* Now determine directory to start with and put it in NEWDIR */
1872 if (nm
[0] == '~') /* prefix ~ */
1877 || nm
[1] == 0)/* ~/filename */
1879 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1880 newdir
= (unsigned char *) "";
1883 nm
++; /* Don't leave the slash in nm. */
1886 else /* ~user/filename */
1888 /* Get past ~ to user */
1889 unsigned char *user
= nm
+ 1;
1890 /* Find end of name. */
1891 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1892 int len
= ptr
? ptr
- user
: strlen (user
);
1894 unsigned char *ptr1
= index (user
, ':');
1895 if (ptr1
!= 0 && ptr1
- user
< len
)
1898 /* Copy the user name into temp storage. */
1899 o
= (unsigned char *) alloca (len
+ 1);
1900 bcopy ((char *) user
, o
, len
);
1903 /* Look up the user name. */
1904 pw
= (struct passwd
*) getpwnam (o
+ 1);
1906 error ("\"%s\" isn't a registered user", o
+ 1);
1908 newdir
= (unsigned char *) pw
->pw_dir
;
1910 /* Discard the user name from NM. */
1917 #endif /* not VMS */
1921 defalt
= current_buffer
->directory
;
1922 CHECK_STRING (defalt
);
1923 newdir
= SDATA (defalt
);
1926 /* Now concatenate the directory and name to new space in the stack frame */
1928 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1929 target
= (unsigned char *) alloca (tlen
);
1935 if (nm
[0] == 0 || nm
[0] == '/')
1936 strcpy (target
, newdir
);
1939 file_name_as_directory (target
, newdir
);
1942 strcat (target
, nm
);
1944 if (index (target
, '/'))
1945 strcpy (target
, sys_translate_unix (target
));
1948 /* Now canonicalize by removing /. and /foo/.. if they appear */
1956 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1962 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1963 /* brackets are offset from each other by 2 */
1966 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1967 /* convert [foo][bar] to [bar] */
1968 while (o
[-1] != '[' && o
[-1] != '<')
1970 else if (*p
== '-' && *o
!= '.')
1973 else if (p
[0] == '-' && o
[-1] == '.' &&
1974 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1975 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1979 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1980 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1982 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1984 /* else [foo.-] ==> [-] */
1990 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1991 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2001 else if (!strncmp (p
, "//", 2)
2003 /* // at start of filename is meaningful in Apollo system. */
2011 else if (p
[0] == '/' && p
[1] == '.' &&
2012 (p
[2] == '/' || p
[2] == 0))
2014 else if (!strncmp (p
, "/..", 3)
2015 /* `/../' is the "superroot" on certain file systems. */
2017 && (p
[3] == '/' || p
[3] == 0))
2019 while (o
!= target
&& *--o
!= '/')
2022 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2026 if (o
== target
&& *o
== '/')
2034 #endif /* not VMS */
2037 return make_string (target
, o
- target
);
2041 /* If /~ or // appears, discard everything through first slash. */
2043 file_name_absolute_p (filename
)
2044 const unsigned char *filename
;
2047 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2049 /* ??? This criterion is probably wrong for '<'. */
2050 || index (filename
, ':') || index (filename
, '<')
2051 || (*filename
== '[' && (filename
[1] != '-'
2052 || (filename
[2] != '.' && filename
[2] != ']'))
2053 && filename
[1] != '.')
2056 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2057 && IS_DIRECTORY_SEP (filename
[2]))
2062 static unsigned char *
2063 search_embedded_absfilename (nm
, endp
)
2064 unsigned char *nm
, *endp
;
2066 unsigned char *p
, *s
;
2068 for (p
= nm
+ 1; p
< endp
; p
++)
2072 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2074 || IS_DIRECTORY_SEP (p
[-1]))
2075 && file_name_absolute_p (p
)
2076 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2077 /* // at start of file name is meaningful in Apollo,
2078 WindowsNT and Cygwin systems. */
2079 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2080 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2083 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2088 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2090 unsigned char *o
= alloca (s
- p
+ 1);
2092 bcopy (p
, o
, s
- p
);
2095 /* If we have ~user and `user' exists, discard
2096 everything up to ~. But if `user' does not exist, leave
2097 ~user alone, it might be a literal file name. */
2098 if ((pw
= getpwnam (o
+ 1)))
2110 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2111 Ssubstitute_in_file_name
, 1, 1, 0,
2112 doc
: /* Substitute environment variables referred to in FILENAME.
2113 `$FOO' where FOO is an environment variable name means to substitute
2114 the value of that variable. The variable name should be terminated
2115 with a character not a letter, digit or underscore; otherwise, enclose
2116 the entire variable name in braces.
2117 If `/~' appears, all of FILENAME through that `/' is discarded.
2119 On VMS, `$' substitution is not done; this function does little and only
2120 duplicates what `expand-file-name' does. */)
2122 Lisp_Object filename
;
2126 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2127 unsigned char *target
= NULL
;
2129 int substituted
= 0;
2131 Lisp_Object handler
;
2133 CHECK_STRING (filename
);
2135 /* If the file name has special constructs in it,
2136 call the corresponding file handler. */
2137 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2138 if (!NILP (handler
))
2139 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2141 nm
= SDATA (filename
);
2143 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2144 CORRECT_DIR_SEPS (nm
);
2145 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2147 endp
= nm
+ SBYTES (filename
);
2149 /* If /~ or // appears, discard everything through first slash. */
2150 p
= search_embedded_absfilename (nm
, endp
);
2152 /* Start over with the new string, so we check the file-name-handler
2153 again. Important with filenames like "/home/foo//:/hello///there"
2154 which whould substitute to "/:/hello///there" rather than "/there". */
2155 return Fsubstitute_in_file_name
2156 (make_specified_string (p
, -1, endp
- p
,
2157 STRING_MULTIBYTE (filename
)));
2163 /* See if any variables are substituted into the string
2164 and find the total length of their values in `total' */
2166 for (p
= nm
; p
!= endp
;)
2176 /* "$$" means a single "$" */
2185 while (p
!= endp
&& *p
!= '}') p
++;
2186 if (*p
!= '}') goto missingclose
;
2192 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2196 /* Copy out the variable name */
2197 target
= (unsigned char *) alloca (s
- o
+ 1);
2198 strncpy (target
, o
, s
- o
);
2201 strupr (target
); /* $home == $HOME etc. */
2204 /* Get variable value */
2205 o
= (unsigned char *) egetenv (target
);
2208 total
+= strlen (o
);
2218 /* If substitution required, recopy the string and do it */
2219 /* Make space in stack frame for the new copy */
2220 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2223 /* Copy the rest of the name through, replacing $ constructs with values */
2240 while (p
!= endp
&& *p
!= '}') p
++;
2241 if (*p
!= '}') goto missingclose
;
2247 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2251 /* Copy out the variable name */
2252 target
= (unsigned char *) alloca (s
- o
+ 1);
2253 strncpy (target
, o
, s
- o
);
2256 strupr (target
); /* $home == $HOME etc. */
2259 /* Get variable value */
2260 o
= (unsigned char *) egetenv (target
);
2264 strcpy (x
, target
); x
+= strlen (target
);
2266 else if (STRING_MULTIBYTE (filename
))
2268 /* If the original string is multibyte,
2269 convert what we substitute into multibyte. */
2272 int c
= unibyte_char_to_multibyte (*o
++);
2273 x
+= CHAR_STRING (c
, x
);
2285 /* If /~ or // appears, discard everything through first slash. */
2286 while ((p
= search_embedded_absfilename (xnm
, x
)))
2287 /* This time we do not start over because we've already expanded envvars
2288 and replaced $$ with $. Maybe we should start over as well, but we'd
2289 need to quote some $ to $$ first. */
2292 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2295 error ("Bad format environment-variable substitution");
2297 error ("Missing \"}\" in environment-variable substitution");
2299 error ("Substituting nonexistent environment variable \"%s\"", target
);
2302 #endif /* not VMS */
2306 /* A slightly faster and more convenient way to get
2307 (directory-file-name (expand-file-name FOO)). */
2310 expand_and_dir_to_file (filename
, defdir
)
2311 Lisp_Object filename
, defdir
;
2313 register Lisp_Object absname
;
2315 absname
= Fexpand_file_name (filename
, defdir
);
2318 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2319 if (c
== ':' || c
== ']' || c
== '>')
2320 absname
= Fdirectory_file_name (absname
);
2323 /* Remove final slash, if any (unless this is the root dir).
2324 stat behaves differently depending! */
2325 if (SCHARS (absname
) > 1
2326 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2327 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2328 /* We cannot take shortcuts; they might be wrong for magic file names. */
2329 absname
= Fdirectory_file_name (absname
);
2334 /* Signal an error if the file ABSNAME already exists.
2335 If INTERACTIVE is nonzero, ask the user whether to proceed,
2336 and bypass the error if the user says to go ahead.
2337 QUERYSTRING is a name for the action that is being considered
2340 *STATPTR is used to store the stat information if the file exists.
2341 If the file does not exist, STATPTR->st_mode is set to 0.
2342 If STATPTR is null, we don't store into it.
2344 If QUICK is nonzero, we ask for y or n, not yes or no. */
2347 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2348 Lisp_Object absname
;
2349 unsigned char *querystring
;
2351 struct stat
*statptr
;
2354 register Lisp_Object tem
, encoded_filename
;
2355 struct stat statbuf
;
2356 struct gcpro gcpro1
;
2358 encoded_filename
= ENCODE_FILE (absname
);
2360 /* stat is a good way to tell whether the file exists,
2361 regardless of what access permissions it has. */
2362 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2365 Fsignal (Qfile_already_exists
,
2366 Fcons (build_string ("File already exists"),
2367 Fcons (absname
, Qnil
)));
2369 tem
= format2 ("File %s already exists; %s anyway? ",
2370 absname
, build_string (querystring
));
2372 tem
= Fy_or_n_p (tem
);
2374 tem
= do_yes_or_no_p (tem
);
2377 Fsignal (Qfile_already_exists
,
2378 Fcons (build_string ("File already exists"),
2379 Fcons (absname
, Qnil
)));
2386 statptr
->st_mode
= 0;
2391 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2392 "fCopy file: \nGCopy %s to file: \np\nP",
2393 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2394 If NEWNAME names a directory, copy FILE there.
2395 Signals a `file-already-exists' error if file NEWNAME already exists,
2396 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2397 A number as third arg means request confirmation if NEWNAME already exists.
2398 This is what happens in interactive use with M-x.
2399 Always sets the file modes of the output file to match the input file.
2401 Fourth arg KEEP-TIME non-nil means give the output file the same
2402 last-modified time as the old one. (This works on only some systems.)
2404 A prefix arg makes KEEP-TIME non-nil.
2406 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2407 for an existing file with the same name. If MUSTBENEW is `excl',
2408 that means to get an error if the file already exists; never overwrite.
2409 If MUSTBENEW is neither nil nor `excl', that means ask for
2410 confirmation before overwriting, but do go ahead and overwrite the file
2411 if the user confirms. */)
2412 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
)
2413 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2416 char buf
[16 * 1024];
2417 struct stat st
, out_st
;
2418 Lisp_Object handler
;
2419 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2420 int count
= SPECPDL_INDEX ();
2421 int input_file_statable_p
;
2422 Lisp_Object encoded_file
, encoded_newname
;
2424 encoded_file
= encoded_newname
= Qnil
;
2425 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2426 CHECK_STRING (file
);
2427 CHECK_STRING (newname
);
2429 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2430 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2432 if (!NILP (Ffile_directory_p (newname
)))
2433 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2435 newname
= Fexpand_file_name (newname
, Qnil
);
2437 file
= Fexpand_file_name (file
, Qnil
);
2439 /* If the input file name has special constructs in it,
2440 call the corresponding file handler. */
2441 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2442 /* Likewise for output file name. */
2444 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2445 if (!NILP (handler
))
2446 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2447 ok_if_already_exists
, keep_time
));
2449 encoded_file
= ENCODE_FILE (file
);
2450 encoded_newname
= ENCODE_FILE (newname
);
2452 if (NILP (ok_if_already_exists
)
2453 || INTEGERP (ok_if_already_exists
))
2454 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2455 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2456 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2460 if (!CopyFile (SDATA (encoded_file
),
2461 SDATA (encoded_newname
),
2463 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2464 /* CopyFile retains the timestamp by default. */
2465 else if (NILP (keep_time
))
2471 EMACS_GET_TIME (now
);
2472 filename
= SDATA (encoded_newname
);
2474 /* Ensure file is writable while its modified time is set. */
2475 attributes
= GetFileAttributes (filename
);
2476 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2477 if (set_file_times (filename
, now
, now
))
2479 /* Restore original attributes. */
2480 SetFileAttributes (filename
, attributes
);
2481 Fsignal (Qfile_date_error
,
2482 Fcons (build_string ("Cannot set file date"),
2483 Fcons (newname
, Qnil
)));
2485 /* Restore original attributes. */
2486 SetFileAttributes (filename
, attributes
);
2488 #else /* not WINDOWSNT */
2490 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2494 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2496 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2498 /* We can only copy regular files and symbolic links. Other files are not
2500 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2502 #if !defined (DOS_NT) || __DJGPP__ > 1
2503 if (out_st
.st_mode
!= 0
2504 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2507 report_file_error ("Input and output files are the same",
2508 Fcons (file
, Fcons (newname
, Qnil
)));
2512 #if defined (S_ISREG) && defined (S_ISLNK)
2513 if (input_file_statable_p
)
2515 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2517 #if defined (EISDIR)
2518 /* Get a better looking error message. */
2521 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2524 #endif /* S_ISREG && S_ISLNK */
2527 /* Create the copy file with the same record format as the input file */
2528 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2531 /* System's default file type was set to binary by _fmode in emacs.c. */
2532 ofd
= emacs_open (SDATA (encoded_newname
),
2533 O_WRONLY
| O_TRUNC
| O_CREAT
2534 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2535 S_IREAD
| S_IWRITE
);
2536 #else /* not MSDOS */
2537 ofd
= emacs_open (SDATA (encoded_newname
),
2538 O_WRONLY
| O_TRUNC
| O_CREAT
2539 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2541 #endif /* not MSDOS */
2544 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2546 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2550 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2551 if (emacs_write (ofd
, buf
, n
) != n
)
2552 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2555 /* Closing the output clobbers the file times on some systems. */
2556 if (emacs_close (ofd
) < 0)
2557 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2559 if (input_file_statable_p
)
2561 if (!NILP (keep_time
))
2563 EMACS_TIME atime
, mtime
;
2564 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2565 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2566 if (set_file_times (SDATA (encoded_newname
),
2568 Fsignal (Qfile_date_error
,
2569 Fcons (build_string ("Cannot set file date"),
2570 Fcons (newname
, Qnil
)));
2573 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2575 #if defined (__DJGPP__) && __DJGPP__ > 1
2576 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2577 and if it can't, it tells so. Otherwise, under MSDOS we usually
2578 get only the READ bit, which will make the copied file read-only,
2579 so it's better not to chmod at all. */
2580 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2581 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2582 #endif /* DJGPP version 2 or newer */
2587 #endif /* WINDOWSNT */
2589 /* Discard the unwind protects. */
2590 specpdl_ptr
= specpdl
+ count
;
2596 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2597 Smake_directory_internal
, 1, 1, 0,
2598 doc
: /* Create a new directory named DIRECTORY. */)
2600 Lisp_Object directory
;
2602 const unsigned char *dir
;
2603 Lisp_Object handler
;
2604 Lisp_Object encoded_dir
;
2606 CHECK_STRING (directory
);
2607 directory
= Fexpand_file_name (directory
, Qnil
);
2609 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2610 if (!NILP (handler
))
2611 return call2 (handler
, Qmake_directory_internal
, directory
);
2613 encoded_dir
= ENCODE_FILE (directory
);
2615 dir
= SDATA (encoded_dir
);
2618 if (mkdir (dir
) != 0)
2620 if (mkdir (dir
, 0777) != 0)
2622 report_file_error ("Creating directory", Flist (1, &directory
));
2627 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2628 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2630 Lisp_Object directory
;
2632 const unsigned char *dir
;
2633 Lisp_Object handler
;
2634 Lisp_Object encoded_dir
;
2636 CHECK_STRING (directory
);
2637 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2639 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2640 if (!NILP (handler
))
2641 return call2 (handler
, Qdelete_directory
, directory
);
2643 encoded_dir
= ENCODE_FILE (directory
);
2645 dir
= SDATA (encoded_dir
);
2647 if (rmdir (dir
) != 0)
2648 report_file_error ("Removing directory", Flist (1, &directory
));
2653 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2654 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2655 If file has multiple names, it continues to exist with the other names. */)
2657 Lisp_Object filename
;
2659 Lisp_Object handler
;
2660 Lisp_Object encoded_file
;
2661 struct gcpro gcpro1
;
2664 if (!NILP (Ffile_directory_p (filename
))
2665 && NILP (Ffile_symlink_p (filename
)))
2666 Fsignal (Qfile_error
,
2667 Fcons (build_string ("Removing old name: is a directory"),
2668 Fcons (filename
, Qnil
)));
2670 filename
= Fexpand_file_name (filename
, Qnil
);
2672 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2673 if (!NILP (handler
))
2674 return call2 (handler
, Qdelete_file
, filename
);
2676 encoded_file
= ENCODE_FILE (filename
);
2678 if (0 > unlink (SDATA (encoded_file
)))
2679 report_file_error ("Removing old name", Flist (1, &filename
));
2684 internal_delete_file_1 (ignore
)
2690 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2693 internal_delete_file (filename
)
2694 Lisp_Object filename
;
2696 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2697 Qt
, internal_delete_file_1
));
2700 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2701 "fRename file: \nGRename %s to file: \np",
2702 doc
: /* Rename FILE as NEWNAME. Both args strings.
2703 If file has names other than FILE, it continues to have those names.
2704 Signals a `file-already-exists' error if a file NEWNAME already exists
2705 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2706 A number as third arg means request confirmation if NEWNAME already exists.
2707 This is what happens in interactive use with M-x. */)
2708 (file
, newname
, ok_if_already_exists
)
2709 Lisp_Object file
, newname
, ok_if_already_exists
;
2712 Lisp_Object args
[2];
2714 Lisp_Object handler
;
2715 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2716 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2718 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2719 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2720 CHECK_STRING (file
);
2721 CHECK_STRING (newname
);
2722 file
= Fexpand_file_name (file
, Qnil
);
2724 if (!NILP (Ffile_directory_p (newname
)))
2725 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2727 newname
= Fexpand_file_name (newname
, Qnil
);
2729 /* If the file name has special constructs in it,
2730 call the corresponding file handler. */
2731 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2733 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2734 if (!NILP (handler
))
2735 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2736 file
, newname
, ok_if_already_exists
));
2738 encoded_file
= ENCODE_FILE (file
);
2739 encoded_newname
= ENCODE_FILE (newname
);
2742 /* If the file names are identical but for the case, don't ask for
2743 confirmation: they simply want to change the letter-case of the
2745 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2747 if (NILP (ok_if_already_exists
)
2748 || INTEGERP (ok_if_already_exists
))
2749 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2750 INTEGERP (ok_if_already_exists
), 0, 0);
2752 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2754 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2755 || 0 > unlink (SDATA (encoded_file
)))
2761 symlink_target
= Ffile_symlink_p (file
);
2762 if (! NILP (symlink_target
))
2763 Fmake_symbolic_link (symlink_target
, newname
,
2764 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2767 Fcopy_file (file
, newname
,
2768 /* We have already prompted if it was an integer,
2769 so don't have copy-file prompt again. */
2770 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2772 Fdelete_file (file
);
2779 report_file_error ("Renaming", Flist (2, args
));
2782 report_file_error ("Renaming", Flist (2, &file
));
2789 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2790 "fAdd name to file: \nGName to add to %s: \np",
2791 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2792 Signals a `file-already-exists' error if a file NEWNAME already exists
2793 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2794 A number as third arg means request confirmation if NEWNAME already exists.
2795 This is what happens in interactive use with M-x. */)
2796 (file
, newname
, ok_if_already_exists
)
2797 Lisp_Object file
, newname
, ok_if_already_exists
;
2800 Lisp_Object args
[2];
2802 Lisp_Object handler
;
2803 Lisp_Object encoded_file
, encoded_newname
;
2804 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2806 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2807 encoded_file
= encoded_newname
= Qnil
;
2808 CHECK_STRING (file
);
2809 CHECK_STRING (newname
);
2810 file
= Fexpand_file_name (file
, Qnil
);
2812 if (!NILP (Ffile_directory_p (newname
)))
2813 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2815 newname
= Fexpand_file_name (newname
, Qnil
);
2817 /* If the file name has special constructs in it,
2818 call the corresponding file handler. */
2819 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2820 if (!NILP (handler
))
2821 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2822 newname
, ok_if_already_exists
));
2824 /* If the new name has special constructs in it,
2825 call the corresponding file handler. */
2826 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2827 if (!NILP (handler
))
2828 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2829 newname
, ok_if_already_exists
));
2831 encoded_file
= ENCODE_FILE (file
);
2832 encoded_newname
= ENCODE_FILE (newname
);
2834 if (NILP (ok_if_already_exists
)
2835 || INTEGERP (ok_if_already_exists
))
2836 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2837 INTEGERP (ok_if_already_exists
), 0, 0);
2839 unlink (SDATA (newname
));
2840 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2845 report_file_error ("Adding new name", Flist (2, args
));
2847 report_file_error ("Adding new name", Flist (2, &file
));
2856 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2857 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2858 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2859 Signals a `file-already-exists' error if a file LINKNAME already exists
2860 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2861 A number as third arg means request confirmation if LINKNAME already exists.
2862 This happens for interactive use with M-x. */)
2863 (filename
, linkname
, ok_if_already_exists
)
2864 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2867 Lisp_Object args
[2];
2869 Lisp_Object handler
;
2870 Lisp_Object encoded_filename
, encoded_linkname
;
2871 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2873 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2874 encoded_filename
= encoded_linkname
= Qnil
;
2875 CHECK_STRING (filename
);
2876 CHECK_STRING (linkname
);
2877 /* If the link target has a ~, we must expand it to get
2878 a truly valid file name. Otherwise, do not expand;
2879 we want to permit links to relative file names. */
2880 if (SREF (filename
, 0) == '~')
2881 filename
= Fexpand_file_name (filename
, Qnil
);
2883 if (!NILP (Ffile_directory_p (linkname
)))
2884 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2886 linkname
= Fexpand_file_name (linkname
, Qnil
);
2888 /* If the file name has special constructs in it,
2889 call the corresponding file handler. */
2890 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2891 if (!NILP (handler
))
2892 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2893 linkname
, ok_if_already_exists
));
2895 /* If the new link name has special constructs in it,
2896 call the corresponding file handler. */
2897 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2898 if (!NILP (handler
))
2899 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2900 linkname
, ok_if_already_exists
));
2902 encoded_filename
= ENCODE_FILE (filename
);
2903 encoded_linkname
= ENCODE_FILE (linkname
);
2905 if (NILP (ok_if_already_exists
)
2906 || INTEGERP (ok_if_already_exists
))
2907 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2908 INTEGERP (ok_if_already_exists
), 0, 0);
2909 if (0 > symlink (SDATA (encoded_filename
),
2910 SDATA (encoded_linkname
)))
2912 /* If we didn't complain already, silently delete existing file. */
2913 if (errno
== EEXIST
)
2915 unlink (SDATA (encoded_linkname
));
2916 if (0 <= symlink (SDATA (encoded_filename
),
2917 SDATA (encoded_linkname
)))
2927 report_file_error ("Making symbolic link", Flist (2, args
));
2929 report_file_error ("Making symbolic link", Flist (2, &filename
));
2935 #endif /* S_IFLNK */
2939 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2940 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2941 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2942 If STRING is nil or a null string, the logical name NAME is deleted. */)
2947 CHECK_STRING (name
);
2949 delete_logical_name (SDATA (name
));
2952 CHECK_STRING (string
);
2954 if (SCHARS (string
) == 0)
2955 delete_logical_name (SDATA (name
));
2957 define_logical_name (SDATA (name
), SDATA (string
));
2966 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2967 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2969 Lisp_Object path
, login
;
2973 CHECK_STRING (path
);
2974 CHECK_STRING (login
);
2976 netresult
= netunam (SDATA (path
), SDATA (login
));
2978 if (netresult
== -1)
2983 #endif /* HPUX_NET */
2985 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2987 doc
: /* Return t if file FILENAME specifies an absolute file name.
2988 On Unix, this is a name starting with a `/' or a `~'. */)
2990 Lisp_Object filename
;
2992 CHECK_STRING (filename
);
2993 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2996 /* Return nonzero if file FILENAME exists and can be executed. */
2999 check_executable (filename
)
3003 int len
= strlen (filename
);
3006 if (stat (filename
, &st
) < 0)
3008 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3009 return ((st
.st_mode
& S_IEXEC
) != 0);
3011 return (S_ISREG (st
.st_mode
)
3013 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3014 || stricmp (suffix
, ".exe") == 0
3015 || stricmp (suffix
, ".bat") == 0)
3016 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3017 #endif /* not WINDOWSNT */
3018 #else /* not DOS_NT */
3019 #ifdef HAVE_EUIDACCESS
3020 return (euidaccess (filename
, 1) >= 0);
3022 /* Access isn't quite right because it uses the real uid
3023 and we really want to test with the effective uid.
3024 But Unix doesn't give us a right way to do it. */
3025 return (access (filename
, 1) >= 0);
3027 #endif /* not DOS_NT */
3030 /* Return nonzero if file FILENAME exists and can be written. */
3033 check_writable (filename
)
3038 if (stat (filename
, &st
) < 0)
3040 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3041 #else /* not MSDOS */
3042 #ifdef HAVE_EUIDACCESS
3043 return (euidaccess (filename
, 2) >= 0);
3045 /* Access isn't quite right because it uses the real uid
3046 and we really want to test with the effective uid.
3047 But Unix doesn't give us a right way to do it.
3048 Opening with O_WRONLY could work for an ordinary file,
3049 but would lose for directories. */
3050 return (access (filename
, 2) >= 0);
3052 #endif /* not MSDOS */
3055 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3056 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3057 See also `file-readable-p' and `file-attributes'. */)
3059 Lisp_Object filename
;
3061 Lisp_Object absname
;
3062 Lisp_Object handler
;
3063 struct stat statbuf
;
3065 CHECK_STRING (filename
);
3066 absname
= Fexpand_file_name (filename
, Qnil
);
3068 /* If the file name has special constructs in it,
3069 call the corresponding file handler. */
3070 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3071 if (!NILP (handler
))
3072 return call2 (handler
, Qfile_exists_p
, absname
);
3074 absname
= ENCODE_FILE (absname
);
3076 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3079 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3080 doc
: /* Return t if FILENAME can be executed by you.
3081 For a directory, this means you can access files in that directory. */)
3083 Lisp_Object filename
;
3085 Lisp_Object absname
;
3086 Lisp_Object handler
;
3088 CHECK_STRING (filename
);
3089 absname
= Fexpand_file_name (filename
, Qnil
);
3091 /* If the file name has special constructs in it,
3092 call the corresponding file handler. */
3093 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3094 if (!NILP (handler
))
3095 return call2 (handler
, Qfile_executable_p
, absname
);
3097 absname
= ENCODE_FILE (absname
);
3099 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3102 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3103 doc
: /* Return t if file FILENAME exists and you can read it.
3104 See also `file-exists-p' and `file-attributes'. */)
3106 Lisp_Object filename
;
3108 Lisp_Object absname
;
3109 Lisp_Object handler
;
3112 struct stat statbuf
;
3114 CHECK_STRING (filename
);
3115 absname
= Fexpand_file_name (filename
, Qnil
);
3117 /* If the file name has special constructs in it,
3118 call the corresponding file handler. */
3119 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3120 if (!NILP (handler
))
3121 return call2 (handler
, Qfile_readable_p
, absname
);
3123 absname
= ENCODE_FILE (absname
);
3125 #if defined(DOS_NT) || defined(macintosh)
3126 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3128 if (access (SDATA (absname
), 0) == 0)
3131 #else /* not DOS_NT and not macintosh */
3133 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3134 /* Opening a fifo without O_NONBLOCK can wait.
3135 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3136 except in the case of a fifo, on a system which handles it. */
3137 desc
= stat (SDATA (absname
), &statbuf
);
3140 if (S_ISFIFO (statbuf
.st_mode
))
3141 flags
|= O_NONBLOCK
;
3143 desc
= emacs_open (SDATA (absname
), flags
, 0);
3148 #endif /* not DOS_NT and not macintosh */
3151 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3153 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3154 doc
: /* Return t if file FILENAME can be written or created by you. */)
3156 Lisp_Object filename
;
3158 Lisp_Object absname
, dir
, encoded
;
3159 Lisp_Object handler
;
3160 struct stat statbuf
;
3162 CHECK_STRING (filename
);
3163 absname
= Fexpand_file_name (filename
, Qnil
);
3165 /* If the file name has special constructs in it,
3166 call the corresponding file handler. */
3167 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3168 if (!NILP (handler
))
3169 return call2 (handler
, Qfile_writable_p
, absname
);
3171 encoded
= ENCODE_FILE (absname
);
3172 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3173 return (check_writable (SDATA (encoded
))
3176 dir
= Ffile_name_directory (absname
);
3179 dir
= Fdirectory_file_name (dir
);
3183 dir
= Fdirectory_file_name (dir
);
3186 dir
= ENCODE_FILE (dir
);
3188 /* The read-only attribute of the parent directory doesn't affect
3189 whether a file or directory can be created within it. Some day we
3190 should check ACLs though, which do affect this. */
3191 if (stat (SDATA (dir
), &statbuf
) < 0)
3193 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3195 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3200 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3201 doc
: /* Access file FILENAME, and get an error if that does not work.
3202 The second argument STRING is used in the error message.
3203 If there is no error, we return nil. */)
3205 Lisp_Object filename
, string
;
3207 Lisp_Object handler
, encoded_filename
, absname
;
3210 CHECK_STRING (filename
);
3211 absname
= Fexpand_file_name (filename
, Qnil
);
3213 CHECK_STRING (string
);
3215 /* If the file name has special constructs in it,
3216 call the corresponding file handler. */
3217 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3218 if (!NILP (handler
))
3219 return call3 (handler
, Qaccess_file
, absname
, string
);
3221 encoded_filename
= ENCODE_FILE (absname
);
3223 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3225 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3231 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3232 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3233 The value is the link target, as a string.
3234 Otherwise returns nil. */)
3236 Lisp_Object filename
;
3238 Lisp_Object handler
;
3240 CHECK_STRING (filename
);
3241 filename
= Fexpand_file_name (filename
, Qnil
);
3243 /* If the file name has special constructs in it,
3244 call the corresponding file handler. */
3245 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3246 if (!NILP (handler
))
3247 return call2 (handler
, Qfile_symlink_p
, filename
);
3256 filename
= ENCODE_FILE (filename
);
3263 buf
= (char *) xrealloc (buf
, bufsize
);
3264 bzero (buf
, bufsize
);
3267 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3271 /* HP-UX reports ERANGE if buffer is too small. */
3272 if (errno
== ERANGE
)
3282 while (valsize
>= bufsize
);
3284 val
= make_string (buf
, valsize
);
3285 if (buf
[0] == '/' && index (buf
, ':'))
3286 val
= concat2 (build_string ("/:"), val
);
3288 val
= DECODE_FILE (val
);
3291 #else /* not S_IFLNK */
3293 #endif /* not S_IFLNK */
3296 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3297 doc
: /* Return t if FILENAME names an existing directory.
3298 Symbolic links to directories count as directories.
3299 See `file-symlink-p' to distinguish symlinks. */)
3301 Lisp_Object filename
;
3303 register Lisp_Object absname
;
3305 Lisp_Object handler
;
3307 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3309 /* If the file name has special constructs in it,
3310 call the corresponding file handler. */
3311 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3312 if (!NILP (handler
))
3313 return call2 (handler
, Qfile_directory_p
, absname
);
3315 absname
= ENCODE_FILE (absname
);
3317 if (stat (SDATA (absname
), &st
) < 0)
3319 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3322 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3323 doc
: /* Return t if file FILENAME names a directory you can open.
3324 For the value to be t, FILENAME must specify the name of a directory as a file,
3325 and the directory must allow you to open files in it. In order to use a
3326 directory as a buffer's current directory, this predicate must return true.
3327 A directory name spec may be given instead; then the value is t
3328 if the directory so specified exists and really is a readable and
3329 searchable directory. */)
3331 Lisp_Object filename
;
3333 Lisp_Object handler
;
3335 struct gcpro gcpro1
;
3337 /* If the file name has special constructs in it,
3338 call the corresponding file handler. */
3339 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3340 if (!NILP (handler
))
3341 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3344 tem
= (NILP (Ffile_directory_p (filename
))
3345 || NILP (Ffile_executable_p (filename
)));
3347 return tem
? Qnil
: Qt
;
3350 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3351 doc
: /* Return t if file FILENAME is the name of a regular file.
3352 This is the sort of file that holds an ordinary stream of data bytes. */)
3354 Lisp_Object filename
;
3356 register Lisp_Object absname
;
3358 Lisp_Object handler
;
3360 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3362 /* If the file name has special constructs in it,
3363 call the corresponding file handler. */
3364 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3365 if (!NILP (handler
))
3366 return call2 (handler
, Qfile_regular_p
, absname
);
3368 absname
= ENCODE_FILE (absname
);
3373 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3375 /* Tell stat to use expensive method to get accurate info. */
3376 Vw32_get_true_file_attributes
= Qt
;
3377 result
= stat (SDATA (absname
), &st
);
3378 Vw32_get_true_file_attributes
= tem
;
3382 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3385 if (stat (SDATA (absname
), &st
) < 0)
3387 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3391 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3392 doc
: /* Return mode bits of file named FILENAME, as an integer.
3393 Return nil, if file does not exist or is not accessible. */)
3395 Lisp_Object filename
;
3397 Lisp_Object absname
;
3399 Lisp_Object handler
;
3401 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3403 /* If the file name has special constructs in it,
3404 call the corresponding file handler. */
3405 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3406 if (!NILP (handler
))
3407 return call2 (handler
, Qfile_modes
, absname
);
3409 absname
= ENCODE_FILE (absname
);
3411 if (stat (SDATA (absname
), &st
) < 0)
3413 #if defined (MSDOS) && __DJGPP__ < 2
3414 if (check_executable (SDATA (absname
)))
3415 st
.st_mode
|= S_IEXEC
;
3416 #endif /* MSDOS && __DJGPP__ < 2 */
3418 return make_number (st
.st_mode
& 07777);
3421 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3422 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3423 Only the 12 low bits of MODE are used. */)
3425 Lisp_Object filename
, mode
;
3427 Lisp_Object absname
, encoded_absname
;
3428 Lisp_Object handler
;
3430 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3431 CHECK_NUMBER (mode
);
3433 /* If the file name has special constructs in it,
3434 call the corresponding file handler. */
3435 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3436 if (!NILP (handler
))
3437 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3439 encoded_absname
= ENCODE_FILE (absname
);
3441 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3442 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3447 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3448 doc
: /* Set the file permission bits for newly created files.
3449 The argument MODE should be an integer; only the low 9 bits are used.
3450 This setting is inherited by subprocesses. */)
3454 CHECK_NUMBER (mode
);
3456 umask ((~ XINT (mode
)) & 0777);
3461 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3462 doc
: /* Return the default file protection for created files.
3463 The value is an integer. */)
3469 realmask
= umask (0);
3472 XSETINT (value
, (~ realmask
) & 0777);
3476 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3478 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3479 doc
: /* Set times of file FILENAME to TIME.
3480 Set both access and modification times.
3481 Return t on success, else nil.
3482 Use the current time if TIME is nil. TIME is in the format of
3485 Lisp_Object filename
, time
;
3487 Lisp_Object absname
, encoded_absname
;
3488 Lisp_Object handler
;
3492 if (! lisp_time_argument (time
, &sec
, &usec
))
3493 error ("Invalid time specification");
3495 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3497 /* If the file name has special constructs in it,
3498 call the corresponding file handler. */
3499 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3500 if (!NILP (handler
))
3501 return call3 (handler
, Qset_file_times
, absname
, time
);
3503 encoded_absname
= ENCODE_FILE (absname
);
3508 EMACS_SET_SECS (t
, sec
);
3509 EMACS_SET_USECS (t
, usec
);
3511 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3516 /* Setting times on a directory always fails. */
3517 if (stat (SDATA (encoded_absname
), &st
) == 0
3518 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3521 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3534 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3535 doc
: /* Tell Unix to finish all pending disk updates. */)
3544 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3545 doc
: /* Return t if file FILE1 is newer than file FILE2.
3546 If FILE1 does not exist, the answer is nil;
3547 otherwise, if FILE2 does not exist, the answer is t. */)
3549 Lisp_Object file1
, file2
;
3551 Lisp_Object absname1
, absname2
;
3554 Lisp_Object handler
;
3555 struct gcpro gcpro1
, gcpro2
;
3557 CHECK_STRING (file1
);
3558 CHECK_STRING (file2
);
3561 GCPRO2 (absname1
, file2
);
3562 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3563 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3566 /* If the file name has special constructs in it,
3567 call the corresponding file handler. */
3568 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3570 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3571 if (!NILP (handler
))
3572 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3574 GCPRO2 (absname1
, absname2
);
3575 absname1
= ENCODE_FILE (absname1
);
3576 absname2
= ENCODE_FILE (absname2
);
3579 if (stat (SDATA (absname1
), &st
) < 0)
3582 mtime1
= st
.st_mtime
;
3584 if (stat (SDATA (absname2
), &st
) < 0)
3587 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3591 Lisp_Object Qfind_buffer_file_type
;
3594 #ifndef READ_BUF_SIZE
3595 #define READ_BUF_SIZE (64 << 10)
3598 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3600 /* This function is called after Lisp functions to decide a coding
3601 system are called, or when they cause an error. Before they are
3602 called, the current buffer is set unibyte and it contains only a
3603 newly inserted text (thus the buffer was empty before the
3606 The functions may set markers, overlays, text properties, or even
3607 alter the buffer contents, change the current buffer.
3609 Here, we reset all those changes by:
3610 o set back the current buffer.
3611 o move all markers and overlays to BEG.
3612 o remove all text properties.
3613 o set back the buffer multibyteness. */
3616 decide_coding_unwind (unwind_data
)
3617 Lisp_Object unwind_data
;
3619 Lisp_Object multibyte
, undo_list
, buffer
;
3621 multibyte
= XCAR (unwind_data
);
3622 unwind_data
= XCDR (unwind_data
);
3623 undo_list
= XCAR (unwind_data
);
3624 buffer
= XCDR (unwind_data
);
3626 if (current_buffer
!= XBUFFER (buffer
))
3627 set_buffer_internal (XBUFFER (buffer
));
3628 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3629 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3630 BUF_INTERVALS (current_buffer
) = 0;
3631 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3633 /* Now we are safe to change the buffer's multibyteness directly. */
3634 current_buffer
->enable_multibyte_characters
= multibyte
;
3635 current_buffer
->undo_list
= undo_list
;
3641 /* Used to pass values from insert-file-contents to read_non_regular. */
3643 static int non_regular_fd
;
3644 static int non_regular_inserted
;
3645 static int non_regular_nbytes
;
3648 /* Read from a non-regular file.
3649 Read non_regular_trytry bytes max from non_regular_fd.
3650 Non_regular_inserted specifies where to put the read bytes.
3651 Value is the number of bytes read. */
3660 nbytes
= emacs_read (non_regular_fd
,
3661 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3662 non_regular_nbytes
);
3664 return make_number (nbytes
);
3668 /* Condition-case handler used when reading from non-regular files
3669 in insert-file-contents. */
3672 read_non_regular_quit ()
3678 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3680 doc
: /* Insert contents of file FILENAME after point.
3681 Returns list of absolute file name and number of characters inserted.
3682 If second argument VISIT is non-nil, the buffer's visited filename
3683 and last save file modtime are set, and it is marked unmodified.
3684 If visiting and the file does not exist, visiting is completed
3685 before the error is signaled.
3686 The optional third and fourth arguments BEG and END
3687 specify what portion of the file to insert.
3688 These arguments count bytes in the file, not characters in the buffer.
3689 If VISIT is non-nil, BEG and END must be nil.
3691 If optional fifth argument REPLACE is non-nil,
3692 it means replace the current buffer contents (in the accessible portion)
3693 with the file contents. This is better than simply deleting and inserting
3694 the whole thing because (1) it preserves some marker positions
3695 and (2) it puts less data in the undo list.
3696 When REPLACE is non-nil, the value is the number of characters actually read,
3697 which is often less than the number of characters to be read.
3699 This does code conversion according to the value of
3700 `coding-system-for-read' or `file-coding-system-alist',
3701 and sets the variable `last-coding-system-used' to the coding system
3703 (filename
, visit
, beg
, end
, replace
)
3704 Lisp_Object filename
, visit
, beg
, end
, replace
;
3709 register int how_much
;
3710 register int unprocessed
;
3711 int count
= SPECPDL_INDEX ();
3712 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3713 Lisp_Object handler
, val
, insval
, orig_filename
;
3716 int not_regular
= 0;
3717 unsigned char read_buf
[READ_BUF_SIZE
];
3718 struct coding_system coding
;
3719 unsigned char buffer
[1 << 14];
3720 int replace_handled
= 0;
3721 int set_coding_system
= 0;
3722 int coding_system_decided
= 0;
3725 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3726 error ("Cannot do file visiting in an indirect buffer");
3728 if (!NILP (current_buffer
->read_only
))
3729 Fbarf_if_buffer_read_only ();
3733 orig_filename
= Qnil
;
3735 GCPRO4 (filename
, val
, p
, orig_filename
);
3737 CHECK_STRING (filename
);
3738 filename
= Fexpand_file_name (filename
, Qnil
);
3740 /* If the file name has special constructs in it,
3741 call the corresponding file handler. */
3742 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3743 if (!NILP (handler
))
3745 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3746 visit
, beg
, end
, replace
);
3747 if (CONSP (val
) && CONSP (XCDR (val
)))
3748 inserted
= XINT (XCAR (XCDR (val
)));
3752 orig_filename
= filename
;
3753 filename
= ENCODE_FILE (filename
);
3759 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3761 /* Tell stat to use expensive method to get accurate info. */
3762 Vw32_get_true_file_attributes
= Qt
;
3763 total
= stat (SDATA (filename
), &st
);
3764 Vw32_get_true_file_attributes
= tem
;
3769 if (stat (SDATA (filename
), &st
) < 0)
3771 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3772 || fstat (fd
, &st
) < 0)
3773 #endif /* not APOLLO */
3774 #endif /* WINDOWSNT */
3776 if (fd
>= 0) emacs_close (fd
);
3779 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3782 if (!NILP (Vcoding_system_for_read
))
3783 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3788 /* This code will need to be changed in order to work on named
3789 pipes, and it's probably just not worth it. So we should at
3790 least signal an error. */
3791 if (!S_ISREG (st
.st_mode
))
3798 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3799 Fsignal (Qfile_error
,
3800 Fcons (build_string ("not a regular file"),
3801 Fcons (orig_filename
, Qnil
)));
3806 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3809 /* Replacement should preserve point as it preserves markers. */
3810 if (!NILP (replace
))
3811 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3813 record_unwind_protect (close_file_unwind
, make_number (fd
));
3815 /* Supposedly happens on VMS. */
3816 /* Can happen on any platform that uses long as type of off_t, but allows
3817 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3818 give a message suitable for the latter case. */
3819 if (! not_regular
&& st
.st_size
< 0)
3820 error ("Maximum buffer size exceeded");
3822 /* Prevent redisplay optimizations. */
3823 current_buffer
->clip_changed
= 1;
3827 if (!NILP (beg
) || !NILP (end
))
3828 error ("Attempt to visit less than an entire file");
3829 if (BEG
< Z
&& NILP (replace
))
3830 error ("Cannot do file visiting in a non-empty buffer");
3836 XSETFASTINT (beg
, 0);
3844 XSETINT (end
, st
.st_size
);
3846 /* Arithmetic overflow can occur if an Emacs integer cannot
3847 represent the file size, or if the calculations below
3848 overflow. The calculations below double the file size
3849 twice, so check that it can be multiplied by 4 safely. */
3850 if (XINT (end
) != st
.st_size
3851 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3852 error ("Maximum buffer size exceeded");
3854 /* The file size returned from stat may be zero, but data
3855 may be readable nonetheless, for example when this is a
3856 file in the /proc filesystem. */
3857 if (st
.st_size
== 0)
3858 XSETINT (end
, READ_BUF_SIZE
);
3862 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3864 /* We use emacs-mule for auto saving... */
3865 setup_coding_system (Qemacs_mule
, &coding
);
3866 /* ... but with the special flag to indicate to read in a
3867 multibyte sequence for eight-bit-control char as is. */
3869 coding
.src_multibyte
= 0;
3870 coding
.dst_multibyte
3871 = !NILP (current_buffer
->enable_multibyte_characters
);
3872 coding
.eol_type
= CODING_EOL_LF
;
3873 coding_system_decided
= 1;
3877 /* Decide the coding system to use for reading the file now
3878 because we can't use an optimized method for handling
3879 `coding:' tag if the current buffer is not empty. */
3883 if (!NILP (Vcoding_system_for_read
))
3884 val
= Vcoding_system_for_read
;
3887 /* Don't try looking inside a file for a coding system
3888 specification if it is not seekable. */
3889 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3891 /* Find a coding system specified in the heading two
3892 lines or in the tailing several lines of the file.
3893 We assume that the 1K-byte and 3K-byte for heading
3894 and tailing respectively are sufficient for this
3898 if (st
.st_size
<= (1024 * 4))
3899 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3902 nread
= emacs_read (fd
, read_buf
, 1024);
3905 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3906 report_file_error ("Setting file position",
3907 Fcons (orig_filename
, Qnil
));
3908 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3913 error ("IO error reading %s: %s",
3914 SDATA (orig_filename
), emacs_strerror (errno
));
3917 struct buffer
*prev
= current_buffer
;
3921 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3923 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3924 buf
= XBUFFER (buffer
);
3926 delete_all_overlays (buf
);
3927 buf
->directory
= current_buffer
->directory
;
3928 buf
->read_only
= Qnil
;
3929 buf
->filename
= Qnil
;
3930 buf
->undo_list
= Qt
;
3931 eassert (buf
->overlays_before
== NULL
);
3932 eassert (buf
->overlays_after
== NULL
);
3934 set_buffer_internal (buf
);
3936 buf
->enable_multibyte_characters
= Qnil
;
3938 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3939 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3940 val
= call2 (Vset_auto_coding_function
,
3941 filename
, make_number (nread
));
3942 set_buffer_internal (prev
);
3944 /* Discard the unwind protect for recovering the
3948 /* Rewind the file for the actual read done later. */
3949 if (lseek (fd
, 0, 0) < 0)
3950 report_file_error ("Setting file position",
3951 Fcons (orig_filename
, Qnil
));
3957 /* If we have not yet decided a coding system, check
3958 file-coding-system-alist. */
3959 Lisp_Object args
[6], coding_systems
;
3961 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3962 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3963 coding_systems
= Ffind_operation_coding_system (6, args
);
3964 if (CONSP (coding_systems
))
3965 val
= XCAR (coding_systems
);
3969 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3970 /* Ensure we set Vlast_coding_system_used. */
3971 set_coding_system
= 1;
3973 if (NILP (current_buffer
->enable_multibyte_characters
)
3975 /* We must suppress all character code conversion except for
3976 end-of-line conversion. */
3977 setup_raw_text_coding_system (&coding
);
3979 coding
.src_multibyte
= 0;
3980 coding
.dst_multibyte
3981 = !NILP (current_buffer
->enable_multibyte_characters
);
3982 coding_system_decided
= 1;
3985 /* If requested, replace the accessible part of the buffer
3986 with the file contents. Avoid replacing text at the
3987 beginning or end of the buffer that matches the file contents;
3988 that preserves markers pointing to the unchanged parts.
3990 Here we implement this feature in an optimized way
3991 for the case where code conversion is NOT needed.
3992 The following if-statement handles the case of conversion
3993 in a less optimal way.
3995 If the code conversion is "automatic" then we try using this
3996 method and hope for the best.
3997 But if we discover the need for conversion, we give up on this method
3998 and let the following if-statement handle the replace job. */
4001 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4003 /* same_at_start and same_at_end count bytes,
4004 because file access counts bytes
4005 and BEG and END count bytes. */
4006 int same_at_start
= BEGV_BYTE
;
4007 int same_at_end
= ZV_BYTE
;
4009 /* There is still a possibility we will find the need to do code
4010 conversion. If that happens, we set this variable to 1 to
4011 give up on handling REPLACE in the optimized way. */
4012 int giveup_match_end
= 0;
4014 if (XINT (beg
) != 0)
4016 if (lseek (fd
, XINT (beg
), 0) < 0)
4017 report_file_error ("Setting file position",
4018 Fcons (orig_filename
, Qnil
));
4023 /* Count how many chars at the start of the file
4024 match the text at the beginning of the buffer. */
4029 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4031 error ("IO error reading %s: %s",
4032 SDATA (orig_filename
), emacs_strerror (errno
));
4033 else if (nread
== 0)
4036 if (coding
.type
== coding_type_undecided
)
4037 detect_coding (&coding
, buffer
, nread
);
4038 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4039 /* We found that the file should be decoded somehow.
4040 Let's give up here. */
4042 giveup_match_end
= 1;
4046 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4047 detect_eol (&coding
, buffer
, nread
);
4048 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4049 && coding
.eol_type
!= CODING_EOL_LF
)
4050 /* We found that the format of eol should be decoded.
4051 Let's give up here. */
4053 giveup_match_end
= 1;
4058 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4059 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4060 same_at_start
++, bufpos
++;
4061 /* If we found a discrepancy, stop the scan.
4062 Otherwise loop around and scan the next bufferful. */
4063 if (bufpos
!= nread
)
4067 /* If the file matches the buffer completely,
4068 there's no need to replace anything. */
4069 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4073 /* Truncate the buffer to the size of the file. */
4074 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4079 /* Count how many chars at the end of the file
4080 match the text at the end of the buffer. But, if we have
4081 already found that decoding is necessary, don't waste time. */
4082 while (!giveup_match_end
)
4084 int total_read
, nread
, bufpos
, curpos
, trial
;
4086 /* At what file position are we now scanning? */
4087 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4088 /* If the entire file matches the buffer tail, stop the scan. */
4091 /* How much can we scan in the next step? */
4092 trial
= min (curpos
, sizeof buffer
);
4093 if (lseek (fd
, curpos
- trial
, 0) < 0)
4094 report_file_error ("Setting file position",
4095 Fcons (orig_filename
, Qnil
));
4097 total_read
= nread
= 0;
4098 while (total_read
< trial
)
4100 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4102 error ("IO error reading %s: %s",
4103 SDATA (orig_filename
), emacs_strerror (errno
));
4104 else if (nread
== 0)
4106 total_read
+= nread
;
4109 /* Scan this bufferful from the end, comparing with
4110 the Emacs buffer. */
4111 bufpos
= total_read
;
4113 /* Compare with same_at_start to avoid counting some buffer text
4114 as matching both at the file's beginning and at the end. */
4115 while (bufpos
> 0 && same_at_end
> same_at_start
4116 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4117 same_at_end
--, bufpos
--;
4119 /* If we found a discrepancy, stop the scan.
4120 Otherwise loop around and scan the preceding bufferful. */
4123 /* If this discrepancy is because of code conversion,
4124 we cannot use this method; giveup and try the other. */
4125 if (same_at_end
> same_at_start
4126 && FETCH_BYTE (same_at_end
- 1) >= 0200
4127 && ! NILP (current_buffer
->enable_multibyte_characters
)
4128 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4129 giveup_match_end
= 1;
4138 if (! giveup_match_end
)
4142 /* We win! We can handle REPLACE the optimized way. */
4144 /* Extend the start of non-matching text area to multibyte
4145 character boundary. */
4146 if (! NILP (current_buffer
->enable_multibyte_characters
))
4147 while (same_at_start
> BEGV_BYTE
4148 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4151 /* Extend the end of non-matching text area to multibyte
4152 character boundary. */
4153 if (! NILP (current_buffer
->enable_multibyte_characters
))
4154 while (same_at_end
< ZV_BYTE
4155 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4158 /* Don't try to reuse the same piece of text twice. */
4159 overlap
= (same_at_start
- BEGV_BYTE
4160 - (same_at_end
+ st
.st_size
- ZV
));
4162 same_at_end
+= overlap
;
4164 /* Arrange to read only the nonmatching middle part of the file. */
4165 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4166 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4168 del_range_byte (same_at_start
, same_at_end
, 0);
4169 /* Insert from the file at the proper position. */
4170 temp
= BYTE_TO_CHAR (same_at_start
);
4171 SET_PT_BOTH (temp
, same_at_start
);
4173 /* If display currently starts at beginning of line,
4174 keep it that way. */
4175 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4176 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4178 replace_handled
= 1;
4182 /* If requested, replace the accessible part of the buffer
4183 with the file contents. Avoid replacing text at the
4184 beginning or end of the buffer that matches the file contents;
4185 that preserves markers pointing to the unchanged parts.
4187 Here we implement this feature for the case where code conversion
4188 is needed, in a simple way that needs a lot of memory.
4189 The preceding if-statement handles the case of no conversion
4190 in a more optimized way. */
4191 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4193 int same_at_start
= BEGV_BYTE
;
4194 int same_at_end
= ZV_BYTE
;
4197 /* Make sure that the gap is large enough. */
4198 int bufsize
= 2 * st
.st_size
;
4199 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4202 /* First read the whole file, performing code conversion into
4203 CONVERSION_BUFFER. */
4205 if (lseek (fd
, XINT (beg
), 0) < 0)
4207 xfree (conversion_buffer
);
4208 report_file_error ("Setting file position",
4209 Fcons (orig_filename
, Qnil
));
4212 total
= st
.st_size
; /* Total bytes in the file. */
4213 how_much
= 0; /* Bytes read from file so far. */
4214 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4215 unprocessed
= 0; /* Bytes not processed in previous loop. */
4217 while (how_much
< total
)
4219 /* try is reserved in some compilers (Microsoft C) */
4220 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4221 unsigned char *destination
= read_buf
+ unprocessed
;
4224 /* Allow quitting out of the actual I/O. */
4227 this = emacs_read (fd
, destination
, trytry
);
4230 if (this < 0 || this + unprocessed
== 0)
4238 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4240 int require
, result
;
4242 this += unprocessed
;
4244 /* If we are using more space than estimated,
4245 make CONVERSION_BUFFER bigger. */
4246 require
= decoding_buffer_size (&coding
, this);
4247 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4249 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4250 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4253 /* Convert this batch with results in CONVERSION_BUFFER. */
4254 if (how_much
>= total
) /* This is the last block. */
4255 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4256 if (coding
.composing
!= COMPOSITION_DISABLED
)
4257 coding_allocate_composition_data (&coding
, BEGV
);
4258 result
= decode_coding (&coding
, read_buf
,
4259 conversion_buffer
+ inserted
,
4260 this, bufsize
- inserted
);
4262 /* Save for next iteration whatever we didn't convert. */
4263 unprocessed
= this - coding
.consumed
;
4264 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4265 if (!NILP (current_buffer
->enable_multibyte_characters
))
4266 this = coding
.produced
;
4268 this = str_as_unibyte (conversion_buffer
+ inserted
,
4275 /* At this point, INSERTED is how many characters (i.e. bytes)
4276 are present in CONVERSION_BUFFER.
4277 HOW_MUCH should equal TOTAL,
4278 or should be <= 0 if we couldn't read the file. */
4282 xfree (conversion_buffer
);
4283 coding_free_composition_data (&coding
);
4285 error ("IO error reading %s: %s",
4286 SDATA (orig_filename
), emacs_strerror (errno
));
4287 else if (how_much
== -2)
4288 error ("maximum buffer size exceeded");
4291 /* Compare the beginning of the converted file
4292 with the buffer text. */
4295 while (bufpos
< inserted
&& same_at_start
< same_at_end
4296 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4297 same_at_start
++, bufpos
++;
4299 /* If the file matches the buffer completely,
4300 there's no need to replace anything. */
4302 if (bufpos
== inserted
)
4304 xfree (conversion_buffer
);
4305 coding_free_composition_data (&coding
);
4308 /* Truncate the buffer to the size of the file. */
4309 del_range_byte (same_at_start
, same_at_end
, 0);
4314 /* Extend the start of non-matching text area to multibyte
4315 character boundary. */
4316 if (! NILP (current_buffer
->enable_multibyte_characters
))
4317 while (same_at_start
> BEGV_BYTE
4318 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4321 /* Scan this bufferful from the end, comparing with
4322 the Emacs buffer. */
4325 /* Compare with same_at_start to avoid counting some buffer text
4326 as matching both at the file's beginning and at the end. */
4327 while (bufpos
> 0 && same_at_end
> same_at_start
4328 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4329 same_at_end
--, bufpos
--;
4331 /* Extend the end of non-matching text area to multibyte
4332 character boundary. */
4333 if (! NILP (current_buffer
->enable_multibyte_characters
))
4334 while (same_at_end
< ZV_BYTE
4335 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4338 /* Don't try to reuse the same piece of text twice. */
4339 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4341 same_at_end
+= overlap
;
4343 /* If display currently starts at beginning of line,
4344 keep it that way. */
4345 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4346 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4348 /* Replace the chars that we need to replace,
4349 and update INSERTED to equal the number of bytes
4350 we are taking from the file. */
4351 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4353 if (same_at_end
!= same_at_start
)
4355 del_range_byte (same_at_start
, same_at_end
, 0);
4357 same_at_start
= GPT_BYTE
;
4361 temp
= BYTE_TO_CHAR (same_at_start
);
4363 /* Insert from the file at the proper position. */
4364 SET_PT_BOTH (temp
, same_at_start
);
4365 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4367 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4368 coding_restore_composition (&coding
, Fcurrent_buffer ());
4369 coding_free_composition_data (&coding
);
4371 /* Set `inserted' to the number of inserted characters. */
4372 inserted
= PT
- temp
;
4374 xfree (conversion_buffer
);
4383 register Lisp_Object temp
;
4385 total
= XINT (end
) - XINT (beg
);
4387 /* Make sure point-max won't overflow after this insertion. */
4388 XSETINT (temp
, total
);
4389 if (total
!= XINT (temp
))
4390 error ("Maximum buffer size exceeded");
4393 /* For a special file, all we can do is guess. */
4394 total
= READ_BUF_SIZE
;
4396 if (NILP (visit
) && total
> 0)
4397 prepare_to_modify_buffer (PT
, PT
, NULL
);
4400 if (GAP_SIZE
< total
)
4401 make_gap (total
- GAP_SIZE
);
4403 if (XINT (beg
) != 0 || !NILP (replace
))
4405 if (lseek (fd
, XINT (beg
), 0) < 0)
4406 report_file_error ("Setting file position",
4407 Fcons (orig_filename
, Qnil
));
4410 /* In the following loop, HOW_MUCH contains the total bytes read so
4411 far for a regular file, and not changed for a special file. But,
4412 before exiting the loop, it is set to a negative value if I/O
4416 /* Total bytes inserted. */
4419 /* Here, we don't do code conversion in the loop. It is done by
4420 code_convert_region after all data are read into the buffer. */
4422 int gap_size
= GAP_SIZE
;
4424 while (how_much
< total
)
4426 /* try is reserved in some compilers (Microsoft C) */
4427 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4434 /* Maybe make more room. */
4435 if (gap_size
< trytry
)
4437 make_gap (total
- gap_size
);
4438 gap_size
= GAP_SIZE
;
4441 /* Read from the file, capturing `quit'. When an
4442 error occurs, end the loop, and arrange for a quit
4443 to be signaled after decoding the text we read. */
4444 non_regular_fd
= fd
;
4445 non_regular_inserted
= inserted
;
4446 non_regular_nbytes
= trytry
;
4447 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4448 read_non_regular_quit
);
4459 /* Allow quitting out of the actual I/O. We don't make text
4460 part of the buffer until all the reading is done, so a C-g
4461 here doesn't do any harm. */
4464 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4476 /* For a regular file, where TOTAL is the real size,
4477 count HOW_MUCH to compare with it.
4478 For a special file, where TOTAL is just a buffer size,
4479 so don't bother counting in HOW_MUCH.
4480 (INSERTED is where we count the number of characters inserted.) */
4487 /* Make the text read part of the buffer. */
4488 GAP_SIZE
-= inserted
;
4490 GPT_BYTE
+= inserted
;
4492 ZV_BYTE
+= inserted
;
4497 /* Put an anchor to ensure multi-byte form ends at gap. */
4502 /* Discard the unwind protect for closing the file. */
4506 error ("IO error reading %s: %s",
4507 SDATA (orig_filename
), emacs_strerror (errno
));
4511 if (! coding_system_decided
)
4513 /* The coding system is not yet decided. Decide it by an
4514 optimized method for handling `coding:' tag.
4516 Note that we can get here only if the buffer was empty
4517 before the insertion. */
4521 if (!NILP (Vcoding_system_for_read
))
4522 val
= Vcoding_system_for_read
;
4525 /* Since we are sure that the current buffer was empty
4526 before the insertion, we can toggle
4527 enable-multibyte-characters directly here without taking
4528 care of marker adjustment and byte combining problem. By
4529 this way, we can run Lisp program safely before decoding
4530 the inserted text. */
4531 Lisp_Object unwind_data
;
4532 int count
= SPECPDL_INDEX ();
4534 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4535 Fcons (current_buffer
->undo_list
,
4536 Fcurrent_buffer ()));
4537 current_buffer
->enable_multibyte_characters
= Qnil
;
4538 current_buffer
->undo_list
= Qt
;
4539 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4541 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4543 val
= call2 (Vset_auto_coding_function
,
4544 filename
, make_number (inserted
));
4549 /* If the coding system is not yet decided, check
4550 file-coding-system-alist. */
4551 Lisp_Object args
[6], coding_systems
;
4553 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4554 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4555 coding_systems
= Ffind_operation_coding_system (6, args
);
4556 if (CONSP (coding_systems
))
4557 val
= XCAR (coding_systems
);
4559 unbind_to (count
, Qnil
);
4560 inserted
= Z_BYTE
- BEG_BYTE
;
4563 /* The following kludgy code is to avoid some compiler bug.
4565 setup_coding_system (val, &coding);
4568 struct coding_system temp_coding
;
4569 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4570 bcopy (&temp_coding
, &coding
, sizeof coding
);
4572 /* Ensure we set Vlast_coding_system_used. */
4573 set_coding_system
= 1;
4575 if (NILP (current_buffer
->enable_multibyte_characters
)
4577 /* We must suppress all character code conversion except for
4578 end-of-line conversion. */
4579 setup_raw_text_coding_system (&coding
);
4580 coding
.src_multibyte
= 0;
4581 coding
.dst_multibyte
4582 = !NILP (current_buffer
->enable_multibyte_characters
);
4586 /* Can't do this if part of the buffer might be preserved. */
4588 && (coding
.type
== coding_type_no_conversion
4589 || coding
.type
== coding_type_raw_text
))
4591 /* Visiting a file with these coding system makes the buffer
4593 current_buffer
->enable_multibyte_characters
= Qnil
;
4594 coding
.dst_multibyte
= 0;
4597 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4599 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4601 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4603 inserted
= coding
.produced_char
;
4606 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4610 /* Now INSERTED is measured in characters. */
4613 /* Use the conversion type to determine buffer-file-type
4614 (find-buffer-file-type is now used to help determine the
4616 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4617 || coding
.eol_type
== CODING_EOL_LF
)
4618 && ! CODING_REQUIRE_DECODING (&coding
))
4619 current_buffer
->buffer_file_type
= Qt
;
4621 current_buffer
->buffer_file_type
= Qnil
;
4628 if (!EQ (current_buffer
->undo_list
, Qt
))
4629 current_buffer
->undo_list
= Qnil
;
4631 stat (SDATA (filename
), &st
);
4636 current_buffer
->modtime
= st
.st_mtime
;
4637 current_buffer
->filename
= orig_filename
;
4640 SAVE_MODIFF
= MODIFF
;
4641 current_buffer
->auto_save_modified
= MODIFF
;
4642 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4643 #ifdef CLASH_DETECTION
4646 if (!NILP (current_buffer
->file_truename
))
4647 unlock_file (current_buffer
->file_truename
);
4648 unlock_file (filename
);
4650 #endif /* CLASH_DETECTION */
4652 Fsignal (Qfile_error
,
4653 Fcons (build_string ("not a regular file"),
4654 Fcons (orig_filename
, Qnil
)));
4657 if (set_coding_system
)
4658 Vlast_coding_system_used
= coding
.symbol
;
4660 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4662 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4664 if (! NILP (insval
))
4666 CHECK_NUMBER (insval
);
4667 inserted
= XFASTINT (insval
);
4671 /* Decode file format */
4674 int empty_undo_list_p
= 0;
4676 /* If we're anyway going to discard undo information, don't
4677 record it in the first place. The buffer's undo list at this
4678 point is either nil or t when visiting a file. */
4681 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4682 current_buffer
->undo_list
= Qt
;
4685 insval
= call3 (Qformat_decode
,
4686 Qnil
, make_number (inserted
), visit
);
4687 CHECK_NUMBER (insval
);
4688 inserted
= XFASTINT (insval
);
4691 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4694 /* Call after-change hooks for the inserted text, aside from the case
4695 of normal visiting (not with REPLACE), which is done in a new buffer
4696 "before" the buffer is changed. */
4697 if (inserted
> 0 && total
> 0
4698 && (NILP (visit
) || !NILP (replace
)))
4700 signal_after_change (PT
, 0, inserted
);
4701 update_compositions (PT
, PT
, CHECK_BORDER
);
4704 p
= Vafter_insert_file_functions
;
4707 insval
= call1 (XCAR (p
), make_number (inserted
));
4710 CHECK_NUMBER (insval
);
4711 inserted
= XFASTINT (insval
);
4718 && current_buffer
->modtime
== -1)
4720 /* If visiting nonexistent file, return nil. */
4721 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4725 Fsignal (Qquit
, Qnil
);
4727 /* ??? Retval needs to be dealt with in all cases consistently. */
4729 val
= Fcons (orig_filename
,
4730 Fcons (make_number (inserted
),
4733 RETURN_UNGCPRO (unbind_to (count
, val
));
4736 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4737 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4738 Lisp_Object
, Lisp_Object
));
4740 /* If build_annotations switched buffers, switch back to BUF.
4741 Kill the temporary buffer that was selected in the meantime.
4743 Since this kill only the last temporary buffer, some buffers remain
4744 not killed if build_annotations switched buffers more than once.
4748 build_annotations_unwind (buf
)
4753 if (XBUFFER (buf
) == current_buffer
)
4755 tembuf
= Fcurrent_buffer ();
4757 Fkill_buffer (tembuf
);
4761 /* Decide the coding-system to encode the data with. */
4764 choose_write_coding_system (start
, end
, filename
,
4765 append
, visit
, lockname
, coding
)
4766 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4767 struct coding_system
*coding
;
4772 && NILP (Fstring_equal (current_buffer
->filename
,
4773 current_buffer
->auto_save_file_name
)))
4775 /* We use emacs-mule for auto saving... */
4776 setup_coding_system (Qemacs_mule
, coding
);
4777 /* ... but with the special flag to indicate not to strip off
4778 leading code of eight-bit-control chars. */
4780 goto done_setup_coding
;
4782 else if (!NILP (Vcoding_system_for_write
))
4784 val
= Vcoding_system_for_write
;
4785 if (coding_system_require_warning
4786 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4787 /* Confirm that VAL can surely encode the current region. */
4788 val
= call5 (Vselect_safe_coding_system_function
,
4789 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4794 /* If the variable `buffer-file-coding-system' is set locally,
4795 it means that the file was read with some kind of code
4796 conversion or the variable is explicitly set by users. We
4797 had better write it out with the same coding system even if
4798 `enable-multibyte-characters' is nil.
4800 If it is not set locally, we anyway have to convert EOL
4801 format if the default value of `buffer-file-coding-system'
4802 tells that it is not Unix-like (LF only) format. */
4803 int using_default_coding
= 0;
4804 int force_raw_text
= 0;
4806 val
= current_buffer
->buffer_file_coding_system
;
4808 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4811 if (NILP (current_buffer
->enable_multibyte_characters
))
4817 /* Check file-coding-system-alist. */
4818 Lisp_Object args
[7], coding_systems
;
4820 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4821 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4823 coding_systems
= Ffind_operation_coding_system (7, args
);
4824 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4825 val
= XCDR (coding_systems
);
4829 && !NILP (current_buffer
->buffer_file_coding_system
))
4831 /* If we still have not decided a coding system, use the
4832 default value of buffer-file-coding-system. */
4833 val
= current_buffer
->buffer_file_coding_system
;
4834 using_default_coding
= 1;
4838 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4839 /* Confirm that VAL can surely encode the current region. */
4840 val
= call5 (Vselect_safe_coding_system_function
,
4841 start
, end
, val
, Qnil
, filename
);
4843 setup_coding_system (Fcheck_coding_system (val
), coding
);
4844 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4845 && !using_default_coding
)
4847 if (! EQ (default_buffer_file_coding
.symbol
,
4848 buffer_defaults
.buffer_file_coding_system
))
4849 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4850 &default_buffer_file_coding
);
4851 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4853 Lisp_Object subsidiaries
;
4855 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4856 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4857 if (VECTORP (subsidiaries
)
4858 && XVECTOR (subsidiaries
)->size
== 3)
4860 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4865 setup_raw_text_coding_system (coding
);
4866 goto done_setup_coding
;
4869 setup_coding_system (Fcheck_coding_system (val
), coding
);
4872 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4873 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4876 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4877 "r\nFWrite region to file: \ni\ni\ni\np",
4878 doc
: /* Write current region into specified file.
4879 When called from a program, requires three arguments:
4880 START, END and FILENAME. START and END are normally buffer positions
4881 specifying the part of the buffer to write.
4882 If START is nil, that means to use the entire buffer contents.
4883 If START is a string, then output that string to the file
4884 instead of any buffer contents; END is ignored.
4886 Optional fourth argument APPEND if non-nil means
4887 append to existing file contents (if any). If it is an integer,
4888 seek to that offset in the file before writing.
4889 Optional fifth argument VISIT, if t or a string, means
4890 set the last-save-file-modtime of buffer to this file's modtime
4891 and mark buffer not modified.
4892 If VISIT is a string, it is a second file name;
4893 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4894 VISIT is also the file name to lock and unlock for clash detection.
4895 If VISIT is neither t nor nil nor a string,
4896 that means do not display the \"Wrote file\" message.
4897 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4898 use for locking and unlocking, overriding FILENAME and VISIT.
4899 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4900 for an existing file with the same name. If MUSTBENEW is `excl',
4901 that means to get an error if the file already exists; never overwrite.
4902 If MUSTBENEW is neither nil nor `excl', that means ask for
4903 confirmation before overwriting, but do go ahead and overwrite the file
4904 if the user confirms.
4906 This does code conversion according to the value of
4907 `coding-system-for-write', `buffer-file-coding-system', or
4908 `file-coding-system-alist', and sets the variable
4909 `last-coding-system-used' to the coding system actually used. */)
4910 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4911 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4916 const unsigned char *fn
;
4919 int count
= SPECPDL_INDEX ();
4922 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4924 Lisp_Object handler
;
4925 Lisp_Object visit_file
;
4926 Lisp_Object annotations
;
4927 Lisp_Object encoded_filename
;
4928 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4929 int quietly
= !NILP (visit
);
4930 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4931 struct buffer
*given_buffer
;
4933 int buffer_file_type
= O_BINARY
;
4935 struct coding_system coding
;
4937 if (current_buffer
->base_buffer
&& visiting
)
4938 error ("Cannot do file visiting in an indirect buffer");
4940 if (!NILP (start
) && !STRINGP (start
))
4941 validate_region (&start
, &end
);
4943 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4945 filename
= Fexpand_file_name (filename
, Qnil
);
4947 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4948 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4950 if (STRINGP (visit
))
4951 visit_file
= Fexpand_file_name (visit
, Qnil
);
4953 visit_file
= filename
;
4955 if (NILP (lockname
))
4956 lockname
= visit_file
;
4960 /* If the file name has special constructs in it,
4961 call the corresponding file handler. */
4962 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4963 /* If FILENAME has no handler, see if VISIT has one. */
4964 if (NILP (handler
) && STRINGP (visit
))
4965 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4967 if (!NILP (handler
))
4970 val
= call6 (handler
, Qwrite_region
, start
, end
,
4971 filename
, append
, visit
);
4975 SAVE_MODIFF
= MODIFF
;
4976 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4977 current_buffer
->filename
= visit_file
;
4983 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4985 /* Special kludge to simplify auto-saving. */
4988 XSETFASTINT (start
, BEG
);
4989 XSETFASTINT (end
, Z
);
4993 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4994 count1
= SPECPDL_INDEX ();
4996 given_buffer
= current_buffer
;
4998 if (!STRINGP (start
))
5000 annotations
= build_annotations (start
, end
);
5002 if (current_buffer
!= given_buffer
)
5004 XSETFASTINT (start
, BEGV
);
5005 XSETFASTINT (end
, ZV
);
5011 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5013 /* Decide the coding-system to encode the data with.
5014 We used to make this choice before calling build_annotations, but that
5015 leads to problems when a write-annotate-function takes care of
5016 unsavable chars (as was the case with X-Symbol). */
5017 choose_write_coding_system (start
, end
, filename
,
5018 append
, visit
, lockname
, &coding
);
5019 Vlast_coding_system_used
= coding
.symbol
;
5021 given_buffer
= current_buffer
;
5022 if (! STRINGP (start
))
5024 annotations
= build_annotations_2 (start
, end
,
5025 coding
.pre_write_conversion
, annotations
);
5026 if (current_buffer
!= given_buffer
)
5028 XSETFASTINT (start
, BEGV
);
5029 XSETFASTINT (end
, ZV
);
5033 #ifdef CLASH_DETECTION
5036 #if 0 /* This causes trouble for GNUS. */
5037 /* If we've locked this file for some other buffer,
5038 query before proceeding. */
5039 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5040 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5043 lock_file (lockname
);
5045 #endif /* CLASH_DETECTION */
5047 encoded_filename
= ENCODE_FILE (filename
);
5049 fn
= SDATA (encoded_filename
);
5053 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5054 #else /* not DOS_NT */
5055 desc
= emacs_open (fn
, O_WRONLY
, 0);
5056 #endif /* not DOS_NT */
5058 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5060 if (auto_saving
) /* Overwrite any previous version of autosave file */
5062 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5063 desc
= emacs_open (fn
, O_RDWR
, 0);
5065 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5066 ? SDATA (current_buffer
->filename
) : 0,
5069 else /* Write to temporary name and rename if no errors */
5071 Lisp_Object temp_name
;
5072 temp_name
= Ffile_name_directory (filename
);
5074 if (!NILP (temp_name
))
5076 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5077 build_string ("$$SAVE$$")));
5078 fname
= SDATA (filename
);
5079 fn
= SDATA (temp_name
);
5080 desc
= creat_copy_attrs (fname
, fn
);
5083 /* If we can't open the temporary file, try creating a new
5084 version of the original file. VMS "creat" creates a
5085 new version rather than truncating an existing file. */
5088 desc
= creat (fn
, 0666);
5089 #if 0 /* This can clobber an existing file and fail to replace it,
5090 if the user runs out of space. */
5093 /* We can't make a new version;
5094 try to truncate and rewrite existing version if any. */
5096 desc
= emacs_open (fn
, O_RDWR
, 0);
5102 desc
= creat (fn
, 0666);
5106 desc
= emacs_open (fn
,
5107 O_WRONLY
| O_CREAT
| buffer_file_type
5108 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5109 S_IREAD
| S_IWRITE
);
5110 #else /* not DOS_NT */
5111 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5112 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5113 auto_saving
? auto_save_mode_bits
: 0666);
5114 #endif /* not DOS_NT */
5115 #endif /* not VMS */
5119 #ifdef CLASH_DETECTION
5121 if (!auto_saving
) unlock_file (lockname
);
5123 #endif /* CLASH_DETECTION */
5125 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5128 record_unwind_protect (close_file_unwind
, make_number (desc
));
5130 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5134 if (NUMBERP (append
))
5135 ret
= lseek (desc
, XINT (append
), 1);
5137 ret
= lseek (desc
, 0, 2);
5140 #ifdef CLASH_DETECTION
5141 if (!auto_saving
) unlock_file (lockname
);
5142 #endif /* CLASH_DETECTION */
5144 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5152 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5153 * if we do writes that don't end with a carriage return. Furthermore
5154 * it cannot handle writes of more then 16K. The modified
5155 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5156 * this EXCEPT for the last record (iff it doesn't end with a carriage
5157 * return). This implies that if your buffer doesn't end with a carriage
5158 * return, you get one free... tough. However it also means that if
5159 * we make two calls to sys_write (a la the following code) you can
5160 * get one at the gap as well. The easiest way to fix this (honest)
5161 * is to move the gap to the next newline (or the end of the buffer).
5166 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5167 move_gap (find_next_newline (GPT
, 1));
5169 /* Whether VMS or not, we must move the gap to the next of newline
5170 when we must put designation sequences at beginning of line. */
5171 if (INTEGERP (start
)
5172 && coding
.type
== coding_type_iso2022
5173 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5174 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5176 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5177 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5178 move_gap_both (PT
, PT_BYTE
);
5179 SET_PT_BOTH (opoint
, opoint_byte
);
5186 if (STRINGP (start
))
5188 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5189 &annotations
, &coding
);
5192 else if (XINT (start
) != XINT (end
))
5194 tem
= CHAR_TO_BYTE (XINT (start
));
5196 if (XINT (start
) < GPT
)
5198 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5199 min (GPT
, XINT (end
)) - XINT (start
),
5200 &annotations
, &coding
);
5204 if (XINT (end
) > GPT
&& !failure
)
5206 tem
= max (XINT (start
), GPT
);
5207 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5208 &annotations
, &coding
);
5214 /* If file was empty, still need to write the annotations */
5215 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5216 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5220 if (CODING_REQUIRE_FLUSHING (&coding
)
5221 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5224 /* We have to flush out a data. */
5225 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5226 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5233 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5234 Disk full in NFS may be reported here. */
5235 /* mib says that closing the file will try to write as fast as NFS can do
5236 it, and that means the fsync here is not crucial for autosave files. */
5237 if (!auto_saving
&& fsync (desc
) < 0)
5239 /* If fsync fails with EINTR, don't treat that as serious. */
5241 failure
= 1, save_errno
= errno
;
5245 /* Spurious "file has changed on disk" warnings have been
5246 observed on Suns as well.
5247 It seems that `close' can change the modtime, under nfs.
5249 (This has supposedly been fixed in Sunos 4,
5250 but who knows about all the other machines with NFS?) */
5253 /* On VMS and APOLLO, must do the stat after the close
5254 since closing changes the modtime. */
5257 /* Recall that #if defined does not work on VMS. */
5264 /* NFS can report a write failure now. */
5265 if (emacs_close (desc
) < 0)
5266 failure
= 1, save_errno
= errno
;
5269 /* If we wrote to a temporary name and had no errors, rename to real name. */
5273 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5281 /* Discard the unwind protect for close_file_unwind. */
5282 specpdl_ptr
= specpdl
+ count1
;
5283 /* Restore the original current buffer. */
5284 visit_file
= unbind_to (count
, visit_file
);
5286 #ifdef CLASH_DETECTION
5288 unlock_file (lockname
);
5289 #endif /* CLASH_DETECTION */
5291 /* Do this before reporting IO error
5292 to avoid a "file has changed on disk" warning on
5293 next attempt to save. */
5295 current_buffer
->modtime
= st
.st_mtime
;
5298 error ("IO error writing %s: %s", SDATA (filename
),
5299 emacs_strerror (save_errno
));
5303 SAVE_MODIFF
= MODIFF
;
5304 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5305 current_buffer
->filename
= visit_file
;
5306 update_mode_lines
++;
5311 && ! NILP (Fstring_equal (current_buffer
->filename
,
5312 current_buffer
->auto_save_file_name
)))
5313 SAVE_MODIFF
= MODIFF
;
5319 message_with_string ((INTEGERP (append
)
5329 Lisp_Object
merge ();
5331 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5332 doc
: /* Return t if (car A) is numerically less than (car B). */)
5336 return Flss (Fcar (a
), Fcar (b
));
5339 /* Build the complete list of annotations appropriate for writing out
5340 the text between START and END, by calling all the functions in
5341 write-region-annotate-functions and merging the lists they return.
5342 If one of these functions switches to a different buffer, we assume
5343 that buffer contains altered text. Therefore, the caller must
5344 make sure to restore the current buffer in all cases,
5345 as save-excursion would do. */
5348 build_annotations (start
, end
)
5349 Lisp_Object start
, end
;
5351 Lisp_Object annotations
;
5353 struct gcpro gcpro1
, gcpro2
;
5354 Lisp_Object original_buffer
;
5355 int i
, used_global
= 0;
5357 XSETBUFFER (original_buffer
, current_buffer
);
5360 p
= Vwrite_region_annotate_functions
;
5361 GCPRO2 (annotations
, p
);
5364 struct buffer
*given_buffer
= current_buffer
;
5365 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5366 { /* Use the global value of the hook. */
5369 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5371 p
= Fappend (2, arg
);
5374 Vwrite_region_annotations_so_far
= annotations
;
5375 res
= call2 (XCAR (p
), start
, end
);
5376 /* If the function makes a different buffer current,
5377 assume that means this buffer contains altered text to be output.
5378 Reset START and END from the buffer bounds
5379 and discard all previous annotations because they should have
5380 been dealt with by this function. */
5381 if (current_buffer
!= given_buffer
)
5383 XSETFASTINT (start
, BEGV
);
5384 XSETFASTINT (end
, ZV
);
5387 Flength (res
); /* Check basic validity of return value */
5388 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5392 /* Now do the same for annotation functions implied by the file-format */
5393 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5394 p
= current_buffer
->auto_save_file_format
;
5396 p
= current_buffer
->file_format
;
5397 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5399 struct buffer
*given_buffer
= current_buffer
;
5401 Vwrite_region_annotations_so_far
= annotations
;
5403 /* Value is either a list of annotations or nil if the function
5404 has written annotations to a temporary buffer, which is now
5406 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5407 original_buffer
, make_number (i
));
5408 if (current_buffer
!= given_buffer
)
5410 XSETFASTINT (start
, BEGV
);
5411 XSETFASTINT (end
, ZV
);
5416 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5424 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5425 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5427 struct gcpro gcpro1
;
5430 GCPRO1 (annotations
);
5431 /* At last, do the same for the function PRE_WRITE_CONVERSION
5432 implied by the current coding-system. */
5433 if (!NILP (pre_write_conversion
))
5435 struct buffer
*given_buffer
= current_buffer
;
5436 Vwrite_region_annotations_so_far
= annotations
;
5437 res
= call2 (pre_write_conversion
, start
, end
);
5439 annotations
= (current_buffer
!= given_buffer
5441 : merge (annotations
, res
, Qcar_less_than_car
));
5448 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5449 If STRING is nil, POS is the character position in the current buffer.
5450 Intersperse with them the annotations from *ANNOT
5451 which fall within the range of POS to POS + NCHARS,
5452 each at its appropriate position.
5454 We modify *ANNOT by discarding elements as we use them up.
5456 The return value is negative in case of system call failure. */
5459 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5462 register int nchars
;
5465 struct coding_system
*coding
;
5469 int lastpos
= pos
+ nchars
;
5471 while (NILP (*annot
) || CONSP (*annot
))
5473 tem
= Fcar_safe (Fcar (*annot
));
5476 nextpos
= XFASTINT (tem
);
5478 /* If there are no more annotations in this range,
5479 output the rest of the range all at once. */
5480 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5481 return e_write (desc
, string
, pos
, lastpos
, coding
);
5483 /* Output buffer text up to the next annotation's position. */
5486 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5490 /* Output the annotation. */
5491 tem
= Fcdr (Fcar (*annot
));
5494 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5497 *annot
= Fcdr (*annot
);
5502 #ifndef WRITE_BUF_SIZE
5503 #define WRITE_BUF_SIZE (16 * 1024)
5506 /* Write text in the range START and END into descriptor DESC,
5507 encoding them with coding system CODING. If STRING is nil, START
5508 and END are character positions of the current buffer, else they
5509 are indexes to the string STRING. */
5512 e_write (desc
, string
, start
, end
, coding
)
5516 struct coding_system
*coding
;
5518 register char *addr
;
5519 register int nbytes
;
5520 char buf
[WRITE_BUF_SIZE
];
5524 coding
->composing
= COMPOSITION_DISABLED
;
5525 if (coding
->composing
!= COMPOSITION_DISABLED
)
5526 coding_save_composition (coding
, start
, end
, string
);
5528 if (STRINGP (string
))
5530 addr
= SDATA (string
);
5531 nbytes
= SBYTES (string
);
5532 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5534 else if (start
< end
)
5536 /* It is assured that the gap is not in the range START and END-1. */
5537 addr
= CHAR_POS_ADDR (start
);
5538 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5539 coding
->src_multibyte
5540 = !NILP (current_buffer
->enable_multibyte_characters
);
5546 coding
->src_multibyte
= 1;
5549 /* We used to have a code for handling selective display here. But,
5550 now it is handled within encode_coding. */
5555 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5556 if (coding
->produced
> 0)
5558 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5559 if (coding
->produced
)
5565 nbytes
-= coding
->consumed
;
5566 addr
+= coding
->consumed
;
5567 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5570 /* The source text ends by an incomplete multibyte form.
5571 There's no way other than write it out as is. */
5572 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5581 start
+= coding
->consumed_char
;
5582 if (coding
->cmp_data
)
5583 coding_adjust_composition_offset (coding
, start
);
5586 if (coding
->cmp_data
)
5587 coding_free_composition_data (coding
);
5592 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5593 Sverify_visited_file_modtime
, 1, 1, 0,
5594 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5595 This means that the file has not been changed since it was visited or saved.
5596 See Info node `(elisp)Modification Time' for more details. */)
5602 Lisp_Object handler
;
5603 Lisp_Object filename
;
5608 if (!STRINGP (b
->filename
)) return Qt
;
5609 if (b
->modtime
== 0) return Qt
;
5611 /* If the file name has special constructs in it,
5612 call the corresponding file handler. */
5613 handler
= Ffind_file_name_handler (b
->filename
,
5614 Qverify_visited_file_modtime
);
5615 if (!NILP (handler
))
5616 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5618 filename
= ENCODE_FILE (b
->filename
);
5620 if (stat (SDATA (filename
), &st
) < 0)
5622 /* If the file doesn't exist now and didn't exist before,
5623 we say that it isn't modified, provided the error is a tame one. */
5624 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5629 if (st
.st_mtime
== b
->modtime
5630 /* If both are positive, accept them if they are off by one second. */
5631 || (st
.st_mtime
> 0 && b
->modtime
> 0
5632 && (st
.st_mtime
== b
->modtime
+ 1
5633 || st
.st_mtime
== b
->modtime
- 1)))
5638 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5639 Sclear_visited_file_modtime
, 0, 0, 0,
5640 doc
: /* Clear out records of last mod time of visited file.
5641 Next attempt to save will certainly not complain of a discrepancy. */)
5644 current_buffer
->modtime
= 0;
5648 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5649 Svisited_file_modtime
, 0, 0, 0,
5650 doc
: /* Return the current buffer's recorded visited file modification time.
5651 The value is a list of the form (HIGH LOW), like the time values
5652 that `file-attributes' returns. If the current buffer has no recorded
5653 file modification time, this function returns 0.
5654 See Info node `(elisp)Modification Time' for more details. */)
5658 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5660 return list2 (XCAR (tcons
), XCDR (tcons
));
5664 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5665 Sset_visited_file_modtime
, 0, 1, 0,
5666 doc
: /* Update buffer's recorded modification time from the visited file's time.
5667 Useful if the buffer was not read from the file normally
5668 or if the file itself has been changed for some known benign reason.
5669 An argument specifies the modification time value to use
5670 \(instead of that of the visited file), in the form of a list
5671 \(HIGH . LOW) or (HIGH LOW). */)
5673 Lisp_Object time_list
;
5675 if (!NILP (time_list
))
5676 current_buffer
->modtime
= cons_to_long (time_list
);
5679 register Lisp_Object filename
;
5681 Lisp_Object handler
;
5683 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5685 /* If the file name has special constructs in it,
5686 call the corresponding file handler. */
5687 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5688 if (!NILP (handler
))
5689 /* The handler can find the file name the same way we did. */
5690 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5692 filename
= ENCODE_FILE (filename
);
5694 if (stat (SDATA (filename
), &st
) >= 0)
5695 current_buffer
->modtime
= st
.st_mtime
;
5702 auto_save_error (error
)
5705 Lisp_Object args
[3], msg
;
5707 struct gcpro gcpro1
;
5711 args
[0] = build_string ("Auto-saving %s: %s");
5712 args
[1] = current_buffer
->name
;
5713 args
[2] = Ferror_message_string (error
);
5714 msg
= Fformat (3, args
);
5716 nbytes
= SBYTES (msg
);
5718 for (i
= 0; i
< 3; ++i
)
5721 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5723 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5724 Fsleep_for (make_number (1), Qnil
);
5737 auto_save_mode_bits
= 0666;
5739 /* Get visited file's mode to become the auto save file's mode. */
5740 if (! NILP (current_buffer
->filename
))
5742 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5743 /* But make sure we can overwrite it later! */
5744 auto_save_mode_bits
= st
.st_mode
| 0600;
5745 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5747 /* Remote files don't cooperate with stat. */
5748 auto_save_mode_bits
= XINT (modes
) | 0600;
5752 Fwrite_region (Qnil
, Qnil
,
5753 current_buffer
->auto_save_file_name
,
5754 Qnil
, Qlambda
, Qnil
, Qnil
);
5758 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5763 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5764 | XFASTINT (XCDR (stream
))));
5769 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5772 minibuffer_auto_raise
= XINT (value
);
5777 do_auto_save_make_dir (dir
)
5780 return call2 (Qmake_directory
, dir
, Qt
);
5784 do_auto_save_eh (ignore
)
5790 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5791 doc
: /* Auto-save all buffers that need it.
5792 This is all buffers that have auto-saving enabled
5793 and are changed since last auto-saved.
5794 Auto-saving writes the buffer into a file
5795 so that your editing is not lost if the system crashes.
5796 This file is not the file you visited; that changes only when you save.
5797 Normally we run the normal hook `auto-save-hook' before saving.
5799 A non-nil NO-MESSAGE argument means do not print any message if successful.
5800 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5801 (no_message
, current_only
)
5802 Lisp_Object no_message
, current_only
;
5804 struct buffer
*old
= current_buffer
, *b
;
5805 Lisp_Object tail
, buf
;
5807 int do_handled_files
;
5810 Lisp_Object lispstream
;
5811 int count
= SPECPDL_INDEX ();
5812 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5813 int old_message_p
= 0;
5814 struct gcpro gcpro1
, gcpro2
;
5816 if (max_specpdl_size
< specpdl_size
+ 40)
5817 max_specpdl_size
= specpdl_size
+ 40;
5822 if (NILP (no_message
))
5824 old_message_p
= push_message ();
5825 record_unwind_protect (pop_message_unwind
, Qnil
);
5828 /* Ordinarily don't quit within this function,
5829 but don't make it impossible to quit (in case we get hung in I/O). */
5833 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5834 point to non-strings reached from Vbuffer_alist. */
5836 if (!NILP (Vrun_hooks
))
5837 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5839 if (STRINGP (Vauto_save_list_file_name
))
5841 Lisp_Object listfile
;
5843 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5845 /* Don't try to create the directory when shutting down Emacs,
5846 because creating the directory might signal an error, and
5847 that would leave Emacs in a strange state. */
5848 if (!NILP (Vrun_hooks
))
5852 GCPRO2 (dir
, listfile
);
5853 dir
= Ffile_name_directory (listfile
);
5854 if (NILP (Ffile_directory_p (dir
)))
5855 internal_condition_case_1 (do_auto_save_make_dir
,
5856 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5861 stream
= fopen (SDATA (listfile
), "w");
5864 /* Arrange to close that file whether or not we get an error.
5865 Also reset auto_saving to 0. */
5866 lispstream
= Fcons (Qnil
, Qnil
);
5867 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5868 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5879 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5880 record_unwind_protect (do_auto_save_unwind_1
,
5881 make_number (minibuffer_auto_raise
));
5882 minibuffer_auto_raise
= 0;
5885 /* On first pass, save all files that don't have handlers.
5886 On second pass, save all files that do have handlers.
5888 If Emacs is crashing, the handlers may tweak what is causing
5889 Emacs to crash in the first place, and it would be a shame if
5890 Emacs failed to autosave perfectly ordinary files because it
5891 couldn't handle some ange-ftp'd file. */
5893 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5894 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5896 buf
= XCDR (XCAR (tail
));
5899 /* Record all the buffers that have auto save mode
5900 in the special file that lists them. For each of these buffers,
5901 Record visited name (if any) and auto save name. */
5902 if (STRINGP (b
->auto_save_file_name
)
5903 && stream
!= NULL
&& do_handled_files
== 0)
5905 if (!NILP (b
->filename
))
5907 fwrite (SDATA (b
->filename
), 1,
5908 SBYTES (b
->filename
), stream
);
5910 putc ('\n', stream
);
5911 fwrite (SDATA (b
->auto_save_file_name
), 1,
5912 SBYTES (b
->auto_save_file_name
), stream
);
5913 putc ('\n', stream
);
5916 if (!NILP (current_only
)
5917 && b
!= current_buffer
)
5920 /* Don't auto-save indirect buffers.
5921 The base buffer takes care of it. */
5925 /* Check for auto save enabled
5926 and file changed since last auto save
5927 and file changed since last real save. */
5928 if (STRINGP (b
->auto_save_file_name
)
5929 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5930 && b
->auto_save_modified
< BUF_MODIFF (b
)
5931 /* -1 means we've turned off autosaving for a while--see below. */
5932 && XINT (b
->save_length
) >= 0
5933 && (do_handled_files
5934 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5937 EMACS_TIME before_time
, after_time
;
5939 EMACS_GET_TIME (before_time
);
5941 /* If we had a failure, don't try again for 20 minutes. */
5942 if (b
->auto_save_failure_time
>= 0
5943 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5946 if ((XFASTINT (b
->save_length
) * 10
5947 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5948 /* A short file is likely to change a large fraction;
5949 spare the user annoying messages. */
5950 && XFASTINT (b
->save_length
) > 5000
5951 /* These messages are frequent and annoying for `*mail*'. */
5952 && !EQ (b
->filename
, Qnil
)
5953 && NILP (no_message
))
5955 /* It has shrunk too much; turn off auto-saving here. */
5956 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5957 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5959 minibuffer_auto_raise
= 0;
5960 /* Turn off auto-saving until there's a real save,
5961 and prevent any more warnings. */
5962 XSETINT (b
->save_length
, -1);
5963 Fsleep_for (make_number (1), Qnil
);
5966 set_buffer_internal (b
);
5967 if (!auto_saved
&& NILP (no_message
))
5968 message1 ("Auto-saving...");
5969 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5971 b
->auto_save_modified
= BUF_MODIFF (b
);
5972 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5973 set_buffer_internal (old
);
5975 EMACS_GET_TIME (after_time
);
5977 /* If auto-save took more than 60 seconds,
5978 assume it was an NFS failure that got a timeout. */
5979 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5980 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5984 /* Prevent another auto save till enough input events come in. */
5985 record_auto_save ();
5987 if (auto_saved
&& NILP (no_message
))
5991 /* If we are going to restore an old message,
5992 give time to read ours. */
5993 sit_for (1, 0, 0, 0, 0);
5997 /* If we displayed a message and then restored a state
5998 with no message, leave a "done" message on the screen. */
5999 message1 ("Auto-saving...done");
6004 /* This restores the message-stack status. */
6005 unbind_to (count
, Qnil
);
6009 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6010 Sset_buffer_auto_saved
, 0, 0, 0,
6011 doc
: /* Mark current buffer as auto-saved with its current text.
6012 No auto-save file will be written until the buffer changes again. */)
6015 current_buffer
->auto_save_modified
= MODIFF
;
6016 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6017 current_buffer
->auto_save_failure_time
= -1;
6021 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6022 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6023 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6026 current_buffer
->auto_save_failure_time
= -1;
6030 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6032 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6035 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6038 /* Reading and completing file names */
6039 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6041 /* In the string VAL, change each $ to $$ and return the result. */
6044 double_dollars (val
)
6047 register const unsigned char *old
;
6048 register unsigned char *new;
6052 osize
= SBYTES (val
);
6054 /* Count the number of $ characters. */
6055 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6056 if (*old
++ == '$') count
++;
6060 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6063 for (n
= osize
; n
> 0; n
--)
6077 read_file_name_cleanup (arg
)
6080 return (current_buffer
->directory
= arg
);
6083 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6085 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6086 (string
, dir
, action
)
6087 Lisp_Object string
, dir
, action
;
6088 /* action is nil for complete, t for return list of completions,
6089 lambda for verify final value */
6091 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6093 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6095 CHECK_STRING (string
);
6102 /* No need to protect ACTION--we only compare it with t and nil. */
6103 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6105 if (SCHARS (string
) == 0)
6107 if (EQ (action
, Qlambda
))
6115 orig_string
= string
;
6116 string
= Fsubstitute_in_file_name (string
);
6117 changed
= NILP (Fstring_equal (string
, orig_string
));
6118 name
= Ffile_name_nondirectory (string
);
6119 val
= Ffile_name_directory (string
);
6121 realdir
= Fexpand_file_name (val
, realdir
);
6126 specdir
= Ffile_name_directory (string
);
6127 val
= Ffile_name_completion (name
, realdir
);
6132 return double_dollars (string
);
6136 if (!NILP (specdir
))
6137 val
= concat2 (specdir
, val
);
6139 return double_dollars (val
);
6142 #endif /* not VMS */
6146 if (EQ (action
, Qt
))
6148 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6152 if (NILP (Vread_file_name_predicate
)
6153 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6157 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6159 /* Brute-force speed up for directory checking:
6160 Discard strings which don't end in a slash. */
6161 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6163 Lisp_Object tem
= XCAR (all
);
6165 if (STRINGP (tem
) &&
6166 (len
= SCHARS (tem
), len
> 0) &&
6167 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6168 comp
= Fcons (tem
, comp
);
6174 /* Must do it the hard (and slow) way. */
6175 GCPRO3 (all
, comp
, specdir
);
6176 count
= SPECPDL_INDEX ();
6177 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6178 current_buffer
->directory
= realdir
;
6179 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6180 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6181 comp
= Fcons (XCAR (all
), comp
);
6182 unbind_to (count
, Qnil
);
6185 return Fnreverse (comp
);
6188 /* Only other case actually used is ACTION = lambda */
6190 /* Supposedly this helps commands such as `cd' that read directory names,
6191 but can someone explain how it helps them? -- RMS */
6192 if (SCHARS (name
) == 0)
6195 string
= Fexpand_file_name (string
, dir
);
6196 if (!NILP (Vread_file_name_predicate
))
6197 return call1 (Vread_file_name_predicate
, string
);
6198 return Ffile_exists_p (string
);
6201 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6202 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6203 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6204 The return value is only relevant for a call to `read-file-name' that happens
6205 before any other event (mouse or keypress) is handeled. */)
6208 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6209 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6218 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6219 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6220 Value is not expanded---you must call `expand-file-name' yourself.
6221 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6222 the same non-empty string that was inserted by this function.
6223 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6224 except that if INITIAL is specified, that combined with DIR is used.)
6225 If the user exits with an empty minibuffer, this function returns
6226 an empty string. (This can only happen if the user erased the
6227 pre-inserted contents or if `insert-default-directory' is nil.)
6228 Fourth arg MUSTMATCH non-nil means require existing file's name.
6229 Non-nil and non-t means also require confirmation after completion.
6230 Fifth arg INITIAL specifies text to start with.
6231 If optional sixth arg PREDICATE is non-nil, possible completions and
6232 the resulting file name must satisfy (funcall PREDICATE NAME).
6233 DIR should be an absolute directory name. It defaults to the value of
6234 `default-directory'.
6236 If this command was invoked with the mouse, use a file dialog box if
6237 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6238 provides a file dialog box.
6240 See also `read-file-name-completion-ignore-case'
6241 and `read-file-name-function'. */)
6242 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6243 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6245 Lisp_Object val
, insdef
, tem
;
6246 struct gcpro gcpro1
, gcpro2
;
6247 register char *homedir
;
6248 Lisp_Object decoded_homedir
;
6249 int replace_in_history
= 0;
6250 int add_to_history
= 0;
6254 dir
= current_buffer
->directory
;
6255 if (NILP (Ffile_name_absolute_p (dir
)))
6256 dir
= Fexpand_file_name (dir
, Qnil
);
6257 if (NILP (default_filename
))
6260 ? Fexpand_file_name (initial
, dir
)
6261 : current_buffer
->filename
);
6263 /* If dir starts with user's homedir, change that to ~. */
6264 homedir
= (char *) egetenv ("HOME");
6266 /* homedir can be NULL in temacs, since Vprocess_environment is not
6267 yet set up. We shouldn't crash in that case. */
6270 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6271 CORRECT_DIR_SEPS (homedir
);
6276 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6279 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6280 SBYTES (decoded_homedir
))
6281 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6283 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6284 dir
= concat2 (build_string ("~"), dir
);
6286 /* Likewise for default_filename. */
6288 && STRINGP (default_filename
)
6289 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6290 SBYTES (decoded_homedir
))
6291 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6294 = Fsubstring (default_filename
,
6295 make_number (SCHARS (decoded_homedir
)), Qnil
);
6296 default_filename
= concat2 (build_string ("~"), default_filename
);
6298 if (!NILP (default_filename
))
6300 CHECK_STRING (default_filename
);
6301 default_filename
= double_dollars (default_filename
);
6304 if (insert_default_directory
&& STRINGP (dir
))
6307 if (!NILP (initial
))
6309 Lisp_Object args
[2], pos
;
6313 insdef
= Fconcat (2, args
);
6314 pos
= make_number (SCHARS (double_dollars (dir
)));
6315 insdef
= Fcons (double_dollars (insdef
), pos
);
6318 insdef
= double_dollars (insdef
);
6320 else if (STRINGP (initial
))
6321 insdef
= Fcons (double_dollars (initial
), make_number (0));
6325 if (!NILP (Vread_file_name_function
))
6327 Lisp_Object args
[7];
6329 GCPRO2 (insdef
, default_filename
);
6330 args
[0] = Vread_file_name_function
;
6333 args
[3] = default_filename
;
6334 args
[4] = mustmatch
;
6336 args
[6] = predicate
;
6337 RETURN_UNGCPRO (Ffuncall (7, args
));
6340 count
= SPECPDL_INDEX ();
6341 specbind (intern ("completion-ignore-case"),
6342 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6343 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6344 specbind (intern ("read-file-name-predicate"),
6345 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6347 GCPRO2 (insdef
, default_filename
);
6349 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6350 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6352 /* If DIR contains a file name, split it. */
6354 file
= Ffile_name_nondirectory (dir
);
6355 if (SCHARS (file
) && NILP (default_filename
))
6357 default_filename
= file
;
6358 dir
= Ffile_name_directory (dir
);
6360 if (!NILP(default_filename
))
6361 default_filename
= Fexpand_file_name (default_filename
, dir
);
6362 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6363 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6368 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6369 dir
, mustmatch
, insdef
,
6370 Qfile_name_history
, default_filename
, Qnil
);
6372 tem
= Fsymbol_value (Qfile_name_history
);
6373 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6374 replace_in_history
= 1;
6376 /* If Fcompleting_read returned the inserted default string itself
6377 (rather than a new string with the same contents),
6378 it has to mean that the user typed RET with the minibuffer empty.
6379 In that case, we really want to return ""
6380 so that commands such as set-visited-file-name can distinguish. */
6381 if (EQ (val
, default_filename
))
6383 /* In this case, Fcompleting_read has not added an element
6384 to the history. Maybe we should. */
6385 if (! replace_in_history
)
6391 unbind_to (count
, Qnil
);
6394 error ("No file name specified");
6396 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6398 if (!NILP (tem
) && !NILP (default_filename
))
6399 val
= default_filename
;
6400 val
= Fsubstitute_in_file_name (val
);
6402 if (replace_in_history
)
6403 /* Replace what Fcompleting_read added to the history
6404 with what we will actually return. */
6406 Lisp_Object val1
= double_dollars (val
);
6407 tem
= Fsymbol_value (Qfile_name_history
);
6408 if (history_delete_duplicates
)
6409 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6410 XSETCAR (tem
, val1
);
6412 else if (add_to_history
)
6414 /* Add the value to the history--but not if it matches
6415 the last value already there. */
6416 Lisp_Object val1
= double_dollars (val
);
6417 tem
= Fsymbol_value (Qfile_name_history
);
6418 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6420 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6421 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6432 /* Must be set before any path manipulation is performed. */
6433 XSETFASTINT (Vdirectory_sep_char
, '/');
6440 Qexpand_file_name
= intern ("expand-file-name");
6441 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6442 Qdirectory_file_name
= intern ("directory-file-name");
6443 Qfile_name_directory
= intern ("file-name-directory");
6444 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6445 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6446 Qfile_name_as_directory
= intern ("file-name-as-directory");
6447 Qcopy_file
= intern ("copy-file");
6448 Qmake_directory_internal
= intern ("make-directory-internal");
6449 Qmake_directory
= intern ("make-directory");
6450 Qdelete_directory
= intern ("delete-directory");
6451 Qdelete_file
= intern ("delete-file");
6452 Qrename_file
= intern ("rename-file");
6453 Qadd_name_to_file
= intern ("add-name-to-file");
6454 Qmake_symbolic_link
= intern ("make-symbolic-link");
6455 Qfile_exists_p
= intern ("file-exists-p");
6456 Qfile_executable_p
= intern ("file-executable-p");
6457 Qfile_readable_p
= intern ("file-readable-p");
6458 Qfile_writable_p
= intern ("file-writable-p");
6459 Qfile_symlink_p
= intern ("file-symlink-p");
6460 Qaccess_file
= intern ("access-file");
6461 Qfile_directory_p
= intern ("file-directory-p");
6462 Qfile_regular_p
= intern ("file-regular-p");
6463 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6464 Qfile_modes
= intern ("file-modes");
6465 Qset_file_modes
= intern ("set-file-modes");
6466 Qset_file_times
= intern ("set-file-times");
6467 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6468 Qinsert_file_contents
= intern ("insert-file-contents");
6469 Qwrite_region
= intern ("write-region");
6470 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6471 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6472 Qauto_save_coding
= intern ("auto-save-coding");
6474 staticpro (&Qexpand_file_name
);
6475 staticpro (&Qsubstitute_in_file_name
);
6476 staticpro (&Qdirectory_file_name
);
6477 staticpro (&Qfile_name_directory
);
6478 staticpro (&Qfile_name_nondirectory
);
6479 staticpro (&Qunhandled_file_name_directory
);
6480 staticpro (&Qfile_name_as_directory
);
6481 staticpro (&Qcopy_file
);
6482 staticpro (&Qmake_directory_internal
);
6483 staticpro (&Qmake_directory
);
6484 staticpro (&Qdelete_directory
);
6485 staticpro (&Qdelete_file
);
6486 staticpro (&Qrename_file
);
6487 staticpro (&Qadd_name_to_file
);
6488 staticpro (&Qmake_symbolic_link
);
6489 staticpro (&Qfile_exists_p
);
6490 staticpro (&Qfile_executable_p
);
6491 staticpro (&Qfile_readable_p
);
6492 staticpro (&Qfile_writable_p
);
6493 staticpro (&Qaccess_file
);
6494 staticpro (&Qfile_symlink_p
);
6495 staticpro (&Qfile_directory_p
);
6496 staticpro (&Qfile_regular_p
);
6497 staticpro (&Qfile_accessible_directory_p
);
6498 staticpro (&Qfile_modes
);
6499 staticpro (&Qset_file_modes
);
6500 staticpro (&Qset_file_times
);
6501 staticpro (&Qfile_newer_than_file_p
);
6502 staticpro (&Qinsert_file_contents
);
6503 staticpro (&Qwrite_region
);
6504 staticpro (&Qverify_visited_file_modtime
);
6505 staticpro (&Qset_visited_file_modtime
);
6506 staticpro (&Qauto_save_coding
);
6508 Qfile_name_history
= intern ("file-name-history");
6509 Fset (Qfile_name_history
, Qnil
);
6510 staticpro (&Qfile_name_history
);
6512 Qfile_error
= intern ("file-error");
6513 staticpro (&Qfile_error
);
6514 Qfile_already_exists
= intern ("file-already-exists");
6515 staticpro (&Qfile_already_exists
);
6516 Qfile_date_error
= intern ("file-date-error");
6517 staticpro (&Qfile_date_error
);
6518 Qexcl
= intern ("excl");
6522 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6523 staticpro (&Qfind_buffer_file_type
);
6526 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6527 doc
: /* *Coding system for encoding file names.
6528 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6529 Vfile_name_coding_system
= Qnil
;
6531 DEFVAR_LISP ("default-file-name-coding-system",
6532 &Vdefault_file_name_coding_system
,
6533 doc
: /* Default coding system for encoding file names.
6534 This variable is used only when `file-name-coding-system' is nil.
6536 This variable is set/changed by the command `set-language-environment'.
6537 User should not set this variable manually,
6538 instead use `file-name-coding-system' to get a constant encoding
6539 of file names regardless of the current language environment. */);
6540 Vdefault_file_name_coding_system
= Qnil
;
6542 Qformat_decode
= intern ("format-decode");
6543 staticpro (&Qformat_decode
);
6544 Qformat_annotate_function
= intern ("format-annotate-function");
6545 staticpro (&Qformat_annotate_function
);
6546 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6547 staticpro (&Qafter_insert_file_set_coding
);
6549 Qcar_less_than_car
= intern ("car-less-than-car");
6550 staticpro (&Qcar_less_than_car
);
6552 Fput (Qfile_error
, Qerror_conditions
,
6553 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6554 Fput (Qfile_error
, Qerror_message
,
6555 build_string ("File error"));
6557 Fput (Qfile_already_exists
, Qerror_conditions
,
6558 Fcons (Qfile_already_exists
,
6559 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6560 Fput (Qfile_already_exists
, Qerror_message
,
6561 build_string ("File already exists"));
6563 Fput (Qfile_date_error
, Qerror_conditions
,
6564 Fcons (Qfile_date_error
,
6565 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6566 Fput (Qfile_date_error
, Qerror_message
,
6567 build_string ("Cannot set file date"));
6569 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6570 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6571 Vread_file_name_function
= Qnil
;
6573 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6574 doc
: /* Current predicate used by `read-file-name-internal'. */);
6575 Vread_file_name_predicate
= Qnil
;
6577 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6578 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6579 #if defined VMS || defined DOS_NT || defined MAC_OS
6580 read_file_name_completion_ignore_case
= 1;
6582 read_file_name_completion_ignore_case
= 0;
6585 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6586 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6587 If the initial minibuffer contents are non-empty, you can usually
6588 request a default filename by typing RETURN without editing. For some
6589 commands, exiting with an empty minibuffer has a special meaning,
6590 such as making the current buffer visit no file in the case of
6591 `set-visited-file-name'.
6592 If this variable is non-nil, the minibuffer contents are always
6593 initially non-empty and typing RETURN without editing will fetch the
6594 default name, if one is provided. Note however that this default name
6595 is not necessarily the name originally inserted in the minibuffer, if
6596 that is just the default directory.
6597 If this variable is nil, the minibuffer often starts out empty. In
6598 that case you may have to explicitly fetch the next history element to
6599 request the default name. */);
6600 insert_default_directory
= 1;
6602 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6603 doc
: /* *Non-nil means write new files with record format `stmlf'.
6604 nil means use format `var'. This variable is meaningful only on VMS. */);
6605 vms_stmlf_recfm
= 0;
6607 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6608 doc
: /* Directory separator character for built-in functions that return file names.
6609 The value is always ?/. Don't use this variable, just use `/'. */);
6611 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6612 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6613 If a file name matches REGEXP, then all I/O on that file is done by calling
6616 The first argument given to HANDLER is the name of the I/O primitive
6617 to be handled; the remaining arguments are the arguments that were
6618 passed to that primitive. For example, if you do
6619 (file-exists-p FILENAME)
6620 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6621 (funcall HANDLER 'file-exists-p FILENAME)
6622 The function `find-file-name-handler' checks this list for a handler
6623 for its argument. */);
6624 Vfile_name_handler_alist
= Qnil
;
6626 DEFVAR_LISP ("set-auto-coding-function",
6627 &Vset_auto_coding_function
,
6628 doc
: /* If non-nil, a function to call to decide a coding system of file.
6629 Two arguments are passed to this function: the file name
6630 and the length of a file contents following the point.
6631 This function should return a coding system to decode the file contents.
6632 It should check the file name against `auto-coding-alist'.
6633 If no coding system is decided, it should check a coding system
6634 specified in the heading lines with the format:
6635 -*- ... coding: CODING-SYSTEM; ... -*-
6636 or local variable spec of the tailing lines with `coding:' tag. */);
6637 Vset_auto_coding_function
= Qnil
;
6639 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6640 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6641 Each is passed one argument, the number of characters inserted.
6642 It should return the new character count, and leave point the same.
6643 If `insert-file-contents' is intercepted by a handler from
6644 `file-name-handler-alist', that handler is responsible for calling the
6645 functions in `after-insert-file-functions' if appropriate. */);
6646 Vafter_insert_file_functions
= Qnil
;
6648 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6649 doc
: /* A list of functions to be called at the start of `write-region'.
6650 Each is passed two arguments, START and END as for `write-region'.
6651 These are usually two numbers but not always; see the documentation
6652 for `write-region'. The function should return a list of pairs
6653 of the form (POSITION . STRING), consisting of strings to be effectively
6654 inserted at the specified positions of the file being written (1 means to
6655 insert before the first byte written). The POSITIONs must be sorted into
6656 increasing order. If there are several functions in the list, the several
6657 lists are merged destructively. Alternatively, the function can return
6658 with a different buffer current; in that case it should pay attention
6659 to the annotations returned by previous functions and listed in
6660 `write-region-annotations-so-far'.*/);
6661 Vwrite_region_annotate_functions
= Qnil
;
6662 staticpro (&Qwrite_region_annotate_functions
);
6663 Qwrite_region_annotate_functions
6664 = intern ("write-region-annotate-functions");
6666 DEFVAR_LISP ("write-region-annotations-so-far",
6667 &Vwrite_region_annotations_so_far
,
6668 doc
: /* When an annotation function is called, this holds the previous annotations.
6669 These are the annotations made by other annotation functions
6670 that were already called. See also `write-region-annotate-functions'. */);
6671 Vwrite_region_annotations_so_far
= Qnil
;
6673 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6674 doc
: /* A list of file name handlers that temporarily should not be used.
6675 This applies only to the operation `inhibit-file-name-operation'. */);
6676 Vinhibit_file_name_handlers
= Qnil
;
6678 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6679 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6680 Vinhibit_file_name_operation
= Qnil
;
6682 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6683 doc
: /* File name in which we write a list of all auto save file names.
6684 This variable is initialized automatically from `auto-save-list-file-prefix'
6685 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6686 a non-nil value. */);
6687 Vauto_save_list_file_name
= Qnil
;
6689 defsubr (&Sfind_file_name_handler
);
6690 defsubr (&Sfile_name_directory
);
6691 defsubr (&Sfile_name_nondirectory
);
6692 defsubr (&Sunhandled_file_name_directory
);
6693 defsubr (&Sfile_name_as_directory
);
6694 defsubr (&Sdirectory_file_name
);
6695 defsubr (&Smake_temp_name
);
6696 defsubr (&Sexpand_file_name
);
6697 defsubr (&Ssubstitute_in_file_name
);
6698 defsubr (&Scopy_file
);
6699 defsubr (&Smake_directory_internal
);
6700 defsubr (&Sdelete_directory
);
6701 defsubr (&Sdelete_file
);
6702 defsubr (&Srename_file
);
6703 defsubr (&Sadd_name_to_file
);
6705 defsubr (&Smake_symbolic_link
);
6706 #endif /* S_IFLNK */
6708 defsubr (&Sdefine_logical_name
);
6711 defsubr (&Ssysnetunam
);
6712 #endif /* HPUX_NET */
6713 defsubr (&Sfile_name_absolute_p
);
6714 defsubr (&Sfile_exists_p
);
6715 defsubr (&Sfile_executable_p
);
6716 defsubr (&Sfile_readable_p
);
6717 defsubr (&Sfile_writable_p
);
6718 defsubr (&Saccess_file
);
6719 defsubr (&Sfile_symlink_p
);
6720 defsubr (&Sfile_directory_p
);
6721 defsubr (&Sfile_accessible_directory_p
);
6722 defsubr (&Sfile_regular_p
);
6723 defsubr (&Sfile_modes
);
6724 defsubr (&Sset_file_modes
);
6725 defsubr (&Sset_file_times
);
6726 defsubr (&Sset_default_file_modes
);
6727 defsubr (&Sdefault_file_modes
);
6728 defsubr (&Sfile_newer_than_file_p
);
6729 defsubr (&Sinsert_file_contents
);
6730 defsubr (&Swrite_region
);
6731 defsubr (&Scar_less_than_car
);
6732 defsubr (&Sverify_visited_file_modtime
);
6733 defsubr (&Sclear_visited_file_modtime
);
6734 defsubr (&Svisited_file_modtime
);
6735 defsubr (&Sset_visited_file_modtime
);
6736 defsubr (&Sdo_auto_save
);
6737 defsubr (&Sset_buffer_auto_saved
);
6738 defsubr (&Sclear_buffer_auto_save_failure
);
6739 defsubr (&Srecent_auto_save_p
);
6741 defsubr (&Sread_file_name_internal
);
6742 defsubr (&Sread_file_name
);
6743 defsubr (&Snext_read_file_uses_dialog_p
);
6746 defsubr (&Sunix_sync
);
6750 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6751 (do not change this comment) */