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 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
;
228 extern Lisp_Object Vuser_login_name
;
231 extern Lisp_Object Vw32_get_true_file_attributes
;
234 extern int minibuf_level
;
236 extern int minibuffer_auto_raise
;
238 extern int history_delete_duplicates
;
240 /* These variables describe handlers that have "already" had a chance
241 to handle the current operation.
243 Vinhibit_file_name_handlers is a list of file name handlers.
244 Vinhibit_file_name_operation is the operation being handled.
245 If we try to handle that operation, we ignore those handlers. */
247 static Lisp_Object Vinhibit_file_name_handlers
;
248 static Lisp_Object Vinhibit_file_name_operation
;
250 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
252 Lisp_Object Qfile_name_history
;
254 Lisp_Object Qcar_less_than_car
;
256 static int a_write
P_ ((int, Lisp_Object
, int, int,
257 Lisp_Object
*, struct coding_system
*));
258 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
262 report_file_error (string
, data
)
266 Lisp_Object errstring
;
269 synchronize_system_messages_locale ();
270 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
271 Vlocale_coding_system
, 0);
277 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
280 /* System error messages are capitalized. Downcase the initial
281 unless it is followed by a slash. */
282 if (SREF (errstring
, 1) != '/')
283 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
285 Fsignal (Qfile_error
,
286 Fcons (build_string (string
), Fcons (errstring
, data
)));
291 close_file_unwind (fd
)
294 emacs_close (XFASTINT (fd
));
298 /* Restore point, having saved it as a marker. */
301 restore_point_unwind (location
)
302 Lisp_Object location
;
304 Fgoto_char (location
);
305 Fset_marker (location
, Qnil
, Qnil
);
309 Lisp_Object Qexpand_file_name
;
310 Lisp_Object Qsubstitute_in_file_name
;
311 Lisp_Object Qdirectory_file_name
;
312 Lisp_Object Qfile_name_directory
;
313 Lisp_Object Qfile_name_nondirectory
;
314 Lisp_Object Qunhandled_file_name_directory
;
315 Lisp_Object Qfile_name_as_directory
;
316 Lisp_Object Qcopy_file
;
317 Lisp_Object Qmake_directory_internal
;
318 Lisp_Object Qmake_directory
;
319 Lisp_Object Qdelete_directory
;
320 Lisp_Object Qdelete_file
;
321 Lisp_Object Qrename_file
;
322 Lisp_Object Qadd_name_to_file
;
323 Lisp_Object Qmake_symbolic_link
;
324 Lisp_Object Qfile_exists_p
;
325 Lisp_Object Qfile_executable_p
;
326 Lisp_Object Qfile_readable_p
;
327 Lisp_Object Qfile_writable_p
;
328 Lisp_Object Qfile_symlink_p
;
329 Lisp_Object Qaccess_file
;
330 Lisp_Object Qfile_directory_p
;
331 Lisp_Object Qfile_regular_p
;
332 Lisp_Object Qfile_accessible_directory_p
;
333 Lisp_Object Qfile_modes
;
334 Lisp_Object Qset_file_modes
;
335 Lisp_Object Qset_file_times
;
336 Lisp_Object Qfile_newer_than_file_p
;
337 Lisp_Object Qinsert_file_contents
;
338 Lisp_Object Qwrite_region
;
339 Lisp_Object Qverify_visited_file_modtime
;
340 Lisp_Object Qset_visited_file_modtime
;
342 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
343 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
344 Otherwise, return nil.
345 A file name is handled if one of the regular expressions in
346 `file-name-handler-alist' matches it.
348 If OPERATION equals `inhibit-file-name-operation', then we ignore
349 any handlers that are members of `inhibit-file-name-handlers',
350 but we still do run any other handlers. This lets handlers
351 use the standard functions without calling themselves recursively. */)
352 (filename
, operation
)
353 Lisp_Object filename
, operation
;
355 /* This function must not munge the match data. */
356 Lisp_Object chain
, inhibited_handlers
, result
;
360 CHECK_STRING (filename
);
362 if (EQ (operation
, Vinhibit_file_name_operation
))
363 inhibited_handlers
= Vinhibit_file_name_handlers
;
365 inhibited_handlers
= Qnil
;
367 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
368 chain
= XCDR (chain
))
374 Lisp_Object string
= XCAR (elt
);
376 Lisp_Object handler
= XCDR (elt
);
377 Lisp_Object operations
= Qnil
;
379 if (SYMBOLP (handler
))
380 operations
= Fget (handler
, Qoperations
);
383 && (match_pos
= fast_string_match (string
, filename
)) > pos
384 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
388 handler
= XCDR (elt
);
389 tem
= Fmemq (handler
, inhibited_handlers
);
403 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
405 doc
: /* Return the directory component in file name FILENAME.
406 Return nil if FILENAME does not include a directory.
407 Otherwise return a directory spec.
408 Given a Unix syntax file name, returns a string ending in slash;
409 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
411 Lisp_Object filename
;
414 register const unsigned char *beg
;
416 register unsigned char *beg
;
418 register const unsigned char *p
;
421 CHECK_STRING (filename
);
423 /* If the file name has special constructs in it,
424 call the corresponding file handler. */
425 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
427 return call2 (handler
, Qfile_name_directory
, filename
);
429 filename
= FILE_SYSTEM_CASE (filename
);
430 beg
= SDATA (filename
);
432 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
434 p
= beg
+ SBYTES (filename
);
436 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
438 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
441 /* only recognise drive specifier at the beginning */
443 /* handle the "/:d:foo" and "/:foo" cases correctly */
444 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
445 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
452 /* Expansion of "c:" to drive and default directory. */
455 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
456 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
457 unsigned char *r
= res
;
459 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
461 strncpy (res
, beg
, 2);
466 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
468 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
471 p
= beg
+ strlen (beg
);
474 CORRECT_DIR_SEPS (beg
);
477 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
480 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
481 Sfile_name_nondirectory
, 1, 1, 0,
482 doc
: /* Return file name FILENAME sans its directory.
483 For example, in a Unix-syntax file name,
484 this is everything after the last slash,
485 or the entire name if it contains no slash. */)
487 Lisp_Object filename
;
489 register const unsigned char *beg
, *p
, *end
;
492 CHECK_STRING (filename
);
494 /* If the file name has special constructs in it,
495 call the corresponding file handler. */
496 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
498 return call2 (handler
, Qfile_name_nondirectory
, filename
);
500 beg
= SDATA (filename
);
501 end
= p
= beg
+ SBYTES (filename
);
503 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
505 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
508 /* only recognise drive specifier at beginning */
510 /* handle the "/:d:foo" case correctly */
511 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
516 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
519 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
520 Sunhandled_file_name_directory
, 1, 1, 0,
521 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
522 A `directly usable' directory name is one that may be used without the
523 intervention of any file handler.
524 If FILENAME is a directly usable file itself, return
525 \(file-name-directory FILENAME).
526 The `call-process' and `start-process' functions use this function to
527 get a current directory to run processes in. */)
529 Lisp_Object filename
;
533 /* If the file name has special constructs in it,
534 call the corresponding file handler. */
535 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
537 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
539 return Ffile_name_directory (filename
);
544 file_name_as_directory (out
, in
)
547 int size
= strlen (in
) - 1;
560 /* Is it already a directory string? */
561 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
563 /* Is it a VMS directory file name? If so, hack VMS syntax. */
564 else if (! index (in
, '/')
565 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
566 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
567 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
568 || ! strncmp (&in
[size
- 5], ".dir", 4))
569 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
570 && in
[size
] == '1')))
572 register char *p
, *dot
;
576 dir:x.dir --> dir:[x]
577 dir:[x]y.dir --> dir:[x.y] */
579 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
582 strncpy (out
, in
, p
- in
);
601 dot
= index (p
, '.');
604 /* blindly remove any extension */
605 size
= strlen (out
) + (dot
- p
);
606 strncat (out
, p
, dot
- p
);
617 /* For Unix syntax, Append a slash if necessary */
618 if (!IS_DIRECTORY_SEP (out
[size
]))
620 /* Cannot use DIRECTORY_SEP, which could have any value */
622 out
[size
+ 2] = '\0';
625 CORRECT_DIR_SEPS (out
);
631 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
632 Sfile_name_as_directory
, 1, 1, 0,
633 doc
: /* Return a string representing the file name FILE interpreted as a directory.
634 This operation exists because a directory is also a file, but its name as
635 a directory is different from its name as a file.
636 The result can be used as the value of `default-directory'
637 or passed as second argument to `expand-file-name'.
638 For a Unix-syntax file name, just appends a slash.
639 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
650 /* If the file name has special constructs in it,
651 call the corresponding file handler. */
652 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
654 return call2 (handler
, Qfile_name_as_directory
, file
);
656 buf
= (char *) alloca (SBYTES (file
) + 10);
657 file_name_as_directory (buf
, SDATA (file
));
658 return make_specified_string (buf
, -1, strlen (buf
),
659 STRING_MULTIBYTE (file
));
663 * Convert from directory name to filename.
665 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
666 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
667 * On UNIX, it's simple: just make sure there isn't a terminating /
669 * Value is nonzero if the string output is different from the input.
673 directory_file_name (src
, dst
)
681 struct FAB fab
= cc$rms_fab
;
682 struct NAM nam
= cc$rms_nam
;
683 char esa
[NAM$C_MAXRSS
];
688 if (! index (src
, '/')
689 && (src
[slen
- 1] == ']'
690 || src
[slen
- 1] == ':'
691 || src
[slen
- 1] == '>'))
693 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
695 fab
.fab$b_fns
= slen
;
696 fab
.fab$l_nam
= &nam
;
697 fab
.fab$l_fop
= FAB$M_NAM
;
700 nam
.nam$b_ess
= sizeof esa
;
701 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
703 /* We call SYS$PARSE to handle such things as [--] for us. */
704 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
706 slen
= nam
.nam$b_esl
;
707 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
712 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
714 /* what about when we have logical_name:???? */
715 if (src
[slen
- 1] == ':')
716 { /* Xlate logical name and see what we get */
717 ptr
= strcpy (dst
, src
); /* upper case for getenv */
720 if ('a' <= *ptr
&& *ptr
<= 'z')
724 dst
[slen
- 1] = 0; /* remove colon */
725 if (!(src
= egetenv (dst
)))
727 /* should we jump to the beginning of this procedure?
728 Good points: allows us to use logical names that xlate
730 Bad points: can be a problem if we just translated to a device
732 For now, I'll punt and always expect VMS names, and hope for
735 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
736 { /* no recursion here! */
742 { /* not a directory spec */
747 bracket
= src
[slen
- 1];
749 /* If bracket is ']' or '>', bracket - 2 is the corresponding
751 ptr
= index (src
, bracket
- 2);
753 { /* no opening bracket */
757 if (!(rptr
= rindex (src
, '.')))
760 strncpy (dst
, src
, slen
);
764 dst
[slen
++] = bracket
;
769 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
770 then translate the device and recurse. */
771 if (dst
[slen
- 1] == ':'
772 && dst
[slen
- 2] != ':' /* skip decnet nodes */
773 && strcmp (src
+ slen
, "[000000]") == 0)
775 dst
[slen
- 1] = '\0';
776 if ((ptr
= egetenv (dst
))
777 && (rlen
= strlen (ptr
) - 1) > 0
778 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
779 && ptr
[rlen
- 1] == '.')
781 char * buf
= (char *) alloca (strlen (ptr
) + 1);
785 return directory_file_name (buf
, dst
);
790 strcat (dst
, "[000000]");
794 rlen
= strlen (rptr
) - 1;
795 strncat (dst
, rptr
, rlen
);
796 dst
[slen
+ rlen
] = '\0';
797 strcat (dst
, ".DIR.1");
801 /* Process as Unix format: just remove any final slash.
802 But leave "/" unchanged; do not change it to "". */
805 /* Handle // as root for apollo's. */
806 if ((slen
> 2 && dst
[slen
- 1] == '/')
807 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
811 && IS_DIRECTORY_SEP (dst
[slen
- 1])
813 && !IS_ANY_SEP (dst
[slen
- 2])
819 CORRECT_DIR_SEPS (dst
);
824 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
826 doc
: /* Returns the file name of the directory named DIRECTORY.
827 This is the name of the file that holds the data for the directory DIRECTORY.
828 This operation exists because a directory is also a file, but its name as
829 a directory is different from its name as a file.
830 In Unix-syntax, this function just removes the final slash.
831 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
832 it returns a file name such as \"[X]Y.DIR.1\". */)
834 Lisp_Object directory
;
839 CHECK_STRING (directory
);
841 if (NILP (directory
))
844 /* If the file name has special constructs in it,
845 call the corresponding file handler. */
846 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
848 return call2 (handler
, Qdirectory_file_name
, directory
);
851 /* 20 extra chars is insufficient for VMS, since we might perform a
852 logical name translation. an equivalence string can be up to 255
853 chars long, so grab that much extra space... - sss */
854 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
856 buf
= (char *) alloca (SBYTES (directory
) + 20);
858 directory_file_name (SDATA (directory
), buf
);
859 return make_specified_string (buf
, -1, strlen (buf
),
860 STRING_MULTIBYTE (directory
));
863 static char make_temp_name_tbl
[64] =
865 'A','B','C','D','E','F','G','H',
866 'I','J','K','L','M','N','O','P',
867 'Q','R','S','T','U','V','W','X',
868 'Y','Z','a','b','c','d','e','f',
869 'g','h','i','j','k','l','m','n',
870 'o','p','q','r','s','t','u','v',
871 'w','x','y','z','0','1','2','3',
872 '4','5','6','7','8','9','-','_'
875 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
877 /* Value is a temporary file name starting with PREFIX, a string.
879 The Emacs process number forms part of the result, so there is
880 no danger of generating a name being used by another process.
881 In addition, this function makes an attempt to choose a name
882 which has no existing file. To make this work, PREFIX should be
883 an absolute file name.
885 BASE64_P non-zero means add the pid as 3 characters in base64
886 encoding. In this case, 6 characters will be added to PREFIX to
887 form the file name. Otherwise, if Emacs is running on a system
888 with long file names, add the pid as a decimal number.
890 This function signals an error if no unique file name could be
894 make_temp_name (prefix
, base64_p
)
901 unsigned char *p
, *data
;
905 CHECK_STRING (prefix
);
907 /* VAL is created by adding 6 characters to PREFIX. The first
908 three are the PID of this process, in base 64, and the second
909 three are incremented if the file already exists. This ensures
910 262144 unique file names per PID per PREFIX. */
912 pid
= (int) getpid ();
916 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
918 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 #ifdef HAVE_LONG_FILE_NAMES
924 sprintf (pidbuf
, "%d", pid
);
925 pidlen
= strlen (pidbuf
);
927 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
928 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
929 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
934 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
935 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
936 if (!STRING_MULTIBYTE (prefix
))
937 STRING_SET_UNIBYTE (val
);
939 bcopy(SDATA (prefix
), data
, len
);
942 bcopy (pidbuf
, p
, pidlen
);
945 /* Here we try to minimize useless stat'ing when this function is
946 invoked many times successively with the same PREFIX. We achieve
947 this by initializing count to a random value, and incrementing it
950 We don't want make-temp-name to be called while dumping,
951 because then make_temp_name_count_initialized_p would get set
952 and then make_temp_name_count would not be set when Emacs starts. */
954 if (!make_temp_name_count_initialized_p
)
956 make_temp_name_count
= (unsigned) time (NULL
);
957 make_temp_name_count_initialized_p
= 1;
963 unsigned num
= make_temp_name_count
;
965 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
966 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
967 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
969 /* Poor man's congruential RN generator. Replace with
970 ++make_temp_name_count for debugging. */
971 make_temp_name_count
+= 25229;
972 make_temp_name_count
%= 225307;
974 if (stat (data
, &ignored
) < 0)
976 /* We want to return only if errno is ENOENT. */
980 /* The error here is dubious, but there is little else we
981 can do. The alternatives are to return nil, which is
982 as bad as (and in many cases worse than) throwing the
983 error, or to ignore the error, which will likely result
984 in looping through 225307 stat's, which is not only
985 dog-slow, but also useless since it will fallback to
986 the errow below, anyway. */
987 report_file_error ("Cannot create temporary name for prefix",
988 Fcons (prefix
, Qnil
));
993 error ("Cannot create temporary name for prefix `%s'",
999 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1000 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1001 The Emacs process number forms part of the result,
1002 so there is no danger of generating a name being used by another process.
1004 In addition, this function makes an attempt to choose a name
1005 which has no existing file. To make this work,
1006 PREFIX should be an absolute file name.
1008 There is a race condition between calling `make-temp-name' and creating the
1009 file which opens all kinds of security holes. For that reason, you should
1010 probably use `make-temp-file' instead, except in three circumstances:
1012 * If you are creating the file in the user's home directory.
1013 * If you are creating a directory rather than an ordinary file.
1014 * If you are taking special precautions as `make-temp-file' does. */)
1018 return make_temp_name (prefix
, 0);
1023 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1024 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1025 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1026 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1027 the current buffer's value of `default-directory' is used.
1028 File name components that are `.' are removed, and
1029 so are file name components followed by `..', along with the `..' itself;
1030 note that these simplifications are done without checking the resulting
1031 file names in the file system.
1032 An initial `~/' expands to your home directory.
1033 An initial `~USER/' expands to USER's home directory.
1034 See also the function `substitute-in-file-name'. */)
1035 (name
, default_directory
)
1036 Lisp_Object name
, default_directory
;
1040 register unsigned char *newdir
, *p
, *o
;
1042 unsigned char *target
;
1045 unsigned char * colon
= 0;
1046 unsigned char * close
= 0;
1047 unsigned char * slash
= 0;
1048 unsigned char * brack
= 0;
1049 int lbrack
= 0, rbrack
= 0;
1054 int collapse_newdir
= 1;
1058 Lisp_Object handler
, result
;
1060 CHECK_STRING (name
);
1062 /* If the file name has special constructs in it,
1063 call the corresponding file handler. */
1064 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1065 if (!NILP (handler
))
1066 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1068 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1069 if (NILP (default_directory
))
1070 default_directory
= current_buffer
->directory
;
1071 if (! STRINGP (default_directory
))
1074 /* "/" is not considered a root directory on DOS_NT, so using "/"
1075 here causes an infinite recursion in, e.g., the following:
1077 (let (default-directory)
1078 (expand-file-name "a"))
1080 To avoid this, we set default_directory to the root of the
1082 extern char *emacs_root_dir (void);
1084 default_directory
= build_string (emacs_root_dir ());
1086 default_directory
= build_string ("/");
1090 if (!NILP (default_directory
))
1092 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1093 if (!NILP (handler
))
1094 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1097 o
= SDATA (default_directory
);
1099 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1100 It would be better to do this down below where we actually use
1101 default_directory. Unfortunately, calling Fexpand_file_name recursively
1102 could invoke GC, and the strings might be relocated. This would
1103 be annoying because we have pointers into strings lying around
1104 that would need adjusting, and people would add new pointers to
1105 the code and forget to adjust them, resulting in intermittent bugs.
1106 Putting this call here avoids all that crud.
1108 The EQ test avoids infinite recursion. */
1109 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1110 /* Save time in some common cases - as long as default_directory
1111 is not relative, it can be canonicalized with name below (if it
1112 is needed at all) without requiring it to be expanded now. */
1114 /* Detect MSDOS file names with drive specifiers. */
1115 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1117 /* Detect Windows file names in UNC format. */
1118 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1120 #else /* not DOS_NT */
1121 /* Detect Unix absolute file names (/... alone is not absolute on
1123 && ! (IS_DIRECTORY_SEP (o
[0]))
1124 #endif /* not DOS_NT */
1127 struct gcpro gcpro1
;
1130 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1134 name
= FILE_SYSTEM_CASE (name
);
1138 /* We will force directory separators to be either all \ or /, so make
1139 a local copy to modify, even if there ends up being no change. */
1140 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1142 /* Note if special escape prefix is present, but remove for now. */
1143 if (nm
[0] == '/' && nm
[1] == ':')
1149 /* Find and remove drive specifier if present; this makes nm absolute
1150 even if the rest of the name appears to be relative. Only look for
1151 drive specifier at the beginning. */
1152 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1159 /* If we see "c://somedir", we want to strip the first slash after the
1160 colon when stripping the drive letter. Otherwise, this expands to
1162 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1164 #endif /* WINDOWSNT */
1168 /* Discard any previous drive specifier if nm is now in UNC format. */
1169 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1175 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1176 none are found, we can probably return right away. We will avoid
1177 allocating a new string if name is already fully expanded. */
1179 IS_DIRECTORY_SEP (nm
[0])
1181 && drive
&& !is_escaped
1184 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1191 /* If it turns out that the filename we want to return is just a
1192 suffix of FILENAME, we don't need to go through and edit
1193 things; we just need to construct a new string using data
1194 starting at the middle of FILENAME. If we set lose to a
1195 non-zero value, that means we've discovered that we can't do
1202 /* Since we know the name is absolute, we can assume that each
1203 element starts with a "/". */
1205 /* "." and ".." are hairy. */
1206 if (IS_DIRECTORY_SEP (p
[0])
1208 && (IS_DIRECTORY_SEP (p
[2])
1210 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1213 /* We want to replace multiple `/' in a row with a single
1216 && IS_DIRECTORY_SEP (p
[0])
1217 && IS_DIRECTORY_SEP (p
[1]))
1224 /* if dev:[dir]/, move nm to / */
1225 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1226 nm
= (brack
? brack
+ 1 : colon
+ 1);
1227 lbrack
= rbrack
= 0;
1234 #ifdef NO_HYPHENS_IN_FILENAMES
1235 if (lbrack
== rbrack
)
1237 /* Avoid clobbering negative version numbers. */
1242 #endif /* NO_HYPHENS_IN_FILENAMES */
1243 if (lbrack
> rbrack
&&
1244 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1245 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1247 #ifdef NO_HYPHENS_IN_FILENAMES
1250 #endif /* NO_HYPHENS_IN_FILENAMES */
1251 /* count open brackets, reset close bracket pointer */
1252 if (p
[0] == '[' || p
[0] == '<')
1253 lbrack
++, brack
= 0;
1254 /* count close brackets, set close bracket pointer */
1255 if (p
[0] == ']' || p
[0] == '>')
1256 rbrack
++, brack
= p
;
1257 /* detect ][ or >< */
1258 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1260 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1261 nm
= p
+ 1, lose
= 1;
1262 if (p
[0] == ':' && (colon
|| slash
))
1263 /* if dev1:[dir]dev2:, move nm to dev2: */
1269 /* if /name/dev:, move nm to dev: */
1272 /* if node::dev:, move colon following dev */
1273 else if (colon
&& colon
[-1] == ':')
1275 /* if dev1:dev2:, move nm to dev2: */
1276 else if (colon
&& colon
[-1] != ':')
1281 if (p
[0] == ':' && !colon
)
1287 if (lbrack
== rbrack
)
1290 else if (p
[0] == '.')
1298 if (index (nm
, '/'))
1300 nm
= sys_translate_unix (nm
);
1301 return make_specified_string (nm
, -1, strlen (nm
),
1302 STRING_MULTIBYTE (name
));
1306 /* Make sure directories are all separated with / or \ as
1307 desired, but avoid allocation of a new string when not
1309 CORRECT_DIR_SEPS (nm
);
1311 if (IS_DIRECTORY_SEP (nm
[1]))
1313 if (strcmp (nm
, SDATA (name
)) != 0)
1314 name
= make_specified_string (nm
, -1, strlen (nm
),
1315 STRING_MULTIBYTE (name
));
1319 /* drive must be set, so this is okay */
1320 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1324 name
= make_specified_string (nm
, -1, p
- nm
,
1325 STRING_MULTIBYTE (name
));
1326 temp
[0] = DRIVE_LETTER (drive
);
1327 name
= concat2 (build_string (temp
), name
);
1330 #else /* not DOS_NT */
1331 if (nm
== SDATA (name
))
1333 return make_specified_string (nm
, -1, strlen (nm
),
1334 STRING_MULTIBYTE (name
));
1335 #endif /* not DOS_NT */
1339 /* At this point, nm might or might not be an absolute file name. We
1340 need to expand ~ or ~user if present, otherwise prefix nm with
1341 default_directory if nm is not absolute, and finally collapse /./
1342 and /foo/../ sequences.
1344 We set newdir to be the appropriate prefix if one is needed:
1345 - the relevant user directory if nm starts with ~ or ~user
1346 - the specified drive's working dir (DOS/NT only) if nm does not
1348 - the value of default_directory.
1350 Note that these prefixes are not guaranteed to be absolute (except
1351 for the working dir of a drive). Therefore, to ensure we always
1352 return an absolute name, if the final prefix is not absolute we
1353 append it to the current working directory. */
1357 if (nm
[0] == '~') /* prefix ~ */
1359 if (IS_DIRECTORY_SEP (nm
[1])
1363 || nm
[1] == 0) /* ~ by itself */
1365 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1366 newdir
= (unsigned char *) "";
1369 collapse_newdir
= 0;
1372 nm
++; /* Don't leave the slash in nm. */
1375 else /* ~user/filename */
1377 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1382 o
= (unsigned char *) alloca (p
- nm
+ 1);
1383 bcopy ((char *) nm
, o
, p
- nm
);
1386 pw
= (struct passwd
*) getpwnam (o
+ 1);
1389 newdir
= (unsigned char *) pw
-> pw_dir
;
1391 nm
= p
+ 1; /* skip the terminator */
1395 collapse_newdir
= 0;
1400 /* If we don't find a user of that name, leave the name
1401 unchanged; don't move nm forward to p. */
1406 /* On DOS and Windows, nm is absolute if a drive name was specified;
1407 use the drive's current directory as the prefix if needed. */
1408 if (!newdir
&& drive
)
1410 /* Get default directory if needed to make nm absolute. */
1411 if (!IS_DIRECTORY_SEP (nm
[0]))
1413 newdir
= alloca (MAXPATHLEN
+ 1);
1414 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1419 /* Either nm starts with /, or drive isn't mounted. */
1420 newdir
= alloca (4);
1421 newdir
[0] = DRIVE_LETTER (drive
);
1429 /* Finally, if no prefix has been specified and nm is not absolute,
1430 then it must be expanded relative to default_directory. */
1434 /* /... alone is not absolute on DOS and Windows. */
1435 && !IS_DIRECTORY_SEP (nm
[0])
1438 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1445 newdir
= SDATA (default_directory
);
1447 /* Note if special escape prefix is present, but remove for now. */
1448 if (newdir
[0] == '/' && newdir
[1] == ':')
1459 /* First ensure newdir is an absolute name. */
1461 /* Detect MSDOS file names with drive specifiers. */
1462 ! (IS_DRIVE (newdir
[0])
1463 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1465 /* Detect Windows file names in UNC format. */
1466 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1470 /* Effectively, let newdir be (expand-file-name newdir cwd).
1471 Because of the admonition against calling expand-file-name
1472 when we have pointers into lisp strings, we accomplish this
1473 indirectly by prepending newdir to nm if necessary, and using
1474 cwd (or the wd of newdir's drive) as the new newdir. */
1476 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1481 if (!IS_DIRECTORY_SEP (nm
[0]))
1483 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1484 file_name_as_directory (tmp
, newdir
);
1488 newdir
= alloca (MAXPATHLEN
+ 1);
1491 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1498 /* Strip off drive name from prefix, if present. */
1499 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1505 /* Keep only a prefix from newdir if nm starts with slash
1506 (//server/share for UNC, nothing otherwise). */
1507 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1510 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1512 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1514 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1516 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1528 /* Get rid of any slash at the end of newdir, unless newdir is
1529 just / or // (an incomplete UNC name). */
1530 length
= strlen (newdir
);
1531 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1533 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1537 unsigned char *temp
= (unsigned char *) alloca (length
);
1538 bcopy (newdir
, temp
, length
- 1);
1539 temp
[length
- 1] = 0;
1547 /* Now concatenate the directory and name to new space in the stack frame */
1548 tlen
+= strlen (nm
) + 1;
1550 /* Reserve space for drive specifier and escape prefix, since either
1551 or both may need to be inserted. (The Microsoft x86 compiler
1552 produces incorrect code if the following two lines are combined.) */
1553 target
= (unsigned char *) alloca (tlen
+ 4);
1555 #else /* not DOS_NT */
1556 target
= (unsigned char *) alloca (tlen
);
1557 #endif /* not DOS_NT */
1563 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1566 /* If newdir is effectively "C:/", then the drive letter will have
1567 been stripped and newdir will be "/". Concatenating with an
1568 absolute directory in nm produces "//", which will then be
1569 incorrectly treated as a network share. Ignore newdir in
1570 this case (keeping the drive letter). */
1571 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1572 && newdir
[1] == '\0'))
1574 strcpy (target
, newdir
);
1578 file_name_as_directory (target
, newdir
);
1581 strcat (target
, nm
);
1583 if (index (target
, '/'))
1584 strcpy (target
, sys_translate_unix (target
));
1587 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1589 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1598 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1604 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1605 /* brackets are offset from each other by 2 */
1608 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1609 /* convert [foo][bar] to [bar] */
1610 while (o
[-1] != '[' && o
[-1] != '<')
1612 else if (*p
== '-' && *o
!= '.')
1615 else if (p
[0] == '-' && o
[-1] == '.' &&
1616 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1617 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1621 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1622 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1624 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1626 /* else [foo.-] ==> [-] */
1630 #ifdef NO_HYPHENS_IN_FILENAMES
1632 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1633 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1635 #endif /* NO_HYPHENS_IN_FILENAMES */
1639 if (!IS_DIRECTORY_SEP (*p
))
1643 else if (IS_DIRECTORY_SEP (p
[0])
1645 && (IS_DIRECTORY_SEP (p
[2])
1648 /* If "/." is the entire filename, keep the "/". Otherwise,
1649 just delete the whole "/.". */
1650 if (o
== target
&& p
[2] == '\0')
1654 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1655 /* `/../' is the "superroot" on certain file systems.
1656 Turned off on DOS_NT systems because they have no
1657 "superroot" and because this causes us to produce
1658 file names like "d:/../foo" which fail file-related
1659 functions of the underlying OS. (To reproduce, try a
1660 long series of "../../" in default_directory, longer
1661 than the number of levels from the root.) */
1665 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1667 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1669 /* Keep initial / only if this is the whole name. */
1670 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1675 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1677 /* Collapse multiple `/' in a row. */
1679 while (IS_DIRECTORY_SEP (*p
))
1686 #endif /* not VMS */
1690 /* At last, set drive name. */
1692 /* Except for network file name. */
1693 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1694 #endif /* WINDOWSNT */
1696 if (!drive
) abort ();
1698 target
[0] = DRIVE_LETTER (drive
);
1701 /* Reinsert the escape prefix if required. */
1708 CORRECT_DIR_SEPS (target
);
1711 result
= make_specified_string (target
, -1, o
- target
,
1712 STRING_MULTIBYTE (name
));
1714 /* Again look to see if the file name has special constructs in it
1715 and perhaps call the corresponding file handler. This is needed
1716 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1717 the ".." component gives us "/user@host:/bar/../baz" which needs
1718 to be expanded again. */
1719 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1720 if (!NILP (handler
))
1721 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1727 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1728 This is the old version of expand-file-name, before it was thoroughly
1729 rewritten for Emacs 10.31. We leave this version here commented-out,
1730 because the code is very complex and likely to have subtle bugs. If
1731 bugs _are_ found, it might be of interest to look at the old code and
1732 see what did it do in the relevant situation.
1734 Don't remove this code: it's true that it will be accessible via CVS,
1735 but a few years from deletion, people will forget it is there. */
1737 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1738 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1739 "Convert FILENAME to absolute, and canonicalize it.\n\
1740 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1741 \(does not start with slash); if DEFAULT is nil or missing,\n\
1742 the current buffer's value of default-directory is used.\n\
1743 Filenames containing `.' or `..' as components are simplified;\n\
1744 initial `~/' expands to your home directory.\n\
1745 See also the function `substitute-in-file-name'.")
1747 Lisp_Object name
, defalt
;
1751 register unsigned char *newdir
, *p
, *o
;
1753 unsigned char *target
;
1757 unsigned char * colon
= 0;
1758 unsigned char * close
= 0;
1759 unsigned char * slash
= 0;
1760 unsigned char * brack
= 0;
1761 int lbrack
= 0, rbrack
= 0;
1765 CHECK_STRING (name
);
1768 /* Filenames on VMS are always upper case. */
1769 name
= Fupcase (name
);
1774 /* If nm is absolute, flush ...// and detect /./ and /../.
1775 If no /./ or /../ we can return right away. */
1787 if (p
[0] == '/' && p
[1] == '/'
1789 /* // at start of filename is meaningful on Apollo system. */
1794 if (p
[0] == '/' && p
[1] == '~')
1795 nm
= p
+ 1, lose
= 1;
1796 if (p
[0] == '/' && p
[1] == '.'
1797 && (p
[2] == '/' || p
[2] == 0
1798 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1804 /* if dev:[dir]/, move nm to / */
1805 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1806 nm
= (brack
? brack
+ 1 : colon
+ 1);
1807 lbrack
= rbrack
= 0;
1815 /* VMS pre V4.4,convert '-'s in filenames. */
1816 if (lbrack
== rbrack
)
1818 if (dots
< 2) /* this is to allow negative version numbers */
1823 if (lbrack
> rbrack
&&
1824 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1825 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1831 /* count open brackets, reset close bracket pointer */
1832 if (p
[0] == '[' || p
[0] == '<')
1833 lbrack
++, brack
= 0;
1834 /* count close brackets, set close bracket pointer */
1835 if (p
[0] == ']' || p
[0] == '>')
1836 rbrack
++, brack
= p
;
1837 /* detect ][ or >< */
1838 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1840 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1841 nm
= p
+ 1, lose
= 1;
1842 if (p
[0] == ':' && (colon
|| slash
))
1843 /* if dev1:[dir]dev2:, move nm to dev2: */
1849 /* If /name/dev:, move nm to dev: */
1852 /* If node::dev:, move colon following dev */
1853 else if (colon
&& colon
[-1] == ':')
1855 /* If dev1:dev2:, move nm to dev2: */
1856 else if (colon
&& colon
[-1] != ':')
1861 if (p
[0] == ':' && !colon
)
1867 if (lbrack
== rbrack
)
1870 else if (p
[0] == '.')
1878 if (index (nm
, '/'))
1879 return build_string (sys_translate_unix (nm
));
1881 if (nm
== SDATA (name
))
1883 return build_string (nm
);
1887 /* Now determine directory to start with and put it in NEWDIR */
1891 if (nm
[0] == '~') /* prefix ~ */
1896 || nm
[1] == 0)/* ~/filename */
1898 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1899 newdir
= (unsigned char *) "";
1902 nm
++; /* Don't leave the slash in nm. */
1905 else /* ~user/filename */
1907 /* Get past ~ to user */
1908 unsigned char *user
= nm
+ 1;
1909 /* Find end of name. */
1910 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1911 int len
= ptr
? ptr
- user
: strlen (user
);
1913 unsigned char *ptr1
= index (user
, ':');
1914 if (ptr1
!= 0 && ptr1
- user
< len
)
1917 /* Copy the user name into temp storage. */
1918 o
= (unsigned char *) alloca (len
+ 1);
1919 bcopy ((char *) user
, o
, len
);
1922 /* Look up the user name. */
1923 pw
= (struct passwd
*) getpwnam (o
+ 1);
1925 error ("\"%s\" isn't a registered user", o
+ 1);
1927 newdir
= (unsigned char *) pw
->pw_dir
;
1929 /* Discard the user name from NM. */
1936 #endif /* not VMS */
1940 defalt
= current_buffer
->directory
;
1941 CHECK_STRING (defalt
);
1942 newdir
= SDATA (defalt
);
1945 /* Now concatenate the directory and name to new space in the stack frame */
1947 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1948 target
= (unsigned char *) alloca (tlen
);
1954 if (nm
[0] == 0 || nm
[0] == '/')
1955 strcpy (target
, newdir
);
1958 file_name_as_directory (target
, newdir
);
1961 strcat (target
, nm
);
1963 if (index (target
, '/'))
1964 strcpy (target
, sys_translate_unix (target
));
1967 /* Now canonicalize by removing /. and /foo/.. if they appear */
1975 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1981 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1982 /* brackets are offset from each other by 2 */
1985 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1986 /* convert [foo][bar] to [bar] */
1987 while (o
[-1] != '[' && o
[-1] != '<')
1989 else if (*p
== '-' && *o
!= '.')
1992 else if (p
[0] == '-' && o
[-1] == '.' &&
1993 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1994 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1998 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1999 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2001 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2003 /* else [foo.-] ==> [-] */
2009 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2010 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2020 else if (!strncmp (p
, "//", 2)
2022 /* // at start of filename is meaningful in Apollo system. */
2030 else if (p
[0] == '/' && p
[1] == '.' &&
2031 (p
[2] == '/' || p
[2] == 0))
2033 else if (!strncmp (p
, "/..", 3)
2034 /* `/../' is the "superroot" on certain file systems. */
2036 && (p
[3] == '/' || p
[3] == 0))
2038 while (o
!= target
&& *--o
!= '/')
2041 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2045 if (o
== target
&& *o
== '/')
2053 #endif /* not VMS */
2056 return make_string (target
, o
- target
);
2060 /* If /~ or // appears, discard everything through first slash. */
2062 file_name_absolute_p (filename
)
2063 const unsigned char *filename
;
2066 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2068 /* ??? This criterion is probably wrong for '<'. */
2069 || index (filename
, ':') || index (filename
, '<')
2070 || (*filename
== '[' && (filename
[1] != '-'
2071 || (filename
[2] != '.' && filename
[2] != ']'))
2072 && filename
[1] != '.')
2075 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2076 && IS_DIRECTORY_SEP (filename
[2]))
2081 static unsigned char *
2082 search_embedded_absfilename (nm
, endp
)
2083 unsigned char *nm
, *endp
;
2085 unsigned char *p
, *s
;
2087 for (p
= nm
+ 1; p
< endp
; p
++)
2091 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2093 || IS_DIRECTORY_SEP (p
[-1]))
2094 && file_name_absolute_p (p
)
2095 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2096 /* // at start of file name is meaningful in Apollo,
2097 WindowsNT and Cygwin systems. */
2098 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2099 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2102 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2107 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2109 unsigned char *o
= alloca (s
- p
+ 1);
2111 bcopy (p
, o
, s
- p
);
2114 /* If we have ~user and `user' exists, discard
2115 everything up to ~. But if `user' does not exist, leave
2116 ~user alone, it might be a literal file name. */
2117 if ((pw
= getpwnam (o
+ 1)))
2129 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2130 Ssubstitute_in_file_name
, 1, 1, 0,
2131 doc
: /* Substitute environment variables referred to in FILENAME.
2132 `$FOO' where FOO is an environment variable name means to substitute
2133 the value of that variable. The variable name should be terminated
2134 with a character not a letter, digit or underscore; otherwise, enclose
2135 the entire variable name in braces.
2136 If `/~' appears, all of FILENAME through that `/' is discarded.
2138 On VMS, `$' substitution is not done; this function does little and only
2139 duplicates what `expand-file-name' does. */)
2141 Lisp_Object filename
;
2145 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2146 unsigned char *target
= NULL
;
2148 int substituted
= 0;
2150 Lisp_Object handler
;
2152 CHECK_STRING (filename
);
2154 /* If the file name has special constructs in it,
2155 call the corresponding file handler. */
2156 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2157 if (!NILP (handler
))
2158 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2160 nm
= SDATA (filename
);
2162 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2163 CORRECT_DIR_SEPS (nm
);
2164 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2166 endp
= nm
+ SBYTES (filename
);
2168 /* If /~ or // appears, discard everything through first slash. */
2169 p
= search_embedded_absfilename (nm
, endp
);
2171 /* Start over with the new string, so we check the file-name-handler
2172 again. Important with filenames like "/home/foo//:/hello///there"
2173 which whould substitute to "/:/hello///there" rather than "/there". */
2174 return Fsubstitute_in_file_name
2175 (make_specified_string (p
, -1, endp
- p
,
2176 STRING_MULTIBYTE (filename
)));
2182 /* See if any variables are substituted into the string
2183 and find the total length of their values in `total' */
2185 for (p
= nm
; p
!= endp
;)
2195 /* "$$" means a single "$" */
2204 while (p
!= endp
&& *p
!= '}') p
++;
2205 if (*p
!= '}') goto missingclose
;
2211 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2215 /* Copy out the variable name */
2216 target
= (unsigned char *) alloca (s
- o
+ 1);
2217 strncpy (target
, o
, s
- o
);
2220 strupr (target
); /* $home == $HOME etc. */
2223 /* Get variable value */
2224 o
= (unsigned char *) egetenv (target
);
2227 total
+= strlen (o
);
2237 /* If substitution required, recopy the string and do it */
2238 /* Make space in stack frame for the new copy */
2239 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2242 /* Copy the rest of the name through, replacing $ constructs with values */
2259 while (p
!= endp
&& *p
!= '}') p
++;
2260 if (*p
!= '}') goto missingclose
;
2266 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2270 /* Copy out the variable name */
2271 target
= (unsigned char *) alloca (s
- o
+ 1);
2272 strncpy (target
, o
, s
- o
);
2275 strupr (target
); /* $home == $HOME etc. */
2278 /* Get variable value */
2279 o
= (unsigned char *) egetenv (target
);
2283 strcpy (x
, target
); x
+= strlen (target
);
2285 else if (STRING_MULTIBYTE (filename
))
2287 /* If the original string is multibyte,
2288 convert what we substitute into multibyte. */
2291 int c
= unibyte_char_to_multibyte (*o
++);
2292 x
+= CHAR_STRING (c
, x
);
2304 /* If /~ or // appears, discard everything through first slash. */
2305 while ((p
= search_embedded_absfilename (xnm
, x
)))
2306 /* This time we do not start over because we've already expanded envvars
2307 and replaced $$ with $. Maybe we should start over as well, but we'd
2308 need to quote some $ to $$ first. */
2311 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2314 error ("Bad format environment-variable substitution");
2316 error ("Missing \"}\" in environment-variable substitution");
2318 error ("Substituting nonexistent environment variable \"%s\"", target
);
2321 #endif /* not VMS */
2325 /* A slightly faster and more convenient way to get
2326 (directory-file-name (expand-file-name FOO)). */
2329 expand_and_dir_to_file (filename
, defdir
)
2330 Lisp_Object filename
, defdir
;
2332 register Lisp_Object absname
;
2334 absname
= Fexpand_file_name (filename
, defdir
);
2337 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2338 if (c
== ':' || c
== ']' || c
== '>')
2339 absname
= Fdirectory_file_name (absname
);
2342 /* Remove final slash, if any (unless this is the root dir).
2343 stat behaves differently depending! */
2344 if (SCHARS (absname
) > 1
2345 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2346 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2347 /* We cannot take shortcuts; they might be wrong for magic file names. */
2348 absname
= Fdirectory_file_name (absname
);
2353 /* Signal an error if the file ABSNAME already exists.
2354 If INTERACTIVE is nonzero, ask the user whether to proceed,
2355 and bypass the error if the user says to go ahead.
2356 QUERYSTRING is a name for the action that is being considered
2359 *STATPTR is used to store the stat information if the file exists.
2360 If the file does not exist, STATPTR->st_mode is set to 0.
2361 If STATPTR is null, we don't store into it.
2363 If QUICK is nonzero, we ask for y or n, not yes or no. */
2366 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2367 Lisp_Object absname
;
2368 unsigned char *querystring
;
2370 struct stat
*statptr
;
2373 register Lisp_Object tem
, encoded_filename
;
2374 struct stat statbuf
;
2375 struct gcpro gcpro1
;
2377 encoded_filename
= ENCODE_FILE (absname
);
2379 /* stat is a good way to tell whether the file exists,
2380 regardless of what access permissions it has. */
2381 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2384 Fsignal (Qfile_already_exists
,
2385 Fcons (build_string ("File already exists"),
2386 Fcons (absname
, Qnil
)));
2388 tem
= format2 ("File %s already exists; %s anyway? ",
2389 absname
, build_string (querystring
));
2391 tem
= Fy_or_n_p (tem
);
2393 tem
= do_yes_or_no_p (tem
);
2396 Fsignal (Qfile_already_exists
,
2397 Fcons (build_string ("File already exists"),
2398 Fcons (absname
, Qnil
)));
2405 statptr
->st_mode
= 0;
2410 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
2411 "fCopy file: \nGCopy %s to file: \np\nP",
2412 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2413 If NEWNAME names a directory, copy FILE there.
2414 Signals a `file-already-exists' error if file NEWNAME already exists,
2415 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2416 A number as third arg means request confirmation if NEWNAME already exists.
2417 This is what happens in interactive use with M-x.
2418 Always sets the file modes of the output file to match the input file.
2420 Fourth arg KEEP-TIME non-nil means give the output file the same
2421 last-modified time as the old one. (This works on only some systems.)
2423 A prefix arg makes KEEP-TIME non-nil.
2425 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2426 for an existing file with the same name. If MUSTBENEW is `excl',
2427 that means to get an error if the file already exists; never overwrite.
2428 If MUSTBENEW is neither nil nor `excl', that means ask for
2429 confirmation before overwriting, but do go ahead and overwrite the file
2430 if the user confirms.
2432 If PRESERVE-UID-GID is non-nil, we try to transfer the
2433 uid and gid of FILE to NEWNAME. */)
2434 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
, preserve_uid_gid
)
2435 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2436 Lisp_Object preserve_uid_gid
;
2439 char buf
[16 * 1024];
2440 struct stat st
, out_st
;
2441 Lisp_Object handler
;
2442 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2443 int count
= SPECPDL_INDEX ();
2444 int input_file_statable_p
;
2445 Lisp_Object encoded_file
, encoded_newname
;
2447 encoded_file
= encoded_newname
= Qnil
;
2448 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2449 CHECK_STRING (file
);
2450 CHECK_STRING (newname
);
2452 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2453 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2455 if (!NILP (Ffile_directory_p (newname
)))
2456 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2458 newname
= Fexpand_file_name (newname
, Qnil
);
2460 file
= Fexpand_file_name (file
, Qnil
);
2462 /* If the input file name has special constructs in it,
2463 call the corresponding file handler. */
2464 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2465 /* Likewise for output file name. */
2467 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2468 if (!NILP (handler
))
2469 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2470 ok_if_already_exists
, keep_time
));
2472 encoded_file
= ENCODE_FILE (file
);
2473 encoded_newname
= ENCODE_FILE (newname
);
2475 if (NILP (ok_if_already_exists
)
2476 || INTEGERP (ok_if_already_exists
))
2477 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2478 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2479 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2483 if (!CopyFile (SDATA (encoded_file
),
2484 SDATA (encoded_newname
),
2486 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2487 /* CopyFile retains the timestamp by default. */
2488 else if (NILP (keep_time
))
2494 EMACS_GET_TIME (now
);
2495 filename
= SDATA (encoded_newname
);
2497 /* Ensure file is writable while its modified time is set. */
2498 attributes
= GetFileAttributes (filename
);
2499 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2500 if (set_file_times (filename
, now
, now
))
2502 /* Restore original attributes. */
2503 SetFileAttributes (filename
, attributes
);
2504 Fsignal (Qfile_date_error
,
2505 Fcons (build_string ("Cannot set file date"),
2506 Fcons (newname
, Qnil
)));
2508 /* Restore original attributes. */
2509 SetFileAttributes (filename
, attributes
);
2511 #else /* not WINDOWSNT */
2513 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2517 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2519 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2521 /* We can only copy regular files and symbolic links. Other files are not
2523 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2525 #if !defined (MSDOS) || __DJGPP__ > 1
2526 if (out_st
.st_mode
!= 0
2527 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2530 report_file_error ("Input and output files are the same",
2531 Fcons (file
, Fcons (newname
, Qnil
)));
2535 #if defined (S_ISREG) && defined (S_ISLNK)
2536 if (input_file_statable_p
)
2538 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2540 #if defined (EISDIR)
2541 /* Get a better looking error message. */
2544 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2547 #endif /* S_ISREG && S_ISLNK */
2550 /* Create the copy file with the same record format as the input file */
2551 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2554 /* System's default file type was set to binary by _fmode in emacs.c. */
2555 ofd
= emacs_open (SDATA (encoded_newname
),
2556 O_WRONLY
| O_TRUNC
| O_CREAT
2557 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2558 S_IREAD
| S_IWRITE
);
2559 #else /* not MSDOS */
2560 ofd
= emacs_open (SDATA (encoded_newname
),
2561 O_WRONLY
| O_TRUNC
| O_CREAT
2562 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2564 #endif /* not MSDOS */
2567 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2569 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2573 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2574 if (emacs_write (ofd
, buf
, n
) != n
)
2575 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2579 /* Preserve the original file modes, and if requested, also its
2581 if (input_file_statable_p
)
2583 if (! NILP (preserve_uid_gid
))
2584 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2585 fchmod (ofd
, st
.st_mode
& 07777);
2587 #endif /* not MSDOS */
2589 /* Closing the output clobbers the file times on some systems. */
2590 if (emacs_close (ofd
) < 0)
2591 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2593 if (input_file_statable_p
)
2595 if (!NILP (keep_time
))
2597 EMACS_TIME atime
, mtime
;
2598 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2599 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2600 if (set_file_times (SDATA (encoded_newname
),
2602 Fsignal (Qfile_date_error
,
2603 Fcons (build_string ("Cannot set file date"),
2604 Fcons (newname
, Qnil
)));
2610 #if defined (__DJGPP__) && __DJGPP__ > 1
2611 if (input_file_statable_p
)
2613 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2614 and if it can't, it tells so. Otherwise, under MSDOS we usually
2615 get only the READ bit, which will make the copied file read-only,
2616 so it's better not to chmod at all. */
2617 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2618 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2620 #endif /* DJGPP version 2 or newer */
2621 #endif /* not WINDOWSNT */
2623 /* Discard the unwind protects. */
2624 specpdl_ptr
= specpdl
+ count
;
2630 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2631 Smake_directory_internal
, 1, 1, 0,
2632 doc
: /* Create a new directory named DIRECTORY. */)
2634 Lisp_Object directory
;
2636 const unsigned char *dir
;
2637 Lisp_Object handler
;
2638 Lisp_Object encoded_dir
;
2640 CHECK_STRING (directory
);
2641 directory
= Fexpand_file_name (directory
, Qnil
);
2643 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2644 if (!NILP (handler
))
2645 return call2 (handler
, Qmake_directory_internal
, directory
);
2647 encoded_dir
= ENCODE_FILE (directory
);
2649 dir
= SDATA (encoded_dir
);
2652 if (mkdir (dir
) != 0)
2654 if (mkdir (dir
, 0777) != 0)
2656 report_file_error ("Creating directory", Flist (1, &directory
));
2661 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2662 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2664 Lisp_Object directory
;
2666 const unsigned char *dir
;
2667 Lisp_Object handler
;
2668 Lisp_Object encoded_dir
;
2670 CHECK_STRING (directory
);
2671 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2673 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2674 if (!NILP (handler
))
2675 return call2 (handler
, Qdelete_directory
, directory
);
2677 encoded_dir
= ENCODE_FILE (directory
);
2679 dir
= SDATA (encoded_dir
);
2681 if (rmdir (dir
) != 0)
2682 report_file_error ("Removing directory", Flist (1, &directory
));
2687 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2688 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2689 If file has multiple names, it continues to exist with the other names. */)
2691 Lisp_Object filename
;
2693 Lisp_Object handler
;
2694 Lisp_Object encoded_file
;
2695 struct gcpro gcpro1
;
2698 if (!NILP (Ffile_directory_p (filename
))
2699 && NILP (Ffile_symlink_p (filename
)))
2700 Fsignal (Qfile_error
,
2701 Fcons (build_string ("Removing old name: is a directory"),
2702 Fcons (filename
, Qnil
)));
2704 filename
= Fexpand_file_name (filename
, Qnil
);
2706 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2707 if (!NILP (handler
))
2708 return call2 (handler
, Qdelete_file
, filename
);
2710 encoded_file
= ENCODE_FILE (filename
);
2712 if (0 > unlink (SDATA (encoded_file
)))
2713 report_file_error ("Removing old name", Flist (1, &filename
));
2718 internal_delete_file_1 (ignore
)
2724 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2727 internal_delete_file (filename
)
2728 Lisp_Object filename
;
2730 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2731 Qt
, internal_delete_file_1
));
2734 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2735 "fRename file: \nGRename %s to file: \np",
2736 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2737 If file has names other than FILE, it continues to have those names.
2738 Signals a `file-already-exists' error if a file NEWNAME already exists
2739 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2740 A number as third arg means request confirmation if NEWNAME already exists.
2741 This is what happens in interactive use with M-x. */)
2742 (file
, newname
, ok_if_already_exists
)
2743 Lisp_Object file
, newname
, ok_if_already_exists
;
2746 Lisp_Object args
[2];
2748 Lisp_Object handler
;
2749 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2750 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2752 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2753 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2754 CHECK_STRING (file
);
2755 CHECK_STRING (newname
);
2756 file
= Fexpand_file_name (file
, Qnil
);
2758 if (!NILP (Ffile_directory_p (newname
)))
2759 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2761 newname
= Fexpand_file_name (newname
, Qnil
);
2763 /* If the file name has special constructs in it,
2764 call the corresponding file handler. */
2765 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2767 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2768 if (!NILP (handler
))
2769 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2770 file
, newname
, ok_if_already_exists
));
2772 encoded_file
= ENCODE_FILE (file
);
2773 encoded_newname
= ENCODE_FILE (newname
);
2776 /* If the file names are identical but for the case, don't ask for
2777 confirmation: they simply want to change the letter-case of the
2779 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2781 if (NILP (ok_if_already_exists
)
2782 || INTEGERP (ok_if_already_exists
))
2783 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2784 INTEGERP (ok_if_already_exists
), 0, 0);
2786 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2788 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2789 || 0 > unlink (SDATA (encoded_file
)))
2795 symlink_target
= Ffile_symlink_p (file
);
2796 if (! NILP (symlink_target
))
2797 Fmake_symbolic_link (symlink_target
, newname
,
2798 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2801 Fcopy_file (file
, newname
,
2802 /* We have already prompted if it was an integer,
2803 so don't have copy-file prompt again. */
2804 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2807 Fdelete_file (file
);
2814 report_file_error ("Renaming", Flist (2, args
));
2817 report_file_error ("Renaming", Flist (2, &file
));
2824 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2825 "fAdd name to file: \nGName to add to %s: \np",
2826 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2827 Signals a `file-already-exists' error if a file NEWNAME already exists
2828 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2829 A number as third arg means request confirmation if NEWNAME already exists.
2830 This is what happens in interactive use with M-x. */)
2831 (file
, newname
, ok_if_already_exists
)
2832 Lisp_Object file
, newname
, ok_if_already_exists
;
2835 Lisp_Object args
[2];
2837 Lisp_Object handler
;
2838 Lisp_Object encoded_file
, encoded_newname
;
2839 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2841 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2842 encoded_file
= encoded_newname
= Qnil
;
2843 CHECK_STRING (file
);
2844 CHECK_STRING (newname
);
2845 file
= Fexpand_file_name (file
, Qnil
);
2847 if (!NILP (Ffile_directory_p (newname
)))
2848 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2850 newname
= Fexpand_file_name (newname
, Qnil
);
2852 /* If the file name has special constructs in it,
2853 call the corresponding file handler. */
2854 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2855 if (!NILP (handler
))
2856 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2857 newname
, ok_if_already_exists
));
2859 /* If the new name has special constructs in it,
2860 call the corresponding file handler. */
2861 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2862 if (!NILP (handler
))
2863 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2864 newname
, ok_if_already_exists
));
2866 encoded_file
= ENCODE_FILE (file
);
2867 encoded_newname
= ENCODE_FILE (newname
);
2869 if (NILP (ok_if_already_exists
)
2870 || INTEGERP (ok_if_already_exists
))
2871 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2872 INTEGERP (ok_if_already_exists
), 0, 0);
2874 unlink (SDATA (newname
));
2875 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2880 report_file_error ("Adding new name", Flist (2, args
));
2882 report_file_error ("Adding new name", Flist (2, &file
));
2891 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2892 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2893 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2894 Both args must be strings.
2895 Signals a `file-already-exists' error if a file LINKNAME already exists
2896 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2897 A number as third arg means request confirmation if LINKNAME already exists.
2898 This happens for interactive use with M-x. */)
2899 (filename
, linkname
, ok_if_already_exists
)
2900 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2903 Lisp_Object args
[2];
2905 Lisp_Object handler
;
2906 Lisp_Object encoded_filename
, encoded_linkname
;
2907 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2909 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2910 encoded_filename
= encoded_linkname
= Qnil
;
2911 CHECK_STRING (filename
);
2912 CHECK_STRING (linkname
);
2913 /* If the link target has a ~, we must expand it to get
2914 a truly valid file name. Otherwise, do not expand;
2915 we want to permit links to relative file names. */
2916 if (SREF (filename
, 0) == '~')
2917 filename
= Fexpand_file_name (filename
, Qnil
);
2919 if (!NILP (Ffile_directory_p (linkname
)))
2920 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2922 linkname
= Fexpand_file_name (linkname
, Qnil
);
2924 /* If the file name has special constructs in it,
2925 call the corresponding file handler. */
2926 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2927 if (!NILP (handler
))
2928 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2929 linkname
, ok_if_already_exists
));
2931 /* If the new link name has special constructs in it,
2932 call the corresponding file handler. */
2933 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2934 if (!NILP (handler
))
2935 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2936 linkname
, ok_if_already_exists
));
2938 encoded_filename
= ENCODE_FILE (filename
);
2939 encoded_linkname
= ENCODE_FILE (linkname
);
2941 if (NILP (ok_if_already_exists
)
2942 || INTEGERP (ok_if_already_exists
))
2943 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2944 INTEGERP (ok_if_already_exists
), 0, 0);
2945 if (0 > symlink (SDATA (encoded_filename
),
2946 SDATA (encoded_linkname
)))
2948 /* If we didn't complain already, silently delete existing file. */
2949 if (errno
== EEXIST
)
2951 unlink (SDATA (encoded_linkname
));
2952 if (0 <= symlink (SDATA (encoded_filename
),
2953 SDATA (encoded_linkname
)))
2963 report_file_error ("Making symbolic link", Flist (2, args
));
2965 report_file_error ("Making symbolic link", Flist (2, &filename
));
2971 #endif /* S_IFLNK */
2975 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2976 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2977 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2978 If STRING is nil or a null string, the logical name NAME is deleted. */)
2983 CHECK_STRING (name
);
2985 delete_logical_name (SDATA (name
));
2988 CHECK_STRING (string
);
2990 if (SCHARS (string
) == 0)
2991 delete_logical_name (SDATA (name
));
2993 define_logical_name (SDATA (name
), SDATA (string
));
3002 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
3003 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
3005 Lisp_Object path
, login
;
3009 CHECK_STRING (path
);
3010 CHECK_STRING (login
);
3012 netresult
= netunam (SDATA (path
), SDATA (login
));
3014 if (netresult
== -1)
3019 #endif /* HPUX_NET */
3021 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3023 doc
: /* Return t if file FILENAME specifies an absolute file name.
3024 On Unix, this is a name starting with a `/' or a `~'. */)
3026 Lisp_Object filename
;
3028 CHECK_STRING (filename
);
3029 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3032 /* Return nonzero if file FILENAME exists and can be executed. */
3035 check_executable (filename
)
3039 int len
= strlen (filename
);
3042 if (stat (filename
, &st
) < 0)
3044 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3045 return ((st
.st_mode
& S_IEXEC
) != 0);
3047 return (S_ISREG (st
.st_mode
)
3049 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3050 || stricmp (suffix
, ".exe") == 0
3051 || stricmp (suffix
, ".bat") == 0)
3052 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3053 #endif /* not WINDOWSNT */
3054 #else /* not DOS_NT */
3055 #ifdef HAVE_EUIDACCESS
3056 return (euidaccess (filename
, 1) >= 0);
3058 /* Access isn't quite right because it uses the real uid
3059 and we really want to test with the effective uid.
3060 But Unix doesn't give us a right way to do it. */
3061 return (access (filename
, 1) >= 0);
3063 #endif /* not DOS_NT */
3066 /* Return nonzero if file FILENAME exists and can be written. */
3069 check_writable (filename
)
3074 if (stat (filename
, &st
) < 0)
3076 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3077 #else /* not MSDOS */
3078 #ifdef HAVE_EUIDACCESS
3079 return (euidaccess (filename
, 2) >= 0);
3081 /* Access isn't quite right because it uses the real uid
3082 and we really want to test with the effective uid.
3083 But Unix doesn't give us a right way to do it.
3084 Opening with O_WRONLY could work for an ordinary file,
3085 but would lose for directories. */
3086 return (access (filename
, 2) >= 0);
3088 #endif /* not MSDOS */
3091 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3092 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3093 See also `file-readable-p' and `file-attributes'.
3094 This returns nil for a symlink to a nonexistent file.
3095 Use `file-symlink-p' to test for such links. */)
3097 Lisp_Object filename
;
3099 Lisp_Object absname
;
3100 Lisp_Object handler
;
3101 struct stat statbuf
;
3103 CHECK_STRING (filename
);
3104 absname
= Fexpand_file_name (filename
, Qnil
);
3106 /* If the file name has special constructs in it,
3107 call the corresponding file handler. */
3108 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3109 if (!NILP (handler
))
3110 return call2 (handler
, Qfile_exists_p
, absname
);
3112 absname
= ENCODE_FILE (absname
);
3114 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3117 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3118 doc
: /* Return t if FILENAME can be executed by you.
3119 For a directory, this means you can access files in that directory. */)
3121 Lisp_Object filename
;
3123 Lisp_Object absname
;
3124 Lisp_Object handler
;
3126 CHECK_STRING (filename
);
3127 absname
= Fexpand_file_name (filename
, Qnil
);
3129 /* If the file name has special constructs in it,
3130 call the corresponding file handler. */
3131 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3132 if (!NILP (handler
))
3133 return call2 (handler
, Qfile_executable_p
, absname
);
3135 absname
= ENCODE_FILE (absname
);
3137 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3140 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3141 doc
: /* Return t if file FILENAME exists and you can read it.
3142 See also `file-exists-p' and `file-attributes'. */)
3144 Lisp_Object filename
;
3146 Lisp_Object absname
;
3147 Lisp_Object handler
;
3150 struct stat statbuf
;
3152 CHECK_STRING (filename
);
3153 absname
= Fexpand_file_name (filename
, Qnil
);
3155 /* If the file name has special constructs in it,
3156 call the corresponding file handler. */
3157 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3158 if (!NILP (handler
))
3159 return call2 (handler
, Qfile_readable_p
, absname
);
3161 absname
= ENCODE_FILE (absname
);
3163 #if defined(DOS_NT) || defined(macintosh)
3164 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3166 if (access (SDATA (absname
), 0) == 0)
3169 #else /* not DOS_NT and not macintosh */
3171 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3172 /* Opening a fifo without O_NONBLOCK can wait.
3173 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3174 except in the case of a fifo, on a system which handles it. */
3175 desc
= stat (SDATA (absname
), &statbuf
);
3178 if (S_ISFIFO (statbuf
.st_mode
))
3179 flags
|= O_NONBLOCK
;
3181 desc
= emacs_open (SDATA (absname
), flags
, 0);
3186 #endif /* not DOS_NT and not macintosh */
3189 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3191 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3192 doc
: /* Return t if file FILENAME can be written or created by you. */)
3194 Lisp_Object filename
;
3196 Lisp_Object absname
, dir
, encoded
;
3197 Lisp_Object handler
;
3198 struct stat statbuf
;
3200 CHECK_STRING (filename
);
3201 absname
= Fexpand_file_name (filename
, Qnil
);
3203 /* If the file name has special constructs in it,
3204 call the corresponding file handler. */
3205 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3206 if (!NILP (handler
))
3207 return call2 (handler
, Qfile_writable_p
, absname
);
3209 encoded
= ENCODE_FILE (absname
);
3210 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3211 return (check_writable (SDATA (encoded
))
3214 dir
= Ffile_name_directory (absname
);
3217 dir
= Fdirectory_file_name (dir
);
3221 dir
= Fdirectory_file_name (dir
);
3224 dir
= ENCODE_FILE (dir
);
3226 /* The read-only attribute of the parent directory doesn't affect
3227 whether a file or directory can be created within it. Some day we
3228 should check ACLs though, which do affect this. */
3229 if (stat (SDATA (dir
), &statbuf
) < 0)
3231 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3233 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3238 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3239 doc
: /* Access file FILENAME, and get an error if that does not work.
3240 The second argument STRING is used in the error message.
3241 If there is no error, returns nil. */)
3243 Lisp_Object filename
, string
;
3245 Lisp_Object handler
, encoded_filename
, absname
;
3248 CHECK_STRING (filename
);
3249 absname
= Fexpand_file_name (filename
, Qnil
);
3251 CHECK_STRING (string
);
3253 /* If the file name has special constructs in it,
3254 call the corresponding file handler. */
3255 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3256 if (!NILP (handler
))
3257 return call3 (handler
, Qaccess_file
, absname
, string
);
3259 encoded_filename
= ENCODE_FILE (absname
);
3261 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3263 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3269 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3270 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3271 The value is the link target, as a string.
3272 Otherwise it returns nil.
3274 This function returns t when given the name of a symlink that
3275 points to a nonexistent file. */)
3277 Lisp_Object filename
;
3279 Lisp_Object handler
;
3281 CHECK_STRING (filename
);
3282 filename
= Fexpand_file_name (filename
, Qnil
);
3284 /* If the file name has special constructs in it,
3285 call the corresponding file handler. */
3286 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3287 if (!NILP (handler
))
3288 return call2 (handler
, Qfile_symlink_p
, filename
);
3297 filename
= ENCODE_FILE (filename
);
3304 buf
= (char *) xrealloc (buf
, bufsize
);
3305 bzero (buf
, bufsize
);
3308 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3312 /* HP-UX reports ERANGE if buffer is too small. */
3313 if (errno
== ERANGE
)
3323 while (valsize
>= bufsize
);
3325 val
= make_string (buf
, valsize
);
3326 if (buf
[0] == '/' && index (buf
, ':'))
3327 val
= concat2 (build_string ("/:"), val
);
3329 val
= DECODE_FILE (val
);
3332 #else /* not S_IFLNK */
3334 #endif /* not S_IFLNK */
3337 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3338 doc
: /* Return t if FILENAME names an existing directory.
3339 Symbolic links to directories count as directories.
3340 See `file-symlink-p' to distinguish symlinks. */)
3342 Lisp_Object filename
;
3344 register Lisp_Object absname
;
3346 Lisp_Object handler
;
3348 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3350 /* If the file name has special constructs in it,
3351 call the corresponding file handler. */
3352 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3353 if (!NILP (handler
))
3354 return call2 (handler
, Qfile_directory_p
, absname
);
3356 absname
= ENCODE_FILE (absname
);
3358 if (stat (SDATA (absname
), &st
) < 0)
3360 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3363 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3364 doc
: /* Return t if file FILENAME names a directory you can open.
3365 For the value to be t, FILENAME must specify the name of a directory as a file,
3366 and the directory must allow you to open files in it. In order to use a
3367 directory as a buffer's current directory, this predicate must return true.
3368 A directory name spec may be given instead; then the value is t
3369 if the directory so specified exists and really is a readable and
3370 searchable directory. */)
3372 Lisp_Object filename
;
3374 Lisp_Object handler
;
3376 struct gcpro gcpro1
;
3378 /* If the file name has special constructs in it,
3379 call the corresponding file handler. */
3380 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3381 if (!NILP (handler
))
3382 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3385 tem
= (NILP (Ffile_directory_p (filename
))
3386 || NILP (Ffile_executable_p (filename
)));
3388 return tem
? Qnil
: Qt
;
3391 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3392 doc
: /* Return t if file FILENAME is the name of a regular file.
3393 This is the sort of file that holds an ordinary stream of data bytes. */)
3395 Lisp_Object filename
;
3397 register Lisp_Object absname
;
3399 Lisp_Object handler
;
3401 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3403 /* If the file name has special constructs in it,
3404 call the corresponding file handler. */
3405 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3406 if (!NILP (handler
))
3407 return call2 (handler
, Qfile_regular_p
, absname
);
3409 absname
= ENCODE_FILE (absname
);
3414 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3416 /* Tell stat to use expensive method to get accurate info. */
3417 Vw32_get_true_file_attributes
= Qt
;
3418 result
= stat (SDATA (absname
), &st
);
3419 Vw32_get_true_file_attributes
= tem
;
3423 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3426 if (stat (SDATA (absname
), &st
) < 0)
3428 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3432 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3433 doc
: /* Return mode bits of file named FILENAME, as an integer.
3434 Return nil, if file does not exist or is not accessible. */)
3436 Lisp_Object filename
;
3438 Lisp_Object absname
;
3440 Lisp_Object handler
;
3442 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3444 /* If the file name has special constructs in it,
3445 call the corresponding file handler. */
3446 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3447 if (!NILP (handler
))
3448 return call2 (handler
, Qfile_modes
, absname
);
3450 absname
= ENCODE_FILE (absname
);
3452 if (stat (SDATA (absname
), &st
) < 0)
3454 #if defined (MSDOS) && __DJGPP__ < 2
3455 if (check_executable (SDATA (absname
)))
3456 st
.st_mode
|= S_IEXEC
;
3457 #endif /* MSDOS && __DJGPP__ < 2 */
3459 return make_number (st
.st_mode
& 07777);
3462 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3463 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3464 Only the 12 low bits of MODE are used. */)
3466 Lisp_Object filename
, mode
;
3468 Lisp_Object absname
, encoded_absname
;
3469 Lisp_Object handler
;
3471 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3472 CHECK_NUMBER (mode
);
3474 /* If the file name has special constructs in it,
3475 call the corresponding file handler. */
3476 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3477 if (!NILP (handler
))
3478 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3480 encoded_absname
= ENCODE_FILE (absname
);
3482 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3483 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3488 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3489 doc
: /* Set the file permission bits for newly created files.
3490 The argument MODE should be an integer; only the low 9 bits are used.
3491 This setting is inherited by subprocesses. */)
3495 CHECK_NUMBER (mode
);
3497 umask ((~ XINT (mode
)) & 0777);
3502 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3503 doc
: /* Return the default file protection for created files.
3504 The value is an integer. */)
3510 realmask
= umask (0);
3513 XSETINT (value
, (~ realmask
) & 0777);
3517 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3519 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3520 doc
: /* Set times of file FILENAME to TIME.
3521 Set both access and modification times.
3522 Return t on success, else nil.
3523 Use the current time if TIME is nil. TIME is in the format of
3526 Lisp_Object filename
, time
;
3528 Lisp_Object absname
, encoded_absname
;
3529 Lisp_Object handler
;
3533 if (! lisp_time_argument (time
, &sec
, &usec
))
3534 error ("Invalid time specification");
3536 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3538 /* If the file name has special constructs in it,
3539 call the corresponding file handler. */
3540 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3541 if (!NILP (handler
))
3542 return call3 (handler
, Qset_file_times
, absname
, time
);
3544 encoded_absname
= ENCODE_FILE (absname
);
3549 EMACS_SET_SECS (t
, sec
);
3550 EMACS_SET_USECS (t
, usec
);
3552 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3557 /* Setting times on a directory always fails. */
3558 if (stat (SDATA (encoded_absname
), &st
) == 0
3559 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3562 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3575 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3576 doc
: /* Tell Unix to finish all pending disk updates. */)
3585 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3586 doc
: /* Return t if file FILE1 is newer than file FILE2.
3587 If FILE1 does not exist, the answer is nil;
3588 otherwise, if FILE2 does not exist, the answer is t. */)
3590 Lisp_Object file1
, file2
;
3592 Lisp_Object absname1
, absname2
;
3595 Lisp_Object handler
;
3596 struct gcpro gcpro1
, gcpro2
;
3598 CHECK_STRING (file1
);
3599 CHECK_STRING (file2
);
3602 GCPRO2 (absname1
, file2
);
3603 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3604 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3607 /* If the file name has special constructs in it,
3608 call the corresponding file handler. */
3609 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3611 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3612 if (!NILP (handler
))
3613 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3615 GCPRO2 (absname1
, absname2
);
3616 absname1
= ENCODE_FILE (absname1
);
3617 absname2
= ENCODE_FILE (absname2
);
3620 if (stat (SDATA (absname1
), &st
) < 0)
3623 mtime1
= st
.st_mtime
;
3625 if (stat (SDATA (absname2
), &st
) < 0)
3628 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3632 Lisp_Object Qfind_buffer_file_type
;
3635 #ifndef READ_BUF_SIZE
3636 #define READ_BUF_SIZE (64 << 10)
3639 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3641 /* This function is called after Lisp functions to decide a coding
3642 system are called, or when they cause an error. Before they are
3643 called, the current buffer is set unibyte and it contains only a
3644 newly inserted text (thus the buffer was empty before the
3647 The functions may set markers, overlays, text properties, or even
3648 alter the buffer contents, change the current buffer.
3650 Here, we reset all those changes by:
3651 o set back the current buffer.
3652 o move all markers and overlays to BEG.
3653 o remove all text properties.
3654 o set back the buffer multibyteness. */
3657 decide_coding_unwind (unwind_data
)
3658 Lisp_Object unwind_data
;
3660 Lisp_Object multibyte
, undo_list
, buffer
;
3662 multibyte
= XCAR (unwind_data
);
3663 unwind_data
= XCDR (unwind_data
);
3664 undo_list
= XCAR (unwind_data
);
3665 buffer
= XCDR (unwind_data
);
3667 if (current_buffer
!= XBUFFER (buffer
))
3668 set_buffer_internal (XBUFFER (buffer
));
3669 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3670 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3671 BUF_INTERVALS (current_buffer
) = 0;
3672 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3674 /* Now we are safe to change the buffer's multibyteness directly. */
3675 current_buffer
->enable_multibyte_characters
= multibyte
;
3676 current_buffer
->undo_list
= undo_list
;
3682 /* Used to pass values from insert-file-contents to read_non_regular. */
3684 static int non_regular_fd
;
3685 static int non_regular_inserted
;
3686 static int non_regular_nbytes
;
3689 /* Read from a non-regular file.
3690 Read non_regular_trytry bytes max from non_regular_fd.
3691 Non_regular_inserted specifies where to put the read bytes.
3692 Value is the number of bytes read. */
3701 nbytes
= emacs_read (non_regular_fd
,
3702 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3703 non_regular_nbytes
);
3705 return make_number (nbytes
);
3709 /* Condition-case handler used when reading from non-regular files
3710 in insert-file-contents. */
3713 read_non_regular_quit ()
3719 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3721 doc
: /* Insert contents of file FILENAME after point.
3722 Returns list of absolute file name and number of characters inserted.
3723 If second argument VISIT is non-nil, the buffer's visited filename
3724 and last save file modtime are set, and it is marked unmodified.
3725 If visiting and the file does not exist, visiting is completed
3726 before the error is signaled.
3727 The optional third and fourth arguments BEG and END
3728 specify what portion of the file to insert.
3729 These arguments count bytes in the file, not characters in the buffer.
3730 If VISIT is non-nil, BEG and END must be nil.
3732 If optional fifth argument REPLACE is non-nil,
3733 it means replace the current buffer contents (in the accessible portion)
3734 with the file contents. This is better than simply deleting and inserting
3735 the whole thing because (1) it preserves some marker positions
3736 and (2) it puts less data in the undo list.
3737 When REPLACE is non-nil, the value is the number of characters actually read,
3738 which is often less than the number of characters to be read.
3740 This does code conversion according to the value of
3741 `coding-system-for-read' or `file-coding-system-alist',
3742 and sets the variable `last-coding-system-used' to the coding system
3744 (filename
, visit
, beg
, end
, replace
)
3745 Lisp_Object filename
, visit
, beg
, end
, replace
;
3750 register int how_much
;
3751 register int unprocessed
;
3752 int count
= SPECPDL_INDEX ();
3753 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3754 Lisp_Object handler
, val
, insval
, orig_filename
;
3757 int not_regular
= 0;
3758 unsigned char read_buf
[READ_BUF_SIZE
];
3759 struct coding_system coding
;
3760 unsigned char buffer
[1 << 14];
3761 int replace_handled
= 0;
3762 int set_coding_system
= 0;
3763 int coding_system_decided
= 0;
3765 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3766 int we_locked_file
= 0;
3768 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3769 error ("Cannot do file visiting in an indirect buffer");
3771 if (!NILP (current_buffer
->read_only
))
3772 Fbarf_if_buffer_read_only ();
3776 orig_filename
= Qnil
;
3778 GCPRO4 (filename
, val
, p
, orig_filename
);
3780 CHECK_STRING (filename
);
3781 filename
= Fexpand_file_name (filename
, Qnil
);
3783 /* If the file name has special constructs in it,
3784 call the corresponding file handler. */
3785 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3786 if (!NILP (handler
))
3788 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3789 visit
, beg
, end
, replace
);
3790 if (CONSP (val
) && CONSP (XCDR (val
)))
3791 inserted
= XINT (XCAR (XCDR (val
)));
3795 orig_filename
= filename
;
3796 filename
= ENCODE_FILE (filename
);
3802 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3804 /* Tell stat to use expensive method to get accurate info. */
3805 Vw32_get_true_file_attributes
= Qt
;
3806 total
= stat (SDATA (filename
), &st
);
3807 Vw32_get_true_file_attributes
= tem
;
3812 if (stat (SDATA (filename
), &st
) < 0)
3814 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3815 || fstat (fd
, &st
) < 0)
3816 #endif /* not APOLLO */
3817 #endif /* WINDOWSNT */
3819 if (fd
>= 0) emacs_close (fd
);
3822 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3825 if (!NILP (Vcoding_system_for_read
))
3826 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3831 /* This code will need to be changed in order to work on named
3832 pipes, and it's probably just not worth it. So we should at
3833 least signal an error. */
3834 if (!S_ISREG (st
.st_mode
))
3841 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3842 Fsignal (Qfile_error
,
3843 Fcons (build_string ("not a regular file"),
3844 Fcons (orig_filename
, Qnil
)));
3849 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3852 /* Replacement should preserve point as it preserves markers. */
3853 if (!NILP (replace
))
3854 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3856 record_unwind_protect (close_file_unwind
, make_number (fd
));
3858 /* Supposedly happens on VMS. */
3859 /* Can happen on any platform that uses long as type of off_t, but allows
3860 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3861 give a message suitable for the latter case. */
3862 if (! not_regular
&& st
.st_size
< 0)
3863 error ("Maximum buffer size exceeded");
3865 /* Prevent redisplay optimizations. */
3866 current_buffer
->clip_changed
= 1;
3870 if (!NILP (beg
) || !NILP (end
))
3871 error ("Attempt to visit less than an entire file");
3872 if (BEG
< Z
&& NILP (replace
))
3873 error ("Cannot do file visiting in a non-empty buffer");
3879 XSETFASTINT (beg
, 0);
3887 XSETINT (end
, st
.st_size
);
3889 /* Arithmetic overflow can occur if an Emacs integer cannot
3890 represent the file size, or if the calculations below
3891 overflow. The calculations below double the file size
3892 twice, so check that it can be multiplied by 4 safely. */
3893 if (XINT (end
) != st
.st_size
3894 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3895 error ("Maximum buffer size exceeded");
3897 /* The file size returned from stat may be zero, but data
3898 may be readable nonetheless, for example when this is a
3899 file in the /proc filesystem. */
3900 if (st
.st_size
== 0)
3901 XSETINT (end
, READ_BUF_SIZE
);
3905 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3907 /* We use emacs-mule for auto saving... */
3908 setup_coding_system (Qemacs_mule
, &coding
);
3909 /* ... but with the special flag to indicate to read in a
3910 multibyte sequence for eight-bit-control char as is. */
3912 coding
.src_multibyte
= 0;
3913 coding
.dst_multibyte
3914 = !NILP (current_buffer
->enable_multibyte_characters
);
3915 coding
.eol_type
= CODING_EOL_LF
;
3916 coding_system_decided
= 1;
3920 /* Decide the coding system to use for reading the file now
3921 because we can't use an optimized method for handling
3922 `coding:' tag if the current buffer is not empty. */
3926 if (!NILP (Vcoding_system_for_read
))
3927 val
= Vcoding_system_for_read
;
3930 /* Don't try looking inside a file for a coding system
3931 specification if it is not seekable. */
3932 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3934 /* Find a coding system specified in the heading two
3935 lines or in the tailing several lines of the file.
3936 We assume that the 1K-byte and 3K-byte for heading
3937 and tailing respectively are sufficient for this
3941 if (st
.st_size
<= (1024 * 4))
3942 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3945 nread
= emacs_read (fd
, read_buf
, 1024);
3948 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3949 report_file_error ("Setting file position",
3950 Fcons (orig_filename
, Qnil
));
3951 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3956 error ("IO error reading %s: %s",
3957 SDATA (orig_filename
), emacs_strerror (errno
));
3960 struct buffer
*prev
= current_buffer
;
3964 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3966 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3967 buf
= XBUFFER (buffer
);
3969 delete_all_overlays (buf
);
3970 buf
->directory
= current_buffer
->directory
;
3971 buf
->read_only
= Qnil
;
3972 buf
->filename
= Qnil
;
3973 buf
->undo_list
= Qt
;
3974 eassert (buf
->overlays_before
== NULL
);
3975 eassert (buf
->overlays_after
== NULL
);
3977 set_buffer_internal (buf
);
3979 buf
->enable_multibyte_characters
= Qnil
;
3981 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3982 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3983 val
= call2 (Vset_auto_coding_function
,
3984 filename
, make_number (nread
));
3985 set_buffer_internal (prev
);
3987 /* Discard the unwind protect for recovering the
3991 /* Rewind the file for the actual read done later. */
3992 if (lseek (fd
, 0, 0) < 0)
3993 report_file_error ("Setting file position",
3994 Fcons (orig_filename
, Qnil
));
4000 /* If we have not yet decided a coding system, check
4001 file-coding-system-alist. */
4002 Lisp_Object args
[6], coding_systems
;
4004 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4005 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4006 coding_systems
= Ffind_operation_coding_system (6, args
);
4007 if (CONSP (coding_systems
))
4008 val
= XCAR (coding_systems
);
4012 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4013 /* Ensure we set Vlast_coding_system_used. */
4014 set_coding_system
= 1;
4016 if (NILP (current_buffer
->enable_multibyte_characters
)
4018 /* We must suppress all character code conversion except for
4019 end-of-line conversion. */
4020 setup_raw_text_coding_system (&coding
);
4022 coding
.src_multibyte
= 0;
4023 coding
.dst_multibyte
4024 = !NILP (current_buffer
->enable_multibyte_characters
);
4025 coding_system_decided
= 1;
4028 /* If requested, replace the accessible part of the buffer
4029 with the file contents. Avoid replacing text at the
4030 beginning or end of the buffer that matches the file contents;
4031 that preserves markers pointing to the unchanged parts.
4033 Here we implement this feature in an optimized way
4034 for the case where code conversion is NOT needed.
4035 The following if-statement handles the case of conversion
4036 in a less optimal way.
4038 If the code conversion is "automatic" then we try using this
4039 method and hope for the best.
4040 But if we discover the need for conversion, we give up on this method
4041 and let the following if-statement handle the replace job. */
4044 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4046 /* same_at_start and same_at_end count bytes,
4047 because file access counts bytes
4048 and BEG and END count bytes. */
4049 int same_at_start
= BEGV_BYTE
;
4050 int same_at_end
= ZV_BYTE
;
4052 /* There is still a possibility we will find the need to do code
4053 conversion. If that happens, we set this variable to 1 to
4054 give up on handling REPLACE in the optimized way. */
4055 int giveup_match_end
= 0;
4057 if (XINT (beg
) != 0)
4059 if (lseek (fd
, XINT (beg
), 0) < 0)
4060 report_file_error ("Setting file position",
4061 Fcons (orig_filename
, Qnil
));
4066 /* Count how many chars at the start of the file
4067 match the text at the beginning of the buffer. */
4072 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4074 error ("IO error reading %s: %s",
4075 SDATA (orig_filename
), emacs_strerror (errno
));
4076 else if (nread
== 0)
4079 if (coding
.type
== coding_type_undecided
)
4080 detect_coding (&coding
, buffer
, nread
);
4081 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4082 /* We found that the file should be decoded somehow.
4083 Let's give up here. */
4085 giveup_match_end
= 1;
4089 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4090 detect_eol (&coding
, buffer
, nread
);
4091 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4092 && coding
.eol_type
!= CODING_EOL_LF
)
4093 /* We found that the format of eol should be decoded.
4094 Let's give up here. */
4096 giveup_match_end
= 1;
4101 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4102 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4103 same_at_start
++, bufpos
++;
4104 /* If we found a discrepancy, stop the scan.
4105 Otherwise loop around and scan the next bufferful. */
4106 if (bufpos
!= nread
)
4110 /* If the file matches the buffer completely,
4111 there's no need to replace anything. */
4112 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4116 /* Truncate the buffer to the size of the file. */
4117 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4122 /* Count how many chars at the end of the file
4123 match the text at the end of the buffer. But, if we have
4124 already found that decoding is necessary, don't waste time. */
4125 while (!giveup_match_end
)
4127 int total_read
, nread
, bufpos
, curpos
, trial
;
4129 /* At what file position are we now scanning? */
4130 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4131 /* If the entire file matches the buffer tail, stop the scan. */
4134 /* How much can we scan in the next step? */
4135 trial
= min (curpos
, sizeof buffer
);
4136 if (lseek (fd
, curpos
- trial
, 0) < 0)
4137 report_file_error ("Setting file position",
4138 Fcons (orig_filename
, Qnil
));
4140 total_read
= nread
= 0;
4141 while (total_read
< trial
)
4143 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4145 error ("IO error reading %s: %s",
4146 SDATA (orig_filename
), emacs_strerror (errno
));
4147 else if (nread
== 0)
4149 total_read
+= nread
;
4152 /* Scan this bufferful from the end, comparing with
4153 the Emacs buffer. */
4154 bufpos
= total_read
;
4156 /* Compare with same_at_start to avoid counting some buffer text
4157 as matching both at the file's beginning and at the end. */
4158 while (bufpos
> 0 && same_at_end
> same_at_start
4159 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4160 same_at_end
--, bufpos
--;
4162 /* If we found a discrepancy, stop the scan.
4163 Otherwise loop around and scan the preceding bufferful. */
4166 /* If this discrepancy is because of code conversion,
4167 we cannot use this method; giveup and try the other. */
4168 if (same_at_end
> same_at_start
4169 && FETCH_BYTE (same_at_end
- 1) >= 0200
4170 && ! NILP (current_buffer
->enable_multibyte_characters
)
4171 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4172 giveup_match_end
= 1;
4181 if (! giveup_match_end
)
4185 /* We win! We can handle REPLACE the optimized way. */
4187 /* Extend the start of non-matching text area to multibyte
4188 character boundary. */
4189 if (! NILP (current_buffer
->enable_multibyte_characters
))
4190 while (same_at_start
> BEGV_BYTE
4191 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4194 /* Extend the end of non-matching text area to multibyte
4195 character boundary. */
4196 if (! NILP (current_buffer
->enable_multibyte_characters
))
4197 while (same_at_end
< ZV_BYTE
4198 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4201 /* Don't try to reuse the same piece of text twice. */
4202 overlap
= (same_at_start
- BEGV_BYTE
4203 - (same_at_end
+ st
.st_size
- ZV
));
4205 same_at_end
+= overlap
;
4207 /* Arrange to read only the nonmatching middle part of the file. */
4208 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4209 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4211 del_range_byte (same_at_start
, same_at_end
, 0);
4212 /* Insert from the file at the proper position. */
4213 temp
= BYTE_TO_CHAR (same_at_start
);
4214 SET_PT_BOTH (temp
, same_at_start
);
4216 /* If display currently starts at beginning of line,
4217 keep it that way. */
4218 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4219 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4221 replace_handled
= 1;
4225 /* If requested, replace the accessible part of the buffer
4226 with the file contents. Avoid replacing text at the
4227 beginning or end of the buffer that matches the file contents;
4228 that preserves markers pointing to the unchanged parts.
4230 Here we implement this feature for the case where code conversion
4231 is needed, in a simple way that needs a lot of memory.
4232 The preceding if-statement handles the case of no conversion
4233 in a more optimized way. */
4234 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4236 int same_at_start
= BEGV_BYTE
;
4237 int same_at_end
= ZV_BYTE
;
4240 /* Make sure that the gap is large enough. */
4241 int bufsize
= 2 * st
.st_size
;
4242 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4245 /* First read the whole file, performing code conversion into
4246 CONVERSION_BUFFER. */
4248 if (lseek (fd
, XINT (beg
), 0) < 0)
4250 xfree (conversion_buffer
);
4251 report_file_error ("Setting file position",
4252 Fcons (orig_filename
, Qnil
));
4255 total
= st
.st_size
; /* Total bytes in the file. */
4256 how_much
= 0; /* Bytes read from file so far. */
4257 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4258 unprocessed
= 0; /* Bytes not processed in previous loop. */
4260 while (how_much
< total
)
4262 /* try is reserved in some compilers (Microsoft C) */
4263 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4264 unsigned char *destination
= read_buf
+ unprocessed
;
4267 /* Allow quitting out of the actual I/O. */
4270 this = emacs_read (fd
, destination
, trytry
);
4273 if (this < 0 || this + unprocessed
== 0)
4281 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4283 int require
, result
;
4285 this += unprocessed
;
4287 /* If we are using more space than estimated,
4288 make CONVERSION_BUFFER bigger. */
4289 require
= decoding_buffer_size (&coding
, this);
4290 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4292 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4293 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4296 /* Convert this batch with results in CONVERSION_BUFFER. */
4297 if (how_much
>= total
) /* This is the last block. */
4298 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4299 if (coding
.composing
!= COMPOSITION_DISABLED
)
4300 coding_allocate_composition_data (&coding
, BEGV
);
4301 result
= decode_coding (&coding
, read_buf
,
4302 conversion_buffer
+ inserted
,
4303 this, bufsize
- inserted
);
4305 /* Save for next iteration whatever we didn't convert. */
4306 unprocessed
= this - coding
.consumed
;
4307 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4308 if (!NILP (current_buffer
->enable_multibyte_characters
))
4309 this = coding
.produced
;
4311 this = str_as_unibyte (conversion_buffer
+ inserted
,
4318 /* At this point, INSERTED is how many characters (i.e. bytes)
4319 are present in CONVERSION_BUFFER.
4320 HOW_MUCH should equal TOTAL,
4321 or should be <= 0 if we couldn't read the file. */
4325 xfree (conversion_buffer
);
4326 coding_free_composition_data (&coding
);
4328 error ("IO error reading %s: %s",
4329 SDATA (orig_filename
), emacs_strerror (errno
));
4330 else if (how_much
== -2)
4331 error ("maximum buffer size exceeded");
4334 /* Compare the beginning of the converted file
4335 with the buffer text. */
4338 while (bufpos
< inserted
&& same_at_start
< same_at_end
4339 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4340 same_at_start
++, bufpos
++;
4342 /* If the file matches the buffer completely,
4343 there's no need to replace anything. */
4345 if (bufpos
== inserted
)
4347 xfree (conversion_buffer
);
4348 coding_free_composition_data (&coding
);
4351 /* Truncate the buffer to the size of the file. */
4352 del_range_byte (same_at_start
, same_at_end
, 0);
4357 /* Extend the start of non-matching text area to multibyte
4358 character boundary. */
4359 if (! NILP (current_buffer
->enable_multibyte_characters
))
4360 while (same_at_start
> BEGV_BYTE
4361 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4364 /* Scan this bufferful from the end, comparing with
4365 the Emacs buffer. */
4368 /* Compare with same_at_start to avoid counting some buffer text
4369 as matching both at the file's beginning and at the end. */
4370 while (bufpos
> 0 && same_at_end
> same_at_start
4371 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4372 same_at_end
--, bufpos
--;
4374 /* Extend the end of non-matching text area to multibyte
4375 character boundary. */
4376 if (! NILP (current_buffer
->enable_multibyte_characters
))
4377 while (same_at_end
< ZV_BYTE
4378 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4381 /* Don't try to reuse the same piece of text twice. */
4382 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4384 same_at_end
+= overlap
;
4386 /* If display currently starts at beginning of line,
4387 keep it that way. */
4388 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4389 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4391 /* Replace the chars that we need to replace,
4392 and update INSERTED to equal the number of bytes
4393 we are taking from the file. */
4394 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4396 if (same_at_end
!= same_at_start
)
4398 del_range_byte (same_at_start
, same_at_end
, 0);
4400 same_at_start
= GPT_BYTE
;
4404 temp
= BYTE_TO_CHAR (same_at_start
);
4406 /* Insert from the file at the proper position. */
4407 SET_PT_BOTH (temp
, same_at_start
);
4408 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4410 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4411 coding_restore_composition (&coding
, Fcurrent_buffer ());
4412 coding_free_composition_data (&coding
);
4414 /* Set `inserted' to the number of inserted characters. */
4415 inserted
= PT
- temp
;
4417 xfree (conversion_buffer
);
4426 register Lisp_Object temp
;
4428 total
= XINT (end
) - XINT (beg
);
4430 /* Make sure point-max won't overflow after this insertion. */
4431 XSETINT (temp
, total
);
4432 if (total
!= XINT (temp
))
4433 error ("Maximum buffer size exceeded");
4436 /* For a special file, all we can do is guess. */
4437 total
= READ_BUF_SIZE
;
4439 if (NILP (visit
) && inserted
> 0)
4441 #ifdef CLASH_DETECTION
4442 if (!NILP (current_buffer
->file_truename
)
4443 /* Make binding buffer-file-name to nil effective. */
4444 && !NILP (current_buffer
->filename
)
4445 && SAVE_MODIFF
>= MODIFF
)
4447 #endif /* CLASH_DETECTION */
4448 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4452 if (GAP_SIZE
< total
)
4453 make_gap (total
- GAP_SIZE
);
4455 if (XINT (beg
) != 0 || !NILP (replace
))
4457 if (lseek (fd
, XINT (beg
), 0) < 0)
4458 report_file_error ("Setting file position",
4459 Fcons (orig_filename
, Qnil
));
4462 /* In the following loop, HOW_MUCH contains the total bytes read so
4463 far for a regular file, and not changed for a special file. But,
4464 before exiting the loop, it is set to a negative value if I/O
4468 /* Total bytes inserted. */
4471 /* Here, we don't do code conversion in the loop. It is done by
4472 code_convert_region after all data are read into the buffer. */
4474 int gap_size
= GAP_SIZE
;
4476 while (how_much
< total
)
4478 /* try is reserved in some compilers (Microsoft C) */
4479 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4486 /* Maybe make more room. */
4487 if (gap_size
< trytry
)
4489 make_gap (total
- gap_size
);
4490 gap_size
= GAP_SIZE
;
4493 /* Read from the file, capturing `quit'. When an
4494 error occurs, end the loop, and arrange for a quit
4495 to be signaled after decoding the text we read. */
4496 non_regular_fd
= fd
;
4497 non_regular_inserted
= inserted
;
4498 non_regular_nbytes
= trytry
;
4499 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4500 read_non_regular_quit
);
4511 /* Allow quitting out of the actual I/O. We don't make text
4512 part of the buffer until all the reading is done, so a C-g
4513 here doesn't do any harm. */
4516 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4528 /* For a regular file, where TOTAL is the real size,
4529 count HOW_MUCH to compare with it.
4530 For a special file, where TOTAL is just a buffer size,
4531 so don't bother counting in HOW_MUCH.
4532 (INSERTED is where we count the number of characters inserted.) */
4539 /* Now we have read all the file data into the gap.
4540 If it was empty, undo marking the buffer modified. */
4544 #ifdef CLASH_DETECTION
4546 unlock_file (current_buffer
->file_truename
);
4548 Vdeactivate_mark
= old_Vdeactivate_mark
;
4551 /* Make the text read part of the buffer. */
4552 GAP_SIZE
-= inserted
;
4554 GPT_BYTE
+= inserted
;
4556 ZV_BYTE
+= inserted
;
4561 /* Put an anchor to ensure multi-byte form ends at gap. */
4566 /* Discard the unwind protect for closing the file. */
4570 error ("IO error reading %s: %s",
4571 SDATA (orig_filename
), emacs_strerror (errno
));
4575 if (! coding_system_decided
)
4577 /* The coding system is not yet decided. Decide it by an
4578 optimized method for handling `coding:' tag.
4580 Note that we can get here only if the buffer was empty
4581 before the insertion. */
4585 if (!NILP (Vcoding_system_for_read
))
4586 val
= Vcoding_system_for_read
;
4589 /* Since we are sure that the current buffer was empty
4590 before the insertion, we can toggle
4591 enable-multibyte-characters directly here without taking
4592 care of marker adjustment and byte combining problem. By
4593 this way, we can run Lisp program safely before decoding
4594 the inserted text. */
4595 Lisp_Object unwind_data
;
4596 int count
= SPECPDL_INDEX ();
4598 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4599 Fcons (current_buffer
->undo_list
,
4600 Fcurrent_buffer ()));
4601 current_buffer
->enable_multibyte_characters
= Qnil
;
4602 current_buffer
->undo_list
= Qt
;
4603 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4605 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4607 val
= call2 (Vset_auto_coding_function
,
4608 filename
, make_number (inserted
));
4613 /* If the coding system is not yet decided, check
4614 file-coding-system-alist. */
4615 Lisp_Object args
[6], coding_systems
;
4617 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4618 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4619 coding_systems
= Ffind_operation_coding_system (6, args
);
4620 if (CONSP (coding_systems
))
4621 val
= XCAR (coding_systems
);
4623 unbind_to (count
, Qnil
);
4624 inserted
= Z_BYTE
- BEG_BYTE
;
4627 /* The following kludgy code is to avoid some compiler bug.
4629 setup_coding_system (val, &coding);
4632 struct coding_system temp_coding
;
4633 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4634 bcopy (&temp_coding
, &coding
, sizeof coding
);
4636 /* Ensure we set Vlast_coding_system_used. */
4637 set_coding_system
= 1;
4639 if (NILP (current_buffer
->enable_multibyte_characters
)
4641 /* We must suppress all character code conversion except for
4642 end-of-line conversion. */
4643 setup_raw_text_coding_system (&coding
);
4644 coding
.src_multibyte
= 0;
4645 coding
.dst_multibyte
4646 = !NILP (current_buffer
->enable_multibyte_characters
);
4650 /* Can't do this if part of the buffer might be preserved. */
4652 && (coding
.type
== coding_type_no_conversion
4653 || coding
.type
== coding_type_raw_text
))
4655 /* Visiting a file with these coding system makes the buffer
4657 current_buffer
->enable_multibyte_characters
= Qnil
;
4658 coding
.dst_multibyte
= 0;
4661 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4663 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4665 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4667 inserted
= coding
.produced_char
;
4670 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4674 /* Now INSERTED is measured in characters. */
4677 /* Use the conversion type to determine buffer-file-type
4678 (find-buffer-file-type is now used to help determine the
4680 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4681 || coding
.eol_type
== CODING_EOL_LF
)
4682 && ! CODING_REQUIRE_DECODING (&coding
))
4683 current_buffer
->buffer_file_type
= Qt
;
4685 current_buffer
->buffer_file_type
= Qnil
;
4692 if (!EQ (current_buffer
->undo_list
, Qt
))
4693 current_buffer
->undo_list
= Qnil
;
4695 stat (SDATA (filename
), &st
);
4700 current_buffer
->modtime
= st
.st_mtime
;
4701 current_buffer
->filename
= orig_filename
;
4704 SAVE_MODIFF
= MODIFF
;
4705 current_buffer
->auto_save_modified
= MODIFF
;
4706 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4707 #ifdef CLASH_DETECTION
4710 if (!NILP (current_buffer
->file_truename
))
4711 unlock_file (current_buffer
->file_truename
);
4712 unlock_file (filename
);
4714 #endif /* CLASH_DETECTION */
4716 Fsignal (Qfile_error
,
4717 Fcons (build_string ("not a regular file"),
4718 Fcons (orig_filename
, Qnil
)));
4721 if (set_coding_system
)
4722 Vlast_coding_system_used
= coding
.symbol
;
4724 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4726 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4728 if (! NILP (insval
))
4730 CHECK_NUMBER (insval
);
4731 inserted
= XFASTINT (insval
);
4735 /* Decode file format */
4738 int empty_undo_list_p
= 0;
4740 /* If we're anyway going to discard undo information, don't
4741 record it in the first place. The buffer's undo list at this
4742 point is either nil or t when visiting a file. */
4745 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4746 current_buffer
->undo_list
= Qt
;
4749 insval
= call3 (Qformat_decode
,
4750 Qnil
, make_number (inserted
), visit
);
4751 CHECK_NUMBER (insval
);
4752 inserted
= XFASTINT (insval
);
4755 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4758 /* Call after-change hooks for the inserted text, aside from the case
4759 of normal visiting (not with REPLACE), which is done in a new buffer
4760 "before" the buffer is changed. */
4761 if (inserted
> 0 && total
> 0
4762 && (NILP (visit
) || !NILP (replace
)))
4764 signal_after_change (PT
, 0, inserted
);
4765 update_compositions (PT
, PT
, CHECK_BORDER
);
4768 p
= Vafter_insert_file_functions
;
4771 insval
= call1 (XCAR (p
), make_number (inserted
));
4774 CHECK_NUMBER (insval
);
4775 inserted
= XFASTINT (insval
);
4782 && current_buffer
->modtime
== -1)
4784 /* If visiting nonexistent file, return nil. */
4785 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4789 Fsignal (Qquit
, Qnil
);
4791 /* ??? Retval needs to be dealt with in all cases consistently. */
4793 val
= Fcons (orig_filename
,
4794 Fcons (make_number (inserted
),
4797 RETURN_UNGCPRO (unbind_to (count
, val
));
4800 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4801 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4802 Lisp_Object
, Lisp_Object
));
4804 /* If build_annotations switched buffers, switch back to BUF.
4805 Kill the temporary buffer that was selected in the meantime.
4807 Since this kill only the last temporary buffer, some buffers remain
4808 not killed if build_annotations switched buffers more than once.
4812 build_annotations_unwind (buf
)
4817 if (XBUFFER (buf
) == current_buffer
)
4819 tembuf
= Fcurrent_buffer ();
4821 Fkill_buffer (tembuf
);
4825 /* Decide the coding-system to encode the data with. */
4828 choose_write_coding_system (start
, end
, filename
,
4829 append
, visit
, lockname
, coding
)
4830 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4831 struct coding_system
*coding
;
4836 && NILP (Fstring_equal (current_buffer
->filename
,
4837 current_buffer
->auto_save_file_name
)))
4839 /* We use emacs-mule for auto saving... */
4840 setup_coding_system (Qemacs_mule
, coding
);
4841 /* ... but with the special flag to indicate not to strip off
4842 leading code of eight-bit-control chars. */
4844 goto done_setup_coding
;
4846 else if (!NILP (Vcoding_system_for_write
))
4848 val
= Vcoding_system_for_write
;
4849 if (coding_system_require_warning
4850 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4851 /* Confirm that VAL can surely encode the current region. */
4852 val
= call5 (Vselect_safe_coding_system_function
,
4853 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4858 /* If the variable `buffer-file-coding-system' is set locally,
4859 it means that the file was read with some kind of code
4860 conversion or the variable is explicitly set by users. We
4861 had better write it out with the same coding system even if
4862 `enable-multibyte-characters' is nil.
4864 If it is not set locally, we anyway have to convert EOL
4865 format if the default value of `buffer-file-coding-system'
4866 tells that it is not Unix-like (LF only) format. */
4867 int using_default_coding
= 0;
4868 int force_raw_text
= 0;
4870 val
= current_buffer
->buffer_file_coding_system
;
4872 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4875 if (NILP (current_buffer
->enable_multibyte_characters
))
4881 /* Check file-coding-system-alist. */
4882 Lisp_Object args
[7], coding_systems
;
4884 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4885 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4887 coding_systems
= Ffind_operation_coding_system (7, args
);
4888 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4889 val
= XCDR (coding_systems
);
4893 && !NILP (current_buffer
->buffer_file_coding_system
))
4895 /* If we still have not decided a coding system, use the
4896 default value of buffer-file-coding-system. */
4897 val
= current_buffer
->buffer_file_coding_system
;
4898 using_default_coding
= 1;
4902 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4903 /* Confirm that VAL can surely encode the current region. */
4904 val
= call5 (Vselect_safe_coding_system_function
,
4905 start
, end
, val
, Qnil
, filename
);
4907 setup_coding_system (Fcheck_coding_system (val
), coding
);
4908 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4909 && !using_default_coding
)
4911 if (! EQ (default_buffer_file_coding
.symbol
,
4912 buffer_defaults
.buffer_file_coding_system
))
4913 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4914 &default_buffer_file_coding
);
4915 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4917 Lisp_Object subsidiaries
;
4919 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4920 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4921 if (VECTORP (subsidiaries
)
4922 && XVECTOR (subsidiaries
)->size
== 3)
4924 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4929 setup_raw_text_coding_system (coding
);
4930 goto done_setup_coding
;
4933 setup_coding_system (Fcheck_coding_system (val
), coding
);
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
);
5007 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5009 filename
= Fexpand_file_name (filename
, Qnil
);
5011 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5012 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5014 if (STRINGP (visit
))
5015 visit_file
= Fexpand_file_name (visit
, Qnil
);
5017 visit_file
= filename
;
5019 if (NILP (lockname
))
5020 lockname
= visit_file
;
5024 /* If the file name has special constructs in it,
5025 call the corresponding file handler. */
5026 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5027 /* If FILENAME has no handler, see if VISIT has one. */
5028 if (NILP (handler
) && STRINGP (visit
))
5029 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5031 if (!NILP (handler
))
5034 val
= call6 (handler
, Qwrite_region
, start
, end
,
5035 filename
, append
, visit
);
5039 SAVE_MODIFF
= MODIFF
;
5040 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5041 current_buffer
->filename
= visit_file
;
5047 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5049 /* Special kludge to simplify auto-saving. */
5052 XSETFASTINT (start
, BEG
);
5053 XSETFASTINT (end
, Z
);
5057 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5058 count1
= SPECPDL_INDEX ();
5060 given_buffer
= current_buffer
;
5062 if (!STRINGP (start
))
5064 annotations
= build_annotations (start
, end
);
5066 if (current_buffer
!= given_buffer
)
5068 XSETFASTINT (start
, BEGV
);
5069 XSETFASTINT (end
, ZV
);
5075 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5077 /* Decide the coding-system to encode the data with.
5078 We used to make this choice before calling build_annotations, but that
5079 leads to problems when a write-annotate-function takes care of
5080 unsavable chars (as was the case with X-Symbol). */
5081 choose_write_coding_system (start
, end
, filename
,
5082 append
, visit
, lockname
, &coding
);
5083 Vlast_coding_system_used
= coding
.symbol
;
5085 given_buffer
= current_buffer
;
5086 if (! STRINGP (start
))
5088 annotations
= build_annotations_2 (start
, end
,
5089 coding
.pre_write_conversion
, annotations
);
5090 if (current_buffer
!= given_buffer
)
5092 XSETFASTINT (start
, BEGV
);
5093 XSETFASTINT (end
, ZV
);
5097 #ifdef CLASH_DETECTION
5100 #if 0 /* This causes trouble for GNUS. */
5101 /* If we've locked this file for some other buffer,
5102 query before proceeding. */
5103 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5104 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5107 lock_file (lockname
);
5109 #endif /* CLASH_DETECTION */
5111 encoded_filename
= ENCODE_FILE (filename
);
5113 fn
= SDATA (encoded_filename
);
5117 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5118 #else /* not DOS_NT */
5119 desc
= emacs_open (fn
, O_WRONLY
, 0);
5120 #endif /* not DOS_NT */
5122 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5124 if (auto_saving
) /* Overwrite any previous version of autosave file */
5126 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5127 desc
= emacs_open (fn
, O_RDWR
, 0);
5129 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5130 ? SDATA (current_buffer
->filename
) : 0,
5133 else /* Write to temporary name and rename if no errors */
5135 Lisp_Object temp_name
;
5136 temp_name
= Ffile_name_directory (filename
);
5138 if (!NILP (temp_name
))
5140 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5141 build_string ("$$SAVE$$")));
5142 fname
= SDATA (filename
);
5143 fn
= SDATA (temp_name
);
5144 desc
= creat_copy_attrs (fname
, fn
);
5147 /* If we can't open the temporary file, try creating a new
5148 version of the original file. VMS "creat" creates a
5149 new version rather than truncating an existing file. */
5152 desc
= creat (fn
, 0666);
5153 #if 0 /* This can clobber an existing file and fail to replace it,
5154 if the user runs out of space. */
5157 /* We can't make a new version;
5158 try to truncate and rewrite existing version if any. */
5160 desc
= emacs_open (fn
, O_RDWR
, 0);
5166 desc
= creat (fn
, 0666);
5170 desc
= emacs_open (fn
,
5171 O_WRONLY
| O_CREAT
| buffer_file_type
5172 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5173 S_IREAD
| S_IWRITE
);
5174 #else /* not DOS_NT */
5175 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5176 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5177 auto_saving
? auto_save_mode_bits
: 0666);
5178 #endif /* not DOS_NT */
5179 #endif /* not VMS */
5183 #ifdef CLASH_DETECTION
5185 if (!auto_saving
) unlock_file (lockname
);
5187 #endif /* CLASH_DETECTION */
5189 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5192 record_unwind_protect (close_file_unwind
, make_number (desc
));
5194 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5198 if (NUMBERP (append
))
5199 ret
= lseek (desc
, XINT (append
), 1);
5201 ret
= lseek (desc
, 0, 2);
5204 #ifdef CLASH_DETECTION
5205 if (!auto_saving
) unlock_file (lockname
);
5206 #endif /* CLASH_DETECTION */
5208 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5216 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5217 * if we do writes that don't end with a carriage return. Furthermore
5218 * it cannot handle writes of more then 16K. The modified
5219 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5220 * this EXCEPT for the last record (iff it doesn't end with a carriage
5221 * return). This implies that if your buffer doesn't end with a carriage
5222 * return, you get one free... tough. However it also means that if
5223 * we make two calls to sys_write (a la the following code) you can
5224 * get one at the gap as well. The easiest way to fix this (honest)
5225 * is to move the gap to the next newline (or the end of the buffer).
5230 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5231 move_gap (find_next_newline (GPT
, 1));
5233 /* Whether VMS or not, we must move the gap to the next of newline
5234 when we must put designation sequences at beginning of line. */
5235 if (INTEGERP (start
)
5236 && coding
.type
== coding_type_iso2022
5237 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5238 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5240 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5241 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5242 move_gap_both (PT
, PT_BYTE
);
5243 SET_PT_BOTH (opoint
, opoint_byte
);
5250 if (STRINGP (start
))
5252 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5253 &annotations
, &coding
);
5256 else if (XINT (start
) != XINT (end
))
5258 tem
= CHAR_TO_BYTE (XINT (start
));
5260 if (XINT (start
) < GPT
)
5262 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5263 min (GPT
, XINT (end
)) - XINT (start
),
5264 &annotations
, &coding
);
5268 if (XINT (end
) > GPT
&& !failure
)
5270 tem
= max (XINT (start
), GPT
);
5271 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5272 &annotations
, &coding
);
5278 /* If file was empty, still need to write the annotations */
5279 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5280 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5284 if (CODING_REQUIRE_FLUSHING (&coding
)
5285 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5288 /* We have to flush out a data. */
5289 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5290 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5297 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5298 Disk full in NFS may be reported here. */
5299 /* mib says that closing the file will try to write as fast as NFS can do
5300 it, and that means the fsync here is not crucial for autosave files. */
5301 if (!auto_saving
&& fsync (desc
) < 0)
5303 /* If fsync fails with EINTR, don't treat that as serious. */
5305 failure
= 1, save_errno
= errno
;
5309 /* Spurious "file has changed on disk" warnings have been
5310 observed on Suns as well.
5311 It seems that `close' can change the modtime, under nfs.
5313 (This has supposedly been fixed in Sunos 4,
5314 but who knows about all the other machines with NFS?) */
5317 /* On VMS and APOLLO, must do the stat after the close
5318 since closing changes the modtime. */
5321 /* Recall that #if defined does not work on VMS. */
5328 /* NFS can report a write failure now. */
5329 if (emacs_close (desc
) < 0)
5330 failure
= 1, save_errno
= errno
;
5333 /* If we wrote to a temporary name and had no errors, rename to real name. */
5337 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5345 /* Discard the unwind protect for close_file_unwind. */
5346 specpdl_ptr
= specpdl
+ count1
;
5347 /* Restore the original current buffer. */
5348 visit_file
= unbind_to (count
, visit_file
);
5350 #ifdef CLASH_DETECTION
5352 unlock_file (lockname
);
5353 #endif /* CLASH_DETECTION */
5355 /* Do this before reporting IO error
5356 to avoid a "file has changed on disk" warning on
5357 next attempt to save. */
5359 current_buffer
->modtime
= st
.st_mtime
;
5362 error ("IO error writing %s: %s", SDATA (filename
),
5363 emacs_strerror (save_errno
));
5367 SAVE_MODIFF
= MODIFF
;
5368 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5369 current_buffer
->filename
= visit_file
;
5370 update_mode_lines
++;
5375 && ! NILP (Fstring_equal (current_buffer
->filename
,
5376 current_buffer
->auto_save_file_name
)))
5377 SAVE_MODIFF
= MODIFF
;
5383 message_with_string ((INTEGERP (append
)
5393 Lisp_Object
merge ();
5395 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5396 doc
: /* Return t if (car A) is numerically less than (car B). */)
5400 return Flss (Fcar (a
), Fcar (b
));
5403 /* Build the complete list of annotations appropriate for writing out
5404 the text between START and END, by calling all the functions in
5405 write-region-annotate-functions and merging the lists they return.
5406 If one of these functions switches to a different buffer, we assume
5407 that buffer contains altered text. Therefore, the caller must
5408 make sure to restore the current buffer in all cases,
5409 as save-excursion would do. */
5412 build_annotations (start
, end
)
5413 Lisp_Object start
, end
;
5415 Lisp_Object annotations
;
5417 struct gcpro gcpro1
, gcpro2
;
5418 Lisp_Object original_buffer
;
5419 int i
, used_global
= 0;
5421 XSETBUFFER (original_buffer
, current_buffer
);
5424 p
= Vwrite_region_annotate_functions
;
5425 GCPRO2 (annotations
, p
);
5428 struct buffer
*given_buffer
= current_buffer
;
5429 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5430 { /* Use the global value of the hook. */
5433 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5435 p
= Fappend (2, arg
);
5438 Vwrite_region_annotations_so_far
= annotations
;
5439 res
= call2 (XCAR (p
), start
, end
);
5440 /* If the function makes a different buffer current,
5441 assume that means this buffer contains altered text to be output.
5442 Reset START and END from the buffer bounds
5443 and discard all previous annotations because they should have
5444 been dealt with by this function. */
5445 if (current_buffer
!= given_buffer
)
5447 XSETFASTINT (start
, BEGV
);
5448 XSETFASTINT (end
, ZV
);
5451 Flength (res
); /* Check basic validity of return value */
5452 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5456 /* Now do the same for annotation functions implied by the file-format */
5457 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5458 p
= current_buffer
->auto_save_file_format
;
5460 p
= current_buffer
->file_format
;
5461 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5463 struct buffer
*given_buffer
= current_buffer
;
5465 Vwrite_region_annotations_so_far
= annotations
;
5467 /* Value is either a list of annotations or nil if the function
5468 has written annotations to a temporary buffer, which is now
5470 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5471 original_buffer
, make_number (i
));
5472 if (current_buffer
!= given_buffer
)
5474 XSETFASTINT (start
, BEGV
);
5475 XSETFASTINT (end
, ZV
);
5480 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5488 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5489 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5491 struct gcpro gcpro1
;
5494 GCPRO1 (annotations
);
5495 /* At last, do the same for the function PRE_WRITE_CONVERSION
5496 implied by the current coding-system. */
5497 if (!NILP (pre_write_conversion
))
5499 struct buffer
*given_buffer
= current_buffer
;
5500 Vwrite_region_annotations_so_far
= annotations
;
5501 res
= call2 (pre_write_conversion
, start
, end
);
5503 annotations
= (current_buffer
!= given_buffer
5505 : merge (annotations
, res
, Qcar_less_than_car
));
5512 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5513 If STRING is nil, POS is the character position in the current buffer.
5514 Intersperse with them the annotations from *ANNOT
5515 which fall within the range of POS to POS + NCHARS,
5516 each at its appropriate position.
5518 We modify *ANNOT by discarding elements as we use them up.
5520 The return value is negative in case of system call failure. */
5523 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5526 register int nchars
;
5529 struct coding_system
*coding
;
5533 int lastpos
= pos
+ nchars
;
5535 while (NILP (*annot
) || CONSP (*annot
))
5537 tem
= Fcar_safe (Fcar (*annot
));
5540 nextpos
= XFASTINT (tem
);
5542 /* If there are no more annotations in this range,
5543 output the rest of the range all at once. */
5544 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5545 return e_write (desc
, string
, pos
, lastpos
, coding
);
5547 /* Output buffer text up to the next annotation's position. */
5550 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5554 /* Output the annotation. */
5555 tem
= Fcdr (Fcar (*annot
));
5558 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5561 *annot
= Fcdr (*annot
);
5566 #ifndef WRITE_BUF_SIZE
5567 #define WRITE_BUF_SIZE (16 * 1024)
5570 /* Write text in the range START and END into descriptor DESC,
5571 encoding them with coding system CODING. If STRING is nil, START
5572 and END are character positions of the current buffer, else they
5573 are indexes to the string STRING. */
5576 e_write (desc
, string
, start
, end
, coding
)
5580 struct coding_system
*coding
;
5582 register char *addr
;
5583 register int nbytes
;
5584 char buf
[WRITE_BUF_SIZE
];
5588 coding
->composing
= COMPOSITION_DISABLED
;
5589 if (coding
->composing
!= COMPOSITION_DISABLED
)
5590 coding_save_composition (coding
, start
, end
, string
);
5592 if (STRINGP (string
))
5594 addr
= SDATA (string
);
5595 nbytes
= SBYTES (string
);
5596 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5598 else if (start
< end
)
5600 /* It is assured that the gap is not in the range START and END-1. */
5601 addr
= CHAR_POS_ADDR (start
);
5602 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5603 coding
->src_multibyte
5604 = !NILP (current_buffer
->enable_multibyte_characters
);
5610 coding
->src_multibyte
= 1;
5613 /* We used to have a code for handling selective display here. But,
5614 now it is handled within encode_coding. */
5619 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5620 if (coding
->produced
> 0)
5622 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5623 if (coding
->produced
)
5629 nbytes
-= coding
->consumed
;
5630 addr
+= coding
->consumed
;
5631 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5634 /* The source text ends by an incomplete multibyte form.
5635 There's no way other than write it out as is. */
5636 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5645 start
+= coding
->consumed_char
;
5646 if (coding
->cmp_data
)
5647 coding_adjust_composition_offset (coding
, start
);
5650 if (coding
->cmp_data
)
5651 coding_free_composition_data (coding
);
5656 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5657 Sverify_visited_file_modtime
, 1, 1, 0,
5658 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5659 This means that the file has not been changed since it was visited or saved.
5660 See Info node `(elisp)Modification Time' for more details. */)
5666 Lisp_Object handler
;
5667 Lisp_Object filename
;
5672 if (!STRINGP (b
->filename
)) return Qt
;
5673 if (b
->modtime
== 0) return Qt
;
5675 /* If the file name has special constructs in it,
5676 call the corresponding file handler. */
5677 handler
= Ffind_file_name_handler (b
->filename
,
5678 Qverify_visited_file_modtime
);
5679 if (!NILP (handler
))
5680 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5682 filename
= ENCODE_FILE (b
->filename
);
5684 if (stat (SDATA (filename
), &st
) < 0)
5686 /* If the file doesn't exist now and didn't exist before,
5687 we say that it isn't modified, provided the error is a tame one. */
5688 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5693 if (st
.st_mtime
== b
->modtime
5694 /* If both are positive, accept them if they are off by one second. */
5695 || (st
.st_mtime
> 0 && b
->modtime
> 0
5696 && (st
.st_mtime
== b
->modtime
+ 1
5697 || st
.st_mtime
== b
->modtime
- 1)))
5702 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5703 Sclear_visited_file_modtime
, 0, 0, 0,
5704 doc
: /* Clear out records of last mod time of visited file.
5705 Next attempt to save will certainly not complain of a discrepancy. */)
5708 current_buffer
->modtime
= 0;
5712 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5713 Svisited_file_modtime
, 0, 0, 0,
5714 doc
: /* Return the current buffer's recorded visited file modification time.
5715 The value is a list of the form (HIGH LOW), like the time values
5716 that `file-attributes' returns. If the current buffer has no recorded
5717 file modification time, this function returns 0.
5718 See Info node `(elisp)Modification Time' for more details. */)
5722 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5724 return list2 (XCAR (tcons
), XCDR (tcons
));
5728 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5729 Sset_visited_file_modtime
, 0, 1, 0,
5730 doc
: /* Update buffer's recorded modification time from the visited file's time.
5731 Useful if the buffer was not read from the file normally
5732 or if the file itself has been changed for some known benign reason.
5733 An argument specifies the modification time value to use
5734 \(instead of that of the visited file), in the form of a list
5735 \(HIGH . LOW) or (HIGH LOW). */)
5737 Lisp_Object time_list
;
5739 if (!NILP (time_list
))
5740 current_buffer
->modtime
= cons_to_long (time_list
);
5743 register Lisp_Object filename
;
5745 Lisp_Object handler
;
5747 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5749 /* If the file name has special constructs in it,
5750 call the corresponding file handler. */
5751 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5752 if (!NILP (handler
))
5753 /* The handler can find the file name the same way we did. */
5754 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5756 filename
= ENCODE_FILE (filename
);
5758 if (stat (SDATA (filename
), &st
) >= 0)
5759 current_buffer
->modtime
= st
.st_mtime
;
5766 auto_save_error (error
)
5769 Lisp_Object args
[3], msg
;
5771 struct gcpro gcpro1
;
5775 args
[0] = build_string ("Auto-saving %s: %s");
5776 args
[1] = current_buffer
->name
;
5777 args
[2] = Ferror_message_string (error
);
5778 msg
= Fformat (3, args
);
5780 nbytes
= SBYTES (msg
);
5782 for (i
= 0; i
< 3; ++i
)
5785 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5787 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5788 Fsleep_for (make_number (1), Qnil
);
5801 auto_save_mode_bits
= 0666;
5803 /* Get visited file's mode to become the auto save file's mode. */
5804 if (! NILP (current_buffer
->filename
))
5806 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5807 /* But make sure we can overwrite it later! */
5808 auto_save_mode_bits
= st
.st_mode
| 0600;
5809 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5811 /* Remote files don't cooperate with stat. */
5812 auto_save_mode_bits
= XINT (modes
) | 0600;
5816 Fwrite_region (Qnil
, Qnil
,
5817 current_buffer
->auto_save_file_name
,
5818 Qnil
, Qlambda
, Qnil
, Qnil
);
5822 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5825 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5833 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5836 minibuffer_auto_raise
= XINT (value
);
5841 do_auto_save_make_dir (dir
)
5844 return call2 (Qmake_directory
, dir
, Qt
);
5848 do_auto_save_eh (ignore
)
5854 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5855 doc
: /* Auto-save all buffers that need it.
5856 This is all buffers that have auto-saving enabled
5857 and are changed since last auto-saved.
5858 Auto-saving writes the buffer into a file
5859 so that your editing is not lost if the system crashes.
5860 This file is not the file you visited; that changes only when you save.
5861 Normally we run the normal hook `auto-save-hook' before saving.
5863 A non-nil NO-MESSAGE argument means do not print any message if successful.
5864 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5865 (no_message
, current_only
)
5866 Lisp_Object no_message
, current_only
;
5868 struct buffer
*old
= current_buffer
, *b
;
5869 Lisp_Object tail
, buf
;
5871 int do_handled_files
;
5873 FILE *stream
= NULL
;
5874 int count
= SPECPDL_INDEX ();
5875 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5876 int old_message_p
= 0;
5877 struct gcpro gcpro1
, gcpro2
;
5879 if (max_specpdl_size
< specpdl_size
+ 40)
5880 max_specpdl_size
= specpdl_size
+ 40;
5885 if (NILP (no_message
))
5887 old_message_p
= push_message ();
5888 record_unwind_protect (pop_message_unwind
, Qnil
);
5891 /* Ordinarily don't quit within this function,
5892 but don't make it impossible to quit (in case we get hung in I/O). */
5896 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5897 point to non-strings reached from Vbuffer_alist. */
5899 if (!NILP (Vrun_hooks
))
5900 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5902 if (STRINGP (Vauto_save_list_file_name
))
5904 Lisp_Object listfile
;
5906 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5908 /* Don't try to create the directory when shutting down Emacs,
5909 because creating the directory might signal an error, and
5910 that would leave Emacs in a strange state. */
5911 if (!NILP (Vrun_hooks
))
5915 GCPRO2 (dir
, listfile
);
5916 dir
= Ffile_name_directory (listfile
);
5917 if (NILP (Ffile_directory_p (dir
)))
5918 internal_condition_case_1 (do_auto_save_make_dir
,
5919 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5924 stream
= fopen (SDATA (listfile
), "w");
5927 record_unwind_protect (do_auto_save_unwind
,
5928 make_save_value (stream
, 0));
5929 record_unwind_protect (do_auto_save_unwind_1
,
5930 make_number (minibuffer_auto_raise
));
5931 minibuffer_auto_raise
= 0;
5934 /* On first pass, save all files that don't have handlers.
5935 On second pass, save all files that do have handlers.
5937 If Emacs is crashing, the handlers may tweak what is causing
5938 Emacs to crash in the first place, and it would be a shame if
5939 Emacs failed to autosave perfectly ordinary files because it
5940 couldn't handle some ange-ftp'd file. */
5942 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5943 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5945 buf
= XCDR (XCAR (tail
));
5948 /* Record all the buffers that have auto save mode
5949 in the special file that lists them. For each of these buffers,
5950 Record visited name (if any) and auto save name. */
5951 if (STRINGP (b
->auto_save_file_name
)
5952 && stream
!= NULL
&& do_handled_files
== 0)
5954 if (!NILP (b
->filename
))
5956 fwrite (SDATA (b
->filename
), 1,
5957 SBYTES (b
->filename
), stream
);
5959 putc ('\n', stream
);
5960 fwrite (SDATA (b
->auto_save_file_name
), 1,
5961 SBYTES (b
->auto_save_file_name
), stream
);
5962 putc ('\n', stream
);
5965 if (!NILP (current_only
)
5966 && b
!= current_buffer
)
5969 /* Don't auto-save indirect buffers.
5970 The base buffer takes care of it. */
5974 /* Check for auto save enabled
5975 and file changed since last auto save
5976 and file changed since last real save. */
5977 if (STRINGP (b
->auto_save_file_name
)
5978 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5979 && b
->auto_save_modified
< BUF_MODIFF (b
)
5980 /* -1 means we've turned off autosaving for a while--see below. */
5981 && XINT (b
->save_length
) >= 0
5982 && (do_handled_files
5983 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5986 EMACS_TIME before_time
, after_time
;
5988 EMACS_GET_TIME (before_time
);
5990 /* If we had a failure, don't try again for 20 minutes. */
5991 if (b
->auto_save_failure_time
>= 0
5992 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5995 if ((XFASTINT (b
->save_length
) * 10
5996 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5997 /* A short file is likely to change a large fraction;
5998 spare the user annoying messages. */
5999 && XFASTINT (b
->save_length
) > 5000
6000 /* These messages are frequent and annoying for `*mail*'. */
6001 && !EQ (b
->filename
, Qnil
)
6002 && NILP (no_message
))
6004 /* It has shrunk too much; turn off auto-saving here. */
6005 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6006 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6008 minibuffer_auto_raise
= 0;
6009 /* Turn off auto-saving until there's a real save,
6010 and prevent any more warnings. */
6011 XSETINT (b
->save_length
, -1);
6012 Fsleep_for (make_number (1), Qnil
);
6015 set_buffer_internal (b
);
6016 if (!auto_saved
&& NILP (no_message
))
6017 message1 ("Auto-saving...");
6018 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6020 b
->auto_save_modified
= BUF_MODIFF (b
);
6021 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6022 set_buffer_internal (old
);
6024 EMACS_GET_TIME (after_time
);
6026 /* If auto-save took more than 60 seconds,
6027 assume it was an NFS failure that got a timeout. */
6028 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6029 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6033 /* Prevent another auto save till enough input events come in. */
6034 record_auto_save ();
6036 if (auto_saved
&& NILP (no_message
))
6040 /* If we are going to restore an old message,
6041 give time to read ours. */
6042 sit_for (1, 0, 0, 0, 0);
6046 /* If we displayed a message and then restored a state
6047 with no message, leave a "done" message on the screen. */
6048 message1 ("Auto-saving...done");
6053 /* This restores the message-stack status. */
6054 unbind_to (count
, Qnil
);
6058 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6059 Sset_buffer_auto_saved
, 0, 0, 0,
6060 doc
: /* Mark current buffer as auto-saved with its current text.
6061 No auto-save file will be written until the buffer changes again. */)
6064 current_buffer
->auto_save_modified
= MODIFF
;
6065 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6066 current_buffer
->auto_save_failure_time
= -1;
6070 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6071 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6072 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6075 current_buffer
->auto_save_failure_time
= -1;
6079 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6081 doc
: /* Return t if current buffer has been auto-saved recently.
6082 More precisely, if it has been auto-saved since last read from or saved
6083 in the visited file. If the buffer has no visited file,
6084 then any auto-save counts as "recent". */)
6087 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6090 /* Reading and completing file names */
6091 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6093 /* In the string VAL, change each $ to $$ and return the result. */
6096 double_dollars (val
)
6099 register const unsigned char *old
;
6100 register unsigned char *new;
6104 osize
= SBYTES (val
);
6106 /* Count the number of $ characters. */
6107 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6108 if (*old
++ == '$') count
++;
6112 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6115 for (n
= osize
; n
> 0; n
--)
6129 read_file_name_cleanup (arg
)
6132 return (current_buffer
->directory
= arg
);
6135 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6137 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6138 (string
, dir
, action
)
6139 Lisp_Object string
, dir
, action
;
6140 /* action is nil for complete, t for return list of completions,
6141 lambda for verify final value */
6143 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6145 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6147 CHECK_STRING (string
);
6154 /* No need to protect ACTION--we only compare it with t and nil. */
6155 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6157 if (SCHARS (string
) == 0)
6159 if (EQ (action
, Qlambda
))
6167 orig_string
= string
;
6168 string
= Fsubstitute_in_file_name (string
);
6169 changed
= NILP (Fstring_equal (string
, orig_string
));
6170 name
= Ffile_name_nondirectory (string
);
6171 val
= Ffile_name_directory (string
);
6173 realdir
= Fexpand_file_name (val
, realdir
);
6178 specdir
= Ffile_name_directory (string
);
6179 val
= Ffile_name_completion (name
, realdir
);
6184 return double_dollars (string
);
6188 if (!NILP (specdir
))
6189 val
= concat2 (specdir
, val
);
6191 return double_dollars (val
);
6194 #endif /* not VMS */
6198 if (EQ (action
, Qt
))
6200 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6204 if (NILP (Vread_file_name_predicate
)
6205 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6209 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6211 /* Brute-force speed up for directory checking:
6212 Discard strings which don't end in a slash. */
6213 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6215 Lisp_Object tem
= XCAR (all
);
6217 if (STRINGP (tem
) &&
6218 (len
= SCHARS (tem
), len
> 0) &&
6219 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6220 comp
= Fcons (tem
, comp
);
6226 /* Must do it the hard (and slow) way. */
6227 GCPRO3 (all
, comp
, specdir
);
6228 count
= SPECPDL_INDEX ();
6229 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6230 current_buffer
->directory
= realdir
;
6231 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6232 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6233 comp
= Fcons (XCAR (all
), comp
);
6234 unbind_to (count
, Qnil
);
6237 return Fnreverse (comp
);
6240 /* Only other case actually used is ACTION = lambda */
6242 /* Supposedly this helps commands such as `cd' that read directory names,
6243 but can someone explain how it helps them? -- RMS */
6244 if (SCHARS (name
) == 0)
6247 string
= Fexpand_file_name (string
, dir
);
6248 if (!NILP (Vread_file_name_predicate
))
6249 return call1 (Vread_file_name_predicate
, string
);
6250 return Ffile_exists_p (string
);
6253 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6254 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6255 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6256 The return value is only relevant for a call to `read-file-name' that happens
6257 before any other event (mouse or keypress) is handeled. */)
6260 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6261 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6270 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6271 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6272 Value is not expanded---you must call `expand-file-name' yourself.
6273 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6274 the same non-empty string that was inserted by this function.
6275 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6276 except that if INITIAL is specified, that combined with DIR is used.)
6277 If the user exits with an empty minibuffer, this function returns
6278 an empty string. (This can only happen if the user erased the
6279 pre-inserted contents or if `insert-default-directory' is nil.)
6280 Fourth arg MUSTMATCH non-nil means require existing file's name.
6281 Non-nil and non-t means also require confirmation after completion.
6282 Fifth arg INITIAL specifies text to start with.
6283 If optional sixth arg PREDICATE is non-nil, possible completions and
6284 the resulting file name must satisfy (funcall PREDICATE NAME).
6285 DIR should be an absolute directory name. It defaults to the value of
6286 `default-directory'.
6288 If this command was invoked with the mouse, use a file dialog box if
6289 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6290 provides a file dialog box.
6292 See also `read-file-name-completion-ignore-case'
6293 and `read-file-name-function'. */)
6294 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6295 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6297 Lisp_Object val
, insdef
, tem
;
6298 struct gcpro gcpro1
, gcpro2
;
6299 register char *homedir
;
6300 Lisp_Object decoded_homedir
;
6301 int replace_in_history
= 0;
6302 int add_to_history
= 0;
6306 dir
= current_buffer
->directory
;
6307 if (NILP (Ffile_name_absolute_p (dir
)))
6308 dir
= Fexpand_file_name (dir
, Qnil
);
6309 if (NILP (default_filename
))
6312 ? Fexpand_file_name (initial
, dir
)
6313 : current_buffer
->filename
);
6315 /* If dir starts with user's homedir, change that to ~. */
6316 homedir
= (char *) egetenv ("HOME");
6318 /* homedir can be NULL in temacs, since Vprocess_environment is not
6319 yet set up. We shouldn't crash in that case. */
6322 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6323 CORRECT_DIR_SEPS (homedir
);
6328 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6331 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6332 SBYTES (decoded_homedir
))
6333 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6335 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6336 dir
= concat2 (build_string ("~"), dir
);
6338 /* Likewise for default_filename. */
6340 && STRINGP (default_filename
)
6341 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6342 SBYTES (decoded_homedir
))
6343 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6346 = Fsubstring (default_filename
,
6347 make_number (SCHARS (decoded_homedir
)), Qnil
);
6348 default_filename
= concat2 (build_string ("~"), default_filename
);
6350 if (!NILP (default_filename
))
6352 CHECK_STRING (default_filename
);
6353 default_filename
= double_dollars (default_filename
);
6356 if (insert_default_directory
&& STRINGP (dir
))
6359 if (!NILP (initial
))
6361 Lisp_Object args
[2], pos
;
6365 insdef
= Fconcat (2, args
);
6366 pos
= make_number (SCHARS (double_dollars (dir
)));
6367 insdef
= Fcons (double_dollars (insdef
), pos
);
6370 insdef
= double_dollars (insdef
);
6372 else if (STRINGP (initial
))
6373 insdef
= Fcons (double_dollars (initial
), make_number (0));
6377 if (!NILP (Vread_file_name_function
))
6379 Lisp_Object args
[7];
6381 GCPRO2 (insdef
, default_filename
);
6382 args
[0] = Vread_file_name_function
;
6385 args
[3] = default_filename
;
6386 args
[4] = mustmatch
;
6388 args
[6] = predicate
;
6389 RETURN_UNGCPRO (Ffuncall (7, args
));
6392 count
= SPECPDL_INDEX ();
6393 specbind (intern ("completion-ignore-case"),
6394 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6395 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6396 specbind (intern ("read-file-name-predicate"),
6397 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6399 GCPRO2 (insdef
, default_filename
);
6401 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6402 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6404 /* If DIR contains a file name, split it. */
6406 file
= Ffile_name_nondirectory (dir
);
6407 if (SCHARS (file
) && NILP (default_filename
))
6409 default_filename
= file
;
6410 dir
= Ffile_name_directory (dir
);
6412 if (!NILP(default_filename
))
6413 default_filename
= Fexpand_file_name (default_filename
, dir
);
6414 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6415 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6420 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6421 dir
, mustmatch
, insdef
,
6422 Qfile_name_history
, default_filename
, Qnil
);
6424 tem
= Fsymbol_value (Qfile_name_history
);
6425 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6426 replace_in_history
= 1;
6428 /* If Fcompleting_read returned the inserted default string itself
6429 (rather than a new string with the same contents),
6430 it has to mean that the user typed RET with the minibuffer empty.
6431 In that case, we really want to return ""
6432 so that commands such as set-visited-file-name can distinguish. */
6433 if (EQ (val
, default_filename
))
6435 /* In this case, Fcompleting_read has not added an element
6436 to the history. Maybe we should. */
6437 if (! replace_in_history
)
6443 unbind_to (count
, Qnil
);
6446 error ("No file name specified");
6448 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6450 if (!NILP (tem
) && !NILP (default_filename
))
6451 val
= default_filename
;
6452 val
= Fsubstitute_in_file_name (val
);
6454 if (replace_in_history
)
6455 /* Replace what Fcompleting_read added to the history
6456 with what we will actually return. */
6458 Lisp_Object val1
= double_dollars (val
);
6459 tem
= Fsymbol_value (Qfile_name_history
);
6460 if (history_delete_duplicates
)
6461 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6462 XSETCAR (tem
, val1
);
6464 else if (add_to_history
)
6466 /* Add the value to the history--but not if it matches
6467 the last value already there. */
6468 Lisp_Object val1
= double_dollars (val
);
6469 tem
= Fsymbol_value (Qfile_name_history
);
6470 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6472 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6473 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6484 /* Must be set before any path manipulation is performed. */
6485 XSETFASTINT (Vdirectory_sep_char
, '/');
6492 Qoperations
= intern ("operations");
6493 Qexpand_file_name
= intern ("expand-file-name");
6494 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6495 Qdirectory_file_name
= intern ("directory-file-name");
6496 Qfile_name_directory
= intern ("file-name-directory");
6497 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6498 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6499 Qfile_name_as_directory
= intern ("file-name-as-directory");
6500 Qcopy_file
= intern ("copy-file");
6501 Qmake_directory_internal
= intern ("make-directory-internal");
6502 Qmake_directory
= intern ("make-directory");
6503 Qdelete_directory
= intern ("delete-directory");
6504 Qdelete_file
= intern ("delete-file");
6505 Qrename_file
= intern ("rename-file");
6506 Qadd_name_to_file
= intern ("add-name-to-file");
6507 Qmake_symbolic_link
= intern ("make-symbolic-link");
6508 Qfile_exists_p
= intern ("file-exists-p");
6509 Qfile_executable_p
= intern ("file-executable-p");
6510 Qfile_readable_p
= intern ("file-readable-p");
6511 Qfile_writable_p
= intern ("file-writable-p");
6512 Qfile_symlink_p
= intern ("file-symlink-p");
6513 Qaccess_file
= intern ("access-file");
6514 Qfile_directory_p
= intern ("file-directory-p");
6515 Qfile_regular_p
= intern ("file-regular-p");
6516 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6517 Qfile_modes
= intern ("file-modes");
6518 Qset_file_modes
= intern ("set-file-modes");
6519 Qset_file_times
= intern ("set-file-times");
6520 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6521 Qinsert_file_contents
= intern ("insert-file-contents");
6522 Qwrite_region
= intern ("write-region");
6523 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6524 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6525 Qauto_save_coding
= intern ("auto-save-coding");
6527 staticpro (&Qoperations
);
6528 staticpro (&Qexpand_file_name
);
6529 staticpro (&Qsubstitute_in_file_name
);
6530 staticpro (&Qdirectory_file_name
);
6531 staticpro (&Qfile_name_directory
);
6532 staticpro (&Qfile_name_nondirectory
);
6533 staticpro (&Qunhandled_file_name_directory
);
6534 staticpro (&Qfile_name_as_directory
);
6535 staticpro (&Qcopy_file
);
6536 staticpro (&Qmake_directory_internal
);
6537 staticpro (&Qmake_directory
);
6538 staticpro (&Qdelete_directory
);
6539 staticpro (&Qdelete_file
);
6540 staticpro (&Qrename_file
);
6541 staticpro (&Qadd_name_to_file
);
6542 staticpro (&Qmake_symbolic_link
);
6543 staticpro (&Qfile_exists_p
);
6544 staticpro (&Qfile_executable_p
);
6545 staticpro (&Qfile_readable_p
);
6546 staticpro (&Qfile_writable_p
);
6547 staticpro (&Qaccess_file
);
6548 staticpro (&Qfile_symlink_p
);
6549 staticpro (&Qfile_directory_p
);
6550 staticpro (&Qfile_regular_p
);
6551 staticpro (&Qfile_accessible_directory_p
);
6552 staticpro (&Qfile_modes
);
6553 staticpro (&Qset_file_modes
);
6554 staticpro (&Qset_file_times
);
6555 staticpro (&Qfile_newer_than_file_p
);
6556 staticpro (&Qinsert_file_contents
);
6557 staticpro (&Qwrite_region
);
6558 staticpro (&Qverify_visited_file_modtime
);
6559 staticpro (&Qset_visited_file_modtime
);
6560 staticpro (&Qauto_save_coding
);
6562 Qfile_name_history
= intern ("file-name-history");
6563 Fset (Qfile_name_history
, Qnil
);
6564 staticpro (&Qfile_name_history
);
6566 Qfile_error
= intern ("file-error");
6567 staticpro (&Qfile_error
);
6568 Qfile_already_exists
= intern ("file-already-exists");
6569 staticpro (&Qfile_already_exists
);
6570 Qfile_date_error
= intern ("file-date-error");
6571 staticpro (&Qfile_date_error
);
6572 Qexcl
= intern ("excl");
6576 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6577 staticpro (&Qfind_buffer_file_type
);
6580 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6581 doc
: /* *Coding system for encoding file names.
6582 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6583 Vfile_name_coding_system
= Qnil
;
6585 DEFVAR_LISP ("default-file-name-coding-system",
6586 &Vdefault_file_name_coding_system
,
6587 doc
: /* Default coding system for encoding file names.
6588 This variable is used only when `file-name-coding-system' is nil.
6590 This variable is set/changed by the command `set-language-environment'.
6591 User should not set this variable manually,
6592 instead use `file-name-coding-system' to get a constant encoding
6593 of file names regardless of the current language environment. */);
6594 Vdefault_file_name_coding_system
= Qnil
;
6596 Qformat_decode
= intern ("format-decode");
6597 staticpro (&Qformat_decode
);
6598 Qformat_annotate_function
= intern ("format-annotate-function");
6599 staticpro (&Qformat_annotate_function
);
6600 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6601 staticpro (&Qafter_insert_file_set_coding
);
6603 Qcar_less_than_car
= intern ("car-less-than-car");
6604 staticpro (&Qcar_less_than_car
);
6606 Fput (Qfile_error
, Qerror_conditions
,
6607 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6608 Fput (Qfile_error
, Qerror_message
,
6609 build_string ("File error"));
6611 Fput (Qfile_already_exists
, Qerror_conditions
,
6612 Fcons (Qfile_already_exists
,
6613 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6614 Fput (Qfile_already_exists
, Qerror_message
,
6615 build_string ("File already exists"));
6617 Fput (Qfile_date_error
, Qerror_conditions
,
6618 Fcons (Qfile_date_error
,
6619 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6620 Fput (Qfile_date_error
, Qerror_message
,
6621 build_string ("Cannot set file date"));
6623 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6624 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6625 Vread_file_name_function
= Qnil
;
6627 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6628 doc
: /* Current predicate used by `read-file-name-internal'. */);
6629 Vread_file_name_predicate
= Qnil
;
6631 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6632 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6633 #if defined VMS || defined DOS_NT || defined MAC_OS
6634 read_file_name_completion_ignore_case
= 1;
6636 read_file_name_completion_ignore_case
= 0;
6639 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6640 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6641 If the initial minibuffer contents are non-empty, you can usually
6642 request a default filename by typing RETURN without editing. For some
6643 commands, exiting with an empty minibuffer has a special meaning,
6644 such as making the current buffer visit no file in the case of
6645 `set-visited-file-name'.
6646 If this variable is non-nil, the minibuffer contents are always
6647 initially non-empty and typing RETURN without editing will fetch the
6648 default name, if one is provided. Note however that this default name
6649 is not necessarily the name originally inserted in the minibuffer, if
6650 that is just the default directory.
6651 If this variable is nil, the minibuffer often starts out empty. In
6652 that case you may have to explicitly fetch the next history element to
6653 request the default name. */);
6654 insert_default_directory
= 1;
6656 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6657 doc
: /* *Non-nil means write new files with record format `stmlf'.
6658 nil means use format `var'. This variable is meaningful only on VMS. */);
6659 vms_stmlf_recfm
= 0;
6661 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6662 doc
: /* Directory separator character for built-in functions that return file names.
6663 The value is always ?/. Don't use this variable, just use `/'. */);
6665 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6666 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6667 If a file name matches REGEXP, then all I/O on that file is done by calling
6670 The first argument given to HANDLER is the name of the I/O primitive
6671 to be handled; the remaining arguments are the arguments that were
6672 passed to that primitive. For example, if you do
6673 (file-exists-p FILENAME)
6674 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6675 (funcall HANDLER 'file-exists-p FILENAME)
6676 The function `find-file-name-handler' checks this list for a handler
6677 for its argument. */);
6678 Vfile_name_handler_alist
= Qnil
;
6680 DEFVAR_LISP ("set-auto-coding-function",
6681 &Vset_auto_coding_function
,
6682 doc
: /* If non-nil, a function to call to decide a coding system of file.
6683 Two arguments are passed to this function: the file name
6684 and the length of a file contents following the point.
6685 This function should return a coding system to decode the file contents.
6686 It should check the file name against `auto-coding-alist'.
6687 If no coding system is decided, it should check a coding system
6688 specified in the heading lines with the format:
6689 -*- ... coding: CODING-SYSTEM; ... -*-
6690 or local variable spec of the tailing lines with `coding:' tag. */);
6691 Vset_auto_coding_function
= Qnil
;
6693 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6694 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6695 Each is passed one argument, the number of characters inserted.
6696 It should return the new character count, and leave point the same.
6697 If `insert-file-contents' is intercepted by a handler from
6698 `file-name-handler-alist', that handler is responsible for calling the
6699 functions in `after-insert-file-functions' if appropriate. */);
6700 Vafter_insert_file_functions
= Qnil
;
6702 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6703 doc
: /* A list of functions to be called at the start of `write-region'.
6704 Each is passed two arguments, START and END as for `write-region'.
6705 These are usually two numbers but not always; see the documentation
6706 for `write-region'. The function should return a list of pairs
6707 of the form (POSITION . STRING), consisting of strings to be effectively
6708 inserted at the specified positions of the file being written (1 means to
6709 insert before the first byte written). The POSITIONs must be sorted into
6710 increasing order. If there are several functions in the list, the several
6711 lists are merged destructively. Alternatively, the function can return
6712 with a different buffer current; in that case it should pay attention
6713 to the annotations returned by previous functions and listed in
6714 `write-region-annotations-so-far'.*/);
6715 Vwrite_region_annotate_functions
= Qnil
;
6716 staticpro (&Qwrite_region_annotate_functions
);
6717 Qwrite_region_annotate_functions
6718 = intern ("write-region-annotate-functions");
6720 DEFVAR_LISP ("write-region-annotations-so-far",
6721 &Vwrite_region_annotations_so_far
,
6722 doc
: /* When an annotation function is called, this holds the previous annotations.
6723 These are the annotations made by other annotation functions
6724 that were already called. See also `write-region-annotate-functions'. */);
6725 Vwrite_region_annotations_so_far
= Qnil
;
6727 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6728 doc
: /* A list of file name handlers that temporarily should not be used.
6729 This applies only to the operation `inhibit-file-name-operation'. */);
6730 Vinhibit_file_name_handlers
= Qnil
;
6732 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6733 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6734 Vinhibit_file_name_operation
= Qnil
;
6736 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6737 doc
: /* File name in which we write a list of all auto save file names.
6738 This variable is initialized automatically from `auto-save-list-file-prefix'
6739 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6740 a non-nil value. */);
6741 Vauto_save_list_file_name
= Qnil
;
6743 defsubr (&Sfind_file_name_handler
);
6744 defsubr (&Sfile_name_directory
);
6745 defsubr (&Sfile_name_nondirectory
);
6746 defsubr (&Sunhandled_file_name_directory
);
6747 defsubr (&Sfile_name_as_directory
);
6748 defsubr (&Sdirectory_file_name
);
6749 defsubr (&Smake_temp_name
);
6750 defsubr (&Sexpand_file_name
);
6751 defsubr (&Ssubstitute_in_file_name
);
6752 defsubr (&Scopy_file
);
6753 defsubr (&Smake_directory_internal
);
6754 defsubr (&Sdelete_directory
);
6755 defsubr (&Sdelete_file
);
6756 defsubr (&Srename_file
);
6757 defsubr (&Sadd_name_to_file
);
6759 defsubr (&Smake_symbolic_link
);
6760 #endif /* S_IFLNK */
6762 defsubr (&Sdefine_logical_name
);
6765 defsubr (&Ssysnetunam
);
6766 #endif /* HPUX_NET */
6767 defsubr (&Sfile_name_absolute_p
);
6768 defsubr (&Sfile_exists_p
);
6769 defsubr (&Sfile_executable_p
);
6770 defsubr (&Sfile_readable_p
);
6771 defsubr (&Sfile_writable_p
);
6772 defsubr (&Saccess_file
);
6773 defsubr (&Sfile_symlink_p
);
6774 defsubr (&Sfile_directory_p
);
6775 defsubr (&Sfile_accessible_directory_p
);
6776 defsubr (&Sfile_regular_p
);
6777 defsubr (&Sfile_modes
);
6778 defsubr (&Sset_file_modes
);
6779 defsubr (&Sset_file_times
);
6780 defsubr (&Sset_default_file_modes
);
6781 defsubr (&Sdefault_file_modes
);
6782 defsubr (&Sfile_newer_than_file_p
);
6783 defsubr (&Sinsert_file_contents
);
6784 defsubr (&Swrite_region
);
6785 defsubr (&Scar_less_than_car
);
6786 defsubr (&Sverify_visited_file_modtime
);
6787 defsubr (&Sclear_visited_file_modtime
);
6788 defsubr (&Svisited_file_modtime
);
6789 defsubr (&Sset_visited_file_modtime
);
6790 defsubr (&Sdo_auto_save
);
6791 defsubr (&Sset_buffer_auto_saved
);
6792 defsubr (&Sclear_buffer_auto_save_failure
);
6793 defsubr (&Srecent_auto_save_p
);
6795 defsubr (&Sread_file_name_internal
);
6796 defsubr (&Sread_file_name
);
6797 defsubr (&Snext_read_file_uses_dialog_p
);
6800 defsubr (&Sunix_sync
);
6804 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6805 (do not change this comment) */