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, 5,
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.
2412 This function always sets the file modes of the output file to match
2415 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2416 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2417 signal a `file-already-exists' error without overwriting. If
2418 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2419 about overwriting; this is what happens in interactive use with M-x.
2420 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2423 Fourth arg KEEP-TIME non-nil means give the output file the same
2424 last-modified time as the old one. (This works on only some systems.)
2426 A prefix arg makes KEEP-TIME non-nil.
2428 If PRESERVE-UID-GID is non-nil, we try to transfer the
2429 uid and gid of FILE to NEWNAME. */)
2430 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2431 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2432 Lisp_Object preserve_uid_gid
;
2435 char buf
[16 * 1024];
2436 struct stat st
, out_st
;
2437 Lisp_Object handler
;
2438 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2439 int count
= SPECPDL_INDEX ();
2440 int input_file_statable_p
;
2441 Lisp_Object encoded_file
, encoded_newname
;
2443 encoded_file
= encoded_newname
= Qnil
;
2444 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2445 CHECK_STRING (file
);
2446 CHECK_STRING (newname
);
2448 if (!NILP (Ffile_directory_p (newname
)))
2449 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2451 newname
= Fexpand_file_name (newname
, Qnil
);
2453 file
= Fexpand_file_name (file
, Qnil
);
2455 /* If the input file name has special constructs in it,
2456 call the corresponding file handler. */
2457 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2458 /* Likewise for output file name. */
2460 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2461 if (!NILP (handler
))
2462 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2463 ok_if_already_exists
, keep_time
));
2465 encoded_file
= ENCODE_FILE (file
);
2466 encoded_newname
= ENCODE_FILE (newname
);
2468 if (NILP (ok_if_already_exists
)
2469 || INTEGERP (ok_if_already_exists
))
2470 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2471 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2472 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2476 if (!CopyFile (SDATA (encoded_file
),
2477 SDATA (encoded_newname
),
2479 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2480 /* CopyFile retains the timestamp by default. */
2481 else if (NILP (keep_time
))
2487 EMACS_GET_TIME (now
);
2488 filename
= SDATA (encoded_newname
);
2490 /* Ensure file is writable while its modified time is set. */
2491 attributes
= GetFileAttributes (filename
);
2492 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2493 if (set_file_times (filename
, now
, now
))
2495 /* Restore original attributes. */
2496 SetFileAttributes (filename
, attributes
);
2497 Fsignal (Qfile_date_error
,
2498 Fcons (build_string ("Cannot set file date"),
2499 Fcons (newname
, Qnil
)));
2501 /* Restore original attributes. */
2502 SetFileAttributes (filename
, attributes
);
2504 #else /* not WINDOWSNT */
2506 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2510 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2512 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2514 /* We can only copy regular files and symbolic links. Other files are not
2516 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2518 #if !defined (MSDOS) || __DJGPP__ > 1
2519 if (out_st
.st_mode
!= 0
2520 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2523 report_file_error ("Input and output files are the same",
2524 Fcons (file
, Fcons (newname
, Qnil
)));
2528 #if defined (S_ISREG) && defined (S_ISLNK)
2529 if (input_file_statable_p
)
2531 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2533 #if defined (EISDIR)
2534 /* Get a better looking error message. */
2537 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2540 #endif /* S_ISREG && S_ISLNK */
2543 /* Create the copy file with the same record format as the input file */
2544 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2547 /* System's default file type was set to binary by _fmode in emacs.c. */
2548 ofd
= emacs_open (SDATA (encoded_newname
),
2549 O_WRONLY
| O_TRUNC
| O_CREAT
2550 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2551 S_IREAD
| S_IWRITE
);
2552 #else /* not MSDOS */
2553 ofd
= emacs_open (SDATA (encoded_newname
),
2554 O_WRONLY
| O_TRUNC
| O_CREAT
2555 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2557 #endif /* not MSDOS */
2560 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2562 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2566 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2567 if (emacs_write (ofd
, buf
, n
) != n
)
2568 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2572 /* Preserve the original file modes, and if requested, also its
2574 if (input_file_statable_p
)
2576 if (! NILP (preserve_uid_gid
))
2577 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2578 fchmod (ofd
, st
.st_mode
& 07777);
2580 #endif /* not MSDOS */
2582 /* Closing the output clobbers the file times on some systems. */
2583 if (emacs_close (ofd
) < 0)
2584 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2586 if (input_file_statable_p
)
2588 if (!NILP (keep_time
))
2590 EMACS_TIME atime
, mtime
;
2591 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2592 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2593 if (set_file_times (SDATA (encoded_newname
),
2595 Fsignal (Qfile_date_error
,
2596 Fcons (build_string ("Cannot set file date"),
2597 Fcons (newname
, Qnil
)));
2603 #if defined (__DJGPP__) && __DJGPP__ > 1
2604 if (input_file_statable_p
)
2606 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2607 and if it can't, it tells so. Otherwise, under MSDOS we usually
2608 get only the READ bit, which will make the copied file read-only,
2609 so it's better not to chmod at all. */
2610 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2611 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2613 #endif /* DJGPP version 2 or newer */
2614 #endif /* not WINDOWSNT */
2616 /* Discard the unwind protects. */
2617 specpdl_ptr
= specpdl
+ count
;
2623 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2624 Smake_directory_internal
, 1, 1, 0,
2625 doc
: /* Create a new directory named DIRECTORY. */)
2627 Lisp_Object directory
;
2629 const unsigned char *dir
;
2630 Lisp_Object handler
;
2631 Lisp_Object encoded_dir
;
2633 CHECK_STRING (directory
);
2634 directory
= Fexpand_file_name (directory
, Qnil
);
2636 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2637 if (!NILP (handler
))
2638 return call2 (handler
, Qmake_directory_internal
, directory
);
2640 encoded_dir
= ENCODE_FILE (directory
);
2642 dir
= SDATA (encoded_dir
);
2645 if (mkdir (dir
) != 0)
2647 if (mkdir (dir
, 0777) != 0)
2649 report_file_error ("Creating directory", Flist (1, &directory
));
2654 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2655 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2657 Lisp_Object directory
;
2659 const unsigned char *dir
;
2660 Lisp_Object handler
;
2661 Lisp_Object encoded_dir
;
2663 CHECK_STRING (directory
);
2664 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2666 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2667 if (!NILP (handler
))
2668 return call2 (handler
, Qdelete_directory
, directory
);
2670 encoded_dir
= ENCODE_FILE (directory
);
2672 dir
= SDATA (encoded_dir
);
2674 if (rmdir (dir
) != 0)
2675 report_file_error ("Removing directory", Flist (1, &directory
));
2680 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2681 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2682 If file has multiple names, it continues to exist with the other names. */)
2684 Lisp_Object filename
;
2686 Lisp_Object handler
;
2687 Lisp_Object encoded_file
;
2688 struct gcpro gcpro1
;
2691 if (!NILP (Ffile_directory_p (filename
))
2692 && NILP (Ffile_symlink_p (filename
)))
2693 Fsignal (Qfile_error
,
2694 Fcons (build_string ("Removing old name: is a directory"),
2695 Fcons (filename
, Qnil
)));
2697 filename
= Fexpand_file_name (filename
, Qnil
);
2699 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2700 if (!NILP (handler
))
2701 return call2 (handler
, Qdelete_file
, filename
);
2703 encoded_file
= ENCODE_FILE (filename
);
2705 if (0 > unlink (SDATA (encoded_file
)))
2706 report_file_error ("Removing old name", Flist (1, &filename
));
2711 internal_delete_file_1 (ignore
)
2717 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2720 internal_delete_file (filename
)
2721 Lisp_Object filename
;
2724 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2725 Qt
, internal_delete_file_1
);
2729 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2730 "fRename file: \nGRename %s to file: \np",
2731 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2732 If file has names other than FILE, it continues to have those names.
2733 Signals a `file-already-exists' error if a file NEWNAME already exists
2734 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2735 A number as third arg means request confirmation if NEWNAME already exists.
2736 This is what happens in interactive use with M-x. */)
2737 (file
, newname
, ok_if_already_exists
)
2738 Lisp_Object file
, newname
, ok_if_already_exists
;
2741 Lisp_Object args
[2];
2743 Lisp_Object handler
;
2744 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2745 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2747 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2748 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2749 CHECK_STRING (file
);
2750 CHECK_STRING (newname
);
2751 file
= Fexpand_file_name (file
, Qnil
);
2753 if (!NILP (Ffile_directory_p (newname
)))
2754 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2756 newname
= Fexpand_file_name (newname
, Qnil
);
2758 /* If the file name has special constructs in it,
2759 call the corresponding file handler. */
2760 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2762 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2763 if (!NILP (handler
))
2764 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2765 file
, newname
, ok_if_already_exists
));
2767 encoded_file
= ENCODE_FILE (file
);
2768 encoded_newname
= ENCODE_FILE (newname
);
2771 /* If the file names are identical but for the case, don't ask for
2772 confirmation: they simply want to change the letter-case of the
2774 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2776 if (NILP (ok_if_already_exists
)
2777 || INTEGERP (ok_if_already_exists
))
2778 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2779 INTEGERP (ok_if_already_exists
), 0, 0);
2781 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2783 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2784 || 0 > unlink (SDATA (encoded_file
)))
2790 symlink_target
= Ffile_symlink_p (file
);
2791 if (! NILP (symlink_target
))
2792 Fmake_symbolic_link (symlink_target
, newname
,
2793 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2796 Fcopy_file (file
, newname
,
2797 /* We have already prompted if it was an integer,
2798 so don't have copy-file prompt again. */
2799 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2802 Fdelete_file (file
);
2809 report_file_error ("Renaming", Flist (2, args
));
2812 report_file_error ("Renaming", Flist (2, &file
));
2819 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2820 "fAdd name to file: \nGName to add to %s: \np",
2821 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2822 Signals a `file-already-exists' error if a file NEWNAME already exists
2823 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2824 A number as third arg means request confirmation if NEWNAME already exists.
2825 This is what happens in interactive use with M-x. */)
2826 (file
, newname
, ok_if_already_exists
)
2827 Lisp_Object file
, newname
, ok_if_already_exists
;
2830 Lisp_Object args
[2];
2832 Lisp_Object handler
;
2833 Lisp_Object encoded_file
, encoded_newname
;
2834 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2836 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2837 encoded_file
= encoded_newname
= Qnil
;
2838 CHECK_STRING (file
);
2839 CHECK_STRING (newname
);
2840 file
= Fexpand_file_name (file
, Qnil
);
2842 if (!NILP (Ffile_directory_p (newname
)))
2843 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2845 newname
= Fexpand_file_name (newname
, Qnil
);
2847 /* If the file name has special constructs in it,
2848 call the corresponding file handler. */
2849 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2850 if (!NILP (handler
))
2851 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2852 newname
, ok_if_already_exists
));
2854 /* If the new name has special constructs in it,
2855 call the corresponding file handler. */
2856 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2857 if (!NILP (handler
))
2858 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2859 newname
, ok_if_already_exists
));
2861 encoded_file
= ENCODE_FILE (file
);
2862 encoded_newname
= ENCODE_FILE (newname
);
2864 if (NILP (ok_if_already_exists
)
2865 || INTEGERP (ok_if_already_exists
))
2866 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2867 INTEGERP (ok_if_already_exists
), 0, 0);
2869 unlink (SDATA (newname
));
2870 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2875 report_file_error ("Adding new name", Flist (2, args
));
2877 report_file_error ("Adding new name", Flist (2, &file
));
2886 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2887 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2888 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2889 Both args must be strings.
2890 Signals a `file-already-exists' error if a file LINKNAME already exists
2891 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2892 A number as third arg means request confirmation if LINKNAME already exists.
2893 This happens for interactive use with M-x. */)
2894 (filename
, linkname
, ok_if_already_exists
)
2895 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2898 Lisp_Object args
[2];
2900 Lisp_Object handler
;
2901 Lisp_Object encoded_filename
, encoded_linkname
;
2902 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2904 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2905 encoded_filename
= encoded_linkname
= Qnil
;
2906 CHECK_STRING (filename
);
2907 CHECK_STRING (linkname
);
2908 /* If the link target has a ~, we must expand it to get
2909 a truly valid file name. Otherwise, do not expand;
2910 we want to permit links to relative file names. */
2911 if (SREF (filename
, 0) == '~')
2912 filename
= Fexpand_file_name (filename
, Qnil
);
2914 if (!NILP (Ffile_directory_p (linkname
)))
2915 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2917 linkname
= Fexpand_file_name (linkname
, Qnil
);
2919 /* If the file name has special constructs in it,
2920 call the corresponding file handler. */
2921 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2922 if (!NILP (handler
))
2923 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2924 linkname
, ok_if_already_exists
));
2926 /* If the new link name has special constructs in it,
2927 call the corresponding file handler. */
2928 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2929 if (!NILP (handler
))
2930 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2931 linkname
, ok_if_already_exists
));
2933 encoded_filename
= ENCODE_FILE (filename
);
2934 encoded_linkname
= ENCODE_FILE (linkname
);
2936 if (NILP (ok_if_already_exists
)
2937 || INTEGERP (ok_if_already_exists
))
2938 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2939 INTEGERP (ok_if_already_exists
), 0, 0);
2940 if (0 > symlink (SDATA (encoded_filename
),
2941 SDATA (encoded_linkname
)))
2943 /* If we didn't complain already, silently delete existing file. */
2944 if (errno
== EEXIST
)
2946 unlink (SDATA (encoded_linkname
));
2947 if (0 <= symlink (SDATA (encoded_filename
),
2948 SDATA (encoded_linkname
)))
2958 report_file_error ("Making symbolic link", Flist (2, args
));
2960 report_file_error ("Making symbolic link", Flist (2, &filename
));
2966 #endif /* S_IFLNK */
2970 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2971 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2972 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2973 If STRING is nil or a null string, the logical name NAME is deleted. */)
2978 CHECK_STRING (name
);
2980 delete_logical_name (SDATA (name
));
2983 CHECK_STRING (string
);
2985 if (SCHARS (string
) == 0)
2986 delete_logical_name (SDATA (name
));
2988 define_logical_name (SDATA (name
), SDATA (string
));
2997 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2998 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
3000 Lisp_Object path
, login
;
3004 CHECK_STRING (path
);
3005 CHECK_STRING (login
);
3007 netresult
= netunam (SDATA (path
), SDATA (login
));
3009 if (netresult
== -1)
3014 #endif /* HPUX_NET */
3016 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3018 doc
: /* Return t if file FILENAME specifies an absolute file name.
3019 On Unix, this is a name starting with a `/' or a `~'. */)
3021 Lisp_Object filename
;
3023 CHECK_STRING (filename
);
3024 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3027 /* Return nonzero if file FILENAME exists and can be executed. */
3030 check_executable (filename
)
3034 int len
= strlen (filename
);
3037 if (stat (filename
, &st
) < 0)
3039 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3040 return ((st
.st_mode
& S_IEXEC
) != 0);
3042 return (S_ISREG (st
.st_mode
)
3044 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3045 || stricmp (suffix
, ".exe") == 0
3046 || stricmp (suffix
, ".bat") == 0)
3047 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3048 #endif /* not WINDOWSNT */
3049 #else /* not DOS_NT */
3050 #ifdef HAVE_EUIDACCESS
3051 return (euidaccess (filename
, 1) >= 0);
3053 /* Access isn't quite right because it uses the real uid
3054 and we really want to test with the effective uid.
3055 But Unix doesn't give us a right way to do it. */
3056 return (access (filename
, 1) >= 0);
3058 #endif /* not DOS_NT */
3061 /* Return nonzero if file FILENAME exists and can be written. */
3064 check_writable (filename
)
3069 if (stat (filename
, &st
) < 0)
3071 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3072 #else /* not MSDOS */
3073 #ifdef HAVE_EUIDACCESS
3074 return (euidaccess (filename
, 2) >= 0);
3076 /* Access isn't quite right because it uses the real uid
3077 and we really want to test with the effective uid.
3078 But Unix doesn't give us a right way to do it.
3079 Opening with O_WRONLY could work for an ordinary file,
3080 but would lose for directories. */
3081 return (access (filename
, 2) >= 0);
3083 #endif /* not MSDOS */
3086 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3087 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3088 See also `file-readable-p' and `file-attributes'.
3089 This returns nil for a symlink to a nonexistent file.
3090 Use `file-symlink-p' to test for such links. */)
3092 Lisp_Object filename
;
3094 Lisp_Object absname
;
3095 Lisp_Object handler
;
3096 struct stat statbuf
;
3098 CHECK_STRING (filename
);
3099 absname
= Fexpand_file_name (filename
, Qnil
);
3101 /* If the file name has special constructs in it,
3102 call the corresponding file handler. */
3103 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3104 if (!NILP (handler
))
3105 return call2 (handler
, Qfile_exists_p
, absname
);
3107 absname
= ENCODE_FILE (absname
);
3109 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3112 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3113 doc
: /* Return t if FILENAME can be executed by you.
3114 For a directory, this means you can access files in that directory. */)
3116 Lisp_Object filename
;
3118 Lisp_Object absname
;
3119 Lisp_Object handler
;
3121 CHECK_STRING (filename
);
3122 absname
= Fexpand_file_name (filename
, Qnil
);
3124 /* If the file name has special constructs in it,
3125 call the corresponding file handler. */
3126 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3127 if (!NILP (handler
))
3128 return call2 (handler
, Qfile_executable_p
, absname
);
3130 absname
= ENCODE_FILE (absname
);
3132 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3135 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3136 doc
: /* Return t if file FILENAME exists and you can read it.
3137 See also `file-exists-p' and `file-attributes'. */)
3139 Lisp_Object filename
;
3141 Lisp_Object absname
;
3142 Lisp_Object handler
;
3145 struct stat statbuf
;
3147 CHECK_STRING (filename
);
3148 absname
= Fexpand_file_name (filename
, Qnil
);
3150 /* If the file name has special constructs in it,
3151 call the corresponding file handler. */
3152 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3153 if (!NILP (handler
))
3154 return call2 (handler
, Qfile_readable_p
, absname
);
3156 absname
= ENCODE_FILE (absname
);
3158 #if defined(DOS_NT) || defined(macintosh)
3159 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3161 if (access (SDATA (absname
), 0) == 0)
3164 #else /* not DOS_NT and not macintosh */
3166 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3167 /* Opening a fifo without O_NONBLOCK can wait.
3168 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3169 except in the case of a fifo, on a system which handles it. */
3170 desc
= stat (SDATA (absname
), &statbuf
);
3173 if (S_ISFIFO (statbuf
.st_mode
))
3174 flags
|= O_NONBLOCK
;
3176 desc
= emacs_open (SDATA (absname
), flags
, 0);
3181 #endif /* not DOS_NT and not macintosh */
3184 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3186 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3187 doc
: /* Return t if file FILENAME can be written or created by you. */)
3189 Lisp_Object filename
;
3191 Lisp_Object absname
, dir
, encoded
;
3192 Lisp_Object handler
;
3193 struct stat statbuf
;
3195 CHECK_STRING (filename
);
3196 absname
= Fexpand_file_name (filename
, Qnil
);
3198 /* If the file name has special constructs in it,
3199 call the corresponding file handler. */
3200 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3201 if (!NILP (handler
))
3202 return call2 (handler
, Qfile_writable_p
, absname
);
3204 encoded
= ENCODE_FILE (absname
);
3205 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3206 return (check_writable (SDATA (encoded
))
3209 dir
= Ffile_name_directory (absname
);
3212 dir
= Fdirectory_file_name (dir
);
3216 dir
= Fdirectory_file_name (dir
);
3219 dir
= ENCODE_FILE (dir
);
3221 /* The read-only attribute of the parent directory doesn't affect
3222 whether a file or directory can be created within it. Some day we
3223 should check ACLs though, which do affect this. */
3224 if (stat (SDATA (dir
), &statbuf
) < 0)
3226 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3228 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3233 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3234 doc
: /* Access file FILENAME, and get an error if that does not work.
3235 The second argument STRING is used in the error message.
3236 If there is no error, returns nil. */)
3238 Lisp_Object filename
, string
;
3240 Lisp_Object handler
, encoded_filename
, absname
;
3243 CHECK_STRING (filename
);
3244 absname
= Fexpand_file_name (filename
, Qnil
);
3246 CHECK_STRING (string
);
3248 /* If the file name has special constructs in it,
3249 call the corresponding file handler. */
3250 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3251 if (!NILP (handler
))
3252 return call3 (handler
, Qaccess_file
, absname
, string
);
3254 encoded_filename
= ENCODE_FILE (absname
);
3256 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3258 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3264 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3265 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3266 The value is the link target, as a string.
3267 Otherwise it returns nil.
3269 This function returns t when given the name of a symlink that
3270 points to a nonexistent file. */)
3272 Lisp_Object filename
;
3274 Lisp_Object handler
;
3276 CHECK_STRING (filename
);
3277 filename
= Fexpand_file_name (filename
, Qnil
);
3279 /* If the file name has special constructs in it,
3280 call the corresponding file handler. */
3281 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3282 if (!NILP (handler
))
3283 return call2 (handler
, Qfile_symlink_p
, filename
);
3292 filename
= ENCODE_FILE (filename
);
3299 buf
= (char *) xrealloc (buf
, bufsize
);
3300 bzero (buf
, bufsize
);
3303 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3307 /* HP-UX reports ERANGE if buffer is too small. */
3308 if (errno
== ERANGE
)
3318 while (valsize
>= bufsize
);
3320 val
= make_string (buf
, valsize
);
3321 if (buf
[0] == '/' && index (buf
, ':'))
3322 val
= concat2 (build_string ("/:"), val
);
3324 val
= DECODE_FILE (val
);
3327 #else /* not S_IFLNK */
3329 #endif /* not S_IFLNK */
3332 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3333 doc
: /* Return t if FILENAME names an existing directory.
3334 Symbolic links to directories count as directories.
3335 See `file-symlink-p' to distinguish symlinks. */)
3337 Lisp_Object filename
;
3339 register Lisp_Object absname
;
3341 Lisp_Object handler
;
3343 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3345 /* If the file name has special constructs in it,
3346 call the corresponding file handler. */
3347 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3348 if (!NILP (handler
))
3349 return call2 (handler
, Qfile_directory_p
, absname
);
3351 absname
= ENCODE_FILE (absname
);
3353 if (stat (SDATA (absname
), &st
) < 0)
3355 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3358 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3359 doc
: /* Return t if file FILENAME names a directory you can open.
3360 For the value to be t, FILENAME must specify the name of a directory as a file,
3361 and the directory must allow you to open files in it. In order to use a
3362 directory as a buffer's current directory, this predicate must return true.
3363 A directory name spec may be given instead; then the value is t
3364 if the directory so specified exists and really is a readable and
3365 searchable directory. */)
3367 Lisp_Object filename
;
3369 Lisp_Object handler
;
3371 struct gcpro gcpro1
;
3373 /* If the file name has special constructs in it,
3374 call the corresponding file handler. */
3375 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3376 if (!NILP (handler
))
3377 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3380 tem
= (NILP (Ffile_directory_p (filename
))
3381 || NILP (Ffile_executable_p (filename
)));
3383 return tem
? Qnil
: Qt
;
3386 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3387 doc
: /* Return t if FILENAME names a regular file.
3388 This is the sort of file that holds an ordinary stream of data bytes.
3389 Symbolic links to regular files count as regular files.
3390 See `file-symlink-p' to distinguish symlinks. */)
3392 Lisp_Object filename
;
3394 register Lisp_Object absname
;
3396 Lisp_Object handler
;
3398 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3400 /* If the file name has special constructs in it,
3401 call the corresponding file handler. */
3402 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3403 if (!NILP (handler
))
3404 return call2 (handler
, Qfile_regular_p
, absname
);
3406 absname
= ENCODE_FILE (absname
);
3411 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3413 /* Tell stat to use expensive method to get accurate info. */
3414 Vw32_get_true_file_attributes
= Qt
;
3415 result
= stat (SDATA (absname
), &st
);
3416 Vw32_get_true_file_attributes
= tem
;
3420 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3423 if (stat (SDATA (absname
), &st
) < 0)
3425 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3429 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3430 doc
: /* Return mode bits of file named FILENAME, as an integer.
3431 Return nil, if file does not exist or is not accessible. */)
3433 Lisp_Object filename
;
3435 Lisp_Object absname
;
3437 Lisp_Object handler
;
3439 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3441 /* If the file name has special constructs in it,
3442 call the corresponding file handler. */
3443 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3444 if (!NILP (handler
))
3445 return call2 (handler
, Qfile_modes
, absname
);
3447 absname
= ENCODE_FILE (absname
);
3449 if (stat (SDATA (absname
), &st
) < 0)
3451 #if defined (MSDOS) && __DJGPP__ < 2
3452 if (check_executable (SDATA (absname
)))
3453 st
.st_mode
|= S_IEXEC
;
3454 #endif /* MSDOS && __DJGPP__ < 2 */
3456 return make_number (st
.st_mode
& 07777);
3459 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3460 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3461 Only the 12 low bits of MODE are used. */)
3463 Lisp_Object filename
, mode
;
3465 Lisp_Object absname
, encoded_absname
;
3466 Lisp_Object handler
;
3468 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3469 CHECK_NUMBER (mode
);
3471 /* If the file name has special constructs in it,
3472 call the corresponding file handler. */
3473 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3474 if (!NILP (handler
))
3475 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3477 encoded_absname
= ENCODE_FILE (absname
);
3479 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3480 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3485 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3486 doc
: /* Set the file permission bits for newly created files.
3487 The argument MODE should be an integer; only the low 9 bits are used.
3488 This setting is inherited by subprocesses. */)
3492 CHECK_NUMBER (mode
);
3494 umask ((~ XINT (mode
)) & 0777);
3499 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3500 doc
: /* Return the default file protection for created files.
3501 The value is an integer. */)
3507 realmask
= umask (0);
3510 XSETINT (value
, (~ realmask
) & 0777);
3514 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3516 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3517 doc
: /* Set times of file FILENAME to TIME.
3518 Set both access and modification times.
3519 Return t on success, else nil.
3520 Use the current time if TIME is nil. TIME is in the format of
3523 Lisp_Object filename
, time
;
3525 Lisp_Object absname
, encoded_absname
;
3526 Lisp_Object handler
;
3530 if (! lisp_time_argument (time
, &sec
, &usec
))
3531 error ("Invalid time specification");
3533 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3535 /* If the file name has special constructs in it,
3536 call the corresponding file handler. */
3537 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3538 if (!NILP (handler
))
3539 return call3 (handler
, Qset_file_times
, absname
, time
);
3541 encoded_absname
= ENCODE_FILE (absname
);
3546 EMACS_SET_SECS (t
, sec
);
3547 EMACS_SET_USECS (t
, usec
);
3549 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3554 /* Setting times on a directory always fails. */
3555 if (stat (SDATA (encoded_absname
), &st
) == 0
3556 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3559 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3572 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3573 doc
: /* Tell Unix to finish all pending disk updates. */)
3582 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3583 doc
: /* Return t if file FILE1 is newer than file FILE2.
3584 If FILE1 does not exist, the answer is nil;
3585 otherwise, if FILE2 does not exist, the answer is t. */)
3587 Lisp_Object file1
, file2
;
3589 Lisp_Object absname1
, absname2
;
3592 Lisp_Object handler
;
3593 struct gcpro gcpro1
, gcpro2
;
3595 CHECK_STRING (file1
);
3596 CHECK_STRING (file2
);
3599 GCPRO2 (absname1
, file2
);
3600 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3601 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3604 /* If the file name has special constructs in it,
3605 call the corresponding file handler. */
3606 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3608 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3609 if (!NILP (handler
))
3610 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3612 GCPRO2 (absname1
, absname2
);
3613 absname1
= ENCODE_FILE (absname1
);
3614 absname2
= ENCODE_FILE (absname2
);
3617 if (stat (SDATA (absname1
), &st
) < 0)
3620 mtime1
= st
.st_mtime
;
3622 if (stat (SDATA (absname2
), &st
) < 0)
3625 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3629 Lisp_Object Qfind_buffer_file_type
;
3632 #ifndef READ_BUF_SIZE
3633 #define READ_BUF_SIZE (64 << 10)
3636 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3638 /* This function is called after Lisp functions to decide a coding
3639 system are called, or when they cause an error. Before they are
3640 called, the current buffer is set unibyte and it contains only a
3641 newly inserted text (thus the buffer was empty before the
3644 The functions may set markers, overlays, text properties, or even
3645 alter the buffer contents, change the current buffer.
3647 Here, we reset all those changes by:
3648 o set back the current buffer.
3649 o move all markers and overlays to BEG.
3650 o remove all text properties.
3651 o set back the buffer multibyteness. */
3654 decide_coding_unwind (unwind_data
)
3655 Lisp_Object unwind_data
;
3657 Lisp_Object multibyte
, undo_list
, buffer
;
3659 multibyte
= XCAR (unwind_data
);
3660 unwind_data
= XCDR (unwind_data
);
3661 undo_list
= XCAR (unwind_data
);
3662 buffer
= XCDR (unwind_data
);
3664 if (current_buffer
!= XBUFFER (buffer
))
3665 set_buffer_internal (XBUFFER (buffer
));
3666 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3667 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3668 BUF_INTERVALS (current_buffer
) = 0;
3669 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3671 /* Now we are safe to change the buffer's multibyteness directly. */
3672 current_buffer
->enable_multibyte_characters
= multibyte
;
3673 current_buffer
->undo_list
= undo_list
;
3679 /* Used to pass values from insert-file-contents to read_non_regular. */
3681 static int non_regular_fd
;
3682 static int non_regular_inserted
;
3683 static int non_regular_nbytes
;
3686 /* Read from a non-regular file.
3687 Read non_regular_trytry bytes max from non_regular_fd.
3688 Non_regular_inserted specifies where to put the read bytes.
3689 Value is the number of bytes read. */
3698 nbytes
= emacs_read (non_regular_fd
,
3699 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3700 non_regular_nbytes
);
3702 return make_number (nbytes
);
3706 /* Condition-case handler used when reading from non-regular files
3707 in insert-file-contents. */
3710 read_non_regular_quit ()
3716 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3718 doc
: /* Insert contents of file FILENAME after point.
3719 Returns list of absolute file name and number of characters inserted.
3720 If second argument VISIT is non-nil, the buffer's visited filename
3721 and last save file modtime are set, and it is marked unmodified.
3722 If visiting and the file does not exist, visiting is completed
3723 before the error is signaled.
3724 The optional third and fourth arguments BEG and END
3725 specify what portion of the file to insert.
3726 These arguments count bytes in the file, not characters in the buffer.
3727 If VISIT is non-nil, BEG and END must be nil.
3729 If optional fifth argument REPLACE is non-nil,
3730 it means replace the current buffer contents (in the accessible portion)
3731 with the file contents. This is better than simply deleting and inserting
3732 the whole thing because (1) it preserves some marker positions
3733 and (2) it puts less data in the undo list.
3734 When REPLACE is non-nil, the value is the number of characters actually read,
3735 which is often less than the number of characters to be read.
3737 This does code conversion according to the value of
3738 `coding-system-for-read' or `file-coding-system-alist',
3739 and sets the variable `last-coding-system-used' to the coding system
3741 (filename
, visit
, beg
, end
, replace
)
3742 Lisp_Object filename
, visit
, beg
, end
, replace
;
3747 register int how_much
;
3748 register int unprocessed
;
3749 int count
= SPECPDL_INDEX ();
3750 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3751 Lisp_Object handler
, val
, insval
, orig_filename
;
3754 int not_regular
= 0;
3755 unsigned char read_buf
[READ_BUF_SIZE
];
3756 struct coding_system coding
;
3757 unsigned char buffer
[1 << 14];
3758 int replace_handled
= 0;
3759 int set_coding_system
= 0;
3760 int coding_system_decided
= 0;
3762 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3763 int we_locked_file
= 0;
3765 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3766 error ("Cannot do file visiting in an indirect buffer");
3768 if (!NILP (current_buffer
->read_only
))
3769 Fbarf_if_buffer_read_only ();
3773 orig_filename
= Qnil
;
3775 GCPRO4 (filename
, val
, p
, orig_filename
);
3777 CHECK_STRING (filename
);
3778 filename
= Fexpand_file_name (filename
, Qnil
);
3780 /* If the file name has special constructs in it,
3781 call the corresponding file handler. */
3782 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3783 if (!NILP (handler
))
3785 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3786 visit
, beg
, end
, replace
);
3787 if (CONSP (val
) && CONSP (XCDR (val
)))
3788 inserted
= XINT (XCAR (XCDR (val
)));
3792 orig_filename
= filename
;
3793 filename
= ENCODE_FILE (filename
);
3799 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3801 /* Tell stat to use expensive method to get accurate info. */
3802 Vw32_get_true_file_attributes
= Qt
;
3803 total
= stat (SDATA (filename
), &st
);
3804 Vw32_get_true_file_attributes
= tem
;
3809 if (stat (SDATA (filename
), &st
) < 0)
3811 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3812 || fstat (fd
, &st
) < 0)
3813 #endif /* not APOLLO */
3814 #endif /* WINDOWSNT */
3816 if (fd
>= 0) emacs_close (fd
);
3819 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3822 if (!NILP (Vcoding_system_for_read
))
3823 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3828 /* This code will need to be changed in order to work on named
3829 pipes, and it's probably just not worth it. So we should at
3830 least signal an error. */
3831 if (!S_ISREG (st
.st_mode
))
3838 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3839 Fsignal (Qfile_error
,
3840 Fcons (build_string ("not a regular file"),
3841 Fcons (orig_filename
, Qnil
)));
3846 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3849 /* Replacement should preserve point as it preserves markers. */
3850 if (!NILP (replace
))
3851 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3853 record_unwind_protect (close_file_unwind
, make_number (fd
));
3855 /* Supposedly happens on VMS. */
3856 /* Can happen on any platform that uses long as type of off_t, but allows
3857 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3858 give a message suitable for the latter case. */
3859 if (! not_regular
&& st
.st_size
< 0)
3860 error ("Maximum buffer size exceeded");
3862 /* Prevent redisplay optimizations. */
3863 current_buffer
->clip_changed
= 1;
3867 if (!NILP (beg
) || !NILP (end
))
3868 error ("Attempt to visit less than an entire file");
3869 if (BEG
< Z
&& NILP (replace
))
3870 error ("Cannot do file visiting in a non-empty buffer");
3876 XSETFASTINT (beg
, 0);
3884 XSETINT (end
, st
.st_size
);
3886 /* Arithmetic overflow can occur if an Emacs integer cannot
3887 represent the file size, or if the calculations below
3888 overflow. The calculations below double the file size
3889 twice, so check that it can be multiplied by 4 safely. */
3890 if (XINT (end
) != st
.st_size
3891 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3892 error ("Maximum buffer size exceeded");
3894 /* The file size returned from stat may be zero, but data
3895 may be readable nonetheless, for example when this is a
3896 file in the /proc filesystem. */
3897 if (st
.st_size
== 0)
3898 XSETINT (end
, READ_BUF_SIZE
);
3902 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3904 /* We use emacs-mule for auto saving... */
3905 setup_coding_system (Qemacs_mule
, &coding
);
3906 /* ... but with the special flag to indicate to read in a
3907 multibyte sequence for eight-bit-control char as is. */
3909 coding
.src_multibyte
= 0;
3910 coding
.dst_multibyte
3911 = !NILP (current_buffer
->enable_multibyte_characters
);
3912 coding
.eol_type
= CODING_EOL_LF
;
3913 coding_system_decided
= 1;
3917 /* Decide the coding system to use for reading the file now
3918 because we can't use an optimized method for handling
3919 `coding:' tag if the current buffer is not empty. */
3923 if (!NILP (Vcoding_system_for_read
))
3924 val
= Vcoding_system_for_read
;
3927 /* Don't try looking inside a file for a coding system
3928 specification if it is not seekable. */
3929 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3931 /* Find a coding system specified in the heading two
3932 lines or in the tailing several lines of the file.
3933 We assume that the 1K-byte and 3K-byte for heading
3934 and tailing respectively are sufficient for this
3938 if (st
.st_size
<= (1024 * 4))
3939 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3942 nread
= emacs_read (fd
, read_buf
, 1024);
3945 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3946 report_file_error ("Setting file position",
3947 Fcons (orig_filename
, Qnil
));
3948 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3953 error ("IO error reading %s: %s",
3954 SDATA (orig_filename
), emacs_strerror (errno
));
3957 struct buffer
*prev
= current_buffer
;
3961 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3963 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3964 buf
= XBUFFER (buffer
);
3966 delete_all_overlays (buf
);
3967 buf
->directory
= current_buffer
->directory
;
3968 buf
->read_only
= Qnil
;
3969 buf
->filename
= Qnil
;
3970 buf
->undo_list
= Qt
;
3971 eassert (buf
->overlays_before
== NULL
);
3972 eassert (buf
->overlays_after
== NULL
);
3974 set_buffer_internal (buf
);
3976 buf
->enable_multibyte_characters
= Qnil
;
3978 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3979 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3980 val
= call2 (Vset_auto_coding_function
,
3981 filename
, make_number (nread
));
3982 set_buffer_internal (prev
);
3984 /* Discard the unwind protect for recovering the
3988 /* Rewind the file for the actual read done later. */
3989 if (lseek (fd
, 0, 0) < 0)
3990 report_file_error ("Setting file position",
3991 Fcons (orig_filename
, Qnil
));
3997 /* If we have not yet decided a coding system, check
3998 file-coding-system-alist. */
3999 Lisp_Object args
[6], coding_systems
;
4001 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4002 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4003 coding_systems
= Ffind_operation_coding_system (6, args
);
4004 if (CONSP (coding_systems
))
4005 val
= XCAR (coding_systems
);
4009 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4010 /* Ensure we set Vlast_coding_system_used. */
4011 set_coding_system
= 1;
4013 if (NILP (current_buffer
->enable_multibyte_characters
)
4015 /* We must suppress all character code conversion except for
4016 end-of-line conversion. */
4017 setup_raw_text_coding_system (&coding
);
4019 coding
.src_multibyte
= 0;
4020 coding
.dst_multibyte
4021 = !NILP (current_buffer
->enable_multibyte_characters
);
4022 coding_system_decided
= 1;
4025 /* If requested, replace the accessible part of the buffer
4026 with the file contents. Avoid replacing text at the
4027 beginning or end of the buffer that matches the file contents;
4028 that preserves markers pointing to the unchanged parts.
4030 Here we implement this feature in an optimized way
4031 for the case where code conversion is NOT needed.
4032 The following if-statement handles the case of conversion
4033 in a less optimal way.
4035 If the code conversion is "automatic" then we try using this
4036 method and hope for the best.
4037 But if we discover the need for conversion, we give up on this method
4038 and let the following if-statement handle the replace job. */
4041 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4043 /* same_at_start and same_at_end count bytes,
4044 because file access counts bytes
4045 and BEG and END count bytes. */
4046 int same_at_start
= BEGV_BYTE
;
4047 int same_at_end
= ZV_BYTE
;
4049 /* There is still a possibility we will find the need to do code
4050 conversion. If that happens, we set this variable to 1 to
4051 give up on handling REPLACE in the optimized way. */
4052 int giveup_match_end
= 0;
4054 if (XINT (beg
) != 0)
4056 if (lseek (fd
, XINT (beg
), 0) < 0)
4057 report_file_error ("Setting file position",
4058 Fcons (orig_filename
, Qnil
));
4063 /* Count how many chars at the start of the file
4064 match the text at the beginning of the buffer. */
4069 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4071 error ("IO error reading %s: %s",
4072 SDATA (orig_filename
), emacs_strerror (errno
));
4073 else if (nread
== 0)
4076 if (coding
.type
== coding_type_undecided
)
4077 detect_coding (&coding
, buffer
, nread
);
4078 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4079 /* We found that the file should be decoded somehow.
4080 Let's give up here. */
4082 giveup_match_end
= 1;
4086 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4087 detect_eol (&coding
, buffer
, nread
);
4088 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4089 && coding
.eol_type
!= CODING_EOL_LF
)
4090 /* We found that the format of eol should be decoded.
4091 Let's give up here. */
4093 giveup_match_end
= 1;
4098 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4099 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4100 same_at_start
++, bufpos
++;
4101 /* If we found a discrepancy, stop the scan.
4102 Otherwise loop around and scan the next bufferful. */
4103 if (bufpos
!= nread
)
4107 /* If the file matches the buffer completely,
4108 there's no need to replace anything. */
4109 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4113 /* Truncate the buffer to the size of the file. */
4114 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4119 /* Count how many chars at the end of the file
4120 match the text at the end of the buffer. But, if we have
4121 already found that decoding is necessary, don't waste time. */
4122 while (!giveup_match_end
)
4124 int total_read
, nread
, bufpos
, curpos
, trial
;
4126 /* At what file position are we now scanning? */
4127 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4128 /* If the entire file matches the buffer tail, stop the scan. */
4131 /* How much can we scan in the next step? */
4132 trial
= min (curpos
, sizeof buffer
);
4133 if (lseek (fd
, curpos
- trial
, 0) < 0)
4134 report_file_error ("Setting file position",
4135 Fcons (orig_filename
, Qnil
));
4137 total_read
= nread
= 0;
4138 while (total_read
< trial
)
4140 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4142 error ("IO error reading %s: %s",
4143 SDATA (orig_filename
), emacs_strerror (errno
));
4144 else if (nread
== 0)
4146 total_read
+= nread
;
4149 /* Scan this bufferful from the end, comparing with
4150 the Emacs buffer. */
4151 bufpos
= total_read
;
4153 /* Compare with same_at_start to avoid counting some buffer text
4154 as matching both at the file's beginning and at the end. */
4155 while (bufpos
> 0 && same_at_end
> same_at_start
4156 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4157 same_at_end
--, bufpos
--;
4159 /* If we found a discrepancy, stop the scan.
4160 Otherwise loop around and scan the preceding bufferful. */
4163 /* If this discrepancy is because of code conversion,
4164 we cannot use this method; giveup and try the other. */
4165 if (same_at_end
> same_at_start
4166 && FETCH_BYTE (same_at_end
- 1) >= 0200
4167 && ! NILP (current_buffer
->enable_multibyte_characters
)
4168 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4169 giveup_match_end
= 1;
4178 if (! giveup_match_end
)
4182 /* We win! We can handle REPLACE the optimized way. */
4184 /* Extend the start of non-matching text area to multibyte
4185 character boundary. */
4186 if (! NILP (current_buffer
->enable_multibyte_characters
))
4187 while (same_at_start
> BEGV_BYTE
4188 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4191 /* Extend the end of non-matching text area to multibyte
4192 character boundary. */
4193 if (! NILP (current_buffer
->enable_multibyte_characters
))
4194 while (same_at_end
< ZV_BYTE
4195 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4198 /* Don't try to reuse the same piece of text twice. */
4199 overlap
= (same_at_start
- BEGV_BYTE
4200 - (same_at_end
+ st
.st_size
- ZV
));
4202 same_at_end
+= overlap
;
4204 /* Arrange to read only the nonmatching middle part of the file. */
4205 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4206 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4208 del_range_byte (same_at_start
, same_at_end
, 0);
4209 /* Insert from the file at the proper position. */
4210 temp
= BYTE_TO_CHAR (same_at_start
);
4211 SET_PT_BOTH (temp
, same_at_start
);
4213 /* If display currently starts at beginning of line,
4214 keep it that way. */
4215 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4216 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4218 replace_handled
= 1;
4222 /* If requested, replace the accessible part of the buffer
4223 with the file contents. Avoid replacing text at the
4224 beginning or end of the buffer that matches the file contents;
4225 that preserves markers pointing to the unchanged parts.
4227 Here we implement this feature for the case where code conversion
4228 is needed, in a simple way that needs a lot of memory.
4229 The preceding if-statement handles the case of no conversion
4230 in a more optimized way. */
4231 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4233 int same_at_start
= BEGV_BYTE
;
4234 int same_at_end
= ZV_BYTE
;
4237 /* Make sure that the gap is large enough. */
4238 int bufsize
= 2 * st
.st_size
;
4239 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4242 /* First read the whole file, performing code conversion into
4243 CONVERSION_BUFFER. */
4245 if (lseek (fd
, XINT (beg
), 0) < 0)
4247 xfree (conversion_buffer
);
4248 report_file_error ("Setting file position",
4249 Fcons (orig_filename
, Qnil
));
4252 total
= st
.st_size
; /* Total bytes in the file. */
4253 how_much
= 0; /* Bytes read from file so far. */
4254 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4255 unprocessed
= 0; /* Bytes not processed in previous loop. */
4257 while (how_much
< total
)
4259 /* try is reserved in some compilers (Microsoft C) */
4260 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4261 unsigned char *destination
= read_buf
+ unprocessed
;
4264 /* Allow quitting out of the actual I/O. */
4267 this = emacs_read (fd
, destination
, trytry
);
4270 if (this < 0 || this + unprocessed
== 0)
4278 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4280 int require
, result
;
4282 this += unprocessed
;
4284 /* If we are using more space than estimated,
4285 make CONVERSION_BUFFER bigger. */
4286 require
= decoding_buffer_size (&coding
, this);
4287 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4289 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4290 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4293 /* Convert this batch with results in CONVERSION_BUFFER. */
4294 if (how_much
>= total
) /* This is the last block. */
4295 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4296 if (coding
.composing
!= COMPOSITION_DISABLED
)
4297 coding_allocate_composition_data (&coding
, BEGV
);
4298 result
= decode_coding (&coding
, read_buf
,
4299 conversion_buffer
+ inserted
,
4300 this, bufsize
- inserted
);
4302 /* Save for next iteration whatever we didn't convert. */
4303 unprocessed
= this - coding
.consumed
;
4304 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4305 if (!NILP (current_buffer
->enable_multibyte_characters
))
4306 this = coding
.produced
;
4308 this = str_as_unibyte (conversion_buffer
+ inserted
,
4315 /* At this point, INSERTED is how many characters (i.e. bytes)
4316 are present in CONVERSION_BUFFER.
4317 HOW_MUCH should equal TOTAL,
4318 or should be <= 0 if we couldn't read the file. */
4322 xfree (conversion_buffer
);
4323 coding_free_composition_data (&coding
);
4324 error ("IO error reading %s: %s",
4325 SDATA (orig_filename
), emacs_strerror (errno
));
4328 /* Compare the beginning of the converted file
4329 with the buffer text. */
4332 while (bufpos
< inserted
&& same_at_start
< same_at_end
4333 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4334 same_at_start
++, bufpos
++;
4336 /* If the file matches the buffer completely,
4337 there's no need to replace anything. */
4339 if (bufpos
== inserted
)
4341 xfree (conversion_buffer
);
4342 coding_free_composition_data (&coding
);
4345 /* Truncate the buffer to the size of the file. */
4346 del_range_byte (same_at_start
, same_at_end
, 0);
4351 /* Extend the start of non-matching text area to multibyte
4352 character boundary. */
4353 if (! NILP (current_buffer
->enable_multibyte_characters
))
4354 while (same_at_start
> BEGV_BYTE
4355 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4358 /* Scan this bufferful from the end, comparing with
4359 the Emacs buffer. */
4362 /* Compare with same_at_start to avoid counting some buffer text
4363 as matching both at the file's beginning and at the end. */
4364 while (bufpos
> 0 && same_at_end
> same_at_start
4365 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4366 same_at_end
--, bufpos
--;
4368 /* Extend the end of non-matching text area to multibyte
4369 character boundary. */
4370 if (! NILP (current_buffer
->enable_multibyte_characters
))
4371 while (same_at_end
< ZV_BYTE
4372 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4375 /* Don't try to reuse the same piece of text twice. */
4376 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4378 same_at_end
+= overlap
;
4380 /* If display currently starts at beginning of line,
4381 keep it that way. */
4382 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4383 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4385 /* Replace the chars that we need to replace,
4386 and update INSERTED to equal the number of bytes
4387 we are taking from the file. */
4388 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4390 if (same_at_end
!= same_at_start
)
4392 del_range_byte (same_at_start
, same_at_end
, 0);
4394 same_at_start
= GPT_BYTE
;
4398 temp
= BYTE_TO_CHAR (same_at_start
);
4400 /* Insert from the file at the proper position. */
4401 SET_PT_BOTH (temp
, same_at_start
);
4402 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4404 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4405 coding_restore_composition (&coding
, Fcurrent_buffer ());
4406 coding_free_composition_data (&coding
);
4408 /* Set `inserted' to the number of inserted characters. */
4409 inserted
= PT
- temp
;
4410 /* Set point before the inserted characters. */
4411 SET_PT_BOTH (temp
, same_at_start
);
4413 xfree (conversion_buffer
);
4422 register Lisp_Object temp
;
4424 total
= XINT (end
) - XINT (beg
);
4426 /* Make sure point-max won't overflow after this insertion. */
4427 XSETINT (temp
, total
);
4428 if (total
!= XINT (temp
))
4429 error ("Maximum buffer size exceeded");
4432 /* For a special file, all we can do is guess. */
4433 total
= READ_BUF_SIZE
;
4435 if (NILP (visit
) && inserted
> 0)
4437 #ifdef CLASH_DETECTION
4438 if (!NILP (current_buffer
->file_truename
)
4439 /* Make binding buffer-file-name to nil effective. */
4440 && !NILP (current_buffer
->filename
)
4441 && SAVE_MODIFF
>= MODIFF
)
4443 #endif /* CLASH_DETECTION */
4444 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4448 if (GAP_SIZE
< total
)
4449 make_gap (total
- GAP_SIZE
);
4451 if (XINT (beg
) != 0 || !NILP (replace
))
4453 if (lseek (fd
, XINT (beg
), 0) < 0)
4454 report_file_error ("Setting file position",
4455 Fcons (orig_filename
, Qnil
));
4458 /* In the following loop, HOW_MUCH contains the total bytes read so
4459 far for a regular file, and not changed for a special file. But,
4460 before exiting the loop, it is set to a negative value if I/O
4464 /* Total bytes inserted. */
4467 /* Here, we don't do code conversion in the loop. It is done by
4468 code_convert_region after all data are read into the buffer. */
4470 int gap_size
= GAP_SIZE
;
4472 while (how_much
< total
)
4474 /* try is reserved in some compilers (Microsoft C) */
4475 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4482 /* Maybe make more room. */
4483 if (gap_size
< trytry
)
4485 make_gap (total
- gap_size
);
4486 gap_size
= GAP_SIZE
;
4489 /* Read from the file, capturing `quit'. When an
4490 error occurs, end the loop, and arrange for a quit
4491 to be signaled after decoding the text we read. */
4492 non_regular_fd
= fd
;
4493 non_regular_inserted
= inserted
;
4494 non_regular_nbytes
= trytry
;
4495 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4496 read_non_regular_quit
);
4507 /* Allow quitting out of the actual I/O. We don't make text
4508 part of the buffer until all the reading is done, so a C-g
4509 here doesn't do any harm. */
4512 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4524 /* For a regular file, where TOTAL is the real size,
4525 count HOW_MUCH to compare with it.
4526 For a special file, where TOTAL is just a buffer size,
4527 so don't bother counting in HOW_MUCH.
4528 (INSERTED is where we count the number of characters inserted.) */
4535 /* Now we have read all the file data into the gap.
4536 If it was empty, undo marking the buffer modified. */
4540 #ifdef CLASH_DETECTION
4542 unlock_file (current_buffer
->file_truename
);
4544 Vdeactivate_mark
= old_Vdeactivate_mark
;
4547 Vdeactivate_mark
= Qt
;
4549 /* Make the text read part of the buffer. */
4550 GAP_SIZE
-= inserted
;
4552 GPT_BYTE
+= inserted
;
4554 ZV_BYTE
+= inserted
;
4559 /* Put an anchor to ensure multi-byte form ends at gap. */
4564 /* Discard the unwind protect for closing the file. */
4568 error ("IO error reading %s: %s",
4569 SDATA (orig_filename
), emacs_strerror (errno
));
4573 if (! coding_system_decided
)
4575 /* The coding system is not yet decided. Decide it by an
4576 optimized method for handling `coding:' tag.
4578 Note that we can get here only if the buffer was empty
4579 before the insertion. */
4583 if (!NILP (Vcoding_system_for_read
))
4584 val
= Vcoding_system_for_read
;
4587 /* Since we are sure that the current buffer was empty
4588 before the insertion, we can toggle
4589 enable-multibyte-characters directly here without taking
4590 care of marker adjustment and byte combining problem. By
4591 this way, we can run Lisp program safely before decoding
4592 the inserted text. */
4593 Lisp_Object unwind_data
;
4594 int count
= SPECPDL_INDEX ();
4596 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4597 Fcons (current_buffer
->undo_list
,
4598 Fcurrent_buffer ()));
4599 current_buffer
->enable_multibyte_characters
= Qnil
;
4600 current_buffer
->undo_list
= Qt
;
4601 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4603 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4605 val
= call2 (Vset_auto_coding_function
,
4606 filename
, make_number (inserted
));
4611 /* If the coding system is not yet decided, check
4612 file-coding-system-alist. */
4613 Lisp_Object args
[6], coding_systems
;
4615 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4616 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4617 coding_systems
= Ffind_operation_coding_system (6, args
);
4618 if (CONSP (coding_systems
))
4619 val
= XCAR (coding_systems
);
4621 unbind_to (count
, Qnil
);
4622 inserted
= Z_BYTE
- BEG_BYTE
;
4625 /* The following kludgy code is to avoid some compiler bug.
4627 setup_coding_system (val, &coding);
4630 struct coding_system temp_coding
;
4631 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4632 bcopy (&temp_coding
, &coding
, sizeof coding
);
4634 /* Ensure we set Vlast_coding_system_used. */
4635 set_coding_system
= 1;
4637 if (NILP (current_buffer
->enable_multibyte_characters
)
4639 /* We must suppress all character code conversion except for
4640 end-of-line conversion. */
4641 setup_raw_text_coding_system (&coding
);
4642 coding
.src_multibyte
= 0;
4643 coding
.dst_multibyte
4644 = !NILP (current_buffer
->enable_multibyte_characters
);
4648 /* Can't do this if part of the buffer might be preserved. */
4650 && (coding
.type
== coding_type_no_conversion
4651 || coding
.type
== coding_type_raw_text
))
4653 /* Visiting a file with these coding system makes the buffer
4655 current_buffer
->enable_multibyte_characters
= Qnil
;
4656 coding
.dst_multibyte
= 0;
4659 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4661 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4663 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4665 inserted
= coding
.produced_char
;
4668 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4672 /* Now INSERTED is measured in characters. */
4675 /* Use the conversion type to determine buffer-file-type
4676 (find-buffer-file-type is now used to help determine the
4678 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4679 || coding
.eol_type
== CODING_EOL_LF
)
4680 && ! CODING_REQUIRE_DECODING (&coding
))
4681 current_buffer
->buffer_file_type
= Qt
;
4683 current_buffer
->buffer_file_type
= Qnil
;
4690 if (!EQ (current_buffer
->undo_list
, Qt
))
4691 current_buffer
->undo_list
= Qnil
;
4693 stat (SDATA (filename
), &st
);
4698 current_buffer
->modtime
= st
.st_mtime
;
4699 current_buffer
->filename
= orig_filename
;
4702 SAVE_MODIFF
= MODIFF
;
4703 current_buffer
->auto_save_modified
= MODIFF
;
4704 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4705 #ifdef CLASH_DETECTION
4708 if (!NILP (current_buffer
->file_truename
))
4709 unlock_file (current_buffer
->file_truename
);
4710 unlock_file (filename
);
4712 #endif /* CLASH_DETECTION */
4714 Fsignal (Qfile_error
,
4715 Fcons (build_string ("not a regular file"),
4716 Fcons (orig_filename
, Qnil
)));
4719 if (set_coding_system
)
4720 Vlast_coding_system_used
= coding
.symbol
;
4722 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4724 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4726 if (! NILP (insval
))
4728 CHECK_NUMBER (insval
);
4729 inserted
= XFASTINT (insval
);
4733 /* Decode file format */
4736 int empty_undo_list_p
= 0;
4738 /* If we're anyway going to discard undo information, don't
4739 record it in the first place. The buffer's undo list at this
4740 point is either nil or t when visiting a file. */
4743 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4744 current_buffer
->undo_list
= Qt
;
4747 insval
= call3 (Qformat_decode
,
4748 Qnil
, make_number (inserted
), visit
);
4749 CHECK_NUMBER (insval
);
4750 inserted
= XFASTINT (insval
);
4753 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4756 /* Call after-change hooks for the inserted text, aside from the case
4757 of normal visiting (not with REPLACE), which is done in a new buffer
4758 "before" the buffer is changed. */
4759 if (inserted
> 0 && total
> 0
4760 && (NILP (visit
) || !NILP (replace
)))
4762 signal_after_change (PT
, 0, inserted
);
4763 update_compositions (PT
, PT
, CHECK_BORDER
);
4766 p
= Vafter_insert_file_functions
;
4769 insval
= call1 (XCAR (p
), make_number (inserted
));
4772 CHECK_NUMBER (insval
);
4773 inserted
= XFASTINT (insval
);
4780 && current_buffer
->modtime
== -1)
4782 /* If visiting nonexistent file, return nil. */
4783 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4787 Fsignal (Qquit
, Qnil
);
4789 /* ??? Retval needs to be dealt with in all cases consistently. */
4791 val
= Fcons (orig_filename
,
4792 Fcons (make_number (inserted
),
4795 RETURN_UNGCPRO (unbind_to (count
, val
));
4798 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4799 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4800 Lisp_Object
, Lisp_Object
));
4802 /* If build_annotations switched buffers, switch back to BUF.
4803 Kill the temporary buffer that was selected in the meantime.
4805 Since this kill only the last temporary buffer, some buffers remain
4806 not killed if build_annotations switched buffers more than once.
4810 build_annotations_unwind (buf
)
4815 if (XBUFFER (buf
) == current_buffer
)
4817 tembuf
= Fcurrent_buffer ();
4819 Fkill_buffer (tembuf
);
4823 /* Decide the coding-system to encode the data with. */
4826 choose_write_coding_system (start
, end
, filename
,
4827 append
, visit
, lockname
, coding
)
4828 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4829 struct coding_system
*coding
;
4834 && NILP (Fstring_equal (current_buffer
->filename
,
4835 current_buffer
->auto_save_file_name
)))
4837 /* We use emacs-mule for auto saving... */
4838 setup_coding_system (Qemacs_mule
, coding
);
4839 /* ... but with the special flag to indicate not to strip off
4840 leading code of eight-bit-control chars. */
4842 goto done_setup_coding
;
4844 else if (!NILP (Vcoding_system_for_write
))
4846 val
= Vcoding_system_for_write
;
4847 if (coding_system_require_warning
4848 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4849 /* Confirm that VAL can surely encode the current region. */
4850 val
= call5 (Vselect_safe_coding_system_function
,
4851 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4856 /* If the variable `buffer-file-coding-system' is set locally,
4857 it means that the file was read with some kind of code
4858 conversion or the variable is explicitly set by users. We
4859 had better write it out with the same coding system even if
4860 `enable-multibyte-characters' is nil.
4862 If it is not set locally, we anyway have to convert EOL
4863 format if the default value of `buffer-file-coding-system'
4864 tells that it is not Unix-like (LF only) format. */
4865 int using_default_coding
= 0;
4866 int force_raw_text
= 0;
4868 val
= current_buffer
->buffer_file_coding_system
;
4870 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4873 if (NILP (current_buffer
->enable_multibyte_characters
))
4879 /* Check file-coding-system-alist. */
4880 Lisp_Object args
[7], coding_systems
;
4882 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4883 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4885 coding_systems
= Ffind_operation_coding_system (7, args
);
4886 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4887 val
= XCDR (coding_systems
);
4891 && !NILP (current_buffer
->buffer_file_coding_system
))
4893 /* If we still have not decided a coding system, use the
4894 default value of buffer-file-coding-system. */
4895 val
= current_buffer
->buffer_file_coding_system
;
4896 using_default_coding
= 1;
4900 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4901 /* Confirm that VAL can surely encode the current region. */
4902 val
= call5 (Vselect_safe_coding_system_function
,
4903 start
, end
, val
, Qnil
, filename
);
4905 setup_coding_system (Fcheck_coding_system (val
), coding
);
4906 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4907 && !using_default_coding
)
4909 if (! EQ (default_buffer_file_coding
.symbol
,
4910 buffer_defaults
.buffer_file_coding_system
))
4911 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4912 &default_buffer_file_coding
);
4913 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4915 Lisp_Object subsidiaries
;
4917 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4918 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4919 if (VECTORP (subsidiaries
)
4920 && XVECTOR (subsidiaries
)->size
== 3)
4922 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4927 setup_raw_text_coding_system (coding
);
4928 goto done_setup_coding
;
4931 setup_coding_system (Fcheck_coding_system (val
), coding
);
4934 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4935 coding
->eol_type
= system_eol_type
;
4936 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4937 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4940 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4941 "r\nFWrite region to file: \ni\ni\ni\np",
4942 doc
: /* Write current region into specified file.
4943 When called from a program, requires three arguments:
4944 START, END and FILENAME. START and END are normally buffer positions
4945 specifying the part of the buffer to write.
4946 If START is nil, that means to use the entire buffer contents.
4947 If START is a string, then output that string to the file
4948 instead of any buffer contents; END is ignored.
4950 Optional fourth argument APPEND if non-nil means
4951 append to existing file contents (if any). If it is an integer,
4952 seek to that offset in the file before writing.
4953 Optional fifth argument VISIT, if t or a string, means
4954 set the last-save-file-modtime of buffer to this file's modtime
4955 and mark buffer not modified.
4956 If VISIT is a string, it is a second file name;
4957 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4958 VISIT is also the file name to lock and unlock for clash detection.
4959 If VISIT is neither t nor nil nor a string,
4960 that means do not display the \"Wrote file\" message.
4961 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4962 use for locking and unlocking, overriding FILENAME and VISIT.
4963 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4964 for an existing file with the same name. If MUSTBENEW is `excl',
4965 that means to get an error if the file already exists; never overwrite.
4966 If MUSTBENEW is neither nil nor `excl', that means ask for
4967 confirmation before overwriting, but do go ahead and overwrite the file
4968 if the user confirms.
4970 This does code conversion according to the value of
4971 `coding-system-for-write', `buffer-file-coding-system', or
4972 `file-coding-system-alist', and sets the variable
4973 `last-coding-system-used' to the coding system actually used. */)
4974 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4975 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4980 const unsigned char *fn
;
4983 int count
= SPECPDL_INDEX ();
4986 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4988 Lisp_Object handler
;
4989 Lisp_Object visit_file
;
4990 Lisp_Object annotations
;
4991 Lisp_Object encoded_filename
;
4992 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4993 int quietly
= !NILP (visit
);
4994 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4995 struct buffer
*given_buffer
;
4997 int buffer_file_type
= O_BINARY
;
4999 struct coding_system coding
;
5001 if (current_buffer
->base_buffer
&& visiting
)
5002 error ("Cannot do file visiting in an indirect buffer");
5004 if (!NILP (start
) && !STRINGP (start
))
5005 validate_region (&start
, &end
);
5008 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5010 filename
= Fexpand_file_name (filename
, Qnil
);
5012 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5013 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5015 if (STRINGP (visit
))
5016 visit_file
= Fexpand_file_name (visit
, Qnil
);
5018 visit_file
= filename
;
5020 if (NILP (lockname
))
5021 lockname
= visit_file
;
5025 /* If the file name has special constructs in it,
5026 call the corresponding file handler. */
5027 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5028 /* If FILENAME has no handler, see if VISIT has one. */
5029 if (NILP (handler
) && STRINGP (visit
))
5030 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5032 if (!NILP (handler
))
5035 val
= call6 (handler
, Qwrite_region
, start
, end
,
5036 filename
, append
, visit
);
5040 SAVE_MODIFF
= MODIFF
;
5041 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5042 current_buffer
->filename
= visit_file
;
5048 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5050 /* Special kludge to simplify auto-saving. */
5053 XSETFASTINT (start
, BEG
);
5054 XSETFASTINT (end
, Z
);
5058 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5059 count1
= SPECPDL_INDEX ();
5061 given_buffer
= current_buffer
;
5063 if (!STRINGP (start
))
5065 annotations
= build_annotations (start
, end
);
5067 if (current_buffer
!= given_buffer
)
5069 XSETFASTINT (start
, BEGV
);
5070 XSETFASTINT (end
, ZV
);
5076 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5078 /* Decide the coding-system to encode the data with.
5079 We used to make this choice before calling build_annotations, but that
5080 leads to problems when a write-annotate-function takes care of
5081 unsavable chars (as was the case with X-Symbol). */
5082 choose_write_coding_system (start
, end
, filename
,
5083 append
, visit
, lockname
, &coding
);
5084 Vlast_coding_system_used
= coding
.symbol
;
5086 given_buffer
= current_buffer
;
5087 if (! STRINGP (start
))
5089 annotations
= build_annotations_2 (start
, end
,
5090 coding
.pre_write_conversion
, annotations
);
5091 if (current_buffer
!= given_buffer
)
5093 XSETFASTINT (start
, BEGV
);
5094 XSETFASTINT (end
, ZV
);
5098 #ifdef CLASH_DETECTION
5101 #if 0 /* This causes trouble for GNUS. */
5102 /* If we've locked this file for some other buffer,
5103 query before proceeding. */
5104 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5105 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5108 lock_file (lockname
);
5110 #endif /* CLASH_DETECTION */
5112 encoded_filename
= ENCODE_FILE (filename
);
5114 fn
= SDATA (encoded_filename
);
5118 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5119 #else /* not DOS_NT */
5120 desc
= emacs_open (fn
, O_WRONLY
, 0);
5121 #endif /* not DOS_NT */
5123 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5125 if (auto_saving
) /* Overwrite any previous version of autosave file */
5127 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5128 desc
= emacs_open (fn
, O_RDWR
, 0);
5130 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5131 ? SDATA (current_buffer
->filename
) : 0,
5134 else /* Write to temporary name and rename if no errors */
5136 Lisp_Object temp_name
;
5137 temp_name
= Ffile_name_directory (filename
);
5139 if (!NILP (temp_name
))
5141 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5142 build_string ("$$SAVE$$")));
5143 fname
= SDATA (filename
);
5144 fn
= SDATA (temp_name
);
5145 desc
= creat_copy_attrs (fname
, fn
);
5148 /* If we can't open the temporary file, try creating a new
5149 version of the original file. VMS "creat" creates a
5150 new version rather than truncating an existing file. */
5153 desc
= creat (fn
, 0666);
5154 #if 0 /* This can clobber an existing file and fail to replace it,
5155 if the user runs out of space. */
5158 /* We can't make a new version;
5159 try to truncate and rewrite existing version if any. */
5161 desc
= emacs_open (fn
, O_RDWR
, 0);
5167 desc
= creat (fn
, 0666);
5171 desc
= emacs_open (fn
,
5172 O_WRONLY
| O_CREAT
| buffer_file_type
5173 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5174 S_IREAD
| S_IWRITE
);
5175 #else /* not DOS_NT */
5176 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5177 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5178 auto_saving
? auto_save_mode_bits
: 0666);
5179 #endif /* not DOS_NT */
5180 #endif /* not VMS */
5184 #ifdef CLASH_DETECTION
5186 if (!auto_saving
) unlock_file (lockname
);
5188 #endif /* CLASH_DETECTION */
5190 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5193 record_unwind_protect (close_file_unwind
, make_number (desc
));
5195 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5199 if (NUMBERP (append
))
5200 ret
= lseek (desc
, XINT (append
), 1);
5202 ret
= lseek (desc
, 0, 2);
5205 #ifdef CLASH_DETECTION
5206 if (!auto_saving
) unlock_file (lockname
);
5207 #endif /* CLASH_DETECTION */
5209 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5217 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5218 * if we do writes that don't end with a carriage return. Furthermore
5219 * it cannot handle writes of more then 16K. The modified
5220 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5221 * this EXCEPT for the last record (iff it doesn't end with a carriage
5222 * return). This implies that if your buffer doesn't end with a carriage
5223 * return, you get one free... tough. However it also means that if
5224 * we make two calls to sys_write (a la the following code) you can
5225 * get one at the gap as well. The easiest way to fix this (honest)
5226 * is to move the gap to the next newline (or the end of the buffer).
5231 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5232 move_gap (find_next_newline (GPT
, 1));
5234 /* Whether VMS or not, we must move the gap to the next of newline
5235 when we must put designation sequences at beginning of line. */
5236 if (INTEGERP (start
)
5237 && coding
.type
== coding_type_iso2022
5238 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5239 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5241 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5242 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5243 move_gap_both (PT
, PT_BYTE
);
5244 SET_PT_BOTH (opoint
, opoint_byte
);
5251 if (STRINGP (start
))
5253 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5254 &annotations
, &coding
);
5257 else if (XINT (start
) != XINT (end
))
5259 tem
= CHAR_TO_BYTE (XINT (start
));
5261 if (XINT (start
) < GPT
)
5263 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5264 min (GPT
, XINT (end
)) - XINT (start
),
5265 &annotations
, &coding
);
5269 if (XINT (end
) > GPT
&& !failure
)
5271 tem
= max (XINT (start
), GPT
);
5272 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5273 &annotations
, &coding
);
5279 /* If file was empty, still need to write the annotations */
5280 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5281 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5285 if (CODING_REQUIRE_FLUSHING (&coding
)
5286 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5289 /* We have to flush out a data. */
5290 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5291 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5298 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5299 Disk full in NFS may be reported here. */
5300 /* mib says that closing the file will try to write as fast as NFS can do
5301 it, and that means the fsync here is not crucial for autosave files. */
5302 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5304 /* If fsync fails with EINTR, don't treat that as serious. */
5306 failure
= 1, save_errno
= errno
;
5310 /* Spurious "file has changed on disk" warnings have been
5311 observed on Suns as well.
5312 It seems that `close' can change the modtime, under nfs.
5314 (This has supposedly been fixed in Sunos 4,
5315 but who knows about all the other machines with NFS?) */
5318 /* On VMS and APOLLO, must do the stat after the close
5319 since closing changes the modtime. */
5322 /* Recall that #if defined does not work on VMS. */
5329 /* NFS can report a write failure now. */
5330 if (emacs_close (desc
) < 0)
5331 failure
= 1, save_errno
= errno
;
5334 /* If we wrote to a temporary name and had no errors, rename to real name. */
5338 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5346 /* Discard the unwind protect for close_file_unwind. */
5347 specpdl_ptr
= specpdl
+ count1
;
5348 /* Restore the original current buffer. */
5349 visit_file
= unbind_to (count
, visit_file
);
5351 #ifdef CLASH_DETECTION
5353 unlock_file (lockname
);
5354 #endif /* CLASH_DETECTION */
5356 /* Do this before reporting IO error
5357 to avoid a "file has changed on disk" warning on
5358 next attempt to save. */
5360 current_buffer
->modtime
= st
.st_mtime
;
5363 error ("IO error writing %s: %s", SDATA (filename
),
5364 emacs_strerror (save_errno
));
5368 SAVE_MODIFF
= MODIFF
;
5369 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5370 current_buffer
->filename
= visit_file
;
5371 update_mode_lines
++;
5376 && ! NILP (Fstring_equal (current_buffer
->filename
,
5377 current_buffer
->auto_save_file_name
)))
5378 SAVE_MODIFF
= MODIFF
;
5384 message_with_string ((INTEGERP (append
)
5394 Lisp_Object
merge ();
5396 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5397 doc
: /* Return t if (car A) is numerically less than (car B). */)
5401 return Flss (Fcar (a
), Fcar (b
));
5404 /* Build the complete list of annotations appropriate for writing out
5405 the text between START and END, by calling all the functions in
5406 write-region-annotate-functions and merging the lists they return.
5407 If one of these functions switches to a different buffer, we assume
5408 that buffer contains altered text. Therefore, the caller must
5409 make sure to restore the current buffer in all cases,
5410 as save-excursion would do. */
5413 build_annotations (start
, end
)
5414 Lisp_Object start
, end
;
5416 Lisp_Object annotations
;
5418 struct gcpro gcpro1
, gcpro2
;
5419 Lisp_Object original_buffer
;
5420 int i
, used_global
= 0;
5422 XSETBUFFER (original_buffer
, current_buffer
);
5425 p
= Vwrite_region_annotate_functions
;
5426 GCPRO2 (annotations
, p
);
5429 struct buffer
*given_buffer
= current_buffer
;
5430 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5431 { /* Use the global value of the hook. */
5434 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5436 p
= Fappend (2, arg
);
5439 Vwrite_region_annotations_so_far
= annotations
;
5440 res
= call2 (XCAR (p
), start
, end
);
5441 /* If the function makes a different buffer current,
5442 assume that means this buffer contains altered text to be output.
5443 Reset START and END from the buffer bounds
5444 and discard all previous annotations because they should have
5445 been dealt with by this function. */
5446 if (current_buffer
!= given_buffer
)
5448 XSETFASTINT (start
, BEGV
);
5449 XSETFASTINT (end
, ZV
);
5452 Flength (res
); /* Check basic validity of return value */
5453 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5457 /* Now do the same for annotation functions implied by the file-format */
5458 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5459 p
= current_buffer
->auto_save_file_format
;
5461 p
= current_buffer
->file_format
;
5462 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5464 struct buffer
*given_buffer
= current_buffer
;
5466 Vwrite_region_annotations_so_far
= annotations
;
5468 /* Value is either a list of annotations or nil if the function
5469 has written annotations to a temporary buffer, which is now
5471 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5472 original_buffer
, make_number (i
));
5473 if (current_buffer
!= given_buffer
)
5475 XSETFASTINT (start
, BEGV
);
5476 XSETFASTINT (end
, ZV
);
5481 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5489 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5490 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5492 struct gcpro gcpro1
;
5495 GCPRO1 (annotations
);
5496 /* At last, do the same for the function PRE_WRITE_CONVERSION
5497 implied by the current coding-system. */
5498 if (!NILP (pre_write_conversion
))
5500 struct buffer
*given_buffer
= current_buffer
;
5501 Vwrite_region_annotations_so_far
= annotations
;
5502 res
= call2 (pre_write_conversion
, start
, end
);
5504 annotations
= (current_buffer
!= given_buffer
5506 : merge (annotations
, res
, Qcar_less_than_car
));
5513 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5514 If STRING is nil, POS is the character position in the current buffer.
5515 Intersperse with them the annotations from *ANNOT
5516 which fall within the range of POS to POS + NCHARS,
5517 each at its appropriate position.
5519 We modify *ANNOT by discarding elements as we use them up.
5521 The return value is negative in case of system call failure. */
5524 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5527 register int nchars
;
5530 struct coding_system
*coding
;
5534 int lastpos
= pos
+ nchars
;
5536 while (NILP (*annot
) || CONSP (*annot
))
5538 tem
= Fcar_safe (Fcar (*annot
));
5541 nextpos
= XFASTINT (tem
);
5543 /* If there are no more annotations in this range,
5544 output the rest of the range all at once. */
5545 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5546 return e_write (desc
, string
, pos
, lastpos
, coding
);
5548 /* Output buffer text up to the next annotation's position. */
5551 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5555 /* Output the annotation. */
5556 tem
= Fcdr (Fcar (*annot
));
5559 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5562 *annot
= Fcdr (*annot
);
5567 #ifndef WRITE_BUF_SIZE
5568 #define WRITE_BUF_SIZE (16 * 1024)
5571 /* Write text in the range START and END into descriptor DESC,
5572 encoding them with coding system CODING. If STRING is nil, START
5573 and END are character positions of the current buffer, else they
5574 are indexes to the string STRING. */
5577 e_write (desc
, string
, start
, end
, coding
)
5581 struct coding_system
*coding
;
5583 register char *addr
;
5584 register int nbytes
;
5585 char buf
[WRITE_BUF_SIZE
];
5589 coding
->composing
= COMPOSITION_DISABLED
;
5590 if (coding
->composing
!= COMPOSITION_DISABLED
)
5591 coding_save_composition (coding
, start
, end
, string
);
5593 if (STRINGP (string
))
5595 addr
= SDATA (string
);
5596 nbytes
= SBYTES (string
);
5597 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5599 else if (start
< end
)
5601 /* It is assured that the gap is not in the range START and END-1. */
5602 addr
= CHAR_POS_ADDR (start
);
5603 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5604 coding
->src_multibyte
5605 = !NILP (current_buffer
->enable_multibyte_characters
);
5611 coding
->src_multibyte
= 1;
5614 /* We used to have a code for handling selective display here. But,
5615 now it is handled within encode_coding. */
5620 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5621 if (coding
->produced
> 0)
5623 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5624 if (coding
->produced
)
5630 nbytes
-= coding
->consumed
;
5631 addr
+= coding
->consumed
;
5632 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5635 /* The source text ends by an incomplete multibyte form.
5636 There's no way other than write it out as is. */
5637 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5646 start
+= coding
->consumed_char
;
5647 if (coding
->cmp_data
)
5648 coding_adjust_composition_offset (coding
, start
);
5651 if (coding
->cmp_data
)
5652 coding_free_composition_data (coding
);
5657 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5658 Sverify_visited_file_modtime
, 1, 1, 0,
5659 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5660 This means that the file has not been changed since it was visited or saved.
5661 See Info node `(elisp)Modification Time' for more details. */)
5667 Lisp_Object handler
;
5668 Lisp_Object filename
;
5673 if (!STRINGP (b
->filename
)) return Qt
;
5674 if (b
->modtime
== 0) return Qt
;
5676 /* If the file name has special constructs in it,
5677 call the corresponding file handler. */
5678 handler
= Ffind_file_name_handler (b
->filename
,
5679 Qverify_visited_file_modtime
);
5680 if (!NILP (handler
))
5681 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5683 filename
= ENCODE_FILE (b
->filename
);
5685 if (stat (SDATA (filename
), &st
) < 0)
5687 /* If the file doesn't exist now and didn't exist before,
5688 we say that it isn't modified, provided the error is a tame one. */
5689 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5694 if (st
.st_mtime
== b
->modtime
5695 /* If both are positive, accept them if they are off by one second. */
5696 || (st
.st_mtime
> 0 && b
->modtime
> 0
5697 && (st
.st_mtime
== b
->modtime
+ 1
5698 || st
.st_mtime
== b
->modtime
- 1)))
5703 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5704 Sclear_visited_file_modtime
, 0, 0, 0,
5705 doc
: /* Clear out records of last mod time of visited file.
5706 Next attempt to save will certainly not complain of a discrepancy. */)
5709 current_buffer
->modtime
= 0;
5713 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5714 Svisited_file_modtime
, 0, 0, 0,
5715 doc
: /* Return the current buffer's recorded visited file modification time.
5716 The value is a list of the form (HIGH LOW), like the time values
5717 that `file-attributes' returns. If the current buffer has no recorded
5718 file modification time, this function returns 0.
5719 See Info node `(elisp)Modification Time' for more details. */)
5723 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5725 return list2 (XCAR (tcons
), XCDR (tcons
));
5729 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5730 Sset_visited_file_modtime
, 0, 1, 0,
5731 doc
: /* Update buffer's recorded modification time from the visited file's time.
5732 Useful if the buffer was not read from the file normally
5733 or if the file itself has been changed for some known benign reason.
5734 An argument specifies the modification time value to use
5735 \(instead of that of the visited file), in the form of a list
5736 \(HIGH . LOW) or (HIGH LOW). */)
5738 Lisp_Object time_list
;
5740 if (!NILP (time_list
))
5741 current_buffer
->modtime
= cons_to_long (time_list
);
5744 register Lisp_Object filename
;
5746 Lisp_Object handler
;
5748 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5750 /* If the file name has special constructs in it,
5751 call the corresponding file handler. */
5752 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5753 if (!NILP (handler
))
5754 /* The handler can find the file name the same way we did. */
5755 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5757 filename
= ENCODE_FILE (filename
);
5759 if (stat (SDATA (filename
), &st
) >= 0)
5760 current_buffer
->modtime
= st
.st_mtime
;
5767 auto_save_error (error
)
5770 Lisp_Object args
[3], msg
;
5772 struct gcpro gcpro1
;
5778 args
[0] = build_string ("Auto-saving %s: %s");
5779 args
[1] = current_buffer
->name
;
5780 args
[2] = Ferror_message_string (error
);
5781 msg
= Fformat (3, args
);
5783 nbytes
= SBYTES (msg
);
5784 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5785 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5787 for (i
= 0; i
< 3; ++i
)
5790 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5792 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5793 Fsleep_for (make_number (1), Qnil
);
5807 auto_save_mode_bits
= 0666;
5809 /* Get visited file's mode to become the auto save file's mode. */
5810 if (! NILP (current_buffer
->filename
))
5812 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5813 /* But make sure we can overwrite it later! */
5814 auto_save_mode_bits
= st
.st_mode
| 0600;
5815 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5817 /* Remote files don't cooperate with stat. */
5818 auto_save_mode_bits
= XINT (modes
) | 0600;
5822 Fwrite_region (Qnil
, Qnil
,
5823 current_buffer
->auto_save_file_name
,
5824 Qnil
, Qlambda
, Qnil
, Qnil
);
5828 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5831 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5839 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5842 minibuffer_auto_raise
= XINT (value
);
5847 do_auto_save_make_dir (dir
)
5850 return call2 (Qmake_directory
, dir
, Qt
);
5854 do_auto_save_eh (ignore
)
5860 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5861 doc
: /* Auto-save all buffers that need it.
5862 This is all buffers that have auto-saving enabled
5863 and are changed since last auto-saved.
5864 Auto-saving writes the buffer into a file
5865 so that your editing is not lost if the system crashes.
5866 This file is not the file you visited; that changes only when you save.
5867 Normally we run the normal hook `auto-save-hook' before saving.
5869 A non-nil NO-MESSAGE argument means do not print any message if successful.
5870 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5871 (no_message
, current_only
)
5872 Lisp_Object no_message
, current_only
;
5874 struct buffer
*old
= current_buffer
, *b
;
5875 Lisp_Object tail
, buf
;
5877 int do_handled_files
;
5879 FILE *stream
= NULL
;
5880 int count
= SPECPDL_INDEX ();
5881 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5882 int old_message_p
= 0;
5883 struct gcpro gcpro1
, gcpro2
;
5885 if (max_specpdl_size
< specpdl_size
+ 40)
5886 max_specpdl_size
= specpdl_size
+ 40;
5891 if (NILP (no_message
))
5893 old_message_p
= push_message ();
5894 record_unwind_protect (pop_message_unwind
, Qnil
);
5897 /* Ordinarily don't quit within this function,
5898 but don't make it impossible to quit (in case we get hung in I/O). */
5902 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5903 point to non-strings reached from Vbuffer_alist. */
5905 if (!NILP (Vrun_hooks
))
5906 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5908 if (STRINGP (Vauto_save_list_file_name
))
5910 Lisp_Object listfile
;
5912 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5914 /* Don't try to create the directory when shutting down Emacs,
5915 because creating the directory might signal an error, and
5916 that would leave Emacs in a strange state. */
5917 if (!NILP (Vrun_hooks
))
5921 GCPRO2 (dir
, listfile
);
5922 dir
= Ffile_name_directory (listfile
);
5923 if (NILP (Ffile_directory_p (dir
)))
5924 internal_condition_case_1 (do_auto_save_make_dir
,
5925 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5930 stream
= fopen (SDATA (listfile
), "w");
5933 record_unwind_protect (do_auto_save_unwind
,
5934 make_save_value (stream
, 0));
5935 record_unwind_protect (do_auto_save_unwind_1
,
5936 make_number (minibuffer_auto_raise
));
5937 minibuffer_auto_raise
= 0;
5940 /* On first pass, save all files that don't have handlers.
5941 On second pass, save all files that do have handlers.
5943 If Emacs is crashing, the handlers may tweak what is causing
5944 Emacs to crash in the first place, and it would be a shame if
5945 Emacs failed to autosave perfectly ordinary files because it
5946 couldn't handle some ange-ftp'd file. */
5948 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5949 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5951 buf
= XCDR (XCAR (tail
));
5954 /* Record all the buffers that have auto save mode
5955 in the special file that lists them. For each of these buffers,
5956 Record visited name (if any) and auto save name. */
5957 if (STRINGP (b
->auto_save_file_name
)
5958 && stream
!= NULL
&& do_handled_files
== 0)
5960 if (!NILP (b
->filename
))
5962 fwrite (SDATA (b
->filename
), 1,
5963 SBYTES (b
->filename
), stream
);
5965 putc ('\n', stream
);
5966 fwrite (SDATA (b
->auto_save_file_name
), 1,
5967 SBYTES (b
->auto_save_file_name
), stream
);
5968 putc ('\n', stream
);
5971 if (!NILP (current_only
)
5972 && b
!= current_buffer
)
5975 /* Don't auto-save indirect buffers.
5976 The base buffer takes care of it. */
5980 /* Check for auto save enabled
5981 and file changed since last auto save
5982 and file changed since last real save. */
5983 if (STRINGP (b
->auto_save_file_name
)
5984 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5985 && b
->auto_save_modified
< BUF_MODIFF (b
)
5986 /* -1 means we've turned off autosaving for a while--see below. */
5987 && XINT (b
->save_length
) >= 0
5988 && (do_handled_files
5989 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5992 EMACS_TIME before_time
, after_time
;
5994 EMACS_GET_TIME (before_time
);
5996 /* If we had a failure, don't try again for 20 minutes. */
5997 if (b
->auto_save_failure_time
>= 0
5998 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6001 if ((XFASTINT (b
->save_length
) * 10
6002 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6003 /* A short file is likely to change a large fraction;
6004 spare the user annoying messages. */
6005 && XFASTINT (b
->save_length
) > 5000
6006 /* These messages are frequent and annoying for `*mail*'. */
6007 && !EQ (b
->filename
, Qnil
)
6008 && NILP (no_message
))
6010 /* It has shrunk too much; turn off auto-saving here. */
6011 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6012 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6014 minibuffer_auto_raise
= 0;
6015 /* Turn off auto-saving until there's a real save,
6016 and prevent any more warnings. */
6017 XSETINT (b
->save_length
, -1);
6018 Fsleep_for (make_number (1), Qnil
);
6021 set_buffer_internal (b
);
6022 if (!auto_saved
&& NILP (no_message
))
6023 message1 ("Auto-saving...");
6024 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6026 b
->auto_save_modified
= BUF_MODIFF (b
);
6027 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6028 set_buffer_internal (old
);
6030 EMACS_GET_TIME (after_time
);
6032 /* If auto-save took more than 60 seconds,
6033 assume it was an NFS failure that got a timeout. */
6034 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6035 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6039 /* Prevent another auto save till enough input events come in. */
6040 record_auto_save ();
6042 if (auto_saved
&& NILP (no_message
))
6046 /* If we are going to restore an old message,
6047 give time to read ours. */
6048 sit_for (1, 0, 0, 0, 0);
6052 /* If we displayed a message and then restored a state
6053 with no message, leave a "done" message on the screen. */
6054 message1 ("Auto-saving...done");
6059 /* This restores the message-stack status. */
6060 unbind_to (count
, Qnil
);
6064 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6065 Sset_buffer_auto_saved
, 0, 0, 0,
6066 doc
: /* Mark current buffer as auto-saved with its current text.
6067 No auto-save file will be written until the buffer changes again. */)
6070 current_buffer
->auto_save_modified
= MODIFF
;
6071 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6072 current_buffer
->auto_save_failure_time
= -1;
6076 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6077 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6078 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6081 current_buffer
->auto_save_failure_time
= -1;
6085 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6087 doc
: /* Return t if current buffer has been auto-saved recently.
6088 More precisely, if it has been auto-saved since last read from or saved
6089 in the visited file. If the buffer has no visited file,
6090 then any auto-save counts as "recent". */)
6093 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6096 /* Reading and completing file names */
6097 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6099 /* In the string VAL, change each $ to $$ and return the result. */
6102 double_dollars (val
)
6105 register const unsigned char *old
;
6106 register unsigned char *new;
6110 osize
= SBYTES (val
);
6112 /* Count the number of $ characters. */
6113 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6114 if (*old
++ == '$') count
++;
6118 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6121 for (n
= osize
; n
> 0; n
--)
6135 read_file_name_cleanup (arg
)
6138 return (current_buffer
->directory
= arg
);
6141 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6143 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6144 (string
, dir
, action
)
6145 Lisp_Object string
, dir
, action
;
6146 /* action is nil for complete, t for return list of completions,
6147 lambda for verify final value */
6149 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6151 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6153 CHECK_STRING (string
);
6160 /* No need to protect ACTION--we only compare it with t and nil. */
6161 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6163 if (SCHARS (string
) == 0)
6165 if (EQ (action
, Qlambda
))
6173 orig_string
= string
;
6174 string
= Fsubstitute_in_file_name (string
);
6175 changed
= NILP (Fstring_equal (string
, orig_string
));
6176 name
= Ffile_name_nondirectory (string
);
6177 val
= Ffile_name_directory (string
);
6179 realdir
= Fexpand_file_name (val
, realdir
);
6184 specdir
= Ffile_name_directory (string
);
6185 val
= Ffile_name_completion (name
, realdir
);
6190 return double_dollars (string
);
6194 if (!NILP (specdir
))
6195 val
= concat2 (specdir
, val
);
6197 return double_dollars (val
);
6200 #endif /* not VMS */
6204 if (EQ (action
, Qt
))
6206 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6210 if (NILP (Vread_file_name_predicate
)
6211 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6215 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6217 /* Brute-force speed up for directory checking:
6218 Discard strings which don't end in a slash. */
6219 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6221 Lisp_Object tem
= XCAR (all
);
6223 if (STRINGP (tem
) &&
6224 (len
= SCHARS (tem
), len
> 0) &&
6225 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6226 comp
= Fcons (tem
, comp
);
6232 /* Must do it the hard (and slow) way. */
6234 GCPRO3 (all
, comp
, specdir
);
6235 count
= SPECPDL_INDEX ();
6236 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6237 current_buffer
->directory
= realdir
;
6238 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6240 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6242 comp
= Fcons (XCAR (all
), comp
);
6244 unbind_to (count
, Qnil
);
6247 return Fnreverse (comp
);
6250 /* Only other case actually used is ACTION = lambda */
6252 /* Supposedly this helps commands such as `cd' that read directory names,
6253 but can someone explain how it helps them? -- RMS */
6254 if (SCHARS (name
) == 0)
6257 string
= Fexpand_file_name (string
, dir
);
6258 if (!NILP (Vread_file_name_predicate
))
6259 return call1 (Vread_file_name_predicate
, string
);
6260 return Ffile_exists_p (string
);
6263 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6264 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6265 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6266 The return value is only relevant for a call to `read-file-name' that happens
6267 before any other event (mouse or keypress) is handeled. */)
6270 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6271 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6280 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6281 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6282 Value is not expanded---you must call `expand-file-name' yourself.
6283 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6284 the same non-empty string that was inserted by this function.
6285 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6286 except that if INITIAL is specified, that combined with DIR is used.)
6287 If the user exits with an empty minibuffer, this function returns
6288 an empty string. (This can only happen if the user erased the
6289 pre-inserted contents or if `insert-default-directory' is nil.)
6290 Fourth arg MUSTMATCH non-nil means require existing file's name.
6291 Non-nil and non-t means also require confirmation after completion.
6292 Fifth arg INITIAL specifies text to start with.
6293 If optional sixth arg PREDICATE is non-nil, possible completions and
6294 the resulting file name must satisfy (funcall PREDICATE NAME).
6295 DIR should be an absolute directory name. It defaults to the value of
6296 `default-directory'.
6298 If this command was invoked with the mouse, use a file dialog box if
6299 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6300 provides a file dialog box.
6302 See also `read-file-name-completion-ignore-case'
6303 and `read-file-name-function'. */)
6304 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6305 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6307 Lisp_Object val
, insdef
, tem
;
6308 struct gcpro gcpro1
, gcpro2
;
6309 register char *homedir
;
6310 Lisp_Object decoded_homedir
;
6311 int replace_in_history
= 0;
6312 int add_to_history
= 0;
6316 dir
= current_buffer
->directory
;
6317 if (NILP (Ffile_name_absolute_p (dir
)))
6318 dir
= Fexpand_file_name (dir
, Qnil
);
6319 if (NILP (default_filename
))
6322 ? Fexpand_file_name (initial
, dir
)
6323 : current_buffer
->filename
);
6325 /* If dir starts with user's homedir, change that to ~. */
6326 homedir
= (char *) egetenv ("HOME");
6328 /* homedir can be NULL in temacs, since Vprocess_environment is not
6329 yet set up. We shouldn't crash in that case. */
6332 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6333 CORRECT_DIR_SEPS (homedir
);
6338 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6341 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6342 SBYTES (decoded_homedir
))
6343 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6345 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6346 dir
= concat2 (build_string ("~"), dir
);
6348 /* Likewise for default_filename. */
6350 && STRINGP (default_filename
)
6351 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6352 SBYTES (decoded_homedir
))
6353 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6356 = Fsubstring (default_filename
,
6357 make_number (SCHARS (decoded_homedir
)), Qnil
);
6358 default_filename
= concat2 (build_string ("~"), default_filename
);
6360 if (!NILP (default_filename
))
6362 CHECK_STRING (default_filename
);
6363 default_filename
= double_dollars (default_filename
);
6366 if (insert_default_directory
&& STRINGP (dir
))
6369 if (!NILP (initial
))
6371 Lisp_Object args
[2], pos
;
6375 insdef
= Fconcat (2, args
);
6376 pos
= make_number (SCHARS (double_dollars (dir
)));
6377 insdef
= Fcons (double_dollars (insdef
), pos
);
6380 insdef
= double_dollars (insdef
);
6382 else if (STRINGP (initial
))
6383 insdef
= Fcons (double_dollars (initial
), make_number (0));
6387 if (!NILP (Vread_file_name_function
))
6389 Lisp_Object args
[7];
6391 GCPRO2 (insdef
, default_filename
);
6392 args
[0] = Vread_file_name_function
;
6395 args
[3] = default_filename
;
6396 args
[4] = mustmatch
;
6398 args
[6] = predicate
;
6399 RETURN_UNGCPRO (Ffuncall (7, args
));
6402 count
= SPECPDL_INDEX ();
6403 specbind (intern ("completion-ignore-case"),
6404 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6405 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6406 specbind (intern ("read-file-name-predicate"),
6407 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6409 GCPRO2 (insdef
, default_filename
);
6411 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6412 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6414 /* If DIR contains a file name, split it. */
6416 file
= Ffile_name_nondirectory (dir
);
6417 if (SCHARS (file
) && NILP (default_filename
))
6419 default_filename
= file
;
6420 dir
= Ffile_name_directory (dir
);
6422 if (!NILP(default_filename
))
6423 default_filename
= Fexpand_file_name (default_filename
, dir
);
6424 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6425 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6430 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6431 dir
, mustmatch
, insdef
,
6432 Qfile_name_history
, default_filename
, Qnil
);
6434 tem
= Fsymbol_value (Qfile_name_history
);
6435 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6436 replace_in_history
= 1;
6438 /* If Fcompleting_read returned the inserted default string itself
6439 (rather than a new string with the same contents),
6440 it has to mean that the user typed RET with the minibuffer empty.
6441 In that case, we really want to return ""
6442 so that commands such as set-visited-file-name can distinguish. */
6443 if (EQ (val
, default_filename
))
6445 /* In this case, Fcompleting_read has not added an element
6446 to the history. Maybe we should. */
6447 if (! replace_in_history
)
6453 unbind_to (count
, Qnil
);
6456 error ("No file name specified");
6458 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6460 if (!NILP (tem
) && !NILP (default_filename
))
6461 val
= default_filename
;
6462 val
= Fsubstitute_in_file_name (val
);
6464 if (replace_in_history
)
6465 /* Replace what Fcompleting_read added to the history
6466 with what we will actually return. */
6468 Lisp_Object val1
= double_dollars (val
);
6469 tem
= Fsymbol_value (Qfile_name_history
);
6470 if (history_delete_duplicates
)
6471 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6472 XSETCAR (tem
, val1
);
6474 else if (add_to_history
)
6476 /* Add the value to the history--but not if it matches
6477 the last value already there. */
6478 Lisp_Object val1
= double_dollars (val
);
6479 tem
= Fsymbol_value (Qfile_name_history
);
6480 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6482 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6483 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6494 /* Must be set before any path manipulation is performed. */
6495 XSETFASTINT (Vdirectory_sep_char
, '/');
6502 Qoperations
= intern ("operations");
6503 Qexpand_file_name
= intern ("expand-file-name");
6504 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6505 Qdirectory_file_name
= intern ("directory-file-name");
6506 Qfile_name_directory
= intern ("file-name-directory");
6507 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6508 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6509 Qfile_name_as_directory
= intern ("file-name-as-directory");
6510 Qcopy_file
= intern ("copy-file");
6511 Qmake_directory_internal
= intern ("make-directory-internal");
6512 Qmake_directory
= intern ("make-directory");
6513 Qdelete_directory
= intern ("delete-directory");
6514 Qdelete_file
= intern ("delete-file");
6515 Qrename_file
= intern ("rename-file");
6516 Qadd_name_to_file
= intern ("add-name-to-file");
6517 Qmake_symbolic_link
= intern ("make-symbolic-link");
6518 Qfile_exists_p
= intern ("file-exists-p");
6519 Qfile_executable_p
= intern ("file-executable-p");
6520 Qfile_readable_p
= intern ("file-readable-p");
6521 Qfile_writable_p
= intern ("file-writable-p");
6522 Qfile_symlink_p
= intern ("file-symlink-p");
6523 Qaccess_file
= intern ("access-file");
6524 Qfile_directory_p
= intern ("file-directory-p");
6525 Qfile_regular_p
= intern ("file-regular-p");
6526 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6527 Qfile_modes
= intern ("file-modes");
6528 Qset_file_modes
= intern ("set-file-modes");
6529 Qset_file_times
= intern ("set-file-times");
6530 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6531 Qinsert_file_contents
= intern ("insert-file-contents");
6532 Qwrite_region
= intern ("write-region");
6533 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6534 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6535 Qauto_save_coding
= intern ("auto-save-coding");
6537 staticpro (&Qoperations
);
6538 staticpro (&Qexpand_file_name
);
6539 staticpro (&Qsubstitute_in_file_name
);
6540 staticpro (&Qdirectory_file_name
);
6541 staticpro (&Qfile_name_directory
);
6542 staticpro (&Qfile_name_nondirectory
);
6543 staticpro (&Qunhandled_file_name_directory
);
6544 staticpro (&Qfile_name_as_directory
);
6545 staticpro (&Qcopy_file
);
6546 staticpro (&Qmake_directory_internal
);
6547 staticpro (&Qmake_directory
);
6548 staticpro (&Qdelete_directory
);
6549 staticpro (&Qdelete_file
);
6550 staticpro (&Qrename_file
);
6551 staticpro (&Qadd_name_to_file
);
6552 staticpro (&Qmake_symbolic_link
);
6553 staticpro (&Qfile_exists_p
);
6554 staticpro (&Qfile_executable_p
);
6555 staticpro (&Qfile_readable_p
);
6556 staticpro (&Qfile_writable_p
);
6557 staticpro (&Qaccess_file
);
6558 staticpro (&Qfile_symlink_p
);
6559 staticpro (&Qfile_directory_p
);
6560 staticpro (&Qfile_regular_p
);
6561 staticpro (&Qfile_accessible_directory_p
);
6562 staticpro (&Qfile_modes
);
6563 staticpro (&Qset_file_modes
);
6564 staticpro (&Qset_file_times
);
6565 staticpro (&Qfile_newer_than_file_p
);
6566 staticpro (&Qinsert_file_contents
);
6567 staticpro (&Qwrite_region
);
6568 staticpro (&Qverify_visited_file_modtime
);
6569 staticpro (&Qset_visited_file_modtime
);
6570 staticpro (&Qauto_save_coding
);
6572 Qfile_name_history
= intern ("file-name-history");
6573 Fset (Qfile_name_history
, Qnil
);
6574 staticpro (&Qfile_name_history
);
6576 Qfile_error
= intern ("file-error");
6577 staticpro (&Qfile_error
);
6578 Qfile_already_exists
= intern ("file-already-exists");
6579 staticpro (&Qfile_already_exists
);
6580 Qfile_date_error
= intern ("file-date-error");
6581 staticpro (&Qfile_date_error
);
6582 Qexcl
= intern ("excl");
6586 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6587 staticpro (&Qfind_buffer_file_type
);
6590 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6591 doc
: /* *Coding system for encoding file names.
6592 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6593 Vfile_name_coding_system
= Qnil
;
6595 DEFVAR_LISP ("default-file-name-coding-system",
6596 &Vdefault_file_name_coding_system
,
6597 doc
: /* Default coding system for encoding file names.
6598 This variable is used only when `file-name-coding-system' is nil.
6600 This variable is set/changed by the command `set-language-environment'.
6601 User should not set this variable manually,
6602 instead use `file-name-coding-system' to get a constant encoding
6603 of file names regardless of the current language environment. */);
6604 Vdefault_file_name_coding_system
= Qnil
;
6606 Qformat_decode
= intern ("format-decode");
6607 staticpro (&Qformat_decode
);
6608 Qformat_annotate_function
= intern ("format-annotate-function");
6609 staticpro (&Qformat_annotate_function
);
6610 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6611 staticpro (&Qafter_insert_file_set_coding
);
6613 Qcar_less_than_car
= intern ("car-less-than-car");
6614 staticpro (&Qcar_less_than_car
);
6616 Fput (Qfile_error
, Qerror_conditions
,
6617 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6618 Fput (Qfile_error
, Qerror_message
,
6619 build_string ("File error"));
6621 Fput (Qfile_already_exists
, Qerror_conditions
,
6622 Fcons (Qfile_already_exists
,
6623 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6624 Fput (Qfile_already_exists
, Qerror_message
,
6625 build_string ("File already exists"));
6627 Fput (Qfile_date_error
, Qerror_conditions
,
6628 Fcons (Qfile_date_error
,
6629 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6630 Fput (Qfile_date_error
, Qerror_message
,
6631 build_string ("Cannot set file date"));
6633 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6634 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6635 Vread_file_name_function
= Qnil
;
6637 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6638 doc
: /* Current predicate used by `read-file-name-internal'. */);
6639 Vread_file_name_predicate
= Qnil
;
6641 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6642 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6643 #if defined VMS || defined DOS_NT || defined MAC_OS
6644 read_file_name_completion_ignore_case
= 1;
6646 read_file_name_completion_ignore_case
= 0;
6649 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6650 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6651 If the initial minibuffer contents are non-empty, you can usually
6652 request a default filename by typing RETURN without editing. For some
6653 commands, exiting with an empty minibuffer has a special meaning,
6654 such as making the current buffer visit no file in the case of
6655 `set-visited-file-name'.
6656 If this variable is non-nil, the minibuffer contents are always
6657 initially non-empty and typing RETURN without editing will fetch the
6658 default name, if one is provided. Note however that this default name
6659 is not necessarily the name originally inserted in the minibuffer, if
6660 that is just the default directory.
6661 If this variable is nil, the minibuffer often starts out empty. In
6662 that case you may have to explicitly fetch the next history element to
6663 request the default name. */);
6664 insert_default_directory
= 1;
6666 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6667 doc
: /* *Non-nil means write new files with record format `stmlf'.
6668 nil means use format `var'. This variable is meaningful only on VMS. */);
6669 vms_stmlf_recfm
= 0;
6671 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6672 doc
: /* Directory separator character for built-in functions that return file names.
6673 The value is always ?/. Don't use this variable, just use `/'. */);
6675 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6676 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6677 If a file name matches REGEXP, then all I/O on that file is done by calling
6680 The first argument given to HANDLER is the name of the I/O primitive
6681 to be handled; the remaining arguments are the arguments that were
6682 passed to that primitive. For example, if you do
6683 (file-exists-p FILENAME)
6684 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6685 (funcall HANDLER 'file-exists-p FILENAME)
6686 The function `find-file-name-handler' checks this list for a handler
6687 for its argument. */);
6688 Vfile_name_handler_alist
= Qnil
;
6690 DEFVAR_LISP ("set-auto-coding-function",
6691 &Vset_auto_coding_function
,
6692 doc
: /* If non-nil, a function to call to decide a coding system of file.
6693 Two arguments are passed to this function: the file name
6694 and the length of a file contents following the point.
6695 This function should return a coding system to decode the file contents.
6696 It should check the file name against `auto-coding-alist'.
6697 If no coding system is decided, it should check a coding system
6698 specified in the heading lines with the format:
6699 -*- ... coding: CODING-SYSTEM; ... -*-
6700 or local variable spec of the tailing lines with `coding:' tag. */);
6701 Vset_auto_coding_function
= Qnil
;
6703 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6704 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6705 Each is passed one argument, the number of characters inserted.
6706 It should return the new character count, and leave point the same.
6707 If `insert-file-contents' is intercepted by a handler from
6708 `file-name-handler-alist', that handler is responsible for calling the
6709 functions in `after-insert-file-functions' if appropriate. */);
6710 Vafter_insert_file_functions
= Qnil
;
6712 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6713 doc
: /* A list of functions to be called at the start of `write-region'.
6714 Each is passed two arguments, START and END as for `write-region'.
6715 These are usually two numbers but not always; see the documentation
6716 for `write-region'. The function should return a list of pairs
6717 of the form (POSITION . STRING), consisting of strings to be effectively
6718 inserted at the specified positions of the file being written (1 means to
6719 insert before the first byte written). The POSITIONs must be sorted into
6720 increasing order. If there are several functions in the list, the several
6721 lists are merged destructively. Alternatively, the function can return
6722 with a different buffer current; in that case it should pay attention
6723 to the annotations returned by previous functions and listed in
6724 `write-region-annotations-so-far'.*/);
6725 Vwrite_region_annotate_functions
= Qnil
;
6726 staticpro (&Qwrite_region_annotate_functions
);
6727 Qwrite_region_annotate_functions
6728 = intern ("write-region-annotate-functions");
6730 DEFVAR_LISP ("write-region-annotations-so-far",
6731 &Vwrite_region_annotations_so_far
,
6732 doc
: /* When an annotation function is called, this holds the previous annotations.
6733 These are the annotations made by other annotation functions
6734 that were already called. See also `write-region-annotate-functions'. */);
6735 Vwrite_region_annotations_so_far
= Qnil
;
6737 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6738 doc
: /* A list of file name handlers that temporarily should not be used.
6739 This applies only to the operation `inhibit-file-name-operation'. */);
6740 Vinhibit_file_name_handlers
= Qnil
;
6742 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6743 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6744 Vinhibit_file_name_operation
= Qnil
;
6746 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6747 doc
: /* File name in which we write a list of all auto save file names.
6748 This variable is initialized automatically from `auto-save-list-file-prefix'
6749 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6750 a non-nil value. */);
6751 Vauto_save_list_file_name
= Qnil
;
6754 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6755 doc
: /* *Non-nil means don't call fsync in `write-region'.
6756 This variable affects calls to `write-region' as well as save commands.
6757 A non-nil value may result in data loss! */);
6758 write_region_inhibit_fsync
= 0;
6761 defsubr (&Sfind_file_name_handler
);
6762 defsubr (&Sfile_name_directory
);
6763 defsubr (&Sfile_name_nondirectory
);
6764 defsubr (&Sunhandled_file_name_directory
);
6765 defsubr (&Sfile_name_as_directory
);
6766 defsubr (&Sdirectory_file_name
);
6767 defsubr (&Smake_temp_name
);
6768 defsubr (&Sexpand_file_name
);
6769 defsubr (&Ssubstitute_in_file_name
);
6770 defsubr (&Scopy_file
);
6771 defsubr (&Smake_directory_internal
);
6772 defsubr (&Sdelete_directory
);
6773 defsubr (&Sdelete_file
);
6774 defsubr (&Srename_file
);
6775 defsubr (&Sadd_name_to_file
);
6777 defsubr (&Smake_symbolic_link
);
6778 #endif /* S_IFLNK */
6780 defsubr (&Sdefine_logical_name
);
6783 defsubr (&Ssysnetunam
);
6784 #endif /* HPUX_NET */
6785 defsubr (&Sfile_name_absolute_p
);
6786 defsubr (&Sfile_exists_p
);
6787 defsubr (&Sfile_executable_p
);
6788 defsubr (&Sfile_readable_p
);
6789 defsubr (&Sfile_writable_p
);
6790 defsubr (&Saccess_file
);
6791 defsubr (&Sfile_symlink_p
);
6792 defsubr (&Sfile_directory_p
);
6793 defsubr (&Sfile_accessible_directory_p
);
6794 defsubr (&Sfile_regular_p
);
6795 defsubr (&Sfile_modes
);
6796 defsubr (&Sset_file_modes
);
6797 defsubr (&Sset_file_times
);
6798 defsubr (&Sset_default_file_modes
);
6799 defsubr (&Sdefault_file_modes
);
6800 defsubr (&Sfile_newer_than_file_p
);
6801 defsubr (&Sinsert_file_contents
);
6802 defsubr (&Swrite_region
);
6803 defsubr (&Scar_less_than_car
);
6804 defsubr (&Sverify_visited_file_modtime
);
6805 defsubr (&Sclear_visited_file_modtime
);
6806 defsubr (&Svisited_file_modtime
);
6807 defsubr (&Sset_visited_file_modtime
);
6808 defsubr (&Sdo_auto_save
);
6809 defsubr (&Sset_buffer_auto_saved
);
6810 defsubr (&Sclear_buffer_auto_save_failure
);
6811 defsubr (&Srecent_auto_save_p
);
6813 defsubr (&Sread_file_name_internal
);
6814 defsubr (&Sread_file_name
);
6815 defsubr (&Snext_read_file_uses_dialog_p
);
6818 defsubr (&Sunix_sync
);
6822 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6823 (do not change this comment) */