1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
86 #endif /* not WINDOWSNT */
90 #include <sys/param.h>
98 #define CORRECT_DIR_SEPS(s) \
99 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
100 else unixtodos_filename (s); \
102 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
103 redirector allows the six letters between 'Z' and 'a' as well. */
105 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
108 #define IS_DRIVE(x) isalpha (x)
110 /* Need to lower-case the drive letter, or else expanded
111 filenames will sometimes compare inequal, because
112 `expand-file-name' doesn't always down-case the drive letter. */
113 #define DRIVE_LETTER(x) (tolower (x))
134 #include "commands.h"
135 extern int use_dialog_box
;
136 extern int use_file_dialog
;
150 #ifndef FILE_SYSTEM_CASE
151 #define FILE_SYSTEM_CASE(filename) (filename)
154 /* Nonzero during writing of auto-save files */
157 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
158 a new file with the same mode as the original */
159 int auto_save_mode_bits
;
161 /* The symbol bound to coding-system-for-read when
162 insert-file-contents is called for recovering a file. This is not
163 an actual coding system name, but just an indicator to tell
164 insert-file-contents to use `emacs-mule' with a special flag for
165 auto saving and recovering a file. */
166 Lisp_Object Qauto_save_coding
;
168 /* Coding system for file names, or nil if none. */
169 Lisp_Object Vfile_name_coding_system
;
171 /* Coding system for file names used only when
172 Vfile_name_coding_system is nil. */
173 Lisp_Object Vdefault_file_name_coding_system
;
175 /* Alist of elements (REGEXP . HANDLER) for file names
176 whose I/O is done with a special handler. */
177 Lisp_Object Vfile_name_handler_alist
;
179 /* Property name of a file name handler,
180 which gives a list of operations it handles.. */
181 Lisp_Object Qoperations
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Lisp function for setting buffer-file-coding-system and the
193 multibyteness of the current buffer after inserting a file. */
194 Lisp_Object Qafter_insert_file_set_coding
;
196 /* Functions to be called to create text property annotations for file. */
197 Lisp_Object Vwrite_region_annotate_functions
;
198 Lisp_Object Qwrite_region_annotate_functions
;
200 /* During build_annotations, each time an annotation function is called,
201 this holds the annotations made by the previous functions. */
202 Lisp_Object Vwrite_region_annotations_so_far
;
204 /* File name in which we write a list of all our auto save files. */
205 Lisp_Object Vauto_save_list_file_name
;
207 /* Function to call to read a file name. */
208 Lisp_Object Vread_file_name_function
;
210 /* Current predicate used by read_file_name_internal. */
211 Lisp_Object Vread_file_name_predicate
;
213 /* Nonzero means completion ignores case when reading file name. */
214 int read_file_name_completion_ignore_case
;
216 /* Nonzero means, when reading a filename in the minibuffer,
217 start out by inserting the default directory into the minibuffer. */
218 int insert_default_directory
;
220 /* On VMS, nonzero means write new files with record format stmlf.
221 Zero means use var format. */
224 /* On NT, specifies the directory separator character, used (eg.) when
225 expanding file names. This can be bound to / or \. */
226 Lisp_Object Vdirectory_sep_char
;
229 /* Nonzero means skip the call to fsync in Fwrite-region. */
230 int write_region_inhibit_fsync
;
233 extern Lisp_Object Vuser_login_name
;
236 extern Lisp_Object Vw32_get_true_file_attributes
;
239 extern int minibuf_level
;
241 extern int minibuffer_auto_raise
;
243 extern int history_delete_duplicates
;
245 /* These variables describe handlers that have "already" had a chance
246 to handle the current operation.
248 Vinhibit_file_name_handlers is a list of file name handlers.
249 Vinhibit_file_name_operation is the operation being handled.
250 If we try to handle that operation, we ignore those handlers. */
252 static Lisp_Object Vinhibit_file_name_handlers
;
253 static Lisp_Object Vinhibit_file_name_operation
;
255 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
257 Lisp_Object Qfile_name_history
;
259 Lisp_Object Qcar_less_than_car
;
261 static int a_write
P_ ((int, Lisp_Object
, int, int,
262 Lisp_Object
*, struct coding_system
*));
263 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
267 report_file_error (string
, data
)
271 Lisp_Object errstring
;
274 synchronize_system_messages_locale ();
275 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
276 Vlocale_coding_system
, 0);
282 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
285 /* System error messages are capitalized. Downcase the initial
286 unless it is followed by a slash. */
287 if (SREF (errstring
, 1) != '/')
288 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
290 Fsignal (Qfile_error
,
291 Fcons (build_string (string
), Fcons (errstring
, data
)));
296 close_file_unwind (fd
)
299 emacs_close (XFASTINT (fd
));
303 /* Restore point, having saved it as a marker. */
306 restore_point_unwind (location
)
307 Lisp_Object location
;
309 Fgoto_char (location
);
310 Fset_marker (location
, Qnil
, Qnil
);
314 Lisp_Object Qexpand_file_name
;
315 Lisp_Object Qsubstitute_in_file_name
;
316 Lisp_Object Qdirectory_file_name
;
317 Lisp_Object Qfile_name_directory
;
318 Lisp_Object Qfile_name_nondirectory
;
319 Lisp_Object Qunhandled_file_name_directory
;
320 Lisp_Object Qfile_name_as_directory
;
321 Lisp_Object Qcopy_file
;
322 Lisp_Object Qmake_directory_internal
;
323 Lisp_Object Qmake_directory
;
324 Lisp_Object Qdelete_directory
;
325 Lisp_Object Qdelete_file
;
326 Lisp_Object Qrename_file
;
327 Lisp_Object Qadd_name_to_file
;
328 Lisp_Object Qmake_symbolic_link
;
329 Lisp_Object Qfile_exists_p
;
330 Lisp_Object Qfile_executable_p
;
331 Lisp_Object Qfile_readable_p
;
332 Lisp_Object Qfile_writable_p
;
333 Lisp_Object Qfile_symlink_p
;
334 Lisp_Object Qaccess_file
;
335 Lisp_Object Qfile_directory_p
;
336 Lisp_Object Qfile_regular_p
;
337 Lisp_Object Qfile_accessible_directory_p
;
338 Lisp_Object Qfile_modes
;
339 Lisp_Object Qset_file_modes
;
340 Lisp_Object Qset_file_times
;
341 Lisp_Object Qfile_newer_than_file_p
;
342 Lisp_Object Qinsert_file_contents
;
343 Lisp_Object Qwrite_region
;
344 Lisp_Object Qverify_visited_file_modtime
;
345 Lisp_Object Qset_visited_file_modtime
;
347 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
348 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
349 Otherwise, return nil.
350 A file name is handled if one of the regular expressions in
351 `file-name-handler-alist' matches it.
353 If OPERATION equals `inhibit-file-name-operation', then we ignore
354 any handlers that are members of `inhibit-file-name-handlers',
355 but we still do run any other handlers. This lets handlers
356 use the standard functions without calling themselves recursively. */)
357 (filename
, operation
)
358 Lisp_Object filename
, operation
;
360 /* This function must not munge the match data. */
361 Lisp_Object chain
, inhibited_handlers
, result
;
365 CHECK_STRING (filename
);
367 if (EQ (operation
, Vinhibit_file_name_operation
))
368 inhibited_handlers
= Vinhibit_file_name_handlers
;
370 inhibited_handlers
= Qnil
;
372 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
373 chain
= XCDR (chain
))
379 Lisp_Object string
= XCAR (elt
);
381 Lisp_Object handler
= XCDR (elt
);
382 Lisp_Object operations
= Qnil
;
384 if (SYMBOLP (handler
))
385 operations
= Fget (handler
, Qoperations
);
388 && (match_pos
= fast_string_match (string
, filename
)) > pos
389 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
393 handler
= XCDR (elt
);
394 tem
= Fmemq (handler
, inhibited_handlers
);
408 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
410 doc
: /* Return the directory component in file name FILENAME.
411 Return nil if FILENAME does not include a directory.
412 Otherwise return a directory spec.
413 Given a Unix syntax file name, returns a string ending in slash;
414 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
416 Lisp_Object filename
;
419 register const unsigned char *beg
;
421 register unsigned char *beg
;
423 register const unsigned char *p
;
426 CHECK_STRING (filename
);
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
432 return call2 (handler
, Qfile_name_directory
, filename
);
434 filename
= FILE_SYSTEM_CASE (filename
);
435 beg
= SDATA (filename
);
437 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
439 p
= beg
+ SBYTES (filename
);
441 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
443 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
446 /* only recognise drive specifier at the beginning */
448 /* handle the "/:d:foo" and "/:foo" cases correctly */
449 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
450 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
457 /* Expansion of "c:" to drive and default directory. */
460 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
461 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
462 unsigned char *r
= res
;
464 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
466 strncpy (res
, beg
, 2);
471 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
473 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
476 p
= beg
+ strlen (beg
);
479 CORRECT_DIR_SEPS (beg
);
482 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
485 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
486 Sfile_name_nondirectory
, 1, 1, 0,
487 doc
: /* Return file name FILENAME sans its directory.
488 For example, in a Unix-syntax file name,
489 this is everything after the last slash,
490 or the entire name if it contains no slash. */)
492 Lisp_Object filename
;
494 register const unsigned char *beg
, *p
, *end
;
497 CHECK_STRING (filename
);
499 /* If the file name has special constructs in it,
500 call the corresponding file handler. */
501 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
503 return call2 (handler
, Qfile_name_nondirectory
, filename
);
505 beg
= SDATA (filename
);
506 end
= p
= beg
+ SBYTES (filename
);
508 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
510 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
513 /* only recognise drive specifier at beginning */
515 /* handle the "/:d:foo" case correctly */
516 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
521 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
524 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
525 Sunhandled_file_name_directory
, 1, 1, 0,
526 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
527 A `directly usable' directory name is one that may be used without the
528 intervention of any file handler.
529 If FILENAME is a directly usable file itself, return
530 \(file-name-directory FILENAME).
531 The `call-process' and `start-process' functions use this function to
532 get a current directory to run processes in. */)
534 Lisp_Object filename
;
538 /* If the file name has special constructs in it,
539 call the corresponding file handler. */
540 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
542 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
544 return Ffile_name_directory (filename
);
549 file_name_as_directory (out
, in
)
552 int size
= strlen (in
) - 1;
565 /* Is it already a directory string? */
566 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
568 /* Is it a VMS directory file name? If so, hack VMS syntax. */
569 else if (! index (in
, '/')
570 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
571 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
572 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
573 || ! strncmp (&in
[size
- 5], ".dir", 4))
574 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
575 && in
[size
] == '1')))
577 register char *p
, *dot
;
581 dir:x.dir --> dir:[x]
582 dir:[x]y.dir --> dir:[x.y] */
584 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
587 strncpy (out
, in
, p
- in
);
606 dot
= index (p
, '.');
609 /* blindly remove any extension */
610 size
= strlen (out
) + (dot
- p
);
611 strncat (out
, p
, dot
- p
);
622 /* For Unix syntax, Append a slash if necessary */
623 if (!IS_DIRECTORY_SEP (out
[size
]))
625 /* Cannot use DIRECTORY_SEP, which could have any value */
627 out
[size
+ 2] = '\0';
630 CORRECT_DIR_SEPS (out
);
636 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
637 Sfile_name_as_directory
, 1, 1, 0,
638 doc
: /* Return a string representing the file name FILE interpreted as a directory.
639 This operation exists because a directory is also a file, but its name as
640 a directory is different from its name as a file.
641 The result can be used as the value of `default-directory'
642 or passed as second argument to `expand-file-name'.
643 For a Unix-syntax file name, just appends a slash.
644 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
655 /* If the file name has special constructs in it,
656 call the corresponding file handler. */
657 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
659 return call2 (handler
, Qfile_name_as_directory
, file
);
661 buf
= (char *) alloca (SBYTES (file
) + 10);
662 file_name_as_directory (buf
, SDATA (file
));
663 return make_specified_string (buf
, -1, strlen (buf
),
664 STRING_MULTIBYTE (file
));
668 * Convert from directory name to filename.
670 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
671 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
672 * On UNIX, it's simple: just make sure there isn't a terminating /
674 * Value is nonzero if the string output is different from the input.
678 directory_file_name (src
, dst
)
686 struct FAB fab
= cc$rms_fab
;
687 struct NAM nam
= cc$rms_nam
;
688 char esa
[NAM$C_MAXRSS
];
693 if (! index (src
, '/')
694 && (src
[slen
- 1] == ']'
695 || src
[slen
- 1] == ':'
696 || src
[slen
- 1] == '>'))
698 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
700 fab
.fab$b_fns
= slen
;
701 fab
.fab$l_nam
= &nam
;
702 fab
.fab$l_fop
= FAB$M_NAM
;
705 nam
.nam$b_ess
= sizeof esa
;
706 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
708 /* We call SYS$PARSE to handle such things as [--] for us. */
709 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
711 slen
= nam
.nam$b_esl
;
712 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
717 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
719 /* what about when we have logical_name:???? */
720 if (src
[slen
- 1] == ':')
721 { /* Xlate logical name and see what we get */
722 ptr
= strcpy (dst
, src
); /* upper case for getenv */
725 if ('a' <= *ptr
&& *ptr
<= 'z')
729 dst
[slen
- 1] = 0; /* remove colon */
730 if (!(src
= egetenv (dst
)))
732 /* should we jump to the beginning of this procedure?
733 Good points: allows us to use logical names that xlate
735 Bad points: can be a problem if we just translated to a device
737 For now, I'll punt and always expect VMS names, and hope for
740 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
741 { /* no recursion here! */
747 { /* not a directory spec */
752 bracket
= src
[slen
- 1];
754 /* If bracket is ']' or '>', bracket - 2 is the corresponding
756 ptr
= index (src
, bracket
- 2);
758 { /* no opening bracket */
762 if (!(rptr
= rindex (src
, '.')))
765 strncpy (dst
, src
, slen
);
769 dst
[slen
++] = bracket
;
774 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
775 then translate the device and recurse. */
776 if (dst
[slen
- 1] == ':'
777 && dst
[slen
- 2] != ':' /* skip decnet nodes */
778 && strcmp (src
+ slen
, "[000000]") == 0)
780 dst
[slen
- 1] = '\0';
781 if ((ptr
= egetenv (dst
))
782 && (rlen
= strlen (ptr
) - 1) > 0
783 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
784 && ptr
[rlen
- 1] == '.')
786 char * buf
= (char *) alloca (strlen (ptr
) + 1);
790 return directory_file_name (buf
, dst
);
795 strcat (dst
, "[000000]");
799 rlen
= strlen (rptr
) - 1;
800 strncat (dst
, rptr
, rlen
);
801 dst
[slen
+ rlen
] = '\0';
802 strcat (dst
, ".DIR.1");
806 /* Process as Unix format: just remove any final slash.
807 But leave "/" unchanged; do not change it to "". */
810 /* Handle // as root for apollo's. */
811 if ((slen
> 2 && dst
[slen
- 1] == '/')
812 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
816 && IS_DIRECTORY_SEP (dst
[slen
- 1])
818 && !IS_ANY_SEP (dst
[slen
- 2])
824 CORRECT_DIR_SEPS (dst
);
829 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
831 doc
: /* Returns the file name of the directory named DIRECTORY.
832 This is the name of the file that holds the data for the directory DIRECTORY.
833 This operation exists because a directory is also a file, but its name as
834 a directory is different from its name as a file.
835 In Unix-syntax, this function just removes the final slash.
836 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
837 it returns a file name such as \"[X]Y.DIR.1\". */)
839 Lisp_Object directory
;
844 CHECK_STRING (directory
);
846 if (NILP (directory
))
849 /* If the file name has special constructs in it,
850 call the corresponding file handler. */
851 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
853 return call2 (handler
, Qdirectory_file_name
, directory
);
856 /* 20 extra chars is insufficient for VMS, since we might perform a
857 logical name translation. an equivalence string can be up to 255
858 chars long, so grab that much extra space... - sss */
859 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
861 buf
= (char *) alloca (SBYTES (directory
) + 20);
863 directory_file_name (SDATA (directory
), buf
);
864 return make_specified_string (buf
, -1, strlen (buf
),
865 STRING_MULTIBYTE (directory
));
868 static char make_temp_name_tbl
[64] =
870 'A','B','C','D','E','F','G','H',
871 'I','J','K','L','M','N','O','P',
872 'Q','R','S','T','U','V','W','X',
873 'Y','Z','a','b','c','d','e','f',
874 'g','h','i','j','k','l','m','n',
875 'o','p','q','r','s','t','u','v',
876 'w','x','y','z','0','1','2','3',
877 '4','5','6','7','8','9','-','_'
880 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
882 /* Value is a temporary file name starting with PREFIX, a string.
884 The Emacs process number forms part of the result, so there is
885 no danger of generating a name being used by another process.
886 In addition, this function makes an attempt to choose a name
887 which has no existing file. To make this work, PREFIX should be
888 an absolute file name.
890 BASE64_P non-zero means add the pid as 3 characters in base64
891 encoding. In this case, 6 characters will be added to PREFIX to
892 form the file name. Otherwise, if Emacs is running on a system
893 with long file names, add the pid as a decimal number.
895 This function signals an error if no unique file name could be
899 make_temp_name (prefix
, base64_p
)
906 unsigned char *p
, *data
;
910 CHECK_STRING (prefix
);
912 /* VAL is created by adding 6 characters to PREFIX. The first
913 three are the PID of this process, in base 64, and the second
914 three are incremented if the file already exists. This ensures
915 262144 unique file names per PID per PREFIX. */
917 pid
= (int) getpid ();
921 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
922 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
928 #ifdef HAVE_LONG_FILE_NAMES
929 sprintf (pidbuf
, "%d", pid
);
930 pidlen
= strlen (pidbuf
);
932 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
933 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
934 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
939 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
940 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
941 if (!STRING_MULTIBYTE (prefix
))
942 STRING_SET_UNIBYTE (val
);
944 bcopy(SDATA (prefix
), data
, len
);
947 bcopy (pidbuf
, p
, pidlen
);
950 /* Here we try to minimize useless stat'ing when this function is
951 invoked many times successively with the same PREFIX. We achieve
952 this by initializing count to a random value, and incrementing it
955 We don't want make-temp-name to be called while dumping,
956 because then make_temp_name_count_initialized_p would get set
957 and then make_temp_name_count would not be set when Emacs starts. */
959 if (!make_temp_name_count_initialized_p
)
961 make_temp_name_count
= (unsigned) time (NULL
);
962 make_temp_name_count_initialized_p
= 1;
968 unsigned num
= make_temp_name_count
;
970 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
971 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
972 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
974 /* Poor man's congruential RN generator. Replace with
975 ++make_temp_name_count for debugging. */
976 make_temp_name_count
+= 25229;
977 make_temp_name_count
%= 225307;
979 if (stat (data
, &ignored
) < 0)
981 /* We want to return only if errno is ENOENT. */
985 /* The error here is dubious, but there is little else we
986 can do. The alternatives are to return nil, which is
987 as bad as (and in many cases worse than) throwing the
988 error, or to ignore the error, which will likely result
989 in looping through 225307 stat's, which is not only
990 dog-slow, but also useless since it will fallback to
991 the errow below, anyway. */
992 report_file_error ("Cannot create temporary name for prefix",
993 Fcons (prefix
, Qnil
));
998 error ("Cannot create temporary name for prefix `%s'",
1004 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1005 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1006 The Emacs process number forms part of the result,
1007 so there is no danger of generating a name being used by another process.
1009 In addition, this function makes an attempt to choose a name
1010 which has no existing file. To make this work,
1011 PREFIX should be an absolute file name.
1013 There is a race condition between calling `make-temp-name' and creating the
1014 file which opens all kinds of security holes. For that reason, you should
1015 probably use `make-temp-file' instead, except in three circumstances:
1017 * If you are creating the file in the user's home directory.
1018 * If you are creating a directory rather than an ordinary file.
1019 * If you are taking special precautions as `make-temp-file' does. */)
1023 return make_temp_name (prefix
, 0);
1028 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1029 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1030 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1031 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1032 the current buffer's value of `default-directory' is used.
1033 File name components that are `.' are removed, and
1034 so are file name components followed by `..', along with the `..' itself;
1035 note that these simplifications are done without checking the resulting
1036 file names in the file system.
1037 An initial `~/' expands to your home directory.
1038 An initial `~USER/' expands to USER's home directory.
1039 See also the function `substitute-in-file-name'. */)
1040 (name
, default_directory
)
1041 Lisp_Object name
, default_directory
;
1045 register unsigned char *newdir
, *p
, *o
;
1047 unsigned char *target
;
1050 unsigned char * colon
= 0;
1051 unsigned char * close
= 0;
1052 unsigned char * slash
= 0;
1053 unsigned char * brack
= 0;
1054 int lbrack
= 0, rbrack
= 0;
1059 int collapse_newdir
= 1;
1063 Lisp_Object handler
, result
;
1066 CHECK_STRING (name
);
1068 /* If the file name has special constructs in it,
1069 call the corresponding file handler. */
1070 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1071 if (!NILP (handler
))
1072 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1074 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1075 if (NILP (default_directory
))
1076 default_directory
= current_buffer
->directory
;
1077 if (! STRINGP (default_directory
))
1080 /* "/" is not considered a root directory on DOS_NT, so using "/"
1081 here causes an infinite recursion in, e.g., the following:
1083 (let (default-directory)
1084 (expand-file-name "a"))
1086 To avoid this, we set default_directory to the root of the
1088 extern char *emacs_root_dir (void);
1090 default_directory
= build_string (emacs_root_dir ());
1092 default_directory
= build_string ("/");
1096 if (!NILP (default_directory
))
1098 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1099 if (!NILP (handler
))
1100 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1103 o
= SDATA (default_directory
);
1105 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1106 It would be better to do this down below where we actually use
1107 default_directory. Unfortunately, calling Fexpand_file_name recursively
1108 could invoke GC, and the strings might be relocated. This would
1109 be annoying because we have pointers into strings lying around
1110 that would need adjusting, and people would add new pointers to
1111 the code and forget to adjust them, resulting in intermittent bugs.
1112 Putting this call here avoids all that crud.
1114 The EQ test avoids infinite recursion. */
1115 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1116 /* Save time in some common cases - as long as default_directory
1117 is not relative, it can be canonicalized with name below (if it
1118 is needed at all) without requiring it to be expanded now. */
1120 /* Detect MSDOS file names with drive specifiers. */
1121 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1123 /* Detect Windows file names in UNC format. */
1124 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1126 #else /* not DOS_NT */
1127 /* Detect Unix absolute file names (/... alone is not absolute on
1129 && ! (IS_DIRECTORY_SEP (o
[0]))
1130 #endif /* not DOS_NT */
1133 struct gcpro gcpro1
;
1136 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1140 name
= FILE_SYSTEM_CASE (name
);
1142 multibyte
= STRING_MULTIBYTE (name
);
1145 /* We will force directory separators to be either all \ or /, so make
1146 a local copy to modify, even if there ends up being no change. */
1147 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1149 /* Note if special escape prefix is present, but remove for now. */
1150 if (nm
[0] == '/' && nm
[1] == ':')
1156 /* Find and remove drive specifier if present; this makes nm absolute
1157 even if the rest of the name appears to be relative. Only look for
1158 drive specifier at the beginning. */
1159 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1166 /* If we see "c://somedir", we want to strip the first slash after the
1167 colon when stripping the drive letter. Otherwise, this expands to
1169 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1171 #endif /* WINDOWSNT */
1175 /* Discard any previous drive specifier if nm is now in UNC format. */
1176 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1182 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1183 none are found, we can probably return right away. We will avoid
1184 allocating a new string if name is already fully expanded. */
1186 IS_DIRECTORY_SEP (nm
[0])
1188 && drive
&& !is_escaped
1191 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1198 /* If it turns out that the filename we want to return is just a
1199 suffix of FILENAME, we don't need to go through and edit
1200 things; we just need to construct a new string using data
1201 starting at the middle of FILENAME. If we set lose to a
1202 non-zero value, that means we've discovered that we can't do
1209 /* Since we know the name is absolute, we can assume that each
1210 element starts with a "/". */
1212 /* "." and ".." are hairy. */
1213 if (IS_DIRECTORY_SEP (p
[0])
1215 && (IS_DIRECTORY_SEP (p
[2])
1217 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1220 /* We want to replace multiple `/' in a row with a single
1223 && IS_DIRECTORY_SEP (p
[0])
1224 && IS_DIRECTORY_SEP (p
[1]))
1231 /* if dev:[dir]/, move nm to / */
1232 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1233 nm
= (brack
? brack
+ 1 : colon
+ 1);
1234 lbrack
= rbrack
= 0;
1241 #ifdef NO_HYPHENS_IN_FILENAMES
1242 if (lbrack
== rbrack
)
1244 /* Avoid clobbering negative version numbers. */
1249 #endif /* NO_HYPHENS_IN_FILENAMES */
1250 if (lbrack
> rbrack
&&
1251 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1252 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1254 #ifdef NO_HYPHENS_IN_FILENAMES
1257 #endif /* NO_HYPHENS_IN_FILENAMES */
1258 /* count open brackets, reset close bracket pointer */
1259 if (p
[0] == '[' || p
[0] == '<')
1260 lbrack
++, brack
= 0;
1261 /* count close brackets, set close bracket pointer */
1262 if (p
[0] == ']' || p
[0] == '>')
1263 rbrack
++, brack
= p
;
1264 /* detect ][ or >< */
1265 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1267 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1268 nm
= p
+ 1, lose
= 1;
1269 if (p
[0] == ':' && (colon
|| slash
))
1270 /* if dev1:[dir]dev2:, move nm to dev2: */
1276 /* if /name/dev:, move nm to dev: */
1279 /* if node::dev:, move colon following dev */
1280 else if (colon
&& colon
[-1] == ':')
1282 /* if dev1:dev2:, move nm to dev2: */
1283 else if (colon
&& colon
[-1] != ':')
1288 if (p
[0] == ':' && !colon
)
1294 if (lbrack
== rbrack
)
1297 else if (p
[0] == '.')
1305 if (index (nm
, '/'))
1307 nm
= sys_translate_unix (nm
);
1308 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1312 /* Make sure directories are all separated with / or \ as
1313 desired, but avoid allocation of a new string when not
1315 CORRECT_DIR_SEPS (nm
);
1317 if (IS_DIRECTORY_SEP (nm
[1]))
1319 if (strcmp (nm
, SDATA (name
)) != 0)
1320 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1324 /* drive must be set, so this is okay */
1325 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1329 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1330 temp
[0] = DRIVE_LETTER (drive
);
1331 name
= concat2 (build_string (temp
), name
);
1334 #else /* not DOS_NT */
1335 if (nm
== SDATA (name
))
1337 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1338 #endif /* not DOS_NT */
1342 /* At this point, nm might or might not be an absolute file name. We
1343 need to expand ~ or ~user if present, otherwise prefix nm with
1344 default_directory if nm is not absolute, and finally collapse /./
1345 and /foo/../ sequences.
1347 We set newdir to be the appropriate prefix if one is needed:
1348 - the relevant user directory if nm starts with ~ or ~user
1349 - the specified drive's working dir (DOS/NT only) if nm does not
1351 - the value of default_directory.
1353 Note that these prefixes are not guaranteed to be absolute (except
1354 for the working dir of a drive). Therefore, to ensure we always
1355 return an absolute name, if the final prefix is not absolute we
1356 append it to the current working directory. */
1360 if (nm
[0] == '~') /* prefix ~ */
1362 if (IS_DIRECTORY_SEP (nm
[1])
1366 || nm
[1] == 0) /* ~ by itself */
1368 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1369 newdir
= (unsigned char *) "";
1372 collapse_newdir
= 0;
1375 nm
++; /* Don't leave the slash in nm. */
1378 else /* ~user/filename */
1380 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1385 o
= (unsigned char *) alloca (p
- nm
+ 1);
1386 bcopy ((char *) nm
, o
, p
- nm
);
1389 pw
= (struct passwd
*) getpwnam (o
+ 1);
1392 newdir
= (unsigned char *) pw
-> pw_dir
;
1394 nm
= p
+ 1; /* skip the terminator */
1398 collapse_newdir
= 0;
1403 /* If we don't find a user of that name, leave the name
1404 unchanged; don't move nm forward to p. */
1409 /* On DOS and Windows, nm is absolute if a drive name was specified;
1410 use the drive's current directory as the prefix if needed. */
1411 if (!newdir
&& drive
)
1413 /* Get default directory if needed to make nm absolute. */
1414 if (!IS_DIRECTORY_SEP (nm
[0]))
1416 newdir
= alloca (MAXPATHLEN
+ 1);
1417 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1422 /* Either nm starts with /, or drive isn't mounted. */
1423 newdir
= alloca (4);
1424 newdir
[0] = DRIVE_LETTER (drive
);
1432 /* Finally, if no prefix has been specified and nm is not absolute,
1433 then it must be expanded relative to default_directory. */
1437 /* /... alone is not absolute on DOS and Windows. */
1438 && !IS_DIRECTORY_SEP (nm
[0])
1441 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1448 newdir
= SDATA (default_directory
);
1449 multibyte
|= STRING_MULTIBYTE (default_directory
);
1451 /* Note if special escape prefix is present, but remove for now. */
1452 if (newdir
[0] == '/' && newdir
[1] == ':')
1463 /* First ensure newdir is an absolute name. */
1465 /* Detect MSDOS file names with drive specifiers. */
1466 ! (IS_DRIVE (newdir
[0])
1467 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1469 /* Detect Windows file names in UNC format. */
1470 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1474 /* Effectively, let newdir be (expand-file-name newdir cwd).
1475 Because of the admonition against calling expand-file-name
1476 when we have pointers into lisp strings, we accomplish this
1477 indirectly by prepending newdir to nm if necessary, and using
1478 cwd (or the wd of newdir's drive) as the new newdir. */
1480 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1485 if (!IS_DIRECTORY_SEP (nm
[0]))
1487 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1488 file_name_as_directory (tmp
, newdir
);
1492 newdir
= alloca (MAXPATHLEN
+ 1);
1495 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1502 /* Strip off drive name from prefix, if present. */
1503 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1509 /* Keep only a prefix from newdir if nm starts with slash
1510 (//server/share for UNC, nothing otherwise). */
1511 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1514 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1516 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1518 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1520 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1532 /* Get rid of any slash at the end of newdir, unless newdir is
1533 just / or // (an incomplete UNC name). */
1534 length
= strlen (newdir
);
1535 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1537 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1541 unsigned char *temp
= (unsigned char *) alloca (length
);
1542 bcopy (newdir
, temp
, length
- 1);
1543 temp
[length
- 1] = 0;
1551 /* Now concatenate the directory and name to new space in the stack frame */
1552 tlen
+= strlen (nm
) + 1;
1554 /* Reserve space for drive specifier and escape prefix, since either
1555 or both may need to be inserted. (The Microsoft x86 compiler
1556 produces incorrect code if the following two lines are combined.) */
1557 target
= (unsigned char *) alloca (tlen
+ 4);
1559 #else /* not DOS_NT */
1560 target
= (unsigned char *) alloca (tlen
);
1561 #endif /* not DOS_NT */
1567 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1570 /* If newdir is effectively "C:/", then the drive letter will have
1571 been stripped and newdir will be "/". Concatenating with an
1572 absolute directory in nm produces "//", which will then be
1573 incorrectly treated as a network share. Ignore newdir in
1574 this case (keeping the drive letter). */
1575 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1576 && newdir
[1] == '\0'))
1578 strcpy (target
, newdir
);
1582 file_name_as_directory (target
, newdir
);
1585 strcat (target
, nm
);
1587 if (index (target
, '/'))
1588 strcpy (target
, sys_translate_unix (target
));
1591 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1593 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1602 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1608 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1609 /* brackets are offset from each other by 2 */
1612 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1613 /* convert [foo][bar] to [bar] */
1614 while (o
[-1] != '[' && o
[-1] != '<')
1616 else if (*p
== '-' && *o
!= '.')
1619 else if (p
[0] == '-' && o
[-1] == '.' &&
1620 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1621 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1625 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1626 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1628 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1630 /* else [foo.-] ==> [-] */
1634 #ifdef NO_HYPHENS_IN_FILENAMES
1636 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1637 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1639 #endif /* NO_HYPHENS_IN_FILENAMES */
1643 if (!IS_DIRECTORY_SEP (*p
))
1647 else if (p
[1] == '.'
1648 && (IS_DIRECTORY_SEP (p
[2])
1651 /* If "/." is the entire filename, keep the "/". Otherwise,
1652 just delete the whole "/.". */
1653 if (o
== target
&& p
[2] == '\0')
1657 else if (p
[1] == '.' && p
[2] == '.'
1658 /* `/../' is the "superroot" on certain file systems.
1659 Turned off on DOS_NT systems because they have no
1660 "superroot" and because this causes us to produce
1661 file names like "d:/../foo" which fail file-related
1662 functions of the underlying OS. (To reproduce, try a
1663 long series of "../../" in default_directory, longer
1664 than the number of levels from the root.) */
1668 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1670 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1672 /* Keep initial / only if this is the whole name. */
1673 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1677 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1678 /* Collapse multiple `/' in a row. */
1684 #endif /* not VMS */
1688 /* At last, set drive name. */
1690 /* Except for network file name. */
1691 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1692 #endif /* WINDOWSNT */
1694 if (!drive
) abort ();
1696 target
[0] = DRIVE_LETTER (drive
);
1699 /* Reinsert the escape prefix if required. */
1706 CORRECT_DIR_SEPS (target
);
1709 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1711 /* Again look to see if the file name has special constructs in it
1712 and perhaps call the corresponding file handler. This is needed
1713 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1714 the ".." component gives us "/user@host:/bar/../baz" which needs
1715 to be expanded again. */
1716 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1717 if (!NILP (handler
))
1718 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1724 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1725 This is the old version of expand-file-name, before it was thoroughly
1726 rewritten for Emacs 10.31. We leave this version here commented-out,
1727 because the code is very complex and likely to have subtle bugs. If
1728 bugs _are_ found, it might be of interest to look at the old code and
1729 see what did it do in the relevant situation.
1731 Don't remove this code: it's true that it will be accessible via CVS,
1732 but a few years from deletion, people will forget it is there. */
1734 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1735 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1736 "Convert FILENAME to absolute, and canonicalize it.\n\
1737 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1738 \(does not start with slash); if DEFAULT is nil or missing,\n\
1739 the current buffer's value of default-directory is used.\n\
1740 Filenames containing `.' or `..' as components are simplified;\n\
1741 initial `~/' expands to your home directory.\n\
1742 See also the function `substitute-in-file-name'.")
1744 Lisp_Object name
, defalt
;
1748 register unsigned char *newdir
, *p
, *o
;
1750 unsigned char *target
;
1754 unsigned char * colon
= 0;
1755 unsigned char * close
= 0;
1756 unsigned char * slash
= 0;
1757 unsigned char * brack
= 0;
1758 int lbrack
= 0, rbrack
= 0;
1762 CHECK_STRING (name
);
1765 /* Filenames on VMS are always upper case. */
1766 name
= Fupcase (name
);
1771 /* If nm is absolute, flush ...// and detect /./ and /../.
1772 If no /./ or /../ we can return right away. */
1784 if (p
[0] == '/' && p
[1] == '/'
1786 /* // at start of filename is meaningful on Apollo system. */
1791 if (p
[0] == '/' && p
[1] == '~')
1792 nm
= p
+ 1, lose
= 1;
1793 if (p
[0] == '/' && p
[1] == '.'
1794 && (p
[2] == '/' || p
[2] == 0
1795 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1801 /* if dev:[dir]/, move nm to / */
1802 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1803 nm
= (brack
? brack
+ 1 : colon
+ 1);
1804 lbrack
= rbrack
= 0;
1812 /* VMS pre V4.4,convert '-'s in filenames. */
1813 if (lbrack
== rbrack
)
1815 if (dots
< 2) /* this is to allow negative version numbers */
1820 if (lbrack
> rbrack
&&
1821 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1822 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1828 /* count open brackets, reset close bracket pointer */
1829 if (p
[0] == '[' || p
[0] == '<')
1830 lbrack
++, brack
= 0;
1831 /* count close brackets, set close bracket pointer */
1832 if (p
[0] == ']' || p
[0] == '>')
1833 rbrack
++, brack
= p
;
1834 /* detect ][ or >< */
1835 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1837 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1838 nm
= p
+ 1, lose
= 1;
1839 if (p
[0] == ':' && (colon
|| slash
))
1840 /* if dev1:[dir]dev2:, move nm to dev2: */
1846 /* If /name/dev:, move nm to dev: */
1849 /* If node::dev:, move colon following dev */
1850 else if (colon
&& colon
[-1] == ':')
1852 /* If dev1:dev2:, move nm to dev2: */
1853 else if (colon
&& colon
[-1] != ':')
1858 if (p
[0] == ':' && !colon
)
1864 if (lbrack
== rbrack
)
1867 else if (p
[0] == '.')
1875 if (index (nm
, '/'))
1876 return build_string (sys_translate_unix (nm
));
1878 if (nm
== SDATA (name
))
1880 return build_string (nm
);
1884 /* Now determine directory to start with and put it in NEWDIR */
1888 if (nm
[0] == '~') /* prefix ~ */
1893 || nm
[1] == 0)/* ~/filename */
1895 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1896 newdir
= (unsigned char *) "";
1899 nm
++; /* Don't leave the slash in nm. */
1902 else /* ~user/filename */
1904 /* Get past ~ to user */
1905 unsigned char *user
= nm
+ 1;
1906 /* Find end of name. */
1907 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1908 int len
= ptr
? ptr
- user
: strlen (user
);
1910 unsigned char *ptr1
= index (user
, ':');
1911 if (ptr1
!= 0 && ptr1
- user
< len
)
1914 /* Copy the user name into temp storage. */
1915 o
= (unsigned char *) alloca (len
+ 1);
1916 bcopy ((char *) user
, o
, len
);
1919 /* Look up the user name. */
1920 pw
= (struct passwd
*) getpwnam (o
+ 1);
1922 error ("\"%s\" isn't a registered user", o
+ 1);
1924 newdir
= (unsigned char *) pw
->pw_dir
;
1926 /* Discard the user name from NM. */
1933 #endif /* not VMS */
1937 defalt
= current_buffer
->directory
;
1938 CHECK_STRING (defalt
);
1939 newdir
= SDATA (defalt
);
1942 /* Now concatenate the directory and name to new space in the stack frame */
1944 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1945 target
= (unsigned char *) alloca (tlen
);
1951 if (nm
[0] == 0 || nm
[0] == '/')
1952 strcpy (target
, newdir
);
1955 file_name_as_directory (target
, newdir
);
1958 strcat (target
, nm
);
1960 if (index (target
, '/'))
1961 strcpy (target
, sys_translate_unix (target
));
1964 /* Now canonicalize by removing /. and /foo/.. if they appear */
1972 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1978 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1979 /* brackets are offset from each other by 2 */
1982 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1983 /* convert [foo][bar] to [bar] */
1984 while (o
[-1] != '[' && o
[-1] != '<')
1986 else if (*p
== '-' && *o
!= '.')
1989 else if (p
[0] == '-' && o
[-1] == '.' &&
1990 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1991 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1995 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1996 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1998 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2000 /* else [foo.-] ==> [-] */
2006 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2007 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2017 else if (!strncmp (p
, "//", 2)
2019 /* // at start of filename is meaningful in Apollo system. */
2027 else if (p
[0] == '/' && p
[1] == '.' &&
2028 (p
[2] == '/' || p
[2] == 0))
2030 else if (!strncmp (p
, "/..", 3)
2031 /* `/../' is the "superroot" on certain file systems. */
2033 && (p
[3] == '/' || p
[3] == 0))
2035 while (o
!= target
&& *--o
!= '/')
2038 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2042 if (o
== target
&& *o
== '/')
2050 #endif /* not VMS */
2053 return make_string (target
, o
- target
);
2057 /* If /~ or // appears, discard everything through first slash. */
2059 file_name_absolute_p (filename
)
2060 const unsigned char *filename
;
2063 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2065 /* ??? This criterion is probably wrong for '<'. */
2066 || index (filename
, ':') || index (filename
, '<')
2067 || (*filename
== '[' && (filename
[1] != '-'
2068 || (filename
[2] != '.' && filename
[2] != ']'))
2069 && filename
[1] != '.')
2072 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2073 && IS_DIRECTORY_SEP (filename
[2]))
2078 static unsigned char *
2079 search_embedded_absfilename (nm
, endp
)
2080 unsigned char *nm
, *endp
;
2082 unsigned char *p
, *s
;
2084 for (p
= nm
+ 1; p
< endp
; p
++)
2088 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2090 || IS_DIRECTORY_SEP (p
[-1]))
2091 && file_name_absolute_p (p
)
2092 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2093 /* // at start of file name is meaningful in Apollo,
2094 WindowsNT and Cygwin systems. */
2095 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2096 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2099 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2104 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2106 unsigned char *o
= alloca (s
- p
+ 1);
2108 bcopy (p
, o
, s
- p
);
2111 /* If we have ~user and `user' exists, discard
2112 everything up to ~. But if `user' does not exist, leave
2113 ~user alone, it might be a literal file name. */
2114 if ((pw
= getpwnam (o
+ 1)))
2126 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2127 Ssubstitute_in_file_name
, 1, 1, 0,
2128 doc
: /* Substitute environment variables referred to in FILENAME.
2129 `$FOO' where FOO is an environment variable name means to substitute
2130 the value of that variable. The variable name should be terminated
2131 with a character not a letter, digit or underscore; otherwise, enclose
2132 the entire variable name in braces.
2133 If `/~' appears, all of FILENAME through that `/' is discarded.
2135 On VMS, `$' substitution is not done; this function does little and only
2136 duplicates what `expand-file-name' does. */)
2138 Lisp_Object filename
;
2142 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2143 unsigned char *target
= NULL
;
2145 int substituted
= 0;
2147 Lisp_Object handler
;
2149 CHECK_STRING (filename
);
2151 /* If the file name has special constructs in it,
2152 call the corresponding file handler. */
2153 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2154 if (!NILP (handler
))
2155 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2157 nm
= SDATA (filename
);
2159 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2160 CORRECT_DIR_SEPS (nm
);
2161 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2163 endp
= nm
+ SBYTES (filename
);
2165 /* If /~ or // appears, discard everything through first slash. */
2166 p
= search_embedded_absfilename (nm
, endp
);
2168 /* Start over with the new string, so we check the file-name-handler
2169 again. Important with filenames like "/home/foo//:/hello///there"
2170 which whould substitute to "/:/hello///there" rather than "/there". */
2171 return Fsubstitute_in_file_name
2172 (make_specified_string (p
, -1, endp
- p
,
2173 STRING_MULTIBYTE (filename
)));
2179 /* See if any variables are substituted into the string
2180 and find the total length of their values in `total' */
2182 for (p
= nm
; p
!= endp
;)
2192 /* "$$" means a single "$" */
2201 while (p
!= endp
&& *p
!= '}') p
++;
2202 if (*p
!= '}') goto missingclose
;
2208 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2212 /* Copy out the variable name */
2213 target
= (unsigned char *) alloca (s
- o
+ 1);
2214 strncpy (target
, o
, s
- o
);
2217 strupr (target
); /* $home == $HOME etc. */
2220 /* Get variable value */
2221 o
= (unsigned char *) egetenv (target
);
2224 total
+= strlen (o
);
2234 /* If substitution required, recopy the string and do it */
2235 /* Make space in stack frame for the new copy */
2236 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2239 /* Copy the rest of the name through, replacing $ constructs with values */
2256 while (p
!= endp
&& *p
!= '}') p
++;
2257 if (*p
!= '}') goto missingclose
;
2263 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2267 /* Copy out the variable name */
2268 target
= (unsigned char *) alloca (s
- o
+ 1);
2269 strncpy (target
, o
, s
- o
);
2272 strupr (target
); /* $home == $HOME etc. */
2275 /* Get variable value */
2276 o
= (unsigned char *) egetenv (target
);
2280 strcpy (x
, target
); x
+= strlen (target
);
2282 else if (STRING_MULTIBYTE (filename
))
2284 /* If the original string is multibyte,
2285 convert what we substitute into multibyte. */
2288 int c
= unibyte_char_to_multibyte (*o
++);
2289 x
+= CHAR_STRING (c
, x
);
2301 /* If /~ or // appears, discard everything through first slash. */
2302 while ((p
= search_embedded_absfilename (xnm
, x
)))
2303 /* This time we do not start over because we've already expanded envvars
2304 and replaced $$ with $. Maybe we should start over as well, but we'd
2305 need to quote some $ to $$ first. */
2308 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2311 error ("Bad format environment-variable substitution");
2313 error ("Missing \"}\" in environment-variable substitution");
2315 error ("Substituting nonexistent environment variable \"%s\"", target
);
2318 #endif /* not VMS */
2322 /* A slightly faster and more convenient way to get
2323 (directory-file-name (expand-file-name FOO)). */
2326 expand_and_dir_to_file (filename
, defdir
)
2327 Lisp_Object filename
, defdir
;
2329 register Lisp_Object absname
;
2331 absname
= Fexpand_file_name (filename
, defdir
);
2334 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2335 if (c
== ':' || c
== ']' || c
== '>')
2336 absname
= Fdirectory_file_name (absname
);
2339 /* Remove final slash, if any (unless this is the root dir).
2340 stat behaves differently depending! */
2341 if (SCHARS (absname
) > 1
2342 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2343 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2344 /* We cannot take shortcuts; they might be wrong for magic file names. */
2345 absname
= Fdirectory_file_name (absname
);
2350 /* Signal an error if the file ABSNAME already exists.
2351 If INTERACTIVE is nonzero, ask the user whether to proceed,
2352 and bypass the error if the user says to go ahead.
2353 QUERYSTRING is a name for the action that is being considered
2356 *STATPTR is used to store the stat information if the file exists.
2357 If the file does not exist, STATPTR->st_mode is set to 0.
2358 If STATPTR is null, we don't store into it.
2360 If QUICK is nonzero, we ask for y or n, not yes or no. */
2363 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2364 Lisp_Object absname
;
2365 unsigned char *querystring
;
2367 struct stat
*statptr
;
2370 register Lisp_Object tem
, encoded_filename
;
2371 struct stat statbuf
;
2372 struct gcpro gcpro1
;
2374 encoded_filename
= ENCODE_FILE (absname
);
2376 /* stat is a good way to tell whether the file exists,
2377 regardless of what access permissions it has. */
2378 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2381 Fsignal (Qfile_already_exists
,
2382 Fcons (build_string ("File already exists"),
2383 Fcons (absname
, Qnil
)));
2385 tem
= format2 ("File %s already exists; %s anyway? ",
2386 absname
, build_string (querystring
));
2388 tem
= Fy_or_n_p (tem
);
2390 tem
= do_yes_or_no_p (tem
);
2393 Fsignal (Qfile_already_exists
,
2394 Fcons (build_string ("File already exists"),
2395 Fcons (absname
, Qnil
)));
2402 statptr
->st_mode
= 0;
2407 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
2408 "fCopy file: \nGCopy %s to file: \np\nP",
2409 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2410 If NEWNAME names a directory, copy FILE there.
2411 Signals a `file-already-exists' error if file NEWNAME already exists,
2412 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2413 A number as third arg means request confirmation if NEWNAME already exists.
2414 This is what happens in interactive use with M-x.
2415 Always sets the file modes of the output file to match the input file.
2417 Fourth arg KEEP-TIME non-nil means give the output file the same
2418 last-modified time as the old one. (This works on only some systems.)
2420 A prefix arg makes KEEP-TIME non-nil.
2422 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2423 for an existing file with the same name. If MUSTBENEW is `excl',
2424 that means to get an error if the file already exists; never overwrite.
2425 If MUSTBENEW is neither nil nor `excl', that means ask for
2426 confirmation before overwriting, but do go ahead and overwrite the file
2427 if the user confirms.
2429 If PRESERVE-UID-GID is non-nil, we try to transfer the
2430 uid and gid of FILE to NEWNAME. */)
2431 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
, preserve_uid_gid
)
2432 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2433 Lisp_Object preserve_uid_gid
;
2436 char buf
[16 * 1024];
2437 struct stat st
, out_st
;
2438 Lisp_Object handler
;
2439 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2440 int count
= SPECPDL_INDEX ();
2441 int input_file_statable_p
;
2442 Lisp_Object encoded_file
, encoded_newname
;
2444 encoded_file
= encoded_newname
= Qnil
;
2445 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2446 CHECK_STRING (file
);
2447 CHECK_STRING (newname
);
2449 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2450 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2452 if (!NILP (Ffile_directory_p (newname
)))
2453 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2455 newname
= Fexpand_file_name (newname
, Qnil
);
2457 file
= Fexpand_file_name (file
, Qnil
);
2459 /* If the input file name has special constructs in it,
2460 call the corresponding file handler. */
2461 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2462 /* Likewise for output file name. */
2464 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2465 if (!NILP (handler
))
2466 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2467 ok_if_already_exists
, keep_time
));
2469 encoded_file
= ENCODE_FILE (file
);
2470 encoded_newname
= ENCODE_FILE (newname
);
2472 if (NILP (ok_if_already_exists
)
2473 || INTEGERP (ok_if_already_exists
))
2474 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2475 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2476 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2480 if (!CopyFile (SDATA (encoded_file
),
2481 SDATA (encoded_newname
),
2483 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2484 /* CopyFile retains the timestamp by default. */
2485 else if (NILP (keep_time
))
2491 EMACS_GET_TIME (now
);
2492 filename
= SDATA (encoded_newname
);
2494 /* Ensure file is writable while its modified time is set. */
2495 attributes
= GetFileAttributes (filename
);
2496 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2497 if (set_file_times (filename
, now
, now
))
2499 /* Restore original attributes. */
2500 SetFileAttributes (filename
, attributes
);
2501 Fsignal (Qfile_date_error
,
2502 Fcons (build_string ("Cannot set file date"),
2503 Fcons (newname
, Qnil
)));
2505 /* Restore original attributes. */
2506 SetFileAttributes (filename
, attributes
);
2508 #else /* not WINDOWSNT */
2510 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2514 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2516 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2518 /* We can only copy regular files and symbolic links. Other files are not
2520 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2522 #if !defined (MSDOS) || __DJGPP__ > 1
2523 if (out_st
.st_mode
!= 0
2524 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2527 report_file_error ("Input and output files are the same",
2528 Fcons (file
, Fcons (newname
, Qnil
)));
2532 #if defined (S_ISREG) && defined (S_ISLNK)
2533 if (input_file_statable_p
)
2535 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2537 #if defined (EISDIR)
2538 /* Get a better looking error message. */
2541 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2544 #endif /* S_ISREG && S_ISLNK */
2547 /* Create the copy file with the same record format as the input file */
2548 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2551 /* System's default file type was set to binary by _fmode in emacs.c. */
2552 ofd
= emacs_open (SDATA (encoded_newname
),
2553 O_WRONLY
| O_TRUNC
| O_CREAT
2554 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2555 S_IREAD
| S_IWRITE
);
2556 #else /* not MSDOS */
2557 ofd
= emacs_open (SDATA (encoded_newname
),
2558 O_WRONLY
| O_TRUNC
| O_CREAT
2559 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2561 #endif /* not MSDOS */
2564 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2566 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2570 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2571 if (emacs_write (ofd
, buf
, n
) != n
)
2572 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2576 /* Preserve the original file modes, and if requested, also its
2578 if (input_file_statable_p
)
2580 if (! NILP (preserve_uid_gid
))
2581 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2582 fchmod (ofd
, st
.st_mode
& 07777);
2584 #endif /* not MSDOS */
2586 /* Closing the output clobbers the file times on some systems. */
2587 if (emacs_close (ofd
) < 0)
2588 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2590 if (input_file_statable_p
)
2592 if (!NILP (keep_time
))
2594 EMACS_TIME atime
, mtime
;
2595 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2596 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2597 if (set_file_times (SDATA (encoded_newname
),
2599 Fsignal (Qfile_date_error
,
2600 Fcons (build_string ("Cannot set file date"),
2601 Fcons (newname
, Qnil
)));
2607 #if defined (__DJGPP__) && __DJGPP__ > 1
2608 if (input_file_statable_p
)
2610 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2611 and if it can't, it tells so. Otherwise, under MSDOS we usually
2612 get only the READ bit, which will make the copied file read-only,
2613 so it's better not to chmod at all. */
2614 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2615 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2617 #endif /* DJGPP version 2 or newer */
2618 #endif /* not WINDOWSNT */
2620 /* Discard the unwind protects. */
2621 specpdl_ptr
= specpdl
+ count
;
2627 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2628 Smake_directory_internal
, 1, 1, 0,
2629 doc
: /* Create a new directory named DIRECTORY. */)
2631 Lisp_Object directory
;
2633 const unsigned char *dir
;
2634 Lisp_Object handler
;
2635 Lisp_Object encoded_dir
;
2637 CHECK_STRING (directory
);
2638 directory
= Fexpand_file_name (directory
, Qnil
);
2640 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2641 if (!NILP (handler
))
2642 return call2 (handler
, Qmake_directory_internal
, directory
);
2644 encoded_dir
= ENCODE_FILE (directory
);
2646 dir
= SDATA (encoded_dir
);
2649 if (mkdir (dir
) != 0)
2651 if (mkdir (dir
, 0777) != 0)
2653 report_file_error ("Creating directory", Flist (1, &directory
));
2658 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2659 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2661 Lisp_Object directory
;
2663 const unsigned char *dir
;
2664 Lisp_Object handler
;
2665 Lisp_Object encoded_dir
;
2667 CHECK_STRING (directory
);
2668 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2670 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2671 if (!NILP (handler
))
2672 return call2 (handler
, Qdelete_directory
, directory
);
2674 encoded_dir
= ENCODE_FILE (directory
);
2676 dir
= SDATA (encoded_dir
);
2678 if (rmdir (dir
) != 0)
2679 report_file_error ("Removing directory", Flist (1, &directory
));
2684 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2685 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2686 If file has multiple names, it continues to exist with the other names. */)
2688 Lisp_Object filename
;
2690 Lisp_Object handler
;
2691 Lisp_Object encoded_file
;
2692 struct gcpro gcpro1
;
2695 if (!NILP (Ffile_directory_p (filename
))
2696 && NILP (Ffile_symlink_p (filename
)))
2697 Fsignal (Qfile_error
,
2698 Fcons (build_string ("Removing old name: is a directory"),
2699 Fcons (filename
, Qnil
)));
2701 filename
= Fexpand_file_name (filename
, Qnil
);
2703 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2704 if (!NILP (handler
))
2705 return call2 (handler
, Qdelete_file
, filename
);
2707 encoded_file
= ENCODE_FILE (filename
);
2709 if (0 > unlink (SDATA (encoded_file
)))
2710 report_file_error ("Removing old name", Flist (1, &filename
));
2715 internal_delete_file_1 (ignore
)
2721 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2724 internal_delete_file (filename
)
2725 Lisp_Object filename
;
2728 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2729 Qt
, internal_delete_file_1
);
2733 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2734 "fRename file: \nGRename %s to file: \np",
2735 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2736 If file has names other than FILE, it continues to have those names.
2737 Signals a `file-already-exists' error if a file NEWNAME already exists
2738 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2739 A number as third arg means request confirmation if NEWNAME already exists.
2740 This is what happens in interactive use with M-x. */)
2741 (file
, newname
, ok_if_already_exists
)
2742 Lisp_Object file
, newname
, ok_if_already_exists
;
2745 Lisp_Object args
[2];
2747 Lisp_Object handler
;
2748 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2749 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2751 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2752 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2753 CHECK_STRING (file
);
2754 CHECK_STRING (newname
);
2755 file
= Fexpand_file_name (file
, Qnil
);
2757 if (!NILP (Ffile_directory_p (newname
)))
2758 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2760 newname
= Fexpand_file_name (newname
, Qnil
);
2762 /* If the file name has special constructs in it,
2763 call the corresponding file handler. */
2764 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2766 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2767 if (!NILP (handler
))
2768 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2769 file
, newname
, ok_if_already_exists
));
2771 encoded_file
= ENCODE_FILE (file
);
2772 encoded_newname
= ENCODE_FILE (newname
);
2775 /* If the file names are identical but for the case, don't ask for
2776 confirmation: they simply want to change the letter-case of the
2778 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2780 if (NILP (ok_if_already_exists
)
2781 || INTEGERP (ok_if_already_exists
))
2782 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2783 INTEGERP (ok_if_already_exists
), 0, 0);
2785 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2787 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2788 || 0 > unlink (SDATA (encoded_file
)))
2794 symlink_target
= Ffile_symlink_p (file
);
2795 if (! NILP (symlink_target
))
2796 Fmake_symbolic_link (symlink_target
, newname
,
2797 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2800 Fcopy_file (file
, newname
,
2801 /* We have already prompted if it was an integer,
2802 so don't have copy-file prompt again. */
2803 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2806 Fdelete_file (file
);
2813 report_file_error ("Renaming", Flist (2, args
));
2816 report_file_error ("Renaming", Flist (2, &file
));
2823 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2824 "fAdd name to file: \nGName to add to %s: \np",
2825 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2826 Signals a `file-already-exists' error if a file NEWNAME already exists
2827 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2828 A number as third arg means request confirmation if NEWNAME already exists.
2829 This is what happens in interactive use with M-x. */)
2830 (file
, newname
, ok_if_already_exists
)
2831 Lisp_Object file
, newname
, ok_if_already_exists
;
2834 Lisp_Object args
[2];
2836 Lisp_Object handler
;
2837 Lisp_Object encoded_file
, encoded_newname
;
2838 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2840 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2841 encoded_file
= encoded_newname
= Qnil
;
2842 CHECK_STRING (file
);
2843 CHECK_STRING (newname
);
2844 file
= Fexpand_file_name (file
, Qnil
);
2846 if (!NILP (Ffile_directory_p (newname
)))
2847 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2849 newname
= Fexpand_file_name (newname
, Qnil
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2854 if (!NILP (handler
))
2855 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2856 newname
, ok_if_already_exists
));
2858 /* If the new name has special constructs in it,
2859 call the corresponding file handler. */
2860 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2861 if (!NILP (handler
))
2862 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2863 newname
, ok_if_already_exists
));
2865 encoded_file
= ENCODE_FILE (file
);
2866 encoded_newname
= ENCODE_FILE (newname
);
2868 if (NILP (ok_if_already_exists
)
2869 || INTEGERP (ok_if_already_exists
))
2870 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2871 INTEGERP (ok_if_already_exists
), 0, 0);
2873 unlink (SDATA (newname
));
2874 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2879 report_file_error ("Adding new name", Flist (2, args
));
2881 report_file_error ("Adding new name", Flist (2, &file
));
2890 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2891 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2892 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2893 Both args must be strings.
2894 Signals a `file-already-exists' error if a file LINKNAME already exists
2895 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2896 A number as third arg means request confirmation if LINKNAME already exists.
2897 This happens for interactive use with M-x. */)
2898 (filename
, linkname
, ok_if_already_exists
)
2899 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2902 Lisp_Object args
[2];
2904 Lisp_Object handler
;
2905 Lisp_Object encoded_filename
, encoded_linkname
;
2906 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2908 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2909 encoded_filename
= encoded_linkname
= Qnil
;
2910 CHECK_STRING (filename
);
2911 CHECK_STRING (linkname
);
2912 /* If the link target has a ~, we must expand it to get
2913 a truly valid file name. Otherwise, do not expand;
2914 we want to permit links to relative file names. */
2915 if (SREF (filename
, 0) == '~')
2916 filename
= Fexpand_file_name (filename
, Qnil
);
2918 if (!NILP (Ffile_directory_p (linkname
)))
2919 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2921 linkname
= Fexpand_file_name (linkname
, Qnil
);
2923 /* If the file name has special constructs in it,
2924 call the corresponding file handler. */
2925 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2926 if (!NILP (handler
))
2927 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2928 linkname
, ok_if_already_exists
));
2930 /* If the new link name has special constructs in it,
2931 call the corresponding file handler. */
2932 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2933 if (!NILP (handler
))
2934 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2935 linkname
, ok_if_already_exists
));
2937 encoded_filename
= ENCODE_FILE (filename
);
2938 encoded_linkname
= ENCODE_FILE (linkname
);
2940 if (NILP (ok_if_already_exists
)
2941 || INTEGERP (ok_if_already_exists
))
2942 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2943 INTEGERP (ok_if_already_exists
), 0, 0);
2944 if (0 > symlink (SDATA (encoded_filename
),
2945 SDATA (encoded_linkname
)))
2947 /* If we didn't complain already, silently delete existing file. */
2948 if (errno
== EEXIST
)
2950 unlink (SDATA (encoded_linkname
));
2951 if (0 <= symlink (SDATA (encoded_filename
),
2952 SDATA (encoded_linkname
)))
2962 report_file_error ("Making symbolic link", Flist (2, args
));
2964 report_file_error ("Making symbolic link", Flist (2, &filename
));
2970 #endif /* S_IFLNK */
2974 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2975 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2976 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2977 If STRING is nil or a null string, the logical name NAME is deleted. */)
2982 CHECK_STRING (name
);
2984 delete_logical_name (SDATA (name
));
2987 CHECK_STRING (string
);
2989 if (SCHARS (string
) == 0)
2990 delete_logical_name (SDATA (name
));
2992 define_logical_name (SDATA (name
), SDATA (string
));
3001 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
3002 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
3004 Lisp_Object path
, login
;
3008 CHECK_STRING (path
);
3009 CHECK_STRING (login
);
3011 netresult
= netunam (SDATA (path
), SDATA (login
));
3013 if (netresult
== -1)
3018 #endif /* HPUX_NET */
3020 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3022 doc
: /* Return t if file FILENAME specifies an absolute file name.
3023 On Unix, this is a name starting with a `/' or a `~'. */)
3025 Lisp_Object filename
;
3027 CHECK_STRING (filename
);
3028 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3031 /* Return nonzero if file FILENAME exists and can be executed. */
3034 check_executable (filename
)
3038 int len
= strlen (filename
);
3041 if (stat (filename
, &st
) < 0)
3043 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3044 return ((st
.st_mode
& S_IEXEC
) != 0);
3046 return (S_ISREG (st
.st_mode
)
3048 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3049 || stricmp (suffix
, ".exe") == 0
3050 || stricmp (suffix
, ".bat") == 0)
3051 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3052 #endif /* not WINDOWSNT */
3053 #else /* not DOS_NT */
3054 #ifdef HAVE_EUIDACCESS
3055 return (euidaccess (filename
, 1) >= 0);
3057 /* Access isn't quite right because it uses the real uid
3058 and we really want to test with the effective uid.
3059 But Unix doesn't give us a right way to do it. */
3060 return (access (filename
, 1) >= 0);
3062 #endif /* not DOS_NT */
3065 /* Return nonzero if file FILENAME exists and can be written. */
3068 check_writable (filename
)
3073 if (stat (filename
, &st
) < 0)
3075 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3076 #else /* not MSDOS */
3077 #ifdef HAVE_EUIDACCESS
3078 return (euidaccess (filename
, 2) >= 0);
3080 /* Access isn't quite right because it uses the real uid
3081 and we really want to test with the effective uid.
3082 But Unix doesn't give us a right way to do it.
3083 Opening with O_WRONLY could work for an ordinary file,
3084 but would lose for directories. */
3085 return (access (filename
, 2) >= 0);
3087 #endif /* not MSDOS */
3090 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3091 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3092 See also `file-readable-p' and `file-attributes'.
3093 This returns nil for a symlink to a nonexistent file.
3094 Use `file-symlink-p' to test for such links. */)
3096 Lisp_Object filename
;
3098 Lisp_Object absname
;
3099 Lisp_Object handler
;
3100 struct stat statbuf
;
3102 CHECK_STRING (filename
);
3103 absname
= Fexpand_file_name (filename
, Qnil
);
3105 /* If the file name has special constructs in it,
3106 call the corresponding file handler. */
3107 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3108 if (!NILP (handler
))
3109 return call2 (handler
, Qfile_exists_p
, absname
);
3111 absname
= ENCODE_FILE (absname
);
3113 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3116 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3117 doc
: /* Return t if FILENAME can be executed by you.
3118 For a directory, this means you can access files in that directory. */)
3120 Lisp_Object filename
;
3122 Lisp_Object absname
;
3123 Lisp_Object handler
;
3125 CHECK_STRING (filename
);
3126 absname
= Fexpand_file_name (filename
, Qnil
);
3128 /* If the file name has special constructs in it,
3129 call the corresponding file handler. */
3130 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3131 if (!NILP (handler
))
3132 return call2 (handler
, Qfile_executable_p
, absname
);
3134 absname
= ENCODE_FILE (absname
);
3136 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3139 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3140 doc
: /* Return t if file FILENAME exists and you can read it.
3141 See also `file-exists-p' and `file-attributes'. */)
3143 Lisp_Object filename
;
3145 Lisp_Object absname
;
3146 Lisp_Object handler
;
3149 struct stat statbuf
;
3151 CHECK_STRING (filename
);
3152 absname
= Fexpand_file_name (filename
, Qnil
);
3154 /* If the file name has special constructs in it,
3155 call the corresponding file handler. */
3156 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3157 if (!NILP (handler
))
3158 return call2 (handler
, Qfile_readable_p
, absname
);
3160 absname
= ENCODE_FILE (absname
);
3162 #if defined(DOS_NT) || defined(macintosh)
3163 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3165 if (access (SDATA (absname
), 0) == 0)
3168 #else /* not DOS_NT and not macintosh */
3170 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3171 /* Opening a fifo without O_NONBLOCK can wait.
3172 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3173 except in the case of a fifo, on a system which handles it. */
3174 desc
= stat (SDATA (absname
), &statbuf
);
3177 if (S_ISFIFO (statbuf
.st_mode
))
3178 flags
|= O_NONBLOCK
;
3180 desc
= emacs_open (SDATA (absname
), flags
, 0);
3185 #endif /* not DOS_NT and not macintosh */
3188 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3190 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3191 doc
: /* Return t if file FILENAME can be written or created by you. */)
3193 Lisp_Object filename
;
3195 Lisp_Object absname
, dir
, encoded
;
3196 Lisp_Object handler
;
3197 struct stat statbuf
;
3199 CHECK_STRING (filename
);
3200 absname
= Fexpand_file_name (filename
, Qnil
);
3202 /* If the file name has special constructs in it,
3203 call the corresponding file handler. */
3204 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3205 if (!NILP (handler
))
3206 return call2 (handler
, Qfile_writable_p
, absname
);
3208 encoded
= ENCODE_FILE (absname
);
3209 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3210 return (check_writable (SDATA (encoded
))
3213 dir
= Ffile_name_directory (absname
);
3216 dir
= Fdirectory_file_name (dir
);
3220 dir
= Fdirectory_file_name (dir
);
3223 dir
= ENCODE_FILE (dir
);
3225 /* The read-only attribute of the parent directory doesn't affect
3226 whether a file or directory can be created within it. Some day we
3227 should check ACLs though, which do affect this. */
3228 if (stat (SDATA (dir
), &statbuf
) < 0)
3230 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3232 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3237 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3238 doc
: /* Access file FILENAME, and get an error if that does not work.
3239 The second argument STRING is used in the error message.
3240 If there is no error, returns nil. */)
3242 Lisp_Object filename
, string
;
3244 Lisp_Object handler
, encoded_filename
, absname
;
3247 CHECK_STRING (filename
);
3248 absname
= Fexpand_file_name (filename
, Qnil
);
3250 CHECK_STRING (string
);
3252 /* If the file name has special constructs in it,
3253 call the corresponding file handler. */
3254 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3255 if (!NILP (handler
))
3256 return call3 (handler
, Qaccess_file
, absname
, string
);
3258 encoded_filename
= ENCODE_FILE (absname
);
3260 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3262 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3268 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3269 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3270 The value is the link target, as a string.
3271 Otherwise it returns nil.
3273 This function returns t when given the name of a symlink that
3274 points to a nonexistent file. */)
3276 Lisp_Object filename
;
3278 Lisp_Object handler
;
3280 CHECK_STRING (filename
);
3281 filename
= Fexpand_file_name (filename
, Qnil
);
3283 /* If the file name has special constructs in it,
3284 call the corresponding file handler. */
3285 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3286 if (!NILP (handler
))
3287 return call2 (handler
, Qfile_symlink_p
, filename
);
3296 filename
= ENCODE_FILE (filename
);
3303 buf
= (char *) xrealloc (buf
, bufsize
);
3304 bzero (buf
, bufsize
);
3307 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3311 /* HP-UX reports ERANGE if buffer is too small. */
3312 if (errno
== ERANGE
)
3322 while (valsize
>= bufsize
);
3324 val
= make_string (buf
, valsize
);
3325 if (buf
[0] == '/' && index (buf
, ':'))
3326 val
= concat2 (build_string ("/:"), val
);
3328 val
= DECODE_FILE (val
);
3331 #else /* not S_IFLNK */
3333 #endif /* not S_IFLNK */
3336 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3337 doc
: /* Return t if FILENAME names an existing directory.
3338 Symbolic links to directories count as directories.
3339 See `file-symlink-p' to distinguish symlinks. */)
3341 Lisp_Object filename
;
3343 register Lisp_Object absname
;
3345 Lisp_Object handler
;
3347 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3349 /* If the file name has special constructs in it,
3350 call the corresponding file handler. */
3351 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3352 if (!NILP (handler
))
3353 return call2 (handler
, Qfile_directory_p
, absname
);
3355 absname
= ENCODE_FILE (absname
);
3357 if (stat (SDATA (absname
), &st
) < 0)
3359 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3362 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3363 doc
: /* Return t if file FILENAME names a directory you can open.
3364 For the value to be t, FILENAME must specify the name of a directory as a file,
3365 and the directory must allow you to open files in it. In order to use a
3366 directory as a buffer's current directory, this predicate must return true.
3367 A directory name spec may be given instead; then the value is t
3368 if the directory so specified exists and really is a readable and
3369 searchable directory. */)
3371 Lisp_Object filename
;
3373 Lisp_Object handler
;
3375 struct gcpro gcpro1
;
3377 /* If the file name has special constructs in it,
3378 call the corresponding file handler. */
3379 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3380 if (!NILP (handler
))
3381 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3384 tem
= (NILP (Ffile_directory_p (filename
))
3385 || NILP (Ffile_executable_p (filename
)));
3387 return tem
? Qnil
: Qt
;
3390 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3391 doc
: /* Return t if FILENAME names a regular file.
3392 This is the sort of file that holds an ordinary stream of data bytes.
3393 Symbolic links to regular files count as regular files.
3394 See `file-symlink-p' to distinguish symlinks. */)
3396 Lisp_Object filename
;
3398 register Lisp_Object absname
;
3400 Lisp_Object handler
;
3402 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3404 /* If the file name has special constructs in it,
3405 call the corresponding file handler. */
3406 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3407 if (!NILP (handler
))
3408 return call2 (handler
, Qfile_regular_p
, absname
);
3410 absname
= ENCODE_FILE (absname
);
3415 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3417 /* Tell stat to use expensive method to get accurate info. */
3418 Vw32_get_true_file_attributes
= Qt
;
3419 result
= stat (SDATA (absname
), &st
);
3420 Vw32_get_true_file_attributes
= tem
;
3424 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3427 if (stat (SDATA (absname
), &st
) < 0)
3429 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3433 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3434 doc
: /* Return mode bits of file named FILENAME, as an integer.
3435 Return nil, if file does not exist or is not accessible. */)
3437 Lisp_Object filename
;
3439 Lisp_Object absname
;
3441 Lisp_Object handler
;
3443 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3445 /* If the file name has special constructs in it,
3446 call the corresponding file handler. */
3447 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3448 if (!NILP (handler
))
3449 return call2 (handler
, Qfile_modes
, absname
);
3451 absname
= ENCODE_FILE (absname
);
3453 if (stat (SDATA (absname
), &st
) < 0)
3455 #if defined (MSDOS) && __DJGPP__ < 2
3456 if (check_executable (SDATA (absname
)))
3457 st
.st_mode
|= S_IEXEC
;
3458 #endif /* MSDOS && __DJGPP__ < 2 */
3460 return make_number (st
.st_mode
& 07777);
3463 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3464 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3465 Only the 12 low bits of MODE are used. */)
3467 Lisp_Object filename
, mode
;
3469 Lisp_Object absname
, encoded_absname
;
3470 Lisp_Object handler
;
3472 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3473 CHECK_NUMBER (mode
);
3475 /* If the file name has special constructs in it,
3476 call the corresponding file handler. */
3477 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3478 if (!NILP (handler
))
3479 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3481 encoded_absname
= ENCODE_FILE (absname
);
3483 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3484 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3489 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3490 doc
: /* Set the file permission bits for newly created files.
3491 The argument MODE should be an integer; only the low 9 bits are used.
3492 This setting is inherited by subprocesses. */)
3496 CHECK_NUMBER (mode
);
3498 umask ((~ XINT (mode
)) & 0777);
3503 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3504 doc
: /* Return the default file protection for created files.
3505 The value is an integer. */)
3511 realmask
= umask (0);
3514 XSETINT (value
, (~ realmask
) & 0777);
3518 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3520 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3521 doc
: /* Set times of file FILENAME to TIME.
3522 Set both access and modification times.
3523 Return t on success, else nil.
3524 Use the current time if TIME is nil. TIME is in the format of
3527 Lisp_Object filename
, time
;
3529 Lisp_Object absname
, encoded_absname
;
3530 Lisp_Object handler
;
3534 if (! lisp_time_argument (time
, &sec
, &usec
))
3535 error ("Invalid time specification");
3537 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3539 /* If the file name has special constructs in it,
3540 call the corresponding file handler. */
3541 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3542 if (!NILP (handler
))
3543 return call3 (handler
, Qset_file_times
, absname
, time
);
3545 encoded_absname
= ENCODE_FILE (absname
);
3550 EMACS_SET_SECS (t
, sec
);
3551 EMACS_SET_USECS (t
, usec
);
3553 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3558 /* Setting times on a directory always fails. */
3559 if (stat (SDATA (encoded_absname
), &st
) == 0
3560 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3563 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3576 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3577 doc
: /* Tell Unix to finish all pending disk updates. */)
3586 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3587 doc
: /* Return t if file FILE1 is newer than file FILE2.
3588 If FILE1 does not exist, the answer is nil;
3589 otherwise, if FILE2 does not exist, the answer is t. */)
3591 Lisp_Object file1
, file2
;
3593 Lisp_Object absname1
, absname2
;
3596 Lisp_Object handler
;
3597 struct gcpro gcpro1
, gcpro2
;
3599 CHECK_STRING (file1
);
3600 CHECK_STRING (file2
);
3603 GCPRO2 (absname1
, file2
);
3604 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3605 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3608 /* If the file name has special constructs in it,
3609 call the corresponding file handler. */
3610 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3612 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3613 if (!NILP (handler
))
3614 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3616 GCPRO2 (absname1
, absname2
);
3617 absname1
= ENCODE_FILE (absname1
);
3618 absname2
= ENCODE_FILE (absname2
);
3621 if (stat (SDATA (absname1
), &st
) < 0)
3624 mtime1
= st
.st_mtime
;
3626 if (stat (SDATA (absname2
), &st
) < 0)
3629 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3633 Lisp_Object Qfind_buffer_file_type
;
3636 #ifndef READ_BUF_SIZE
3637 #define READ_BUF_SIZE (64 << 10)
3640 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3642 /* This function is called after Lisp functions to decide a coding
3643 system are called, or when they cause an error. Before they are
3644 called, the current buffer is set unibyte and it contains only a
3645 newly inserted text (thus the buffer was empty before the
3648 The functions may set markers, overlays, text properties, or even
3649 alter the buffer contents, change the current buffer.
3651 Here, we reset all those changes by:
3652 o set back the current buffer.
3653 o move all markers and overlays to BEG.
3654 o remove all text properties.
3655 o set back the buffer multibyteness. */
3658 decide_coding_unwind (unwind_data
)
3659 Lisp_Object unwind_data
;
3661 Lisp_Object multibyte
, undo_list
, buffer
;
3663 multibyte
= XCAR (unwind_data
);
3664 unwind_data
= XCDR (unwind_data
);
3665 undo_list
= XCAR (unwind_data
);
3666 buffer
= XCDR (unwind_data
);
3668 if (current_buffer
!= XBUFFER (buffer
))
3669 set_buffer_internal (XBUFFER (buffer
));
3670 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3671 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3672 BUF_INTERVALS (current_buffer
) = 0;
3673 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3675 /* Now we are safe to change the buffer's multibyteness directly. */
3676 current_buffer
->enable_multibyte_characters
= multibyte
;
3677 current_buffer
->undo_list
= undo_list
;
3683 /* Used to pass values from insert-file-contents to read_non_regular. */
3685 static int non_regular_fd
;
3686 static int non_regular_inserted
;
3687 static int non_regular_nbytes
;
3690 /* Read from a non-regular file.
3691 Read non_regular_trytry bytes max from non_regular_fd.
3692 Non_regular_inserted specifies where to put the read bytes.
3693 Value is the number of bytes read. */
3702 nbytes
= emacs_read (non_regular_fd
,
3703 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3704 non_regular_nbytes
);
3706 return make_number (nbytes
);
3710 /* Condition-case handler used when reading from non-regular files
3711 in insert-file-contents. */
3714 read_non_regular_quit ()
3720 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3722 doc
: /* Insert contents of file FILENAME after point.
3723 Returns list of absolute file name and number of characters inserted.
3724 If second argument VISIT is non-nil, the buffer's visited filename
3725 and last save file modtime are set, and it is marked unmodified.
3726 If visiting and the file does not exist, visiting is completed
3727 before the error is signaled.
3728 The optional third and fourth arguments BEG and END
3729 specify what portion of the file to insert.
3730 These arguments count bytes in the file, not characters in the buffer.
3731 If VISIT is non-nil, BEG and END must be nil.
3733 If optional fifth argument REPLACE is non-nil,
3734 it means replace the current buffer contents (in the accessible portion)
3735 with the file contents. This is better than simply deleting and inserting
3736 the whole thing because (1) it preserves some marker positions
3737 and (2) it puts less data in the undo list.
3738 When REPLACE is non-nil, the value is the number of characters actually read,
3739 which is often less than the number of characters to be read.
3741 This does code conversion according to the value of
3742 `coding-system-for-read' or `file-coding-system-alist',
3743 and sets the variable `last-coding-system-used' to the coding system
3745 (filename
, visit
, beg
, end
, replace
)
3746 Lisp_Object filename
, visit
, beg
, end
, replace
;
3751 register int how_much
;
3752 register int unprocessed
;
3753 int count
= SPECPDL_INDEX ();
3754 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3755 Lisp_Object handler
, val
, insval
, orig_filename
;
3758 int not_regular
= 0;
3759 unsigned char read_buf
[READ_BUF_SIZE
];
3760 struct coding_system coding
;
3761 unsigned char buffer
[1 << 14];
3762 int replace_handled
= 0;
3763 int set_coding_system
= 0;
3764 int coding_system_decided
= 0;
3766 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3767 int we_locked_file
= 0;
3769 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3770 error ("Cannot do file visiting in an indirect buffer");
3772 if (!NILP (current_buffer
->read_only
))
3773 Fbarf_if_buffer_read_only ();
3777 orig_filename
= Qnil
;
3779 GCPRO4 (filename
, val
, p
, orig_filename
);
3781 CHECK_STRING (filename
);
3782 filename
= Fexpand_file_name (filename
, Qnil
);
3784 /* If the file name has special constructs in it,
3785 call the corresponding file handler. */
3786 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3787 if (!NILP (handler
))
3789 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3790 visit
, beg
, end
, replace
);
3791 if (CONSP (val
) && CONSP (XCDR (val
)))
3792 inserted
= XINT (XCAR (XCDR (val
)));
3796 orig_filename
= filename
;
3797 filename
= ENCODE_FILE (filename
);
3803 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3805 /* Tell stat to use expensive method to get accurate info. */
3806 Vw32_get_true_file_attributes
= Qt
;
3807 total
= stat (SDATA (filename
), &st
);
3808 Vw32_get_true_file_attributes
= tem
;
3813 if (stat (SDATA (filename
), &st
) < 0)
3815 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3816 || fstat (fd
, &st
) < 0)
3817 #endif /* not APOLLO */
3818 #endif /* WINDOWSNT */
3820 if (fd
>= 0) emacs_close (fd
);
3823 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3826 if (!NILP (Vcoding_system_for_read
))
3827 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3832 /* This code will need to be changed in order to work on named
3833 pipes, and it's probably just not worth it. So we should at
3834 least signal an error. */
3835 if (!S_ISREG (st
.st_mode
))
3842 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3843 Fsignal (Qfile_error
,
3844 Fcons (build_string ("not a regular file"),
3845 Fcons (orig_filename
, Qnil
)));
3850 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3853 /* Replacement should preserve point as it preserves markers. */
3854 if (!NILP (replace
))
3855 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3857 record_unwind_protect (close_file_unwind
, make_number (fd
));
3859 /* Supposedly happens on VMS. */
3860 /* Can happen on any platform that uses long as type of off_t, but allows
3861 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3862 give a message suitable for the latter case. */
3863 if (! not_regular
&& st
.st_size
< 0)
3864 error ("Maximum buffer size exceeded");
3866 /* Prevent redisplay optimizations. */
3867 current_buffer
->clip_changed
= 1;
3871 if (!NILP (beg
) || !NILP (end
))
3872 error ("Attempt to visit less than an entire file");
3873 if (BEG
< Z
&& NILP (replace
))
3874 error ("Cannot do file visiting in a non-empty buffer");
3880 XSETFASTINT (beg
, 0);
3888 XSETINT (end
, st
.st_size
);
3890 /* Arithmetic overflow can occur if an Emacs integer cannot
3891 represent the file size, or if the calculations below
3892 overflow. The calculations below double the file size
3893 twice, so check that it can be multiplied by 4 safely. */
3894 if (XINT (end
) != st
.st_size
3895 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3896 error ("Maximum buffer size exceeded");
3898 /* The file size returned from stat may be zero, but data
3899 may be readable nonetheless, for example when this is a
3900 file in the /proc filesystem. */
3901 if (st
.st_size
== 0)
3902 XSETINT (end
, READ_BUF_SIZE
);
3906 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3908 /* We use emacs-mule for auto saving... */
3909 setup_coding_system (Qemacs_mule
, &coding
);
3910 /* ... but with the special flag to indicate to read in a
3911 multibyte sequence for eight-bit-control char as is. */
3913 coding
.src_multibyte
= 0;
3914 coding
.dst_multibyte
3915 = !NILP (current_buffer
->enable_multibyte_characters
);
3916 coding
.eol_type
= CODING_EOL_LF
;
3917 coding_system_decided
= 1;
3921 /* Decide the coding system to use for reading the file now
3922 because we can't use an optimized method for handling
3923 `coding:' tag if the current buffer is not empty. */
3927 if (!NILP (Vcoding_system_for_read
))
3928 val
= Vcoding_system_for_read
;
3931 /* Don't try looking inside a file for a coding system
3932 specification if it is not seekable. */
3933 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3935 /* Find a coding system specified in the heading two
3936 lines or in the tailing several lines of the file.
3937 We assume that the 1K-byte and 3K-byte for heading
3938 and tailing respectively are sufficient for this
3942 if (st
.st_size
<= (1024 * 4))
3943 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3946 nread
= emacs_read (fd
, read_buf
, 1024);
3949 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3950 report_file_error ("Setting file position",
3951 Fcons (orig_filename
, Qnil
));
3952 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3957 error ("IO error reading %s: %s",
3958 SDATA (orig_filename
), emacs_strerror (errno
));
3961 struct buffer
*prev
= current_buffer
;
3965 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3967 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3968 buf
= XBUFFER (buffer
);
3970 delete_all_overlays (buf
);
3971 buf
->directory
= current_buffer
->directory
;
3972 buf
->read_only
= Qnil
;
3973 buf
->filename
= Qnil
;
3974 buf
->undo_list
= Qt
;
3975 eassert (buf
->overlays_before
== NULL
);
3976 eassert (buf
->overlays_after
== NULL
);
3978 set_buffer_internal (buf
);
3980 buf
->enable_multibyte_characters
= Qnil
;
3982 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3983 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3984 val
= call2 (Vset_auto_coding_function
,
3985 filename
, make_number (nread
));
3986 set_buffer_internal (prev
);
3988 /* Discard the unwind protect for recovering the
3992 /* Rewind the file for the actual read done later. */
3993 if (lseek (fd
, 0, 0) < 0)
3994 report_file_error ("Setting file position",
3995 Fcons (orig_filename
, Qnil
));
4001 /* If we have not yet decided a coding system, check
4002 file-coding-system-alist. */
4003 Lisp_Object args
[6], coding_systems
;
4005 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4006 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4007 coding_systems
= Ffind_operation_coding_system (6, args
);
4008 if (CONSP (coding_systems
))
4009 val
= XCAR (coding_systems
);
4013 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4014 /* Ensure we set Vlast_coding_system_used. */
4015 set_coding_system
= 1;
4017 if (NILP (current_buffer
->enable_multibyte_characters
)
4019 /* We must suppress all character code conversion except for
4020 end-of-line conversion. */
4021 setup_raw_text_coding_system (&coding
);
4023 coding
.src_multibyte
= 0;
4024 coding
.dst_multibyte
4025 = !NILP (current_buffer
->enable_multibyte_characters
);
4026 coding_system_decided
= 1;
4029 /* If requested, replace the accessible part of the buffer
4030 with the file contents. Avoid replacing text at the
4031 beginning or end of the buffer that matches the file contents;
4032 that preserves markers pointing to the unchanged parts.
4034 Here we implement this feature in an optimized way
4035 for the case where code conversion is NOT needed.
4036 The following if-statement handles the case of conversion
4037 in a less optimal way.
4039 If the code conversion is "automatic" then we try using this
4040 method and hope for the best.
4041 But if we discover the need for conversion, we give up on this method
4042 and let the following if-statement handle the replace job. */
4045 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4047 /* same_at_start and same_at_end count bytes,
4048 because file access counts bytes
4049 and BEG and END count bytes. */
4050 int same_at_start
= BEGV_BYTE
;
4051 int same_at_end
= ZV_BYTE
;
4053 /* There is still a possibility we will find the need to do code
4054 conversion. If that happens, we set this variable to 1 to
4055 give up on handling REPLACE in the optimized way. */
4056 int giveup_match_end
= 0;
4058 if (XINT (beg
) != 0)
4060 if (lseek (fd
, XINT (beg
), 0) < 0)
4061 report_file_error ("Setting file position",
4062 Fcons (orig_filename
, Qnil
));
4067 /* Count how many chars at the start of the file
4068 match the text at the beginning of the buffer. */
4073 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4075 error ("IO error reading %s: %s",
4076 SDATA (orig_filename
), emacs_strerror (errno
));
4077 else if (nread
== 0)
4080 if (coding
.type
== coding_type_undecided
)
4081 detect_coding (&coding
, buffer
, nread
);
4082 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4083 /* We found that the file should be decoded somehow.
4084 Let's give up here. */
4086 giveup_match_end
= 1;
4090 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4091 detect_eol (&coding
, buffer
, nread
);
4092 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4093 && coding
.eol_type
!= CODING_EOL_LF
)
4094 /* We found that the format of eol should be decoded.
4095 Let's give up here. */
4097 giveup_match_end
= 1;
4102 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4103 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4104 same_at_start
++, bufpos
++;
4105 /* If we found a discrepancy, stop the scan.
4106 Otherwise loop around and scan the next bufferful. */
4107 if (bufpos
!= nread
)
4111 /* If the file matches the buffer completely,
4112 there's no need to replace anything. */
4113 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4117 /* Truncate the buffer to the size of the file. */
4118 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4123 /* Count how many chars at the end of the file
4124 match the text at the end of the buffer. But, if we have
4125 already found that decoding is necessary, don't waste time. */
4126 while (!giveup_match_end
)
4128 int total_read
, nread
, bufpos
, curpos
, trial
;
4130 /* At what file position are we now scanning? */
4131 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4132 /* If the entire file matches the buffer tail, stop the scan. */
4135 /* How much can we scan in the next step? */
4136 trial
= min (curpos
, sizeof buffer
);
4137 if (lseek (fd
, curpos
- trial
, 0) < 0)
4138 report_file_error ("Setting file position",
4139 Fcons (orig_filename
, Qnil
));
4141 total_read
= nread
= 0;
4142 while (total_read
< trial
)
4144 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4146 error ("IO error reading %s: %s",
4147 SDATA (orig_filename
), emacs_strerror (errno
));
4148 else if (nread
== 0)
4150 total_read
+= nread
;
4153 /* Scan this bufferful from the end, comparing with
4154 the Emacs buffer. */
4155 bufpos
= total_read
;
4157 /* Compare with same_at_start to avoid counting some buffer text
4158 as matching both at the file's beginning and at the end. */
4159 while (bufpos
> 0 && same_at_end
> same_at_start
4160 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4161 same_at_end
--, bufpos
--;
4163 /* If we found a discrepancy, stop the scan.
4164 Otherwise loop around and scan the preceding bufferful. */
4167 /* If this discrepancy is because of code conversion,
4168 we cannot use this method; giveup and try the other. */
4169 if (same_at_end
> same_at_start
4170 && FETCH_BYTE (same_at_end
- 1) >= 0200
4171 && ! NILP (current_buffer
->enable_multibyte_characters
)
4172 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4173 giveup_match_end
= 1;
4182 if (! giveup_match_end
)
4186 /* We win! We can handle REPLACE the optimized way. */
4188 /* Extend the start of non-matching text area to multibyte
4189 character boundary. */
4190 if (! NILP (current_buffer
->enable_multibyte_characters
))
4191 while (same_at_start
> BEGV_BYTE
4192 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4195 /* Extend the end of non-matching text area to multibyte
4196 character boundary. */
4197 if (! NILP (current_buffer
->enable_multibyte_characters
))
4198 while (same_at_end
< ZV_BYTE
4199 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4202 /* Don't try to reuse the same piece of text twice. */
4203 overlap
= (same_at_start
- BEGV_BYTE
4204 - (same_at_end
+ st
.st_size
- ZV
));
4206 same_at_end
+= overlap
;
4208 /* Arrange to read only the nonmatching middle part of the file. */
4209 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4210 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4212 del_range_byte (same_at_start
, same_at_end
, 0);
4213 /* Insert from the file at the proper position. */
4214 temp
= BYTE_TO_CHAR (same_at_start
);
4215 SET_PT_BOTH (temp
, same_at_start
);
4217 /* If display currently starts at beginning of line,
4218 keep it that way. */
4219 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4220 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4222 replace_handled
= 1;
4226 /* If requested, replace the accessible part of the buffer
4227 with the file contents. Avoid replacing text at the
4228 beginning or end of the buffer that matches the file contents;
4229 that preserves markers pointing to the unchanged parts.
4231 Here we implement this feature for the case where code conversion
4232 is needed, in a simple way that needs a lot of memory.
4233 The preceding if-statement handles the case of no conversion
4234 in a more optimized way. */
4235 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4237 int same_at_start
= BEGV_BYTE
;
4238 int same_at_end
= ZV_BYTE
;
4241 /* Make sure that the gap is large enough. */
4242 int bufsize
= 2 * st
.st_size
;
4243 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4246 /* First read the whole file, performing code conversion into
4247 CONVERSION_BUFFER. */
4249 if (lseek (fd
, XINT (beg
), 0) < 0)
4251 xfree (conversion_buffer
);
4252 report_file_error ("Setting file position",
4253 Fcons (orig_filename
, Qnil
));
4256 total
= st
.st_size
; /* Total bytes in the file. */
4257 how_much
= 0; /* Bytes read from file so far. */
4258 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4259 unprocessed
= 0; /* Bytes not processed in previous loop. */
4261 while (how_much
< total
)
4263 /* try is reserved in some compilers (Microsoft C) */
4264 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4265 unsigned char *destination
= read_buf
+ unprocessed
;
4268 /* Allow quitting out of the actual I/O. */
4271 this = emacs_read (fd
, destination
, trytry
);
4274 if (this < 0 || this + unprocessed
== 0)
4282 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4284 int require
, result
;
4286 this += unprocessed
;
4288 /* If we are using more space than estimated,
4289 make CONVERSION_BUFFER bigger. */
4290 require
= decoding_buffer_size (&coding
, this);
4291 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4293 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4294 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4297 /* Convert this batch with results in CONVERSION_BUFFER. */
4298 if (how_much
>= total
) /* This is the last block. */
4299 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4300 if (coding
.composing
!= COMPOSITION_DISABLED
)
4301 coding_allocate_composition_data (&coding
, BEGV
);
4302 result
= decode_coding (&coding
, read_buf
,
4303 conversion_buffer
+ inserted
,
4304 this, bufsize
- inserted
);
4306 /* Save for next iteration whatever we didn't convert. */
4307 unprocessed
= this - coding
.consumed
;
4308 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4309 if (!NILP (current_buffer
->enable_multibyte_characters
))
4310 this = coding
.produced
;
4312 this = str_as_unibyte (conversion_buffer
+ inserted
,
4319 /* At this point, INSERTED is how many characters (i.e. bytes)
4320 are present in CONVERSION_BUFFER.
4321 HOW_MUCH should equal TOTAL,
4322 or should be <= 0 if we couldn't read the file. */
4326 xfree (conversion_buffer
);
4327 coding_free_composition_data (&coding
);
4328 error ("IO error reading %s: %s",
4329 SDATA (orig_filename
), emacs_strerror (errno
));
4332 /* Compare the beginning of the converted file
4333 with the buffer text. */
4336 while (bufpos
< inserted
&& same_at_start
< same_at_end
4337 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4338 same_at_start
++, bufpos
++;
4340 /* If the file matches the buffer completely,
4341 there's no need to replace anything. */
4343 if (bufpos
== inserted
)
4345 xfree (conversion_buffer
);
4346 coding_free_composition_data (&coding
);
4349 /* Truncate the buffer to the size of the file. */
4350 del_range_byte (same_at_start
, same_at_end
, 0);
4355 /* Extend the start of non-matching text area to multibyte
4356 character boundary. */
4357 if (! NILP (current_buffer
->enable_multibyte_characters
))
4358 while (same_at_start
> BEGV_BYTE
4359 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4362 /* Scan this bufferful from the end, comparing with
4363 the Emacs buffer. */
4366 /* Compare with same_at_start to avoid counting some buffer text
4367 as matching both at the file's beginning and at the end. */
4368 while (bufpos
> 0 && same_at_end
> same_at_start
4369 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4370 same_at_end
--, bufpos
--;
4372 /* Extend the end of non-matching text area to multibyte
4373 character boundary. */
4374 if (! NILP (current_buffer
->enable_multibyte_characters
))
4375 while (same_at_end
< ZV_BYTE
4376 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4379 /* Don't try to reuse the same piece of text twice. */
4380 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4382 same_at_end
+= overlap
;
4384 /* If display currently starts at beginning of line,
4385 keep it that way. */
4386 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4387 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4389 /* Replace the chars that we need to replace,
4390 and update INSERTED to equal the number of bytes
4391 we are taking from the file. */
4392 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4394 if (same_at_end
!= same_at_start
)
4396 del_range_byte (same_at_start
, same_at_end
, 0);
4398 same_at_start
= GPT_BYTE
;
4402 temp
= BYTE_TO_CHAR (same_at_start
);
4404 /* Insert from the file at the proper position. */
4405 SET_PT_BOTH (temp
, same_at_start
);
4406 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4408 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4409 coding_restore_composition (&coding
, Fcurrent_buffer ());
4410 coding_free_composition_data (&coding
);
4412 /* Set `inserted' to the number of inserted characters. */
4413 inserted
= PT
- temp
;
4414 /* Set point before the inserted characters. */
4415 SET_PT_BOTH (temp
, same_at_start
);
4417 xfree (conversion_buffer
);
4426 register Lisp_Object temp
;
4428 total
= XINT (end
) - XINT (beg
);
4430 /* Make sure point-max won't overflow after this insertion. */
4431 XSETINT (temp
, total
);
4432 if (total
!= XINT (temp
))
4433 error ("Maximum buffer size exceeded");
4436 /* For a special file, all we can do is guess. */
4437 total
= READ_BUF_SIZE
;
4439 if (NILP (visit
) && inserted
> 0)
4441 #ifdef CLASH_DETECTION
4442 if (!NILP (current_buffer
->file_truename
)
4443 /* Make binding buffer-file-name to nil effective. */
4444 && !NILP (current_buffer
->filename
)
4445 && SAVE_MODIFF
>= MODIFF
)
4447 #endif /* CLASH_DETECTION */
4448 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4452 if (GAP_SIZE
< total
)
4453 make_gap (total
- GAP_SIZE
);
4455 if (XINT (beg
) != 0 || !NILP (replace
))
4457 if (lseek (fd
, XINT (beg
), 0) < 0)
4458 report_file_error ("Setting file position",
4459 Fcons (orig_filename
, Qnil
));
4462 /* In the following loop, HOW_MUCH contains the total bytes read so
4463 far for a regular file, and not changed for a special file. But,
4464 before exiting the loop, it is set to a negative value if I/O
4468 /* Total bytes inserted. */
4471 /* Here, we don't do code conversion in the loop. It is done by
4472 code_convert_region after all data are read into the buffer. */
4474 int gap_size
= GAP_SIZE
;
4476 while (how_much
< total
)
4478 /* try is reserved in some compilers (Microsoft C) */
4479 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4486 /* Maybe make more room. */
4487 if (gap_size
< trytry
)
4489 make_gap (total
- gap_size
);
4490 gap_size
= GAP_SIZE
;
4493 /* Read from the file, capturing `quit'. When an
4494 error occurs, end the loop, and arrange for a quit
4495 to be signaled after decoding the text we read. */
4496 non_regular_fd
= fd
;
4497 non_regular_inserted
= inserted
;
4498 non_regular_nbytes
= trytry
;
4499 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4500 read_non_regular_quit
);
4511 /* Allow quitting out of the actual I/O. We don't make text
4512 part of the buffer until all the reading is done, so a C-g
4513 here doesn't do any harm. */
4516 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4528 /* For a regular file, where TOTAL is the real size,
4529 count HOW_MUCH to compare with it.
4530 For a special file, where TOTAL is just a buffer size,
4531 so don't bother counting in HOW_MUCH.
4532 (INSERTED is where we count the number of characters inserted.) */
4539 /* Now we have read all the file data into the gap.
4540 If it was empty, undo marking the buffer modified. */
4544 #ifdef CLASH_DETECTION
4546 unlock_file (current_buffer
->file_truename
);
4548 Vdeactivate_mark
= old_Vdeactivate_mark
;
4551 Vdeactivate_mark
= Qt
;
4553 /* Make the text read part of the buffer. */
4554 GAP_SIZE
-= inserted
;
4556 GPT_BYTE
+= inserted
;
4558 ZV_BYTE
+= inserted
;
4563 /* Put an anchor to ensure multi-byte form ends at gap. */
4568 /* Discard the unwind protect for closing the file. */
4572 error ("IO error reading %s: %s",
4573 SDATA (orig_filename
), emacs_strerror (errno
));
4577 if (! coding_system_decided
)
4579 /* The coding system is not yet decided. Decide it by an
4580 optimized method for handling `coding:' tag.
4582 Note that we can get here only if the buffer was empty
4583 before the insertion. */
4587 if (!NILP (Vcoding_system_for_read
))
4588 val
= Vcoding_system_for_read
;
4591 /* Since we are sure that the current buffer was empty
4592 before the insertion, we can toggle
4593 enable-multibyte-characters directly here without taking
4594 care of marker adjustment and byte combining problem. By
4595 this way, we can run Lisp program safely before decoding
4596 the inserted text. */
4597 Lisp_Object unwind_data
;
4598 int count
= SPECPDL_INDEX ();
4600 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4601 Fcons (current_buffer
->undo_list
,
4602 Fcurrent_buffer ()));
4603 current_buffer
->enable_multibyte_characters
= Qnil
;
4604 current_buffer
->undo_list
= Qt
;
4605 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4607 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4609 val
= call2 (Vset_auto_coding_function
,
4610 filename
, make_number (inserted
));
4615 /* If the coding system is not yet decided, check
4616 file-coding-system-alist. */
4617 Lisp_Object args
[6], coding_systems
;
4619 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4620 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4621 coding_systems
= Ffind_operation_coding_system (6, args
);
4622 if (CONSP (coding_systems
))
4623 val
= XCAR (coding_systems
);
4625 unbind_to (count
, Qnil
);
4626 inserted
= Z_BYTE
- BEG_BYTE
;
4629 /* The following kludgy code is to avoid some compiler bug.
4631 setup_coding_system (val, &coding);
4634 struct coding_system temp_coding
;
4635 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4636 bcopy (&temp_coding
, &coding
, sizeof coding
);
4638 /* Ensure we set Vlast_coding_system_used. */
4639 set_coding_system
= 1;
4641 if (NILP (current_buffer
->enable_multibyte_characters
)
4643 /* We must suppress all character code conversion except for
4644 end-of-line conversion. */
4645 setup_raw_text_coding_system (&coding
);
4646 coding
.src_multibyte
= 0;
4647 coding
.dst_multibyte
4648 = !NILP (current_buffer
->enable_multibyte_characters
);
4652 /* Can't do this if part of the buffer might be preserved. */
4654 && (coding
.type
== coding_type_no_conversion
4655 || coding
.type
== coding_type_raw_text
))
4657 /* Visiting a file with these coding system makes the buffer
4659 current_buffer
->enable_multibyte_characters
= Qnil
;
4660 coding
.dst_multibyte
= 0;
4663 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4665 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4667 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4669 inserted
= coding
.produced_char
;
4672 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4676 /* Now INSERTED is measured in characters. */
4679 /* Use the conversion type to determine buffer-file-type
4680 (find-buffer-file-type is now used to help determine the
4682 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4683 || coding
.eol_type
== CODING_EOL_LF
)
4684 && ! CODING_REQUIRE_DECODING (&coding
))
4685 current_buffer
->buffer_file_type
= Qt
;
4687 current_buffer
->buffer_file_type
= Qnil
;
4694 if (!EQ (current_buffer
->undo_list
, Qt
))
4695 current_buffer
->undo_list
= Qnil
;
4697 stat (SDATA (filename
), &st
);
4702 current_buffer
->modtime
= st
.st_mtime
;
4703 current_buffer
->filename
= orig_filename
;
4706 SAVE_MODIFF
= MODIFF
;
4707 current_buffer
->auto_save_modified
= MODIFF
;
4708 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4709 #ifdef CLASH_DETECTION
4712 if (!NILP (current_buffer
->file_truename
))
4713 unlock_file (current_buffer
->file_truename
);
4714 unlock_file (filename
);
4716 #endif /* CLASH_DETECTION */
4718 Fsignal (Qfile_error
,
4719 Fcons (build_string ("not a regular file"),
4720 Fcons (orig_filename
, Qnil
)));
4723 if (set_coding_system
)
4724 Vlast_coding_system_used
= coding
.symbol
;
4726 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4728 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4730 if (! NILP (insval
))
4732 CHECK_NUMBER (insval
);
4733 inserted
= XFASTINT (insval
);
4737 /* Decode file format */
4740 int empty_undo_list_p
= 0;
4742 /* If we're anyway going to discard undo information, don't
4743 record it in the first place. The buffer's undo list at this
4744 point is either nil or t when visiting a file. */
4747 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4748 current_buffer
->undo_list
= Qt
;
4751 insval
= call3 (Qformat_decode
,
4752 Qnil
, make_number (inserted
), visit
);
4753 CHECK_NUMBER (insval
);
4754 inserted
= XFASTINT (insval
);
4757 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4760 /* Call after-change hooks for the inserted text, aside from the case
4761 of normal visiting (not with REPLACE), which is done in a new buffer
4762 "before" the buffer is changed. */
4763 if (inserted
> 0 && total
> 0
4764 && (NILP (visit
) || !NILP (replace
)))
4766 signal_after_change (PT
, 0, inserted
);
4767 update_compositions (PT
, PT
, CHECK_BORDER
);
4770 p
= Vafter_insert_file_functions
;
4773 insval
= call1 (XCAR (p
), make_number (inserted
));
4776 CHECK_NUMBER (insval
);
4777 inserted
= XFASTINT (insval
);
4784 && current_buffer
->modtime
== -1)
4786 /* If visiting nonexistent file, return nil. */
4787 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4791 Fsignal (Qquit
, Qnil
);
4793 /* ??? Retval needs to be dealt with in all cases consistently. */
4795 val
= Fcons (orig_filename
,
4796 Fcons (make_number (inserted
),
4799 RETURN_UNGCPRO (unbind_to (count
, val
));
4802 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4803 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4804 Lisp_Object
, Lisp_Object
));
4806 /* If build_annotations switched buffers, switch back to BUF.
4807 Kill the temporary buffer that was selected in the meantime.
4809 Since this kill only the last temporary buffer, some buffers remain
4810 not killed if build_annotations switched buffers more than once.
4814 build_annotations_unwind (buf
)
4819 if (XBUFFER (buf
) == current_buffer
)
4821 tembuf
= Fcurrent_buffer ();
4823 Fkill_buffer (tembuf
);
4827 /* Decide the coding-system to encode the data with. */
4830 choose_write_coding_system (start
, end
, filename
,
4831 append
, visit
, lockname
, coding
)
4832 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4833 struct coding_system
*coding
;
4838 && NILP (Fstring_equal (current_buffer
->filename
,
4839 current_buffer
->auto_save_file_name
)))
4841 /* We use emacs-mule for auto saving... */
4842 setup_coding_system (Qemacs_mule
, coding
);
4843 /* ... but with the special flag to indicate not to strip off
4844 leading code of eight-bit-control chars. */
4846 goto done_setup_coding
;
4848 else if (!NILP (Vcoding_system_for_write
))
4850 val
= Vcoding_system_for_write
;
4851 if (coding_system_require_warning
4852 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4853 /* Confirm that VAL can surely encode the current region. */
4854 val
= call5 (Vselect_safe_coding_system_function
,
4855 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4860 /* If the variable `buffer-file-coding-system' is set locally,
4861 it means that the file was read with some kind of code
4862 conversion or the variable is explicitly set by users. We
4863 had better write it out with the same coding system even if
4864 `enable-multibyte-characters' is nil.
4866 If it is not set locally, we anyway have to convert EOL
4867 format if the default value of `buffer-file-coding-system'
4868 tells that it is not Unix-like (LF only) format. */
4869 int using_default_coding
= 0;
4870 int force_raw_text
= 0;
4872 val
= current_buffer
->buffer_file_coding_system
;
4874 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4877 if (NILP (current_buffer
->enable_multibyte_characters
))
4883 /* Check file-coding-system-alist. */
4884 Lisp_Object args
[7], coding_systems
;
4886 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4887 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4889 coding_systems
= Ffind_operation_coding_system (7, args
);
4890 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4891 val
= XCDR (coding_systems
);
4895 && !NILP (current_buffer
->buffer_file_coding_system
))
4897 /* If we still have not decided a coding system, use the
4898 default value of buffer-file-coding-system. */
4899 val
= current_buffer
->buffer_file_coding_system
;
4900 using_default_coding
= 1;
4904 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4905 /* Confirm that VAL can surely encode the current region. */
4906 val
= call5 (Vselect_safe_coding_system_function
,
4907 start
, end
, val
, Qnil
, filename
);
4909 setup_coding_system (Fcheck_coding_system (val
), coding
);
4910 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4911 && !using_default_coding
)
4913 if (! EQ (default_buffer_file_coding
.symbol
,
4914 buffer_defaults
.buffer_file_coding_system
))
4915 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4916 &default_buffer_file_coding
);
4917 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4919 Lisp_Object subsidiaries
;
4921 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4922 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4923 if (VECTORP (subsidiaries
)
4924 && XVECTOR (subsidiaries
)->size
== 3)
4926 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4931 setup_raw_text_coding_system (coding
);
4932 goto done_setup_coding
;
4935 setup_coding_system (Fcheck_coding_system (val
), coding
);
4938 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4939 coding
->eol_type
= system_eol_type
;
4940 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4941 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4944 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4945 "r\nFWrite region to file: \ni\ni\ni\np",
4946 doc
: /* Write current region into specified file.
4947 When called from a program, requires three arguments:
4948 START, END and FILENAME. START and END are normally buffer positions
4949 specifying the part of the buffer to write.
4950 If START is nil, that means to use the entire buffer contents.
4951 If START is a string, then output that string to the file
4952 instead of any buffer contents; END is ignored.
4954 Optional fourth argument APPEND if non-nil means
4955 append to existing file contents (if any). If it is an integer,
4956 seek to that offset in the file before writing.
4957 Optional fifth argument VISIT, if t or a string, means
4958 set the last-save-file-modtime of buffer to this file's modtime
4959 and mark buffer not modified.
4960 If VISIT is a string, it is a second file name;
4961 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4962 VISIT is also the file name to lock and unlock for clash detection.
4963 If VISIT is neither t nor nil nor a string,
4964 that means do not display the \"Wrote file\" message.
4965 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4966 use for locking and unlocking, overriding FILENAME and VISIT.
4967 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4968 for an existing file with the same name. If MUSTBENEW is `excl',
4969 that means to get an error if the file already exists; never overwrite.
4970 If MUSTBENEW is neither nil nor `excl', that means ask for
4971 confirmation before overwriting, but do go ahead and overwrite the file
4972 if the user confirms.
4974 This does code conversion according to the value of
4975 `coding-system-for-write', `buffer-file-coding-system', or
4976 `file-coding-system-alist', and sets the variable
4977 `last-coding-system-used' to the coding system actually used. */)
4978 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4979 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4984 const unsigned char *fn
;
4987 int count
= SPECPDL_INDEX ();
4990 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4992 Lisp_Object handler
;
4993 Lisp_Object visit_file
;
4994 Lisp_Object annotations
;
4995 Lisp_Object encoded_filename
;
4996 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4997 int quietly
= !NILP (visit
);
4998 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4999 struct buffer
*given_buffer
;
5001 int buffer_file_type
= O_BINARY
;
5003 struct coding_system coding
;
5005 if (current_buffer
->base_buffer
&& visiting
)
5006 error ("Cannot do file visiting in an indirect buffer");
5008 if (!NILP (start
) && !STRINGP (start
))
5009 validate_region (&start
, &end
);
5012 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5014 filename
= Fexpand_file_name (filename
, Qnil
);
5016 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5017 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5019 if (STRINGP (visit
))
5020 visit_file
= Fexpand_file_name (visit
, Qnil
);
5022 visit_file
= filename
;
5024 if (NILP (lockname
))
5025 lockname
= visit_file
;
5029 /* If the file name has special constructs in it,
5030 call the corresponding file handler. */
5031 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5032 /* If FILENAME has no handler, see if VISIT has one. */
5033 if (NILP (handler
) && STRINGP (visit
))
5034 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5036 if (!NILP (handler
))
5039 val
= call6 (handler
, Qwrite_region
, start
, end
,
5040 filename
, append
, visit
);
5044 SAVE_MODIFF
= MODIFF
;
5045 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5046 current_buffer
->filename
= visit_file
;
5052 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5054 /* Special kludge to simplify auto-saving. */
5057 XSETFASTINT (start
, BEG
);
5058 XSETFASTINT (end
, Z
);
5062 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5063 count1
= SPECPDL_INDEX ();
5065 given_buffer
= current_buffer
;
5067 if (!STRINGP (start
))
5069 annotations
= build_annotations (start
, end
);
5071 if (current_buffer
!= given_buffer
)
5073 XSETFASTINT (start
, BEGV
);
5074 XSETFASTINT (end
, ZV
);
5080 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5082 /* Decide the coding-system to encode the data with.
5083 We used to make this choice before calling build_annotations, but that
5084 leads to problems when a write-annotate-function takes care of
5085 unsavable chars (as was the case with X-Symbol). */
5086 choose_write_coding_system (start
, end
, filename
,
5087 append
, visit
, lockname
, &coding
);
5088 Vlast_coding_system_used
= coding
.symbol
;
5090 given_buffer
= current_buffer
;
5091 if (! STRINGP (start
))
5093 annotations
= build_annotations_2 (start
, end
,
5094 coding
.pre_write_conversion
, annotations
);
5095 if (current_buffer
!= given_buffer
)
5097 XSETFASTINT (start
, BEGV
);
5098 XSETFASTINT (end
, ZV
);
5102 #ifdef CLASH_DETECTION
5105 #if 0 /* This causes trouble for GNUS. */
5106 /* If we've locked this file for some other buffer,
5107 query before proceeding. */
5108 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5109 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5112 lock_file (lockname
);
5114 #endif /* CLASH_DETECTION */
5116 encoded_filename
= ENCODE_FILE (filename
);
5118 fn
= SDATA (encoded_filename
);
5122 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5123 #else /* not DOS_NT */
5124 desc
= emacs_open (fn
, O_WRONLY
, 0);
5125 #endif /* not DOS_NT */
5127 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5129 if (auto_saving
) /* Overwrite any previous version of autosave file */
5131 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5132 desc
= emacs_open (fn
, O_RDWR
, 0);
5134 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5135 ? SDATA (current_buffer
->filename
) : 0,
5138 else /* Write to temporary name and rename if no errors */
5140 Lisp_Object temp_name
;
5141 temp_name
= Ffile_name_directory (filename
);
5143 if (!NILP (temp_name
))
5145 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5146 build_string ("$$SAVE$$")));
5147 fname
= SDATA (filename
);
5148 fn
= SDATA (temp_name
);
5149 desc
= creat_copy_attrs (fname
, fn
);
5152 /* If we can't open the temporary file, try creating a new
5153 version of the original file. VMS "creat" creates a
5154 new version rather than truncating an existing file. */
5157 desc
= creat (fn
, 0666);
5158 #if 0 /* This can clobber an existing file and fail to replace it,
5159 if the user runs out of space. */
5162 /* We can't make a new version;
5163 try to truncate and rewrite existing version if any. */
5165 desc
= emacs_open (fn
, O_RDWR
, 0);
5171 desc
= creat (fn
, 0666);
5175 desc
= emacs_open (fn
,
5176 O_WRONLY
| O_CREAT
| buffer_file_type
5177 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5178 S_IREAD
| S_IWRITE
);
5179 #else /* not DOS_NT */
5180 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5181 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5182 auto_saving
? auto_save_mode_bits
: 0666);
5183 #endif /* not DOS_NT */
5184 #endif /* not VMS */
5188 #ifdef CLASH_DETECTION
5190 if (!auto_saving
) unlock_file (lockname
);
5192 #endif /* CLASH_DETECTION */
5194 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5197 record_unwind_protect (close_file_unwind
, make_number (desc
));
5199 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5203 if (NUMBERP (append
))
5204 ret
= lseek (desc
, XINT (append
), 1);
5206 ret
= lseek (desc
, 0, 2);
5209 #ifdef CLASH_DETECTION
5210 if (!auto_saving
) unlock_file (lockname
);
5211 #endif /* CLASH_DETECTION */
5213 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5221 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5222 * if we do writes that don't end with a carriage return. Furthermore
5223 * it cannot handle writes of more then 16K. The modified
5224 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5225 * this EXCEPT for the last record (iff it doesn't end with a carriage
5226 * return). This implies that if your buffer doesn't end with a carriage
5227 * return, you get one free... tough. However it also means that if
5228 * we make two calls to sys_write (a la the following code) you can
5229 * get one at the gap as well. The easiest way to fix this (honest)
5230 * is to move the gap to the next newline (or the end of the buffer).
5235 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5236 move_gap (find_next_newline (GPT
, 1));
5238 /* Whether VMS or not, we must move the gap to the next of newline
5239 when we must put designation sequences at beginning of line. */
5240 if (INTEGERP (start
)
5241 && coding
.type
== coding_type_iso2022
5242 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5243 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5245 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5246 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5247 move_gap_both (PT
, PT_BYTE
);
5248 SET_PT_BOTH (opoint
, opoint_byte
);
5255 if (STRINGP (start
))
5257 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5258 &annotations
, &coding
);
5261 else if (XINT (start
) != XINT (end
))
5263 tem
= CHAR_TO_BYTE (XINT (start
));
5265 if (XINT (start
) < GPT
)
5267 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5268 min (GPT
, XINT (end
)) - XINT (start
),
5269 &annotations
, &coding
);
5273 if (XINT (end
) > GPT
&& !failure
)
5275 tem
= max (XINT (start
), GPT
);
5276 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5277 &annotations
, &coding
);
5283 /* If file was empty, still need to write the annotations */
5284 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5285 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5289 if (CODING_REQUIRE_FLUSHING (&coding
)
5290 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5293 /* We have to flush out a data. */
5294 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5295 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5302 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5303 Disk full in NFS may be reported here. */
5304 /* mib says that closing the file will try to write as fast as NFS can do
5305 it, and that means the fsync here is not crucial for autosave files. */
5306 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5308 /* If fsync fails with EINTR, don't treat that as serious. */
5310 failure
= 1, save_errno
= errno
;
5314 /* Spurious "file has changed on disk" warnings have been
5315 observed on Suns as well.
5316 It seems that `close' can change the modtime, under nfs.
5318 (This has supposedly been fixed in Sunos 4,
5319 but who knows about all the other machines with NFS?) */
5322 /* On VMS and APOLLO, must do the stat after the close
5323 since closing changes the modtime. */
5326 /* Recall that #if defined does not work on VMS. */
5333 /* NFS can report a write failure now. */
5334 if (emacs_close (desc
) < 0)
5335 failure
= 1, save_errno
= errno
;
5338 /* If we wrote to a temporary name and had no errors, rename to real name. */
5342 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5350 /* Discard the unwind protect for close_file_unwind. */
5351 specpdl_ptr
= specpdl
+ count1
;
5352 /* Restore the original current buffer. */
5353 visit_file
= unbind_to (count
, visit_file
);
5355 #ifdef CLASH_DETECTION
5357 unlock_file (lockname
);
5358 #endif /* CLASH_DETECTION */
5360 /* Do this before reporting IO error
5361 to avoid a "file has changed on disk" warning on
5362 next attempt to save. */
5364 current_buffer
->modtime
= st
.st_mtime
;
5367 error ("IO error writing %s: %s", SDATA (filename
),
5368 emacs_strerror (save_errno
));
5372 SAVE_MODIFF
= MODIFF
;
5373 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5374 current_buffer
->filename
= visit_file
;
5375 update_mode_lines
++;
5380 && ! NILP (Fstring_equal (current_buffer
->filename
,
5381 current_buffer
->auto_save_file_name
)))
5382 SAVE_MODIFF
= MODIFF
;
5388 message_with_string ((INTEGERP (append
)
5398 Lisp_Object
merge ();
5400 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5401 doc
: /* Return t if (car A) is numerically less than (car B). */)
5405 return Flss (Fcar (a
), Fcar (b
));
5408 /* Build the complete list of annotations appropriate for writing out
5409 the text between START and END, by calling all the functions in
5410 write-region-annotate-functions and merging the lists they return.
5411 If one of these functions switches to a different buffer, we assume
5412 that buffer contains altered text. Therefore, the caller must
5413 make sure to restore the current buffer in all cases,
5414 as save-excursion would do. */
5417 build_annotations (start
, end
)
5418 Lisp_Object start
, end
;
5420 Lisp_Object annotations
;
5422 struct gcpro gcpro1
, gcpro2
;
5423 Lisp_Object original_buffer
;
5424 int i
, used_global
= 0;
5426 XSETBUFFER (original_buffer
, current_buffer
);
5429 p
= Vwrite_region_annotate_functions
;
5430 GCPRO2 (annotations
, p
);
5433 struct buffer
*given_buffer
= current_buffer
;
5434 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5435 { /* Use the global value of the hook. */
5438 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5440 p
= Fappend (2, arg
);
5443 Vwrite_region_annotations_so_far
= annotations
;
5444 res
= call2 (XCAR (p
), start
, end
);
5445 /* If the function makes a different buffer current,
5446 assume that means this buffer contains altered text to be output.
5447 Reset START and END from the buffer bounds
5448 and discard all previous annotations because they should have
5449 been dealt with by this function. */
5450 if (current_buffer
!= given_buffer
)
5452 XSETFASTINT (start
, BEGV
);
5453 XSETFASTINT (end
, ZV
);
5456 Flength (res
); /* Check basic validity of return value */
5457 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5461 /* Now do the same for annotation functions implied by the file-format */
5462 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5463 p
= current_buffer
->auto_save_file_format
;
5465 p
= current_buffer
->file_format
;
5466 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5468 struct buffer
*given_buffer
= current_buffer
;
5470 Vwrite_region_annotations_so_far
= annotations
;
5472 /* Value is either a list of annotations or nil if the function
5473 has written annotations to a temporary buffer, which is now
5475 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5476 original_buffer
, make_number (i
));
5477 if (current_buffer
!= given_buffer
)
5479 XSETFASTINT (start
, BEGV
);
5480 XSETFASTINT (end
, ZV
);
5485 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5493 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5494 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5496 struct gcpro gcpro1
;
5499 GCPRO1 (annotations
);
5500 /* At last, do the same for the function PRE_WRITE_CONVERSION
5501 implied by the current coding-system. */
5502 if (!NILP (pre_write_conversion
))
5504 struct buffer
*given_buffer
= current_buffer
;
5505 Vwrite_region_annotations_so_far
= annotations
;
5506 res
= call2 (pre_write_conversion
, start
, end
);
5508 annotations
= (current_buffer
!= given_buffer
5510 : merge (annotations
, res
, Qcar_less_than_car
));
5517 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5518 If STRING is nil, POS is the character position in the current buffer.
5519 Intersperse with them the annotations from *ANNOT
5520 which fall within the range of POS to POS + NCHARS,
5521 each at its appropriate position.
5523 We modify *ANNOT by discarding elements as we use them up.
5525 The return value is negative in case of system call failure. */
5528 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5531 register int nchars
;
5534 struct coding_system
*coding
;
5538 int lastpos
= pos
+ nchars
;
5540 while (NILP (*annot
) || CONSP (*annot
))
5542 tem
= Fcar_safe (Fcar (*annot
));
5545 nextpos
= XFASTINT (tem
);
5547 /* If there are no more annotations in this range,
5548 output the rest of the range all at once. */
5549 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5550 return e_write (desc
, string
, pos
, lastpos
, coding
);
5552 /* Output buffer text up to the next annotation's position. */
5555 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5559 /* Output the annotation. */
5560 tem
= Fcdr (Fcar (*annot
));
5563 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5566 *annot
= Fcdr (*annot
);
5571 #ifndef WRITE_BUF_SIZE
5572 #define WRITE_BUF_SIZE (16 * 1024)
5575 /* Write text in the range START and END into descriptor DESC,
5576 encoding them with coding system CODING. If STRING is nil, START
5577 and END are character positions of the current buffer, else they
5578 are indexes to the string STRING. */
5581 e_write (desc
, string
, start
, end
, coding
)
5585 struct coding_system
*coding
;
5587 register char *addr
;
5588 register int nbytes
;
5589 char buf
[WRITE_BUF_SIZE
];
5593 coding
->composing
= COMPOSITION_DISABLED
;
5594 if (coding
->composing
!= COMPOSITION_DISABLED
)
5595 coding_save_composition (coding
, start
, end
, string
);
5597 if (STRINGP (string
))
5599 addr
= SDATA (string
);
5600 nbytes
= SBYTES (string
);
5601 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5603 else if (start
< end
)
5605 /* It is assured that the gap is not in the range START and END-1. */
5606 addr
= CHAR_POS_ADDR (start
);
5607 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5608 coding
->src_multibyte
5609 = !NILP (current_buffer
->enable_multibyte_characters
);
5615 coding
->src_multibyte
= 1;
5618 /* We used to have a code for handling selective display here. But,
5619 now it is handled within encode_coding. */
5624 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5625 if (coding
->produced
> 0)
5627 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5628 if (coding
->produced
)
5634 nbytes
-= coding
->consumed
;
5635 addr
+= coding
->consumed
;
5636 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5639 /* The source text ends by an incomplete multibyte form.
5640 There's no way other than write it out as is. */
5641 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5650 start
+= coding
->consumed_char
;
5651 if (coding
->cmp_data
)
5652 coding_adjust_composition_offset (coding
, start
);
5655 if (coding
->cmp_data
)
5656 coding_free_composition_data (coding
);
5661 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5662 Sverify_visited_file_modtime
, 1, 1, 0,
5663 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5664 This means that the file has not been changed since it was visited or saved.
5665 See Info node `(elisp)Modification Time' for more details. */)
5671 Lisp_Object handler
;
5672 Lisp_Object filename
;
5677 if (!STRINGP (b
->filename
)) return Qt
;
5678 if (b
->modtime
== 0) return Qt
;
5680 /* If the file name has special constructs in it,
5681 call the corresponding file handler. */
5682 handler
= Ffind_file_name_handler (b
->filename
,
5683 Qverify_visited_file_modtime
);
5684 if (!NILP (handler
))
5685 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5687 filename
= ENCODE_FILE (b
->filename
);
5689 if (stat (SDATA (filename
), &st
) < 0)
5691 /* If the file doesn't exist now and didn't exist before,
5692 we say that it isn't modified, provided the error is a tame one. */
5693 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5698 if (st
.st_mtime
== b
->modtime
5699 /* If both are positive, accept them if they are off by one second. */
5700 || (st
.st_mtime
> 0 && b
->modtime
> 0
5701 && (st
.st_mtime
== b
->modtime
+ 1
5702 || st
.st_mtime
== b
->modtime
- 1)))
5707 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5708 Sclear_visited_file_modtime
, 0, 0, 0,
5709 doc
: /* Clear out records of last mod time of visited file.
5710 Next attempt to save will certainly not complain of a discrepancy. */)
5713 current_buffer
->modtime
= 0;
5717 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5718 Svisited_file_modtime
, 0, 0, 0,
5719 doc
: /* Return the current buffer's recorded visited file modification time.
5720 The value is a list of the form (HIGH LOW), like the time values
5721 that `file-attributes' returns. If the current buffer has no recorded
5722 file modification time, this function returns 0.
5723 See Info node `(elisp)Modification Time' for more details. */)
5727 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5729 return list2 (XCAR (tcons
), XCDR (tcons
));
5733 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5734 Sset_visited_file_modtime
, 0, 1, 0,
5735 doc
: /* Update buffer's recorded modification time from the visited file's time.
5736 Useful if the buffer was not read from the file normally
5737 or if the file itself has been changed for some known benign reason.
5738 An argument specifies the modification time value to use
5739 \(instead of that of the visited file), in the form of a list
5740 \(HIGH . LOW) or (HIGH LOW). */)
5742 Lisp_Object time_list
;
5744 if (!NILP (time_list
))
5745 current_buffer
->modtime
= cons_to_long (time_list
);
5748 register Lisp_Object filename
;
5750 Lisp_Object handler
;
5752 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5754 /* If the file name has special constructs in it,
5755 call the corresponding file handler. */
5756 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5757 if (!NILP (handler
))
5758 /* The handler can find the file name the same way we did. */
5759 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5761 filename
= ENCODE_FILE (filename
);
5763 if (stat (SDATA (filename
), &st
) >= 0)
5764 current_buffer
->modtime
= st
.st_mtime
;
5771 auto_save_error (error
)
5774 Lisp_Object args
[3], msg
;
5776 struct gcpro gcpro1
;
5782 args
[0] = build_string ("Auto-saving %s: %s");
5783 args
[1] = current_buffer
->name
;
5784 args
[2] = Ferror_message_string (error
);
5785 msg
= Fformat (3, args
);
5787 nbytes
= SBYTES (msg
);
5788 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5789 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5791 for (i
= 0; i
< 3; ++i
)
5794 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5796 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5797 Fsleep_for (make_number (1), Qnil
);
5811 auto_save_mode_bits
= 0666;
5813 /* Get visited file's mode to become the auto save file's mode. */
5814 if (! NILP (current_buffer
->filename
))
5816 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5817 /* But make sure we can overwrite it later! */
5818 auto_save_mode_bits
= st
.st_mode
| 0600;
5819 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5821 /* Remote files don't cooperate with stat. */
5822 auto_save_mode_bits
= XINT (modes
) | 0600;
5826 Fwrite_region (Qnil
, Qnil
,
5827 current_buffer
->auto_save_file_name
,
5828 Qnil
, Qlambda
, Qnil
, Qnil
);
5832 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5835 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5843 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5846 minibuffer_auto_raise
= XINT (value
);
5851 do_auto_save_make_dir (dir
)
5854 return call2 (Qmake_directory
, dir
, Qt
);
5858 do_auto_save_eh (ignore
)
5864 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5865 doc
: /* Auto-save all buffers that need it.
5866 This is all buffers that have auto-saving enabled
5867 and are changed since last auto-saved.
5868 Auto-saving writes the buffer into a file
5869 so that your editing is not lost if the system crashes.
5870 This file is not the file you visited; that changes only when you save.
5871 Normally we run the normal hook `auto-save-hook' before saving.
5873 A non-nil NO-MESSAGE argument means do not print any message if successful.
5874 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5875 (no_message
, current_only
)
5876 Lisp_Object no_message
, current_only
;
5878 struct buffer
*old
= current_buffer
, *b
;
5879 Lisp_Object tail
, buf
;
5881 int do_handled_files
;
5883 FILE *stream
= NULL
;
5884 int count
= SPECPDL_INDEX ();
5885 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5886 int old_message_p
= 0;
5887 struct gcpro gcpro1
, gcpro2
;
5889 if (max_specpdl_size
< specpdl_size
+ 40)
5890 max_specpdl_size
= specpdl_size
+ 40;
5895 if (NILP (no_message
))
5897 old_message_p
= push_message ();
5898 record_unwind_protect (pop_message_unwind
, Qnil
);
5901 /* Ordinarily don't quit within this function,
5902 but don't make it impossible to quit (in case we get hung in I/O). */
5906 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5907 point to non-strings reached from Vbuffer_alist. */
5909 if (!NILP (Vrun_hooks
))
5910 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5912 if (STRINGP (Vauto_save_list_file_name
))
5914 Lisp_Object listfile
;
5916 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5918 /* Don't try to create the directory when shutting down Emacs,
5919 because creating the directory might signal an error, and
5920 that would leave Emacs in a strange state. */
5921 if (!NILP (Vrun_hooks
))
5925 GCPRO2 (dir
, listfile
);
5926 dir
= Ffile_name_directory (listfile
);
5927 if (NILP (Ffile_directory_p (dir
)))
5928 internal_condition_case_1 (do_auto_save_make_dir
,
5929 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5934 stream
= fopen (SDATA (listfile
), "w");
5937 record_unwind_protect (do_auto_save_unwind
,
5938 make_save_value (stream
, 0));
5939 record_unwind_protect (do_auto_save_unwind_1
,
5940 make_number (minibuffer_auto_raise
));
5941 minibuffer_auto_raise
= 0;
5944 /* On first pass, save all files that don't have handlers.
5945 On second pass, save all files that do have handlers.
5947 If Emacs is crashing, the handlers may tweak what is causing
5948 Emacs to crash in the first place, and it would be a shame if
5949 Emacs failed to autosave perfectly ordinary files because it
5950 couldn't handle some ange-ftp'd file. */
5952 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5953 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5955 buf
= XCDR (XCAR (tail
));
5958 /* Record all the buffers that have auto save mode
5959 in the special file that lists them. For each of these buffers,
5960 Record visited name (if any) and auto save name. */
5961 if (STRINGP (b
->auto_save_file_name
)
5962 && stream
!= NULL
&& do_handled_files
== 0)
5964 if (!NILP (b
->filename
))
5966 fwrite (SDATA (b
->filename
), 1,
5967 SBYTES (b
->filename
), stream
);
5969 putc ('\n', stream
);
5970 fwrite (SDATA (b
->auto_save_file_name
), 1,
5971 SBYTES (b
->auto_save_file_name
), stream
);
5972 putc ('\n', stream
);
5975 if (!NILP (current_only
)
5976 && b
!= current_buffer
)
5979 /* Don't auto-save indirect buffers.
5980 The base buffer takes care of it. */
5984 /* Check for auto save enabled
5985 and file changed since last auto save
5986 and file changed since last real save. */
5987 if (STRINGP (b
->auto_save_file_name
)
5988 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5989 && b
->auto_save_modified
< BUF_MODIFF (b
)
5990 /* -1 means we've turned off autosaving for a while--see below. */
5991 && XINT (b
->save_length
) >= 0
5992 && (do_handled_files
5993 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5996 EMACS_TIME before_time
, after_time
;
5998 EMACS_GET_TIME (before_time
);
6000 /* If we had a failure, don't try again for 20 minutes. */
6001 if (b
->auto_save_failure_time
>= 0
6002 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6005 if ((XFASTINT (b
->save_length
) * 10
6006 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6007 /* A short file is likely to change a large fraction;
6008 spare the user annoying messages. */
6009 && XFASTINT (b
->save_length
) > 5000
6010 /* These messages are frequent and annoying for `*mail*'. */
6011 && !EQ (b
->filename
, Qnil
)
6012 && NILP (no_message
))
6014 /* It has shrunk too much; turn off auto-saving here. */
6015 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6016 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6018 minibuffer_auto_raise
= 0;
6019 /* Turn off auto-saving until there's a real save,
6020 and prevent any more warnings. */
6021 XSETINT (b
->save_length
, -1);
6022 Fsleep_for (make_number (1), Qnil
);
6025 set_buffer_internal (b
);
6026 if (!auto_saved
&& NILP (no_message
))
6027 message1 ("Auto-saving...");
6028 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6030 b
->auto_save_modified
= BUF_MODIFF (b
);
6031 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6032 set_buffer_internal (old
);
6034 EMACS_GET_TIME (after_time
);
6036 /* If auto-save took more than 60 seconds,
6037 assume it was an NFS failure that got a timeout. */
6038 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6039 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6043 /* Prevent another auto save till enough input events come in. */
6044 record_auto_save ();
6046 if (auto_saved
&& NILP (no_message
))
6050 /* If we are going to restore an old message,
6051 give time to read ours. */
6052 sit_for (1, 0, 0, 0, 0);
6056 /* If we displayed a message and then restored a state
6057 with no message, leave a "done" message on the screen. */
6058 message1 ("Auto-saving...done");
6063 /* This restores the message-stack status. */
6064 unbind_to (count
, Qnil
);
6068 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6069 Sset_buffer_auto_saved
, 0, 0, 0,
6070 doc
: /* Mark current buffer as auto-saved with its current text.
6071 No auto-save file will be written until the buffer changes again. */)
6074 current_buffer
->auto_save_modified
= MODIFF
;
6075 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6076 current_buffer
->auto_save_failure_time
= -1;
6080 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6081 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6082 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6085 current_buffer
->auto_save_failure_time
= -1;
6089 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6091 doc
: /* Return t if current buffer has been auto-saved recently.
6092 More precisely, if it has been auto-saved since last read from or saved
6093 in the visited file. If the buffer has no visited file,
6094 then any auto-save counts as "recent". */)
6097 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6100 /* Reading and completing file names */
6101 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6103 /* In the string VAL, change each $ to $$ and return the result. */
6106 double_dollars (val
)
6109 register const unsigned char *old
;
6110 register unsigned char *new;
6114 osize
= SBYTES (val
);
6116 /* Count the number of $ characters. */
6117 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6118 if (*old
++ == '$') count
++;
6122 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6125 for (n
= osize
; n
> 0; n
--)
6139 read_file_name_cleanup (arg
)
6142 return (current_buffer
->directory
= arg
);
6145 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6147 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6148 (string
, dir
, action
)
6149 Lisp_Object string
, dir
, action
;
6150 /* action is nil for complete, t for return list of completions,
6151 lambda for verify final value */
6153 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6155 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6157 CHECK_STRING (string
);
6164 /* No need to protect ACTION--we only compare it with t and nil. */
6165 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6167 if (SCHARS (string
) == 0)
6169 if (EQ (action
, Qlambda
))
6177 orig_string
= string
;
6178 string
= Fsubstitute_in_file_name (string
);
6179 changed
= NILP (Fstring_equal (string
, orig_string
));
6180 name
= Ffile_name_nondirectory (string
);
6181 val
= Ffile_name_directory (string
);
6183 realdir
= Fexpand_file_name (val
, realdir
);
6188 specdir
= Ffile_name_directory (string
);
6189 val
= Ffile_name_completion (name
, realdir
);
6194 return double_dollars (string
);
6198 if (!NILP (specdir
))
6199 val
= concat2 (specdir
, val
);
6201 return double_dollars (val
);
6204 #endif /* not VMS */
6208 if (EQ (action
, Qt
))
6210 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6214 if (NILP (Vread_file_name_predicate
)
6215 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6219 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6221 /* Brute-force speed up for directory checking:
6222 Discard strings which don't end in a slash. */
6223 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6225 Lisp_Object tem
= XCAR (all
);
6227 if (STRINGP (tem
) &&
6228 (len
= SCHARS (tem
), len
> 0) &&
6229 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6230 comp
= Fcons (tem
, comp
);
6236 /* Must do it the hard (and slow) way. */
6238 GCPRO3 (all
, comp
, specdir
);
6239 count
= SPECPDL_INDEX ();
6240 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6241 current_buffer
->directory
= realdir
;
6242 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6244 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6246 comp
= Fcons (XCAR (all
), comp
);
6248 unbind_to (count
, Qnil
);
6251 return Fnreverse (comp
);
6254 /* Only other case actually used is ACTION = lambda */
6256 /* Supposedly this helps commands such as `cd' that read directory names,
6257 but can someone explain how it helps them? -- RMS */
6258 if (SCHARS (name
) == 0)
6261 string
= Fexpand_file_name (string
, dir
);
6262 if (!NILP (Vread_file_name_predicate
))
6263 return call1 (Vread_file_name_predicate
, string
);
6264 return Ffile_exists_p (string
);
6267 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6268 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6269 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6270 The return value is only relevant for a call to `read-file-name' that happens
6271 before any other event (mouse or keypress) is handeled. */)
6274 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6275 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6284 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6285 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6286 Value is not expanded---you must call `expand-file-name' yourself.
6287 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6288 the same non-empty string that was inserted by this function.
6289 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6290 except that if INITIAL is specified, that combined with DIR is used.)
6291 If the user exits with an empty minibuffer, this function returns
6292 an empty string. (This can only happen if the user erased the
6293 pre-inserted contents or if `insert-default-directory' is nil.)
6294 Fourth arg MUSTMATCH non-nil means require existing file's name.
6295 Non-nil and non-t means also require confirmation after completion.
6296 Fifth arg INITIAL specifies text to start with.
6297 If optional sixth arg PREDICATE is non-nil, possible completions and
6298 the resulting file name must satisfy (funcall PREDICATE NAME).
6299 DIR should be an absolute directory name. It defaults to the value of
6300 `default-directory'.
6302 If this command was invoked with the mouse, use a file dialog box if
6303 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6304 provides a file dialog box.
6306 See also `read-file-name-completion-ignore-case'
6307 and `read-file-name-function'. */)
6308 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6309 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6311 Lisp_Object val
, insdef
, tem
;
6312 struct gcpro gcpro1
, gcpro2
;
6313 register char *homedir
;
6314 Lisp_Object decoded_homedir
;
6315 int replace_in_history
= 0;
6316 int add_to_history
= 0;
6320 dir
= current_buffer
->directory
;
6321 if (NILP (Ffile_name_absolute_p (dir
)))
6322 dir
= Fexpand_file_name (dir
, Qnil
);
6323 if (NILP (default_filename
))
6326 ? Fexpand_file_name (initial
, dir
)
6327 : current_buffer
->filename
);
6329 /* If dir starts with user's homedir, change that to ~. */
6330 homedir
= (char *) egetenv ("HOME");
6332 /* homedir can be NULL in temacs, since Vprocess_environment is not
6333 yet set up. We shouldn't crash in that case. */
6336 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6337 CORRECT_DIR_SEPS (homedir
);
6342 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6345 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6346 SBYTES (decoded_homedir
))
6347 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6349 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6350 dir
= concat2 (build_string ("~"), dir
);
6352 /* Likewise for default_filename. */
6354 && STRINGP (default_filename
)
6355 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6356 SBYTES (decoded_homedir
))
6357 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6360 = Fsubstring (default_filename
,
6361 make_number (SCHARS (decoded_homedir
)), Qnil
);
6362 default_filename
= concat2 (build_string ("~"), default_filename
);
6364 if (!NILP (default_filename
))
6366 CHECK_STRING (default_filename
);
6367 default_filename
= double_dollars (default_filename
);
6370 if (insert_default_directory
&& STRINGP (dir
))
6373 if (!NILP (initial
))
6375 Lisp_Object args
[2], pos
;
6379 insdef
= Fconcat (2, args
);
6380 pos
= make_number (SCHARS (double_dollars (dir
)));
6381 insdef
= Fcons (double_dollars (insdef
), pos
);
6384 insdef
= double_dollars (insdef
);
6386 else if (STRINGP (initial
))
6387 insdef
= Fcons (double_dollars (initial
), make_number (0));
6391 if (!NILP (Vread_file_name_function
))
6393 Lisp_Object args
[7];
6395 GCPRO2 (insdef
, default_filename
);
6396 args
[0] = Vread_file_name_function
;
6399 args
[3] = default_filename
;
6400 args
[4] = mustmatch
;
6402 args
[6] = predicate
;
6403 RETURN_UNGCPRO (Ffuncall (7, args
));
6406 count
= SPECPDL_INDEX ();
6407 specbind (intern ("completion-ignore-case"),
6408 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6409 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6410 specbind (intern ("read-file-name-predicate"),
6411 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6413 GCPRO2 (insdef
, default_filename
);
6415 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6416 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6418 /* If DIR contains a file name, split it. */
6420 file
= Ffile_name_nondirectory (dir
);
6421 if (SCHARS (file
) && NILP (default_filename
))
6423 default_filename
= file
;
6424 dir
= Ffile_name_directory (dir
);
6426 if (!NILP(default_filename
))
6427 default_filename
= Fexpand_file_name (default_filename
, dir
);
6428 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6429 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6434 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6435 dir
, mustmatch
, insdef
,
6436 Qfile_name_history
, default_filename
, Qnil
);
6438 tem
= Fsymbol_value (Qfile_name_history
);
6439 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6440 replace_in_history
= 1;
6442 /* If Fcompleting_read returned the inserted default string itself
6443 (rather than a new string with the same contents),
6444 it has to mean that the user typed RET with the minibuffer empty.
6445 In that case, we really want to return ""
6446 so that commands such as set-visited-file-name can distinguish. */
6447 if (EQ (val
, default_filename
))
6449 /* In this case, Fcompleting_read has not added an element
6450 to the history. Maybe we should. */
6451 if (! replace_in_history
)
6457 unbind_to (count
, Qnil
);
6460 error ("No file name specified");
6462 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6464 if (!NILP (tem
) && !NILP (default_filename
))
6465 val
= default_filename
;
6466 val
= Fsubstitute_in_file_name (val
);
6468 if (replace_in_history
)
6469 /* Replace what Fcompleting_read added to the history
6470 with what we will actually return. */
6472 Lisp_Object val1
= double_dollars (val
);
6473 tem
= Fsymbol_value (Qfile_name_history
);
6474 if (history_delete_duplicates
)
6475 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6476 XSETCAR (tem
, val1
);
6478 else if (add_to_history
)
6480 /* Add the value to the history--but not if it matches
6481 the last value already there. */
6482 Lisp_Object val1
= double_dollars (val
);
6483 tem
= Fsymbol_value (Qfile_name_history
);
6484 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6486 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6487 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6498 /* Must be set before any path manipulation is performed. */
6499 XSETFASTINT (Vdirectory_sep_char
, '/');
6506 Qoperations
= intern ("operations");
6507 Qexpand_file_name
= intern ("expand-file-name");
6508 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6509 Qdirectory_file_name
= intern ("directory-file-name");
6510 Qfile_name_directory
= intern ("file-name-directory");
6511 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6512 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6513 Qfile_name_as_directory
= intern ("file-name-as-directory");
6514 Qcopy_file
= intern ("copy-file");
6515 Qmake_directory_internal
= intern ("make-directory-internal");
6516 Qmake_directory
= intern ("make-directory");
6517 Qdelete_directory
= intern ("delete-directory");
6518 Qdelete_file
= intern ("delete-file");
6519 Qrename_file
= intern ("rename-file");
6520 Qadd_name_to_file
= intern ("add-name-to-file");
6521 Qmake_symbolic_link
= intern ("make-symbolic-link");
6522 Qfile_exists_p
= intern ("file-exists-p");
6523 Qfile_executable_p
= intern ("file-executable-p");
6524 Qfile_readable_p
= intern ("file-readable-p");
6525 Qfile_writable_p
= intern ("file-writable-p");
6526 Qfile_symlink_p
= intern ("file-symlink-p");
6527 Qaccess_file
= intern ("access-file");
6528 Qfile_directory_p
= intern ("file-directory-p");
6529 Qfile_regular_p
= intern ("file-regular-p");
6530 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6531 Qfile_modes
= intern ("file-modes");
6532 Qset_file_modes
= intern ("set-file-modes");
6533 Qset_file_times
= intern ("set-file-times");
6534 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6535 Qinsert_file_contents
= intern ("insert-file-contents");
6536 Qwrite_region
= intern ("write-region");
6537 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6538 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6539 Qauto_save_coding
= intern ("auto-save-coding");
6541 staticpro (&Qoperations
);
6542 staticpro (&Qexpand_file_name
);
6543 staticpro (&Qsubstitute_in_file_name
);
6544 staticpro (&Qdirectory_file_name
);
6545 staticpro (&Qfile_name_directory
);
6546 staticpro (&Qfile_name_nondirectory
);
6547 staticpro (&Qunhandled_file_name_directory
);
6548 staticpro (&Qfile_name_as_directory
);
6549 staticpro (&Qcopy_file
);
6550 staticpro (&Qmake_directory_internal
);
6551 staticpro (&Qmake_directory
);
6552 staticpro (&Qdelete_directory
);
6553 staticpro (&Qdelete_file
);
6554 staticpro (&Qrename_file
);
6555 staticpro (&Qadd_name_to_file
);
6556 staticpro (&Qmake_symbolic_link
);
6557 staticpro (&Qfile_exists_p
);
6558 staticpro (&Qfile_executable_p
);
6559 staticpro (&Qfile_readable_p
);
6560 staticpro (&Qfile_writable_p
);
6561 staticpro (&Qaccess_file
);
6562 staticpro (&Qfile_symlink_p
);
6563 staticpro (&Qfile_directory_p
);
6564 staticpro (&Qfile_regular_p
);
6565 staticpro (&Qfile_accessible_directory_p
);
6566 staticpro (&Qfile_modes
);
6567 staticpro (&Qset_file_modes
);
6568 staticpro (&Qset_file_times
);
6569 staticpro (&Qfile_newer_than_file_p
);
6570 staticpro (&Qinsert_file_contents
);
6571 staticpro (&Qwrite_region
);
6572 staticpro (&Qverify_visited_file_modtime
);
6573 staticpro (&Qset_visited_file_modtime
);
6574 staticpro (&Qauto_save_coding
);
6576 Qfile_name_history
= intern ("file-name-history");
6577 Fset (Qfile_name_history
, Qnil
);
6578 staticpro (&Qfile_name_history
);
6580 Qfile_error
= intern ("file-error");
6581 staticpro (&Qfile_error
);
6582 Qfile_already_exists
= intern ("file-already-exists");
6583 staticpro (&Qfile_already_exists
);
6584 Qfile_date_error
= intern ("file-date-error");
6585 staticpro (&Qfile_date_error
);
6586 Qexcl
= intern ("excl");
6590 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6591 staticpro (&Qfind_buffer_file_type
);
6594 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6595 doc
: /* *Coding system for encoding file names.
6596 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6597 Vfile_name_coding_system
= Qnil
;
6599 DEFVAR_LISP ("default-file-name-coding-system",
6600 &Vdefault_file_name_coding_system
,
6601 doc
: /* Default coding system for encoding file names.
6602 This variable is used only when `file-name-coding-system' is nil.
6604 This variable is set/changed by the command `set-language-environment'.
6605 User should not set this variable manually,
6606 instead use `file-name-coding-system' to get a constant encoding
6607 of file names regardless of the current language environment. */);
6608 Vdefault_file_name_coding_system
= Qnil
;
6610 Qformat_decode
= intern ("format-decode");
6611 staticpro (&Qformat_decode
);
6612 Qformat_annotate_function
= intern ("format-annotate-function");
6613 staticpro (&Qformat_annotate_function
);
6614 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6615 staticpro (&Qafter_insert_file_set_coding
);
6617 Qcar_less_than_car
= intern ("car-less-than-car");
6618 staticpro (&Qcar_less_than_car
);
6620 Fput (Qfile_error
, Qerror_conditions
,
6621 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6622 Fput (Qfile_error
, Qerror_message
,
6623 build_string ("File error"));
6625 Fput (Qfile_already_exists
, Qerror_conditions
,
6626 Fcons (Qfile_already_exists
,
6627 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6628 Fput (Qfile_already_exists
, Qerror_message
,
6629 build_string ("File already exists"));
6631 Fput (Qfile_date_error
, Qerror_conditions
,
6632 Fcons (Qfile_date_error
,
6633 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6634 Fput (Qfile_date_error
, Qerror_message
,
6635 build_string ("Cannot set file date"));
6637 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6638 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6639 Vread_file_name_function
= Qnil
;
6641 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6642 doc
: /* Current predicate used by `read-file-name-internal'. */);
6643 Vread_file_name_predicate
= Qnil
;
6645 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6646 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6647 #if defined VMS || defined DOS_NT || defined MAC_OS
6648 read_file_name_completion_ignore_case
= 1;
6650 read_file_name_completion_ignore_case
= 0;
6653 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6654 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6655 If the initial minibuffer contents are non-empty, you can usually
6656 request a default filename by typing RETURN without editing. For some
6657 commands, exiting with an empty minibuffer has a special meaning,
6658 such as making the current buffer visit no file in the case of
6659 `set-visited-file-name'.
6660 If this variable is non-nil, the minibuffer contents are always
6661 initially non-empty and typing RETURN without editing will fetch the
6662 default name, if one is provided. Note however that this default name
6663 is not necessarily the name originally inserted in the minibuffer, if
6664 that is just the default directory.
6665 If this variable is nil, the minibuffer often starts out empty. In
6666 that case you may have to explicitly fetch the next history element to
6667 request the default name. */);
6668 insert_default_directory
= 1;
6670 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6671 doc
: /* *Non-nil means write new files with record format `stmlf'.
6672 nil means use format `var'. This variable is meaningful only on VMS. */);
6673 vms_stmlf_recfm
= 0;
6675 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6676 doc
: /* Directory separator character for built-in functions that return file names.
6677 The value is always ?/. Don't use this variable, just use `/'. */);
6679 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6680 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6681 If a file name matches REGEXP, then all I/O on that file is done by calling
6684 The first argument given to HANDLER is the name of the I/O primitive
6685 to be handled; the remaining arguments are the arguments that were
6686 passed to that primitive. For example, if you do
6687 (file-exists-p FILENAME)
6688 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6689 (funcall HANDLER 'file-exists-p FILENAME)
6690 The function `find-file-name-handler' checks this list for a handler
6691 for its argument. */);
6692 Vfile_name_handler_alist
= Qnil
;
6694 DEFVAR_LISP ("set-auto-coding-function",
6695 &Vset_auto_coding_function
,
6696 doc
: /* If non-nil, a function to call to decide a coding system of file.
6697 Two arguments are passed to this function: the file name
6698 and the length of a file contents following the point.
6699 This function should return a coding system to decode the file contents.
6700 It should check the file name against `auto-coding-alist'.
6701 If no coding system is decided, it should check a coding system
6702 specified in the heading lines with the format:
6703 -*- ... coding: CODING-SYSTEM; ... -*-
6704 or local variable spec of the tailing lines with `coding:' tag. */);
6705 Vset_auto_coding_function
= Qnil
;
6707 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6708 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6709 Each is passed one argument, the number of characters inserted.
6710 It should return the new character count, and leave point the same.
6711 If `insert-file-contents' is intercepted by a handler from
6712 `file-name-handler-alist', that handler is responsible for calling the
6713 functions in `after-insert-file-functions' if appropriate. */);
6714 Vafter_insert_file_functions
= Qnil
;
6716 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6717 doc
: /* A list of functions to be called at the start of `write-region'.
6718 Each is passed two arguments, START and END as for `write-region'.
6719 These are usually two numbers but not always; see the documentation
6720 for `write-region'. The function should return a list of pairs
6721 of the form (POSITION . STRING), consisting of strings to be effectively
6722 inserted at the specified positions of the file being written (1 means to
6723 insert before the first byte written). The POSITIONs must be sorted into
6724 increasing order. If there are several functions in the list, the several
6725 lists are merged destructively. Alternatively, the function can return
6726 with a different buffer current; in that case it should pay attention
6727 to the annotations returned by previous functions and listed in
6728 `write-region-annotations-so-far'.*/);
6729 Vwrite_region_annotate_functions
= Qnil
;
6730 staticpro (&Qwrite_region_annotate_functions
);
6731 Qwrite_region_annotate_functions
6732 = intern ("write-region-annotate-functions");
6734 DEFVAR_LISP ("write-region-annotations-so-far",
6735 &Vwrite_region_annotations_so_far
,
6736 doc
: /* When an annotation function is called, this holds the previous annotations.
6737 These are the annotations made by other annotation functions
6738 that were already called. See also `write-region-annotate-functions'. */);
6739 Vwrite_region_annotations_so_far
= Qnil
;
6741 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6742 doc
: /* A list of file name handlers that temporarily should not be used.
6743 This applies only to the operation `inhibit-file-name-operation'. */);
6744 Vinhibit_file_name_handlers
= Qnil
;
6746 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6747 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6748 Vinhibit_file_name_operation
= Qnil
;
6750 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6751 doc
: /* File name in which we write a list of all auto save file names.
6752 This variable is initialized automatically from `auto-save-list-file-prefix'
6753 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6754 a non-nil value. */);
6755 Vauto_save_list_file_name
= Qnil
;
6758 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6759 doc
: /* *Non-nil means don't call fsync in `write-region'.
6760 This variable affects calls to `write-region' as well as save commands.
6761 A non-nil value may result in data loss! */);
6762 write_region_inhibit_fsync
= 0;
6765 defsubr (&Sfind_file_name_handler
);
6766 defsubr (&Sfile_name_directory
);
6767 defsubr (&Sfile_name_nondirectory
);
6768 defsubr (&Sunhandled_file_name_directory
);
6769 defsubr (&Sfile_name_as_directory
);
6770 defsubr (&Sdirectory_file_name
);
6771 defsubr (&Smake_temp_name
);
6772 defsubr (&Sexpand_file_name
);
6773 defsubr (&Ssubstitute_in_file_name
);
6774 defsubr (&Scopy_file
);
6775 defsubr (&Smake_directory_internal
);
6776 defsubr (&Sdelete_directory
);
6777 defsubr (&Sdelete_file
);
6778 defsubr (&Srename_file
);
6779 defsubr (&Sadd_name_to_file
);
6781 defsubr (&Smake_symbolic_link
);
6782 #endif /* S_IFLNK */
6784 defsubr (&Sdefine_logical_name
);
6787 defsubr (&Ssysnetunam
);
6788 #endif /* HPUX_NET */
6789 defsubr (&Sfile_name_absolute_p
);
6790 defsubr (&Sfile_exists_p
);
6791 defsubr (&Sfile_executable_p
);
6792 defsubr (&Sfile_readable_p
);
6793 defsubr (&Sfile_writable_p
);
6794 defsubr (&Saccess_file
);
6795 defsubr (&Sfile_symlink_p
);
6796 defsubr (&Sfile_directory_p
);
6797 defsubr (&Sfile_accessible_directory_p
);
6798 defsubr (&Sfile_regular_p
);
6799 defsubr (&Sfile_modes
);
6800 defsubr (&Sset_file_modes
);
6801 defsubr (&Sset_file_times
);
6802 defsubr (&Sset_default_file_modes
);
6803 defsubr (&Sdefault_file_modes
);
6804 defsubr (&Sfile_newer_than_file_p
);
6805 defsubr (&Sinsert_file_contents
);
6806 defsubr (&Swrite_region
);
6807 defsubr (&Scar_less_than_car
);
6808 defsubr (&Sverify_visited_file_modtime
);
6809 defsubr (&Sclear_visited_file_modtime
);
6810 defsubr (&Svisited_file_modtime
);
6811 defsubr (&Sset_visited_file_modtime
);
6812 defsubr (&Sdo_auto_save
);
6813 defsubr (&Sset_buffer_auto_saved
);
6814 defsubr (&Sclear_buffer_auto_save_failure
);
6815 defsubr (&Srecent_auto_save_p
);
6817 defsubr (&Sread_file_name_internal
);
6818 defsubr (&Sread_file_name
);
6819 defsubr (&Snext_read_file_uses_dialog_p
);
6822 defsubr (&Sunix_sync
);
6826 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6827 (do not change this comment) */