1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
74 #include "intervals.h"
80 #include "dispextern.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* The symbol bound to coding-system-for-read when
163 insert-file-contents is called for recovering a file. This is not
164 an actual coding system name, but just an indicator to tell
165 insert-file-contents to use `emacs-mule' with a special flag for
166 auto saving and recovering a file. */
167 Lisp_Object Qauto_save_coding
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Property name of a file name handler,
181 which gives a list of operations it handles.. */
182 Lisp_Object Qoperations
;
184 /* Lisp functions for translating file formats */
185 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
187 /* Function to be called to decide a coding system of a reading file. */
188 Lisp_Object Vset_auto_coding_function
;
190 /* Functions to be called to process text properties in inserted file. */
191 Lisp_Object Vafter_insert_file_functions
;
193 /* Lisp function for setting buffer-file-coding-system and the
194 multibyteness of the current buffer after inserting a file. */
195 Lisp_Object Qafter_insert_file_set_coding
;
197 /* Functions to be called to create text property annotations for file. */
198 Lisp_Object Vwrite_region_annotate_functions
;
199 Lisp_Object Qwrite_region_annotate_functions
;
201 /* During build_annotations, each time an annotation function is called,
202 this holds the annotations made by the previous functions. */
203 Lisp_Object Vwrite_region_annotations_so_far
;
205 /* File name in which we write a list of all our auto save files. */
206 Lisp_Object Vauto_save_list_file_name
;
208 /* Function to call to read a file name. */
209 Lisp_Object Vread_file_name_function
;
211 /* Current predicate used by read_file_name_internal. */
212 Lisp_Object Vread_file_name_predicate
;
214 /* Nonzero means completion ignores case when reading file name. */
215 int read_file_name_completion_ignore_case
;
217 /* Nonzero means, when reading a filename in the minibuffer,
218 start out by inserting the default directory into the minibuffer. */
219 int insert_default_directory
;
221 /* On VMS, nonzero means write new files with record format stmlf.
222 Zero means use var format. */
225 /* On NT, specifies the directory separator character, used (eg.) when
226 expanding file names. This can be bound to / or \. */
227 Lisp_Object Vdirectory_sep_char
;
229 extern Lisp_Object Vuser_login_name
;
232 extern Lisp_Object Vw32_get_true_file_attributes
;
235 extern int minibuf_level
;
237 extern int minibuffer_auto_raise
;
239 extern int history_delete_duplicates
;
241 /* These variables describe handlers that have "already" had a chance
242 to handle the current operation.
244 Vinhibit_file_name_handlers is a list of file name handlers.
245 Vinhibit_file_name_operation is the operation being handled.
246 If we try to handle that operation, we ignore those handlers. */
248 static Lisp_Object Vinhibit_file_name_handlers
;
249 static Lisp_Object Vinhibit_file_name_operation
;
251 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
253 Lisp_Object Qfile_name_history
;
255 Lisp_Object Qcar_less_than_car
;
257 static int a_write
P_ ((int, Lisp_Object
, int, int,
258 Lisp_Object
*, struct coding_system
*));
259 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
263 report_file_error (string
, data
)
267 Lisp_Object errstring
;
270 synchronize_system_messages_locale ();
271 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
272 Vlocale_coding_system
, 0);
278 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
281 /* System error messages are capitalized. Downcase the initial
282 unless it is followed by a slash. */
283 if (SREF (errstring
, 1) != '/')
284 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
286 Fsignal (Qfile_error
,
287 Fcons (build_string (string
), Fcons (errstring
, data
)));
292 close_file_unwind (fd
)
295 emacs_close (XFASTINT (fd
));
299 /* Restore point, having saved it as a marker. */
302 restore_point_unwind (location
)
303 Lisp_Object location
;
305 Fgoto_char (location
);
306 Fset_marker (location
, Qnil
, Qnil
);
310 Lisp_Object Qexpand_file_name
;
311 Lisp_Object Qsubstitute_in_file_name
;
312 Lisp_Object Qdirectory_file_name
;
313 Lisp_Object Qfile_name_directory
;
314 Lisp_Object Qfile_name_nondirectory
;
315 Lisp_Object Qunhandled_file_name_directory
;
316 Lisp_Object Qfile_name_as_directory
;
317 Lisp_Object Qcopy_file
;
318 Lisp_Object Qmake_directory_internal
;
319 Lisp_Object Qmake_directory
;
320 Lisp_Object Qdelete_directory
;
321 Lisp_Object Qdelete_file
;
322 Lisp_Object Qrename_file
;
323 Lisp_Object Qadd_name_to_file
;
324 Lisp_Object Qmake_symbolic_link
;
325 Lisp_Object Qfile_exists_p
;
326 Lisp_Object Qfile_executable_p
;
327 Lisp_Object Qfile_readable_p
;
328 Lisp_Object Qfile_writable_p
;
329 Lisp_Object Qfile_symlink_p
;
330 Lisp_Object Qaccess_file
;
331 Lisp_Object Qfile_directory_p
;
332 Lisp_Object Qfile_regular_p
;
333 Lisp_Object Qfile_accessible_directory_p
;
334 Lisp_Object Qfile_modes
;
335 Lisp_Object Qset_file_modes
;
336 Lisp_Object Qset_file_times
;
337 Lisp_Object Qfile_newer_than_file_p
;
338 Lisp_Object Qinsert_file_contents
;
339 Lisp_Object Qwrite_region
;
340 Lisp_Object Qverify_visited_file_modtime
;
341 Lisp_Object Qset_visited_file_modtime
;
343 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
344 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
345 Otherwise, return nil.
346 A file name is handled if one of the regular expressions in
347 `file-name-handler-alist' matches it.
349 If OPERATION equals `inhibit-file-name-operation', then we ignore
350 any handlers that are members of `inhibit-file-name-handlers',
351 but we still do run any other handlers. This lets handlers
352 use the standard functions without calling themselves recursively. */)
353 (filename
, operation
)
354 Lisp_Object filename
, operation
;
356 /* This function must not munge the match data. */
357 Lisp_Object chain
, inhibited_handlers
, result
;
361 CHECK_STRING (filename
);
363 if (EQ (operation
, Vinhibit_file_name_operation
))
364 inhibited_handlers
= Vinhibit_file_name_handlers
;
366 inhibited_handlers
= Qnil
;
368 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
369 chain
= XCDR (chain
))
375 Lisp_Object string
= XCAR (elt
);
377 Lisp_Object handler
= XCDR (elt
);
378 Lisp_Object operations
= Fget (handler
, Qoperations
);
381 && (match_pos
= fast_string_match (string
, filename
)) > pos
382 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
386 handler
= XCDR (elt
);
387 tem
= Fmemq (handler
, inhibited_handlers
);
401 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
403 doc
: /* Return the directory component in file name FILENAME.
404 Return nil if FILENAME does not include a directory.
405 Otherwise return a directory spec.
406 Given a Unix syntax file name, returns a string ending in slash;
407 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
409 Lisp_Object filename
;
412 register const unsigned char *beg
;
414 register unsigned char *beg
;
416 register const unsigned char *p
;
419 CHECK_STRING (filename
);
421 /* If the file name has special constructs in it,
422 call the corresponding file handler. */
423 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
425 return call2 (handler
, Qfile_name_directory
, filename
);
427 filename
= FILE_SYSTEM_CASE (filename
);
428 beg
= SDATA (filename
);
430 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
432 p
= beg
+ SBYTES (filename
);
434 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
436 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
439 /* only recognise drive specifier at the beginning */
441 /* handle the "/:d:foo" and "/:foo" cases correctly */
442 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
443 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
450 /* Expansion of "c:" to drive and default directory. */
453 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
454 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
455 unsigned char *r
= res
;
457 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
459 strncpy (res
, beg
, 2);
464 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
466 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
469 p
= beg
+ strlen (beg
);
472 CORRECT_DIR_SEPS (beg
);
475 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
478 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
479 Sfile_name_nondirectory
, 1, 1, 0,
480 doc
: /* Return file name FILENAME sans its directory.
481 For example, in a Unix-syntax file name,
482 this is everything after the last slash,
483 or the entire name if it contains no slash. */)
485 Lisp_Object filename
;
487 register const unsigned char *beg
, *p
, *end
;
490 CHECK_STRING (filename
);
492 /* If the file name has special constructs in it,
493 call the corresponding file handler. */
494 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
496 return call2 (handler
, Qfile_name_nondirectory
, filename
);
498 beg
= SDATA (filename
);
499 end
= p
= beg
+ SBYTES (filename
);
501 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
503 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
506 /* only recognise drive specifier at beginning */
508 /* handle the "/:d:foo" case correctly */
509 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
514 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
517 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
518 Sunhandled_file_name_directory
, 1, 1, 0,
519 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
520 A `directly usable' directory name is one that may be used without the
521 intervention of any file handler.
522 If FILENAME is a directly usable file itself, return
523 \(file-name-directory FILENAME).
524 The `call-process' and `start-process' functions use this function to
525 get a current directory to run processes in. */)
527 Lisp_Object filename
;
531 /* If the file name has special constructs in it,
532 call the corresponding file handler. */
533 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
535 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
537 return Ffile_name_directory (filename
);
542 file_name_as_directory (out
, in
)
545 int size
= strlen (in
) - 1;
558 /* Is it already a directory string? */
559 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
561 /* Is it a VMS directory file name? If so, hack VMS syntax. */
562 else if (! index (in
, '/')
563 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
564 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
565 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
566 || ! strncmp (&in
[size
- 5], ".dir", 4))
567 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
568 && in
[size
] == '1')))
570 register char *p
, *dot
;
574 dir:x.dir --> dir:[x]
575 dir:[x]y.dir --> dir:[x.y] */
577 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
580 strncpy (out
, in
, p
- in
);
599 dot
= index (p
, '.');
602 /* blindly remove any extension */
603 size
= strlen (out
) + (dot
- p
);
604 strncat (out
, p
, dot
- p
);
615 /* For Unix syntax, Append a slash if necessary */
616 if (!IS_DIRECTORY_SEP (out
[size
]))
618 /* Cannot use DIRECTORY_SEP, which could have any value */
620 out
[size
+ 2] = '\0';
623 CORRECT_DIR_SEPS (out
);
629 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
630 Sfile_name_as_directory
, 1, 1, 0,
631 doc
: /* Return a string representing the file name FILE interpreted as a directory.
632 This operation exists because a directory is also a file, but its name as
633 a directory is different from its name as a file.
634 The result can be used as the value of `default-directory'
635 or passed as second argument to `expand-file-name'.
636 For a Unix-syntax file name, just appends a slash.
637 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
648 /* If the file name has special constructs in it,
649 call the corresponding file handler. */
650 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
652 return call2 (handler
, Qfile_name_as_directory
, file
);
654 buf
= (char *) alloca (SBYTES (file
) + 10);
655 file_name_as_directory (buf
, SDATA (file
));
656 return make_specified_string (buf
, -1, strlen (buf
),
657 STRING_MULTIBYTE (file
));
661 * Convert from directory name to filename.
663 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
664 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
665 * On UNIX, it's simple: just make sure there isn't a terminating /
667 * Value is nonzero if the string output is different from the input.
671 directory_file_name (src
, dst
)
679 struct FAB fab
= cc$rms_fab
;
680 struct NAM nam
= cc$rms_nam
;
681 char esa
[NAM$C_MAXRSS
];
686 if (! index (src
, '/')
687 && (src
[slen
- 1] == ']'
688 || src
[slen
- 1] == ':'
689 || src
[slen
- 1] == '>'))
691 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
693 fab
.fab$b_fns
= slen
;
694 fab
.fab$l_nam
= &nam
;
695 fab
.fab$l_fop
= FAB$M_NAM
;
698 nam
.nam$b_ess
= sizeof esa
;
699 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
701 /* We call SYS$PARSE to handle such things as [--] for us. */
702 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
704 slen
= nam
.nam$b_esl
;
705 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
710 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
712 /* what about when we have logical_name:???? */
713 if (src
[slen
- 1] == ':')
714 { /* Xlate logical name and see what we get */
715 ptr
= strcpy (dst
, src
); /* upper case for getenv */
718 if ('a' <= *ptr
&& *ptr
<= 'z')
722 dst
[slen
- 1] = 0; /* remove colon */
723 if (!(src
= egetenv (dst
)))
725 /* should we jump to the beginning of this procedure?
726 Good points: allows us to use logical names that xlate
728 Bad points: can be a problem if we just translated to a device
730 For now, I'll punt and always expect VMS names, and hope for
733 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
734 { /* no recursion here! */
740 { /* not a directory spec */
745 bracket
= src
[slen
- 1];
747 /* If bracket is ']' or '>', bracket - 2 is the corresponding
749 ptr
= index (src
, bracket
- 2);
751 { /* no opening bracket */
755 if (!(rptr
= rindex (src
, '.')))
758 strncpy (dst
, src
, slen
);
762 dst
[slen
++] = bracket
;
767 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
768 then translate the device and recurse. */
769 if (dst
[slen
- 1] == ':'
770 && dst
[slen
- 2] != ':' /* skip decnet nodes */
771 && strcmp (src
+ slen
, "[000000]") == 0)
773 dst
[slen
- 1] = '\0';
774 if ((ptr
= egetenv (dst
))
775 && (rlen
= strlen (ptr
) - 1) > 0
776 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
777 && ptr
[rlen
- 1] == '.')
779 char * buf
= (char *) alloca (strlen (ptr
) + 1);
783 return directory_file_name (buf
, dst
);
788 strcat (dst
, "[000000]");
792 rlen
= strlen (rptr
) - 1;
793 strncat (dst
, rptr
, rlen
);
794 dst
[slen
+ rlen
] = '\0';
795 strcat (dst
, ".DIR.1");
799 /* Process as Unix format: just remove any final slash.
800 But leave "/" unchanged; do not change it to "". */
803 /* Handle // as root for apollo's. */
804 if ((slen
> 2 && dst
[slen
- 1] == '/')
805 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
809 && IS_DIRECTORY_SEP (dst
[slen
- 1])
811 && !IS_ANY_SEP (dst
[slen
- 2])
817 CORRECT_DIR_SEPS (dst
);
822 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
824 doc
: /* Returns the file name of the directory named DIRECTORY.
825 This is the name of the file that holds the data for the directory DIRECTORY.
826 This operation exists because a directory is also a file, but its name as
827 a directory is different from its name as a file.
828 In Unix-syntax, this function just removes the final slash.
829 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
830 it returns a file name such as \"[X]Y.DIR.1\". */)
832 Lisp_Object directory
;
837 CHECK_STRING (directory
);
839 if (NILP (directory
))
842 /* If the file name has special constructs in it,
843 call the corresponding file handler. */
844 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
846 return call2 (handler
, Qdirectory_file_name
, directory
);
849 /* 20 extra chars is insufficient for VMS, since we might perform a
850 logical name translation. an equivalence string can be up to 255
851 chars long, so grab that much extra space... - sss */
852 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
854 buf
= (char *) alloca (SBYTES (directory
) + 20);
856 directory_file_name (SDATA (directory
), buf
);
857 return make_specified_string (buf
, -1, strlen (buf
),
858 STRING_MULTIBYTE (directory
));
861 static char make_temp_name_tbl
[64] =
863 'A','B','C','D','E','F','G','H',
864 'I','J','K','L','M','N','O','P',
865 'Q','R','S','T','U','V','W','X',
866 'Y','Z','a','b','c','d','e','f',
867 'g','h','i','j','k','l','m','n',
868 'o','p','q','r','s','t','u','v',
869 'w','x','y','z','0','1','2','3',
870 '4','5','6','7','8','9','-','_'
873 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
875 /* Value is a temporary file name starting with PREFIX, a string.
877 The Emacs process number forms part of the result, so there is
878 no danger of generating a name being used by another process.
879 In addition, this function makes an attempt to choose a name
880 which has no existing file. To make this work, PREFIX should be
881 an absolute file name.
883 BASE64_P non-zero means add the pid as 3 characters in base64
884 encoding. In this case, 6 characters will be added to PREFIX to
885 form the file name. Otherwise, if Emacs is running on a system
886 with long file names, add the pid as a decimal number.
888 This function signals an error if no unique file name could be
892 make_temp_name (prefix
, base64_p
)
899 unsigned char *p
, *data
;
903 CHECK_STRING (prefix
);
905 /* VAL is created by adding 6 characters to PREFIX. The first
906 three are the PID of this process, in base 64, and the second
907 three are incremented if the file already exists. This ensures
908 262144 unique file names per PID per PREFIX. */
910 pid
= (int) getpid ();
914 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
915 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
916 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
921 #ifdef HAVE_LONG_FILE_NAMES
922 sprintf (pidbuf
, "%d", pid
);
923 pidlen
= strlen (pidbuf
);
925 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
927 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
932 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
933 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
934 if (!STRING_MULTIBYTE (prefix
))
935 STRING_SET_UNIBYTE (val
);
937 bcopy(SDATA (prefix
), data
, len
);
940 bcopy (pidbuf
, p
, pidlen
);
943 /* Here we try to minimize useless stat'ing when this function is
944 invoked many times successively with the same PREFIX. We achieve
945 this by initializing count to a random value, and incrementing it
948 We don't want make-temp-name to be called while dumping,
949 because then make_temp_name_count_initialized_p would get set
950 and then make_temp_name_count would not be set when Emacs starts. */
952 if (!make_temp_name_count_initialized_p
)
954 make_temp_name_count
= (unsigned) time (NULL
);
955 make_temp_name_count_initialized_p
= 1;
961 unsigned num
= make_temp_name_count
;
963 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
964 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
965 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
967 /* Poor man's congruential RN generator. Replace with
968 ++make_temp_name_count for debugging. */
969 make_temp_name_count
+= 25229;
970 make_temp_name_count
%= 225307;
972 if (stat (data
, &ignored
) < 0)
974 /* We want to return only if errno is ENOENT. */
978 /* The error here is dubious, but there is little else we
979 can do. The alternatives are to return nil, which is
980 as bad as (and in many cases worse than) throwing the
981 error, or to ignore the error, which will likely result
982 in looping through 225307 stat's, which is not only
983 dog-slow, but also useless since it will fallback to
984 the errow below, anyway. */
985 report_file_error ("Cannot create temporary name for prefix",
986 Fcons (prefix
, Qnil
));
991 error ("Cannot create temporary name for prefix `%s'",
997 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
998 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
999 The Emacs process number forms part of the result,
1000 so there is no danger of generating a name being used by another process.
1002 In addition, this function makes an attempt to choose a name
1003 which has no existing file. To make this work,
1004 PREFIX should be an absolute file name.
1006 There is a race condition between calling `make-temp-name' and creating the
1007 file which opens all kinds of security holes. For that reason, you should
1008 probably use `make-temp-file' instead, except in three circumstances:
1010 * If you are creating the file in the user's home directory.
1011 * If you are creating a directory rather than an ordinary file.
1012 * If you are taking special precautions as `make-temp-file' does. */)
1016 return make_temp_name (prefix
, 0);
1021 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1022 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1023 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1024 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1025 the current buffer's value of default-directory is used.
1026 File name components that are `.' are removed, and
1027 so are file name components followed by `..', along with the `..' itself;
1028 note that these simplifications are done without checking the resulting
1029 file names in the file system.
1030 An initial `~/' expands to your home directory.
1031 An initial `~USER/' expands to USER's home directory.
1032 See also the function `substitute-in-file-name'. */)
1033 (name
, default_directory
)
1034 Lisp_Object name
, default_directory
;
1038 register unsigned char *newdir
, *p
, *o
;
1040 unsigned char *target
;
1043 unsigned char * colon
= 0;
1044 unsigned char * close
= 0;
1045 unsigned char * slash
= 0;
1046 unsigned char * brack
= 0;
1047 int lbrack
= 0, rbrack
= 0;
1052 int collapse_newdir
= 1;
1056 Lisp_Object handler
, result
;
1058 CHECK_STRING (name
);
1060 /* If the file name has special constructs in it,
1061 call the corresponding file handler. */
1062 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1063 if (!NILP (handler
))
1064 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1066 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1067 if (NILP (default_directory
))
1068 default_directory
= current_buffer
->directory
;
1069 if (! STRINGP (default_directory
))
1072 /* "/" is not considered a root directory on DOS_NT, so using "/"
1073 here causes an infinite recursion in, e.g., the following:
1075 (let (default-directory)
1076 (expand-file-name "a"))
1078 To avoid this, we set default_directory to the root of the
1080 extern char *emacs_root_dir (void);
1082 default_directory
= build_string (emacs_root_dir ());
1084 default_directory
= build_string ("/");
1088 if (!NILP (default_directory
))
1090 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1091 if (!NILP (handler
))
1092 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1095 o
= SDATA (default_directory
);
1097 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1098 It would be better to do this down below where we actually use
1099 default_directory. Unfortunately, calling Fexpand_file_name recursively
1100 could invoke GC, and the strings might be relocated. This would
1101 be annoying because we have pointers into strings lying around
1102 that would need adjusting, and people would add new pointers to
1103 the code and forget to adjust them, resulting in intermittent bugs.
1104 Putting this call here avoids all that crud.
1106 The EQ test avoids infinite recursion. */
1107 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1108 /* Save time in some common cases - as long as default_directory
1109 is not relative, it can be canonicalized with name below (if it
1110 is needed at all) without requiring it to be expanded now. */
1112 /* Detect MSDOS file names with drive specifiers. */
1113 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1115 /* Detect Windows file names in UNC format. */
1116 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1118 #else /* not DOS_NT */
1119 /* Detect Unix absolute file names (/... alone is not absolute on
1121 && ! (IS_DIRECTORY_SEP (o
[0]))
1122 #endif /* not DOS_NT */
1125 struct gcpro gcpro1
;
1128 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1132 name
= FILE_SYSTEM_CASE (name
);
1136 /* We will force directory separators to be either all \ or /, so make
1137 a local copy to modify, even if there ends up being no change. */
1138 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1140 /* Note if special escape prefix is present, but remove for now. */
1141 if (nm
[0] == '/' && nm
[1] == ':')
1147 /* Find and remove drive specifier if present; this makes nm absolute
1148 even if the rest of the name appears to be relative. Only look for
1149 drive specifier at the beginning. */
1150 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1157 /* If we see "c://somedir", we want to strip the first slash after the
1158 colon when stripping the drive letter. Otherwise, this expands to
1160 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1162 #endif /* WINDOWSNT */
1166 /* Discard any previous drive specifier if nm is now in UNC format. */
1167 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1173 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1174 none are found, we can probably return right away. We will avoid
1175 allocating a new string if name is already fully expanded. */
1177 IS_DIRECTORY_SEP (nm
[0])
1179 && drive
&& !is_escaped
1182 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1189 /* If it turns out that the filename we want to return is just a
1190 suffix of FILENAME, we don't need to go through and edit
1191 things; we just need to construct a new string using data
1192 starting at the middle of FILENAME. If we set lose to a
1193 non-zero value, that means we've discovered that we can't do
1200 /* Since we know the name is absolute, we can assume that each
1201 element starts with a "/". */
1203 /* "." and ".." are hairy. */
1204 if (IS_DIRECTORY_SEP (p
[0])
1206 && (IS_DIRECTORY_SEP (p
[2])
1208 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1211 /* We want to replace multiple `/' in a row with a single
1214 && IS_DIRECTORY_SEP (p
[0])
1215 && IS_DIRECTORY_SEP (p
[1]))
1222 /* if dev:[dir]/, move nm to / */
1223 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1224 nm
= (brack
? brack
+ 1 : colon
+ 1);
1225 lbrack
= rbrack
= 0;
1232 #ifdef NO_HYPHENS_IN_FILENAMES
1233 if (lbrack
== rbrack
)
1235 /* Avoid clobbering negative version numbers. */
1240 #endif /* NO_HYPHENS_IN_FILENAMES */
1241 if (lbrack
> rbrack
&&
1242 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1243 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1245 #ifdef NO_HYPHENS_IN_FILENAMES
1248 #endif /* NO_HYPHENS_IN_FILENAMES */
1249 /* count open brackets, reset close bracket pointer */
1250 if (p
[0] == '[' || p
[0] == '<')
1251 lbrack
++, brack
= 0;
1252 /* count close brackets, set close bracket pointer */
1253 if (p
[0] == ']' || p
[0] == '>')
1254 rbrack
++, brack
= p
;
1255 /* detect ][ or >< */
1256 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1258 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1259 nm
= p
+ 1, lose
= 1;
1260 if (p
[0] == ':' && (colon
|| slash
))
1261 /* if dev1:[dir]dev2:, move nm to dev2: */
1267 /* if /name/dev:, move nm to dev: */
1270 /* if node::dev:, move colon following dev */
1271 else if (colon
&& colon
[-1] == ':')
1273 /* if dev1:dev2:, move nm to dev2: */
1274 else if (colon
&& colon
[-1] != ':')
1279 if (p
[0] == ':' && !colon
)
1285 if (lbrack
== rbrack
)
1288 else if (p
[0] == '.')
1296 if (index (nm
, '/'))
1298 nm
= sys_translate_unix (nm
);
1299 return make_specified_string (nm
, -1, strlen (nm
),
1300 STRING_MULTIBYTE (name
));
1304 /* Make sure directories are all separated with / or \ as
1305 desired, but avoid allocation of a new string when not
1307 CORRECT_DIR_SEPS (nm
);
1309 if (IS_DIRECTORY_SEP (nm
[1]))
1311 if (strcmp (nm
, SDATA (name
)) != 0)
1312 name
= make_specified_string (nm
, -1, strlen (nm
),
1313 STRING_MULTIBYTE (name
));
1317 /* drive must be set, so this is okay */
1318 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1322 name
= make_specified_string (nm
, -1, p
- nm
,
1323 STRING_MULTIBYTE (name
));
1324 temp
[0] = DRIVE_LETTER (drive
);
1325 name
= concat2 (build_string (temp
), name
);
1328 #else /* not DOS_NT */
1329 if (nm
== SDATA (name
))
1331 return make_specified_string (nm
, -1, strlen (nm
),
1332 STRING_MULTIBYTE (name
));
1333 #endif /* not DOS_NT */
1337 /* At this point, nm might or might not be an absolute file name. We
1338 need to expand ~ or ~user if present, otherwise prefix nm with
1339 default_directory if nm is not absolute, and finally collapse /./
1340 and /foo/../ sequences.
1342 We set newdir to be the appropriate prefix if one is needed:
1343 - the relevant user directory if nm starts with ~ or ~user
1344 - the specified drive's working dir (DOS/NT only) if nm does not
1346 - the value of default_directory.
1348 Note that these prefixes are not guaranteed to be absolute (except
1349 for the working dir of a drive). Therefore, to ensure we always
1350 return an absolute name, if the final prefix is not absolute we
1351 append it to the current working directory. */
1355 if (nm
[0] == '~') /* prefix ~ */
1357 if (IS_DIRECTORY_SEP (nm
[1])
1361 || nm
[1] == 0) /* ~ by itself */
1363 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1364 newdir
= (unsigned char *) "";
1367 collapse_newdir
= 0;
1370 nm
++; /* Don't leave the slash in nm. */
1373 else /* ~user/filename */
1375 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1380 o
= (unsigned char *) alloca (p
- nm
+ 1);
1381 bcopy ((char *) nm
, o
, p
- nm
);
1384 pw
= (struct passwd
*) getpwnam (o
+ 1);
1387 newdir
= (unsigned char *) pw
-> pw_dir
;
1389 nm
= p
+ 1; /* skip the terminator */
1393 collapse_newdir
= 0;
1398 /* If we don't find a user of that name, leave the name
1399 unchanged; don't move nm forward to p. */
1404 /* On DOS and Windows, nm is absolute if a drive name was specified;
1405 use the drive's current directory as the prefix if needed. */
1406 if (!newdir
&& drive
)
1408 /* Get default directory if needed to make nm absolute. */
1409 if (!IS_DIRECTORY_SEP (nm
[0]))
1411 newdir
= alloca (MAXPATHLEN
+ 1);
1412 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1417 /* Either nm starts with /, or drive isn't mounted. */
1418 newdir
= alloca (4);
1419 newdir
[0] = DRIVE_LETTER (drive
);
1427 /* Finally, if no prefix has been specified and nm is not absolute,
1428 then it must be expanded relative to default_directory. */
1432 /* /... alone is not absolute on DOS and Windows. */
1433 && !IS_DIRECTORY_SEP (nm
[0])
1436 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1443 newdir
= SDATA (default_directory
);
1445 /* Note if special escape prefix is present, but remove for now. */
1446 if (newdir
[0] == '/' && newdir
[1] == ':')
1457 /* First ensure newdir is an absolute name. */
1459 /* Detect MSDOS file names with drive specifiers. */
1460 ! (IS_DRIVE (newdir
[0])
1461 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1463 /* Detect Windows file names in UNC format. */
1464 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1468 /* Effectively, let newdir be (expand-file-name newdir cwd).
1469 Because of the admonition against calling expand-file-name
1470 when we have pointers into lisp strings, we accomplish this
1471 indirectly by prepending newdir to nm if necessary, and using
1472 cwd (or the wd of newdir's drive) as the new newdir. */
1474 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1479 if (!IS_DIRECTORY_SEP (nm
[0]))
1481 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1482 file_name_as_directory (tmp
, newdir
);
1486 newdir
= alloca (MAXPATHLEN
+ 1);
1489 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1496 /* Strip off drive name from prefix, if present. */
1497 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1503 /* Keep only a prefix from newdir if nm starts with slash
1504 (//server/share for UNC, nothing otherwise). */
1505 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1508 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1510 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1512 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1514 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1526 /* Get rid of any slash at the end of newdir, unless newdir is
1527 just / or // (an incomplete UNC name). */
1528 length
= strlen (newdir
);
1529 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1531 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1535 unsigned char *temp
= (unsigned char *) alloca (length
);
1536 bcopy (newdir
, temp
, length
- 1);
1537 temp
[length
- 1] = 0;
1545 /* Now concatenate the directory and name to new space in the stack frame */
1546 tlen
+= strlen (nm
) + 1;
1548 /* Reserve space for drive specifier and escape prefix, since either
1549 or both may need to be inserted. (The Microsoft x86 compiler
1550 produces incorrect code if the following two lines are combined.) */
1551 target
= (unsigned char *) alloca (tlen
+ 4);
1553 #else /* not DOS_NT */
1554 target
= (unsigned char *) alloca (tlen
);
1555 #endif /* not DOS_NT */
1561 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1564 /* If newdir is effectively "C:/", then the drive letter will have
1565 been stripped and newdir will be "/". Concatenating with an
1566 absolute directory in nm produces "//", which will then be
1567 incorrectly treated as a network share. Ignore newdir in
1568 this case (keeping the drive letter). */
1569 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1570 && newdir
[1] == '\0'))
1572 strcpy (target
, newdir
);
1576 file_name_as_directory (target
, newdir
);
1579 strcat (target
, nm
);
1581 if (index (target
, '/'))
1582 strcpy (target
, sys_translate_unix (target
));
1585 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1587 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1596 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1602 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1603 /* brackets are offset from each other by 2 */
1606 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1607 /* convert [foo][bar] to [bar] */
1608 while (o
[-1] != '[' && o
[-1] != '<')
1610 else if (*p
== '-' && *o
!= '.')
1613 else if (p
[0] == '-' && o
[-1] == '.' &&
1614 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1615 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1619 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1620 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1622 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1624 /* else [foo.-] ==> [-] */
1628 #ifdef NO_HYPHENS_IN_FILENAMES
1630 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1631 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1633 #endif /* NO_HYPHENS_IN_FILENAMES */
1637 if (!IS_DIRECTORY_SEP (*p
))
1641 else if (IS_DIRECTORY_SEP (p
[0])
1643 && (IS_DIRECTORY_SEP (p
[2])
1646 /* If "/." is the entire filename, keep the "/". Otherwise,
1647 just delete the whole "/.". */
1648 if (o
== target
&& p
[2] == '\0')
1652 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1653 /* `/../' is the "superroot" on certain file systems. */
1655 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1657 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1659 /* Keep initial / only if this is the whole name. */
1660 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1665 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1667 /* Collapse multiple `/' in a row. */
1669 while (IS_DIRECTORY_SEP (*p
))
1676 #endif /* not VMS */
1680 /* At last, set drive name. */
1682 /* Except for network file name. */
1683 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1684 #endif /* WINDOWSNT */
1686 if (!drive
) abort ();
1688 target
[0] = DRIVE_LETTER (drive
);
1691 /* Reinsert the escape prefix if required. */
1698 CORRECT_DIR_SEPS (target
);
1701 result
= make_specified_string (target
, -1, o
- target
,
1702 STRING_MULTIBYTE (name
));
1704 /* Again look to see if the file name has special constructs in it
1705 and perhaps call the corresponding file handler. This is needed
1706 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1707 the ".." component gives us "/user@host:/bar/../baz" which needs
1708 to be expanded again. */
1709 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1710 if (!NILP (handler
))
1711 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1717 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1718 This is the old version of expand-file-name, before it was thoroughly
1719 rewritten for Emacs 10.31. We leave this version here commented-out,
1720 because the code is very complex and likely to have subtle bugs. If
1721 bugs _are_ found, it might be of interest to look at the old code and
1722 see what did it do in the relevant situation.
1724 Don't remove this code: it's true that it will be accessible via CVS,
1725 but a few years from deletion, people will forget it is there. */
1727 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1728 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1729 "Convert FILENAME to absolute, and canonicalize it.\n\
1730 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1731 \(does not start with slash); if DEFAULT is nil or missing,\n\
1732 the current buffer's value of default-directory is used.\n\
1733 Filenames containing `.' or `..' as components are simplified;\n\
1734 initial `~/' expands to your home directory.\n\
1735 See also the function `substitute-in-file-name'.")
1737 Lisp_Object name
, defalt
;
1741 register unsigned char *newdir
, *p
, *o
;
1743 unsigned char *target
;
1747 unsigned char * colon
= 0;
1748 unsigned char * close
= 0;
1749 unsigned char * slash
= 0;
1750 unsigned char * brack
= 0;
1751 int lbrack
= 0, rbrack
= 0;
1755 CHECK_STRING (name
);
1758 /* Filenames on VMS are always upper case. */
1759 name
= Fupcase (name
);
1764 /* If nm is absolute, flush ...// and detect /./ and /../.
1765 If no /./ or /../ we can return right away. */
1777 if (p
[0] == '/' && p
[1] == '/'
1779 /* // at start of filename is meaningful on Apollo system. */
1784 if (p
[0] == '/' && p
[1] == '~')
1785 nm
= p
+ 1, lose
= 1;
1786 if (p
[0] == '/' && p
[1] == '.'
1787 && (p
[2] == '/' || p
[2] == 0
1788 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1794 /* if dev:[dir]/, move nm to / */
1795 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1796 nm
= (brack
? brack
+ 1 : colon
+ 1);
1797 lbrack
= rbrack
= 0;
1805 /* VMS pre V4.4,convert '-'s in filenames. */
1806 if (lbrack
== rbrack
)
1808 if (dots
< 2) /* this is to allow negative version numbers */
1813 if (lbrack
> rbrack
&&
1814 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1815 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1821 /* count open brackets, reset close bracket pointer */
1822 if (p
[0] == '[' || p
[0] == '<')
1823 lbrack
++, brack
= 0;
1824 /* count close brackets, set close bracket pointer */
1825 if (p
[0] == ']' || p
[0] == '>')
1826 rbrack
++, brack
= p
;
1827 /* detect ][ or >< */
1828 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1830 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1831 nm
= p
+ 1, lose
= 1;
1832 if (p
[0] == ':' && (colon
|| slash
))
1833 /* if dev1:[dir]dev2:, move nm to dev2: */
1839 /* If /name/dev:, move nm to dev: */
1842 /* If node::dev:, move colon following dev */
1843 else if (colon
&& colon
[-1] == ':')
1845 /* If dev1:dev2:, move nm to dev2: */
1846 else if (colon
&& colon
[-1] != ':')
1851 if (p
[0] == ':' && !colon
)
1857 if (lbrack
== rbrack
)
1860 else if (p
[0] == '.')
1868 if (index (nm
, '/'))
1869 return build_string (sys_translate_unix (nm
));
1871 if (nm
== SDATA (name
))
1873 return build_string (nm
);
1877 /* Now determine directory to start with and put it in NEWDIR */
1881 if (nm
[0] == '~') /* prefix ~ */
1886 || nm
[1] == 0)/* ~/filename */
1888 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1889 newdir
= (unsigned char *) "";
1892 nm
++; /* Don't leave the slash in nm. */
1895 else /* ~user/filename */
1897 /* Get past ~ to user */
1898 unsigned char *user
= nm
+ 1;
1899 /* Find end of name. */
1900 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1901 int len
= ptr
? ptr
- user
: strlen (user
);
1903 unsigned char *ptr1
= index (user
, ':');
1904 if (ptr1
!= 0 && ptr1
- user
< len
)
1907 /* Copy the user name into temp storage. */
1908 o
= (unsigned char *) alloca (len
+ 1);
1909 bcopy ((char *) user
, o
, len
);
1912 /* Look up the user name. */
1913 pw
= (struct passwd
*) getpwnam (o
+ 1);
1915 error ("\"%s\" isn't a registered user", o
+ 1);
1917 newdir
= (unsigned char *) pw
->pw_dir
;
1919 /* Discard the user name from NM. */
1926 #endif /* not VMS */
1930 defalt
= current_buffer
->directory
;
1931 CHECK_STRING (defalt
);
1932 newdir
= SDATA (defalt
);
1935 /* Now concatenate the directory and name to new space in the stack frame */
1937 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1938 target
= (unsigned char *) alloca (tlen
);
1944 if (nm
[0] == 0 || nm
[0] == '/')
1945 strcpy (target
, newdir
);
1948 file_name_as_directory (target
, newdir
);
1951 strcat (target
, nm
);
1953 if (index (target
, '/'))
1954 strcpy (target
, sys_translate_unix (target
));
1957 /* Now canonicalize by removing /. and /foo/.. if they appear */
1965 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1971 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1972 /* brackets are offset from each other by 2 */
1975 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1976 /* convert [foo][bar] to [bar] */
1977 while (o
[-1] != '[' && o
[-1] != '<')
1979 else if (*p
== '-' && *o
!= '.')
1982 else if (p
[0] == '-' && o
[-1] == '.' &&
1983 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1984 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1988 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1989 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1991 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1993 /* else [foo.-] ==> [-] */
1999 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2000 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2010 else if (!strncmp (p
, "//", 2)
2012 /* // at start of filename is meaningful in Apollo system. */
2020 else if (p
[0] == '/' && p
[1] == '.' &&
2021 (p
[2] == '/' || p
[2] == 0))
2023 else if (!strncmp (p
, "/..", 3)
2024 /* `/../' is the "superroot" on certain file systems. */
2026 && (p
[3] == '/' || p
[3] == 0))
2028 while (o
!= target
&& *--o
!= '/')
2031 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2035 if (o
== target
&& *o
== '/')
2043 #endif /* not VMS */
2046 return make_string (target
, o
- target
);
2050 /* If /~ or // appears, discard everything through first slash. */
2052 file_name_absolute_p (filename
)
2053 const unsigned char *filename
;
2056 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2058 /* ??? This criterion is probably wrong for '<'. */
2059 || index (filename
, ':') || index (filename
, '<')
2060 || (*filename
== '[' && (filename
[1] != '-'
2061 || (filename
[2] != '.' && filename
[2] != ']'))
2062 && filename
[1] != '.')
2065 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2066 && IS_DIRECTORY_SEP (filename
[2]))
2071 static unsigned char *
2072 search_embedded_absfilename (nm
, endp
)
2073 unsigned char *nm
, *endp
;
2075 unsigned char *p
, *s
;
2077 for (p
= nm
+ 1; p
< endp
; p
++)
2081 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2083 || IS_DIRECTORY_SEP (p
[-1]))
2084 && file_name_absolute_p (p
)
2085 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2086 /* // at start of file name is meaningful in Apollo,
2087 WindowsNT and Cygwin systems. */
2088 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2089 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2092 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2097 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2099 unsigned char *o
= alloca (s
- p
+ 1);
2101 bcopy (p
, o
, s
- p
);
2104 /* If we have ~user and `user' exists, discard
2105 everything up to ~. But if `user' does not exist, leave
2106 ~user alone, it might be a literal file name. */
2107 if ((pw
= getpwnam (o
+ 1)))
2119 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2120 Ssubstitute_in_file_name
, 1, 1, 0,
2121 doc
: /* Substitute environment variables referred to in FILENAME.
2122 `$FOO' where FOO is an environment variable name means to substitute
2123 the value of that variable. The variable name should be terminated
2124 with a character not a letter, digit or underscore; otherwise, enclose
2125 the entire variable name in braces.
2126 If `/~' appears, all of FILENAME through that `/' is discarded.
2128 On VMS, `$' substitution is not done; this function does little and only
2129 duplicates what `expand-file-name' does. */)
2131 Lisp_Object filename
;
2135 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2136 unsigned char *target
= NULL
;
2138 int substituted
= 0;
2140 Lisp_Object handler
;
2142 CHECK_STRING (filename
);
2144 /* If the file name has special constructs in it,
2145 call the corresponding file handler. */
2146 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2147 if (!NILP (handler
))
2148 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2150 nm
= SDATA (filename
);
2152 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2153 CORRECT_DIR_SEPS (nm
);
2154 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2156 endp
= nm
+ SBYTES (filename
);
2158 /* If /~ or // appears, discard everything through first slash. */
2159 p
= search_embedded_absfilename (nm
, endp
);
2161 /* Start over with the new string, so we check the file-name-handler
2162 again. Important with filenames like "/home/foo//:/hello///there"
2163 which whould substitute to "/:/hello///there" rather than "/there". */
2164 return Fsubstitute_in_file_name
2165 (make_specified_string (p
, -1, endp
- p
,
2166 STRING_MULTIBYTE (filename
)));
2172 /* See if any variables are substituted into the string
2173 and find the total length of their values in `total' */
2175 for (p
= nm
; p
!= endp
;)
2185 /* "$$" means a single "$" */
2194 while (p
!= endp
&& *p
!= '}') p
++;
2195 if (*p
!= '}') goto missingclose
;
2201 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2205 /* Copy out the variable name */
2206 target
= (unsigned char *) alloca (s
- o
+ 1);
2207 strncpy (target
, o
, s
- o
);
2210 strupr (target
); /* $home == $HOME etc. */
2213 /* Get variable value */
2214 o
= (unsigned char *) egetenv (target
);
2217 total
+= strlen (o
);
2227 /* If substitution required, recopy the string and do it */
2228 /* Make space in stack frame for the new copy */
2229 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2232 /* Copy the rest of the name through, replacing $ constructs with values */
2249 while (p
!= endp
&& *p
!= '}') p
++;
2250 if (*p
!= '}') goto missingclose
;
2256 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2260 /* Copy out the variable name */
2261 target
= (unsigned char *) alloca (s
- o
+ 1);
2262 strncpy (target
, o
, s
- o
);
2265 strupr (target
); /* $home == $HOME etc. */
2268 /* Get variable value */
2269 o
= (unsigned char *) egetenv (target
);
2273 strcpy (x
, target
); x
+= strlen (target
);
2275 else if (STRING_MULTIBYTE (filename
))
2277 /* If the original string is multibyte,
2278 convert what we substitute into multibyte. */
2281 int c
= unibyte_char_to_multibyte (*o
++);
2282 x
+= CHAR_STRING (c
, x
);
2294 /* If /~ or // appears, discard everything through first slash. */
2295 while ((p
= search_embedded_absfilename (xnm
, x
)))
2296 /* This time we do not start over because we've already expanded envvars
2297 and replaced $$ with $. Maybe we should start over as well, but we'd
2298 need to quote some $ to $$ first. */
2301 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2304 error ("Bad format environment-variable substitution");
2306 error ("Missing \"}\" in environment-variable substitution");
2308 error ("Substituting nonexistent environment variable \"%s\"", target
);
2311 #endif /* not VMS */
2315 /* A slightly faster and more convenient way to get
2316 (directory-file-name (expand-file-name FOO)). */
2319 expand_and_dir_to_file (filename
, defdir
)
2320 Lisp_Object filename
, defdir
;
2322 register Lisp_Object absname
;
2324 absname
= Fexpand_file_name (filename
, defdir
);
2327 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2328 if (c
== ':' || c
== ']' || c
== '>')
2329 absname
= Fdirectory_file_name (absname
);
2332 /* Remove final slash, if any (unless this is the root dir).
2333 stat behaves differently depending! */
2334 if (SCHARS (absname
) > 1
2335 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2336 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2337 /* We cannot take shortcuts; they might be wrong for magic file names. */
2338 absname
= Fdirectory_file_name (absname
);
2343 /* Signal an error if the file ABSNAME already exists.
2344 If INTERACTIVE is nonzero, ask the user whether to proceed,
2345 and bypass the error if the user says to go ahead.
2346 QUERYSTRING is a name for the action that is being considered
2349 *STATPTR is used to store the stat information if the file exists.
2350 If the file does not exist, STATPTR->st_mode is set to 0.
2351 If STATPTR is null, we don't store into it.
2353 If QUICK is nonzero, we ask for y or n, not yes or no. */
2356 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2357 Lisp_Object absname
;
2358 unsigned char *querystring
;
2360 struct stat
*statptr
;
2363 register Lisp_Object tem
, encoded_filename
;
2364 struct stat statbuf
;
2365 struct gcpro gcpro1
;
2367 encoded_filename
= ENCODE_FILE (absname
);
2369 /* stat is a good way to tell whether the file exists,
2370 regardless of what access permissions it has. */
2371 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2374 Fsignal (Qfile_already_exists
,
2375 Fcons (build_string ("File already exists"),
2376 Fcons (absname
, Qnil
)));
2378 tem
= format2 ("File %s already exists; %s anyway? ",
2379 absname
, build_string (querystring
));
2381 tem
= Fy_or_n_p (tem
);
2383 tem
= do_yes_or_no_p (tem
);
2386 Fsignal (Qfile_already_exists
,
2387 Fcons (build_string ("File already exists"),
2388 Fcons (absname
, Qnil
)));
2395 statptr
->st_mode
= 0;
2400 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2401 "fCopy file: \nGCopy %s to file: \np\nP",
2402 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2403 If NEWNAME names a directory, copy FILE there.
2404 Signals a `file-already-exists' error if file NEWNAME already exists,
2405 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2406 A number as third arg means request confirmation if NEWNAME already exists.
2407 This is what happens in interactive use with M-x.
2408 Always sets the file modes of the output file to match the input file.
2410 Fourth arg KEEP-TIME non-nil means give the output file the same
2411 last-modified time as the old one. (This works on only some systems.)
2413 A prefix arg makes KEEP-TIME non-nil.
2415 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2416 for an existing file with the same name. If MUSTBENEW is `excl',
2417 that means to get an error if the file already exists; never overwrite.
2418 If MUSTBENEW is neither nil nor `excl', that means ask for
2419 confirmation before overwriting, but do go ahead and overwrite the file
2420 if the user confirms. */)
2421 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
)
2422 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2425 char buf
[16 * 1024];
2426 struct stat st
, out_st
;
2427 Lisp_Object handler
;
2428 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2429 int count
= SPECPDL_INDEX ();
2430 int input_file_statable_p
;
2431 Lisp_Object encoded_file
, encoded_newname
;
2433 encoded_file
= encoded_newname
= Qnil
;
2434 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2435 CHECK_STRING (file
);
2436 CHECK_STRING (newname
);
2438 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2439 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2441 if (!NILP (Ffile_directory_p (newname
)))
2442 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2444 newname
= Fexpand_file_name (newname
, Qnil
);
2446 file
= Fexpand_file_name (file
, Qnil
);
2448 /* If the input file name has special constructs in it,
2449 call the corresponding file handler. */
2450 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2451 /* Likewise for output file name. */
2453 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2454 if (!NILP (handler
))
2455 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2456 ok_if_already_exists
, keep_time
));
2458 encoded_file
= ENCODE_FILE (file
);
2459 encoded_newname
= ENCODE_FILE (newname
);
2461 if (NILP (ok_if_already_exists
)
2462 || INTEGERP (ok_if_already_exists
))
2463 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2464 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2465 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2469 if (!CopyFile (SDATA (encoded_file
),
2470 SDATA (encoded_newname
),
2472 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2473 /* CopyFile retains the timestamp by default. */
2474 else if (NILP (keep_time
))
2480 EMACS_GET_TIME (now
);
2481 filename
= SDATA (encoded_newname
);
2483 /* Ensure file is writable while its modified time is set. */
2484 attributes
= GetFileAttributes (filename
);
2485 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2486 if (set_file_times (filename
, now
, now
))
2488 /* Restore original attributes. */
2489 SetFileAttributes (filename
, attributes
);
2490 Fsignal (Qfile_date_error
,
2491 Fcons (build_string ("Cannot set file date"),
2492 Fcons (newname
, Qnil
)));
2494 /* Restore original attributes. */
2495 SetFileAttributes (filename
, attributes
);
2497 #else /* not WINDOWSNT */
2499 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2503 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2505 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2507 /* We can only copy regular files and symbolic links. Other files are not
2509 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2511 #if !defined (DOS_NT) || __DJGPP__ > 1
2512 if (out_st
.st_mode
!= 0
2513 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2516 report_file_error ("Input and output files are the same",
2517 Fcons (file
, Fcons (newname
, Qnil
)));
2521 #if defined (S_ISREG) && defined (S_ISLNK)
2522 if (input_file_statable_p
)
2524 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2526 #if defined (EISDIR)
2527 /* Get a better looking error message. */
2530 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2533 #endif /* S_ISREG && S_ISLNK */
2536 /* Create the copy file with the same record format as the input file */
2537 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2540 /* System's default file type was set to binary by _fmode in emacs.c. */
2541 ofd
= emacs_open (SDATA (encoded_newname
),
2542 O_WRONLY
| O_TRUNC
| O_CREAT
2543 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2544 S_IREAD
| S_IWRITE
);
2545 #else /* not MSDOS */
2546 ofd
= emacs_open (SDATA (encoded_newname
),
2547 O_WRONLY
| O_TRUNC
| O_CREAT
2548 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2550 #endif /* not MSDOS */
2553 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2555 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2559 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2560 if (emacs_write (ofd
, buf
, n
) != n
)
2561 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2564 /* Closing the output clobbers the file times on some systems. */
2565 if (emacs_close (ofd
) < 0)
2566 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2568 if (input_file_statable_p
)
2570 if (!NILP (keep_time
))
2572 EMACS_TIME atime
, mtime
;
2573 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2574 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2575 if (set_file_times (SDATA (encoded_newname
),
2577 Fsignal (Qfile_date_error
,
2578 Fcons (build_string ("Cannot set file date"),
2579 Fcons (newname
, Qnil
)));
2582 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2584 #if defined (__DJGPP__) && __DJGPP__ > 1
2585 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2586 and if it can't, it tells so. Otherwise, under MSDOS we usually
2587 get only the READ bit, which will make the copied file read-only,
2588 so it's better not to chmod at all. */
2589 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2590 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2591 #endif /* DJGPP version 2 or newer */
2596 #endif /* WINDOWSNT */
2598 /* Discard the unwind protects. */
2599 specpdl_ptr
= specpdl
+ count
;
2605 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2606 Smake_directory_internal
, 1, 1, 0,
2607 doc
: /* Create a new directory named DIRECTORY. */)
2609 Lisp_Object directory
;
2611 const unsigned char *dir
;
2612 Lisp_Object handler
;
2613 Lisp_Object encoded_dir
;
2615 CHECK_STRING (directory
);
2616 directory
= Fexpand_file_name (directory
, Qnil
);
2618 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2619 if (!NILP (handler
))
2620 return call2 (handler
, Qmake_directory_internal
, directory
);
2622 encoded_dir
= ENCODE_FILE (directory
);
2624 dir
= SDATA (encoded_dir
);
2627 if (mkdir (dir
) != 0)
2629 if (mkdir (dir
, 0777) != 0)
2631 report_file_error ("Creating directory", Flist (1, &directory
));
2636 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2637 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2639 Lisp_Object directory
;
2641 const unsigned char *dir
;
2642 Lisp_Object handler
;
2643 Lisp_Object encoded_dir
;
2645 CHECK_STRING (directory
);
2646 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2648 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2649 if (!NILP (handler
))
2650 return call2 (handler
, Qdelete_directory
, directory
);
2652 encoded_dir
= ENCODE_FILE (directory
);
2654 dir
= SDATA (encoded_dir
);
2656 if (rmdir (dir
) != 0)
2657 report_file_error ("Removing directory", Flist (1, &directory
));
2662 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2663 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2664 If file has multiple names, it continues to exist with the other names. */)
2666 Lisp_Object filename
;
2668 Lisp_Object handler
;
2669 Lisp_Object encoded_file
;
2670 struct gcpro gcpro1
;
2673 if (!NILP (Ffile_directory_p (filename
))
2674 && NILP (Ffile_symlink_p (filename
)))
2675 Fsignal (Qfile_error
,
2676 Fcons (build_string ("Removing old name: is a directory"),
2677 Fcons (filename
, Qnil
)));
2679 filename
= Fexpand_file_name (filename
, Qnil
);
2681 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2682 if (!NILP (handler
))
2683 return call2 (handler
, Qdelete_file
, filename
);
2685 encoded_file
= ENCODE_FILE (filename
);
2687 if (0 > unlink (SDATA (encoded_file
)))
2688 report_file_error ("Removing old name", Flist (1, &filename
));
2693 internal_delete_file_1 (ignore
)
2699 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2702 internal_delete_file (filename
)
2703 Lisp_Object filename
;
2705 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2706 Qt
, internal_delete_file_1
));
2709 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2710 "fRename file: \nGRename %s to file: \np",
2711 doc
: /* Rename FILE as NEWNAME. Both args strings.
2712 If file has names other than FILE, it continues to have those names.
2713 Signals a `file-already-exists' error if a file NEWNAME already exists
2714 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2715 A number as third arg means request confirmation if NEWNAME already exists.
2716 This is what happens in interactive use with M-x. */)
2717 (file
, newname
, ok_if_already_exists
)
2718 Lisp_Object file
, newname
, ok_if_already_exists
;
2721 Lisp_Object args
[2];
2723 Lisp_Object handler
;
2724 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2725 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2727 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2728 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2729 CHECK_STRING (file
);
2730 CHECK_STRING (newname
);
2731 file
= Fexpand_file_name (file
, Qnil
);
2733 if (!NILP (Ffile_directory_p (newname
)))
2734 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2736 newname
= Fexpand_file_name (newname
, Qnil
);
2738 /* If the file name has special constructs in it,
2739 call the corresponding file handler. */
2740 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2742 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2743 if (!NILP (handler
))
2744 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2745 file
, newname
, ok_if_already_exists
));
2747 encoded_file
= ENCODE_FILE (file
);
2748 encoded_newname
= ENCODE_FILE (newname
);
2751 /* If the file names are identical but for the case, don't ask for
2752 confirmation: they simply want to change the letter-case of the
2754 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2756 if (NILP (ok_if_already_exists
)
2757 || INTEGERP (ok_if_already_exists
))
2758 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2759 INTEGERP (ok_if_already_exists
), 0, 0);
2761 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2763 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2764 || 0 > unlink (SDATA (encoded_file
)))
2770 symlink_target
= Ffile_symlink_p (file
);
2771 if (! NILP (symlink_target
))
2772 Fmake_symbolic_link (symlink_target
, newname
,
2773 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2776 Fcopy_file (file
, newname
,
2777 /* We have already prompted if it was an integer,
2778 so don't have copy-file prompt again. */
2779 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2781 Fdelete_file (file
);
2788 report_file_error ("Renaming", Flist (2, args
));
2791 report_file_error ("Renaming", Flist (2, &file
));
2798 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2799 "fAdd name to file: \nGName to add to %s: \np",
2800 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2801 Signals a `file-already-exists' error if a file NEWNAME already exists
2802 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2803 A number as third arg means request confirmation if NEWNAME already exists.
2804 This is what happens in interactive use with M-x. */)
2805 (file
, newname
, ok_if_already_exists
)
2806 Lisp_Object file
, newname
, ok_if_already_exists
;
2809 Lisp_Object args
[2];
2811 Lisp_Object handler
;
2812 Lisp_Object encoded_file
, encoded_newname
;
2813 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2815 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2816 encoded_file
= encoded_newname
= Qnil
;
2817 CHECK_STRING (file
);
2818 CHECK_STRING (newname
);
2819 file
= Fexpand_file_name (file
, Qnil
);
2821 if (!NILP (Ffile_directory_p (newname
)))
2822 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2824 newname
= Fexpand_file_name (newname
, Qnil
);
2826 /* If the file name has special constructs in it,
2827 call the corresponding file handler. */
2828 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2829 if (!NILP (handler
))
2830 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2831 newname
, ok_if_already_exists
));
2833 /* If the new name has special constructs in it,
2834 call the corresponding file handler. */
2835 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2836 if (!NILP (handler
))
2837 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2838 newname
, ok_if_already_exists
));
2840 encoded_file
= ENCODE_FILE (file
);
2841 encoded_newname
= ENCODE_FILE (newname
);
2843 if (NILP (ok_if_already_exists
)
2844 || INTEGERP (ok_if_already_exists
))
2845 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2846 INTEGERP (ok_if_already_exists
), 0, 0);
2848 unlink (SDATA (newname
));
2849 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2854 report_file_error ("Adding new name", Flist (2, args
));
2856 report_file_error ("Adding new name", Flist (2, &file
));
2865 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2866 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2867 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2868 Signals a `file-already-exists' error if a file LINKNAME already exists
2869 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2870 A number as third arg means request confirmation if LINKNAME already exists.
2871 This happens for interactive use with M-x. */)
2872 (filename
, linkname
, ok_if_already_exists
)
2873 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2876 Lisp_Object args
[2];
2878 Lisp_Object handler
;
2879 Lisp_Object encoded_filename
, encoded_linkname
;
2880 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2882 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2883 encoded_filename
= encoded_linkname
= Qnil
;
2884 CHECK_STRING (filename
);
2885 CHECK_STRING (linkname
);
2886 /* If the link target has a ~, we must expand it to get
2887 a truly valid file name. Otherwise, do not expand;
2888 we want to permit links to relative file names. */
2889 if (SREF (filename
, 0) == '~')
2890 filename
= Fexpand_file_name (filename
, Qnil
);
2892 if (!NILP (Ffile_directory_p (linkname
)))
2893 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2895 linkname
= Fexpand_file_name (linkname
, Qnil
);
2897 /* If the file name has special constructs in it,
2898 call the corresponding file handler. */
2899 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2900 if (!NILP (handler
))
2901 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2902 linkname
, ok_if_already_exists
));
2904 /* If the new link name has special constructs in it,
2905 call the corresponding file handler. */
2906 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2907 if (!NILP (handler
))
2908 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2909 linkname
, ok_if_already_exists
));
2911 encoded_filename
= ENCODE_FILE (filename
);
2912 encoded_linkname
= ENCODE_FILE (linkname
);
2914 if (NILP (ok_if_already_exists
)
2915 || INTEGERP (ok_if_already_exists
))
2916 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2917 INTEGERP (ok_if_already_exists
), 0, 0);
2918 if (0 > symlink (SDATA (encoded_filename
),
2919 SDATA (encoded_linkname
)))
2921 /* If we didn't complain already, silently delete existing file. */
2922 if (errno
== EEXIST
)
2924 unlink (SDATA (encoded_linkname
));
2925 if (0 <= symlink (SDATA (encoded_filename
),
2926 SDATA (encoded_linkname
)))
2936 report_file_error ("Making symbolic link", Flist (2, args
));
2938 report_file_error ("Making symbolic link", Flist (2, &filename
));
2944 #endif /* S_IFLNK */
2948 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2949 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2950 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2951 If STRING is nil or a null string, the logical name NAME is deleted. */)
2956 CHECK_STRING (name
);
2958 delete_logical_name (SDATA (name
));
2961 CHECK_STRING (string
);
2963 if (SCHARS (string
) == 0)
2964 delete_logical_name (SDATA (name
));
2966 define_logical_name (SDATA (name
), SDATA (string
));
2975 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2976 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2978 Lisp_Object path
, login
;
2982 CHECK_STRING (path
);
2983 CHECK_STRING (login
);
2985 netresult
= netunam (SDATA (path
), SDATA (login
));
2987 if (netresult
== -1)
2992 #endif /* HPUX_NET */
2994 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2996 doc
: /* Return t if file FILENAME specifies an absolute file name.
2997 On Unix, this is a name starting with a `/' or a `~'. */)
2999 Lisp_Object filename
;
3001 CHECK_STRING (filename
);
3002 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3005 /* Return nonzero if file FILENAME exists and can be executed. */
3008 check_executable (filename
)
3012 int len
= strlen (filename
);
3015 if (stat (filename
, &st
) < 0)
3017 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3018 return ((st
.st_mode
& S_IEXEC
) != 0);
3020 return (S_ISREG (st
.st_mode
)
3022 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3023 || stricmp (suffix
, ".exe") == 0
3024 || stricmp (suffix
, ".bat") == 0)
3025 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3026 #endif /* not WINDOWSNT */
3027 #else /* not DOS_NT */
3028 #ifdef HAVE_EUIDACCESS
3029 return (euidaccess (filename
, 1) >= 0);
3031 /* Access isn't quite right because it uses the real uid
3032 and we really want to test with the effective uid.
3033 But Unix doesn't give us a right way to do it. */
3034 return (access (filename
, 1) >= 0);
3036 #endif /* not DOS_NT */
3039 /* Return nonzero if file FILENAME exists and can be written. */
3042 check_writable (filename
)
3047 if (stat (filename
, &st
) < 0)
3049 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3050 #else /* not MSDOS */
3051 #ifdef HAVE_EUIDACCESS
3052 return (euidaccess (filename
, 2) >= 0);
3054 /* Access isn't quite right because it uses the real uid
3055 and we really want to test with the effective uid.
3056 But Unix doesn't give us a right way to do it.
3057 Opening with O_WRONLY could work for an ordinary file,
3058 but would lose for directories. */
3059 return (access (filename
, 2) >= 0);
3061 #endif /* not MSDOS */
3064 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3065 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3066 See also `file-readable-p' and `file-attributes'. */)
3068 Lisp_Object filename
;
3070 Lisp_Object absname
;
3071 Lisp_Object handler
;
3072 struct stat statbuf
;
3074 CHECK_STRING (filename
);
3075 absname
= Fexpand_file_name (filename
, Qnil
);
3077 /* If the file name has special constructs in it,
3078 call the corresponding file handler. */
3079 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3080 if (!NILP (handler
))
3081 return call2 (handler
, Qfile_exists_p
, absname
);
3083 absname
= ENCODE_FILE (absname
);
3085 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3088 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3089 doc
: /* Return t if FILENAME can be executed by you.
3090 For a directory, this means you can access files in that directory. */)
3092 Lisp_Object filename
;
3094 Lisp_Object absname
;
3095 Lisp_Object handler
;
3097 CHECK_STRING (filename
);
3098 absname
= Fexpand_file_name (filename
, Qnil
);
3100 /* If the file name has special constructs in it,
3101 call the corresponding file handler. */
3102 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3103 if (!NILP (handler
))
3104 return call2 (handler
, Qfile_executable_p
, absname
);
3106 absname
= ENCODE_FILE (absname
);
3108 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3111 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3112 doc
: /* Return t if file FILENAME exists and you can read it.
3113 See also `file-exists-p' and `file-attributes'. */)
3115 Lisp_Object filename
;
3117 Lisp_Object absname
;
3118 Lisp_Object handler
;
3121 struct stat statbuf
;
3123 CHECK_STRING (filename
);
3124 absname
= Fexpand_file_name (filename
, Qnil
);
3126 /* If the file name has special constructs in it,
3127 call the corresponding file handler. */
3128 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3129 if (!NILP (handler
))
3130 return call2 (handler
, Qfile_readable_p
, absname
);
3132 absname
= ENCODE_FILE (absname
);
3134 #if defined(DOS_NT) || defined(macintosh)
3135 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3137 if (access (SDATA (absname
), 0) == 0)
3140 #else /* not DOS_NT and not macintosh */
3142 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3143 /* Opening a fifo without O_NONBLOCK can wait.
3144 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3145 except in the case of a fifo, on a system which handles it. */
3146 desc
= stat (SDATA (absname
), &statbuf
);
3149 if (S_ISFIFO (statbuf
.st_mode
))
3150 flags
|= O_NONBLOCK
;
3152 desc
= emacs_open (SDATA (absname
), flags
, 0);
3157 #endif /* not DOS_NT and not macintosh */
3160 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3162 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3163 doc
: /* Return t if file FILENAME can be written or created by you. */)
3165 Lisp_Object filename
;
3167 Lisp_Object absname
, dir
, encoded
;
3168 Lisp_Object handler
;
3169 struct stat statbuf
;
3171 CHECK_STRING (filename
);
3172 absname
= Fexpand_file_name (filename
, Qnil
);
3174 /* If the file name has special constructs in it,
3175 call the corresponding file handler. */
3176 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3177 if (!NILP (handler
))
3178 return call2 (handler
, Qfile_writable_p
, absname
);
3180 encoded
= ENCODE_FILE (absname
);
3181 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3182 return (check_writable (SDATA (encoded
))
3185 dir
= Ffile_name_directory (absname
);
3188 dir
= Fdirectory_file_name (dir
);
3192 dir
= Fdirectory_file_name (dir
);
3195 dir
= ENCODE_FILE (dir
);
3197 /* The read-only attribute of the parent directory doesn't affect
3198 whether a file or directory can be created within it. Some day we
3199 should check ACLs though, which do affect this. */
3200 if (stat (SDATA (dir
), &statbuf
) < 0)
3202 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3204 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3209 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3210 doc
: /* Access file FILENAME, and get an error if that does not work.
3211 The second argument STRING is used in the error message.
3212 If there is no error, we return nil. */)
3214 Lisp_Object filename
, string
;
3216 Lisp_Object handler
, encoded_filename
, absname
;
3219 CHECK_STRING (filename
);
3220 absname
= Fexpand_file_name (filename
, Qnil
);
3222 CHECK_STRING (string
);
3224 /* If the file name has special constructs in it,
3225 call the corresponding file handler. */
3226 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3227 if (!NILP (handler
))
3228 return call3 (handler
, Qaccess_file
, absname
, string
);
3230 encoded_filename
= ENCODE_FILE (absname
);
3232 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3234 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3240 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3241 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3242 The value is the link target, as a string.
3243 Otherwise returns nil. */)
3245 Lisp_Object filename
;
3247 Lisp_Object handler
;
3249 CHECK_STRING (filename
);
3250 filename
= Fexpand_file_name (filename
, Qnil
);
3252 /* If the file name has special constructs in it,
3253 call the corresponding file handler. */
3254 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3255 if (!NILP (handler
))
3256 return call2 (handler
, Qfile_symlink_p
, filename
);
3265 filename
= ENCODE_FILE (filename
);
3272 buf
= (char *) xrealloc (buf
, bufsize
);
3273 bzero (buf
, bufsize
);
3276 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3280 /* HP-UX reports ERANGE if buffer is too small. */
3281 if (errno
== ERANGE
)
3291 while (valsize
>= bufsize
);
3293 val
= make_string (buf
, valsize
);
3294 if (buf
[0] == '/' && index (buf
, ':'))
3295 val
= concat2 (build_string ("/:"), val
);
3297 val
= DECODE_FILE (val
);
3300 #else /* not S_IFLNK */
3302 #endif /* not S_IFLNK */
3305 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3306 doc
: /* Return t if FILENAME names an existing directory.
3307 Symbolic links to directories count as directories.
3308 See `file-symlink-p' to distinguish symlinks. */)
3310 Lisp_Object filename
;
3312 register Lisp_Object absname
;
3314 Lisp_Object handler
;
3316 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3318 /* If the file name has special constructs in it,
3319 call the corresponding file handler. */
3320 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3321 if (!NILP (handler
))
3322 return call2 (handler
, Qfile_directory_p
, absname
);
3324 absname
= ENCODE_FILE (absname
);
3326 if (stat (SDATA (absname
), &st
) < 0)
3328 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3331 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3332 doc
: /* Return t if file FILENAME names a directory you can open.
3333 For the value to be t, FILENAME must specify the name of a directory as a file,
3334 and the directory must allow you to open files in it. In order to use a
3335 directory as a buffer's current directory, this predicate must return true.
3336 A directory name spec may be given instead; then the value is t
3337 if the directory so specified exists and really is a readable and
3338 searchable directory. */)
3340 Lisp_Object filename
;
3342 Lisp_Object handler
;
3344 struct gcpro gcpro1
;
3346 /* If the file name has special constructs in it,
3347 call the corresponding file handler. */
3348 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3349 if (!NILP (handler
))
3350 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3353 tem
= (NILP (Ffile_directory_p (filename
))
3354 || NILP (Ffile_executable_p (filename
)));
3356 return tem
? Qnil
: Qt
;
3359 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3360 doc
: /* Return t if file FILENAME is the name of a regular file.
3361 This is the sort of file that holds an ordinary stream of data bytes. */)
3363 Lisp_Object filename
;
3365 register Lisp_Object absname
;
3367 Lisp_Object handler
;
3369 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3371 /* If the file name has special constructs in it,
3372 call the corresponding file handler. */
3373 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3374 if (!NILP (handler
))
3375 return call2 (handler
, Qfile_regular_p
, absname
);
3377 absname
= ENCODE_FILE (absname
);
3382 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3384 /* Tell stat to use expensive method to get accurate info. */
3385 Vw32_get_true_file_attributes
= Qt
;
3386 result
= stat (SDATA (absname
), &st
);
3387 Vw32_get_true_file_attributes
= tem
;
3391 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3394 if (stat (SDATA (absname
), &st
) < 0)
3396 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3400 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3401 doc
: /* Return mode bits of file named FILENAME, as an integer.
3402 Return nil, if file does not exist or is not accessible. */)
3404 Lisp_Object filename
;
3406 Lisp_Object absname
;
3408 Lisp_Object handler
;
3410 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3412 /* If the file name has special constructs in it,
3413 call the corresponding file handler. */
3414 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3415 if (!NILP (handler
))
3416 return call2 (handler
, Qfile_modes
, absname
);
3418 absname
= ENCODE_FILE (absname
);
3420 if (stat (SDATA (absname
), &st
) < 0)
3422 #if defined (MSDOS) && __DJGPP__ < 2
3423 if (check_executable (SDATA (absname
)))
3424 st
.st_mode
|= S_IEXEC
;
3425 #endif /* MSDOS && __DJGPP__ < 2 */
3427 return make_number (st
.st_mode
& 07777);
3430 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3431 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3432 Only the 12 low bits of MODE are used. */)
3434 Lisp_Object filename
, mode
;
3436 Lisp_Object absname
, encoded_absname
;
3437 Lisp_Object handler
;
3439 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3440 CHECK_NUMBER (mode
);
3442 /* If the file name has special constructs in it,
3443 call the corresponding file handler. */
3444 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3445 if (!NILP (handler
))
3446 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3448 encoded_absname
= ENCODE_FILE (absname
);
3450 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3451 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3456 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3457 doc
: /* Set the file permission bits for newly created files.
3458 The argument MODE should be an integer; only the low 9 bits are used.
3459 This setting is inherited by subprocesses. */)
3463 CHECK_NUMBER (mode
);
3465 umask ((~ XINT (mode
)) & 0777);
3470 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3471 doc
: /* Return the default file protection for created files.
3472 The value is an integer. */)
3478 realmask
= umask (0);
3481 XSETINT (value
, (~ realmask
) & 0777);
3485 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3487 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3488 doc
: /* Set times of file FILENAME to TIME.
3489 Set both access and modification times.
3490 Return t on success, else nil.
3491 Use the current time if TIME is nil. TIME is in the format of
3494 Lisp_Object filename
, time
;
3496 Lisp_Object absname
, encoded_absname
;
3497 Lisp_Object handler
;
3501 if (! lisp_time_argument (time
, &sec
, &usec
))
3502 error ("Invalid time specification");
3504 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3506 /* If the file name has special constructs in it,
3507 call the corresponding file handler. */
3508 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3509 if (!NILP (handler
))
3510 return call3 (handler
, Qset_file_times
, absname
, time
);
3512 encoded_absname
= ENCODE_FILE (absname
);
3517 EMACS_SET_SECS (t
, sec
);
3518 EMACS_SET_USECS (t
, usec
);
3520 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3525 /* Setting times on a directory always fails. */
3526 if (stat (SDATA (encoded_absname
), &st
) == 0
3527 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3530 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3543 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3544 doc
: /* Tell Unix to finish all pending disk updates. */)
3553 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3554 doc
: /* Return t if file FILE1 is newer than file FILE2.
3555 If FILE1 does not exist, the answer is nil;
3556 otherwise, if FILE2 does not exist, the answer is t. */)
3558 Lisp_Object file1
, file2
;
3560 Lisp_Object absname1
, absname2
;
3563 Lisp_Object handler
;
3564 struct gcpro gcpro1
, gcpro2
;
3566 CHECK_STRING (file1
);
3567 CHECK_STRING (file2
);
3570 GCPRO2 (absname1
, file2
);
3571 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3572 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3575 /* If the file name has special constructs in it,
3576 call the corresponding file handler. */
3577 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3579 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3580 if (!NILP (handler
))
3581 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3583 GCPRO2 (absname1
, absname2
);
3584 absname1
= ENCODE_FILE (absname1
);
3585 absname2
= ENCODE_FILE (absname2
);
3588 if (stat (SDATA (absname1
), &st
) < 0)
3591 mtime1
= st
.st_mtime
;
3593 if (stat (SDATA (absname2
), &st
) < 0)
3596 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3600 Lisp_Object Qfind_buffer_file_type
;
3603 #ifndef READ_BUF_SIZE
3604 #define READ_BUF_SIZE (64 << 10)
3607 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3609 /* This function is called after Lisp functions to decide a coding
3610 system are called, or when they cause an error. Before they are
3611 called, the current buffer is set unibyte and it contains only a
3612 newly inserted text (thus the buffer was empty before the
3615 The functions may set markers, overlays, text properties, or even
3616 alter the buffer contents, change the current buffer.
3618 Here, we reset all those changes by:
3619 o set back the current buffer.
3620 o move all markers and overlays to BEG.
3621 o remove all text properties.
3622 o set back the buffer multibyteness. */
3625 decide_coding_unwind (unwind_data
)
3626 Lisp_Object unwind_data
;
3628 Lisp_Object multibyte
, undo_list
, buffer
;
3630 multibyte
= XCAR (unwind_data
);
3631 unwind_data
= XCDR (unwind_data
);
3632 undo_list
= XCAR (unwind_data
);
3633 buffer
= XCDR (unwind_data
);
3635 if (current_buffer
!= XBUFFER (buffer
))
3636 set_buffer_internal (XBUFFER (buffer
));
3637 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3638 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3639 BUF_INTERVALS (current_buffer
) = 0;
3640 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3642 /* Now we are safe to change the buffer's multibyteness directly. */
3643 current_buffer
->enable_multibyte_characters
= multibyte
;
3644 current_buffer
->undo_list
= undo_list
;
3650 /* Used to pass values from insert-file-contents to read_non_regular. */
3652 static int non_regular_fd
;
3653 static int non_regular_inserted
;
3654 static int non_regular_nbytes
;
3657 /* Read from a non-regular file.
3658 Read non_regular_trytry bytes max from non_regular_fd.
3659 Non_regular_inserted specifies where to put the read bytes.
3660 Value is the number of bytes read. */
3669 nbytes
= emacs_read (non_regular_fd
,
3670 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3671 non_regular_nbytes
);
3673 return make_number (nbytes
);
3677 /* Condition-case handler used when reading from non-regular files
3678 in insert-file-contents. */
3681 read_non_regular_quit ()
3687 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3689 doc
: /* Insert contents of file FILENAME after point.
3690 Returns list of absolute file name and number of characters inserted.
3691 If second argument VISIT is non-nil, the buffer's visited filename
3692 and last save file modtime are set, and it is marked unmodified.
3693 If visiting and the file does not exist, visiting is completed
3694 before the error is signaled.
3695 The optional third and fourth arguments BEG and END
3696 specify what portion of the file to insert.
3697 These arguments count bytes in the file, not characters in the buffer.
3698 If VISIT is non-nil, BEG and END must be nil.
3700 If optional fifth argument REPLACE is non-nil,
3701 it means replace the current buffer contents (in the accessible portion)
3702 with the file contents. This is better than simply deleting and inserting
3703 the whole thing because (1) it preserves some marker positions
3704 and (2) it puts less data in the undo list.
3705 When REPLACE is non-nil, the value is the number of characters actually read,
3706 which is often less than the number of characters to be read.
3708 This does code conversion according to the value of
3709 `coding-system-for-read' or `file-coding-system-alist',
3710 and sets the variable `last-coding-system-used' to the coding system
3712 (filename
, visit
, beg
, end
, replace
)
3713 Lisp_Object filename
, visit
, beg
, end
, replace
;
3718 register int how_much
;
3719 register int unprocessed
;
3720 int count
= SPECPDL_INDEX ();
3721 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3722 Lisp_Object handler
, val
, insval
, orig_filename
;
3725 int not_regular
= 0;
3726 unsigned char read_buf
[READ_BUF_SIZE
];
3727 struct coding_system coding
;
3728 unsigned char buffer
[1 << 14];
3729 int replace_handled
= 0;
3730 int set_coding_system
= 0;
3731 int coding_system_decided
= 0;
3734 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3735 error ("Cannot do file visiting in an indirect buffer");
3737 if (!NILP (current_buffer
->read_only
))
3738 Fbarf_if_buffer_read_only ();
3742 orig_filename
= Qnil
;
3744 GCPRO4 (filename
, val
, p
, orig_filename
);
3746 CHECK_STRING (filename
);
3747 filename
= Fexpand_file_name (filename
, Qnil
);
3749 /* If the file name has special constructs in it,
3750 call the corresponding file handler. */
3751 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3752 if (!NILP (handler
))
3754 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3755 visit
, beg
, end
, replace
);
3756 if (CONSP (val
) && CONSP (XCDR (val
)))
3757 inserted
= XINT (XCAR (XCDR (val
)));
3761 orig_filename
= filename
;
3762 filename
= ENCODE_FILE (filename
);
3768 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3770 /* Tell stat to use expensive method to get accurate info. */
3771 Vw32_get_true_file_attributes
= Qt
;
3772 total
= stat (SDATA (filename
), &st
);
3773 Vw32_get_true_file_attributes
= tem
;
3778 if (stat (SDATA (filename
), &st
) < 0)
3780 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3781 || fstat (fd
, &st
) < 0)
3782 #endif /* not APOLLO */
3783 #endif /* WINDOWSNT */
3785 if (fd
>= 0) emacs_close (fd
);
3788 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3791 if (!NILP (Vcoding_system_for_read
))
3792 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3797 /* This code will need to be changed in order to work on named
3798 pipes, and it's probably just not worth it. So we should at
3799 least signal an error. */
3800 if (!S_ISREG (st
.st_mode
))
3807 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3808 Fsignal (Qfile_error
,
3809 Fcons (build_string ("not a regular file"),
3810 Fcons (orig_filename
, Qnil
)));
3815 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3818 /* Replacement should preserve point as it preserves markers. */
3819 if (!NILP (replace
))
3820 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3822 record_unwind_protect (close_file_unwind
, make_number (fd
));
3824 /* Supposedly happens on VMS. */
3825 /* Can happen on any platform that uses long as type of off_t, but allows
3826 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3827 give a message suitable for the latter case. */
3828 if (! not_regular
&& st
.st_size
< 0)
3829 error ("Maximum buffer size exceeded");
3831 /* Prevent redisplay optimizations. */
3832 current_buffer
->clip_changed
= 1;
3836 if (!NILP (beg
) || !NILP (end
))
3837 error ("Attempt to visit less than an entire file");
3838 if (BEG
< Z
&& NILP (replace
))
3839 error ("Cannot do file visiting in a non-empty buffer");
3845 XSETFASTINT (beg
, 0);
3853 XSETINT (end
, st
.st_size
);
3855 /* Arithmetic overflow can occur if an Emacs integer cannot
3856 represent the file size, or if the calculations below
3857 overflow. The calculations below double the file size
3858 twice, so check that it can be multiplied by 4 safely. */
3859 if (XINT (end
) != st
.st_size
3860 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3861 error ("Maximum buffer size exceeded");
3863 /* The file size returned from stat may be zero, but data
3864 may be readable nonetheless, for example when this is a
3865 file in the /proc filesystem. */
3866 if (st
.st_size
== 0)
3867 XSETINT (end
, READ_BUF_SIZE
);
3871 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3873 /* We use emacs-mule for auto saving... */
3874 setup_coding_system (Qemacs_mule
, &coding
);
3875 /* ... but with the special flag to indicate to read in a
3876 multibyte sequence for eight-bit-control char as is. */
3878 coding
.src_multibyte
= 0;
3879 coding
.dst_multibyte
3880 = !NILP (current_buffer
->enable_multibyte_characters
);
3881 coding
.eol_type
= CODING_EOL_LF
;
3882 coding_system_decided
= 1;
3886 /* Decide the coding system to use for reading the file now
3887 because we can't use an optimized method for handling
3888 `coding:' tag if the current buffer is not empty. */
3892 if (!NILP (Vcoding_system_for_read
))
3893 val
= Vcoding_system_for_read
;
3896 /* Don't try looking inside a file for a coding system
3897 specification if it is not seekable. */
3898 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3900 /* Find a coding system specified in the heading two
3901 lines or in the tailing several lines of the file.
3902 We assume that the 1K-byte and 3K-byte for heading
3903 and tailing respectively are sufficient for this
3907 if (st
.st_size
<= (1024 * 4))
3908 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3911 nread
= emacs_read (fd
, read_buf
, 1024);
3914 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3915 report_file_error ("Setting file position",
3916 Fcons (orig_filename
, Qnil
));
3917 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3922 error ("IO error reading %s: %s",
3923 SDATA (orig_filename
), emacs_strerror (errno
));
3926 struct buffer
*prev
= current_buffer
;
3930 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3932 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3933 buf
= XBUFFER (buffer
);
3935 delete_all_overlays (buf
);
3936 buf
->directory
= current_buffer
->directory
;
3937 buf
->read_only
= Qnil
;
3938 buf
->filename
= Qnil
;
3939 buf
->undo_list
= Qt
;
3940 eassert (buf
->overlays_before
== NULL
);
3941 eassert (buf
->overlays_after
== NULL
);
3943 set_buffer_internal (buf
);
3945 buf
->enable_multibyte_characters
= Qnil
;
3947 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3948 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3949 val
= call2 (Vset_auto_coding_function
,
3950 filename
, make_number (nread
));
3951 set_buffer_internal (prev
);
3953 /* Discard the unwind protect for recovering the
3957 /* Rewind the file for the actual read done later. */
3958 if (lseek (fd
, 0, 0) < 0)
3959 report_file_error ("Setting file position",
3960 Fcons (orig_filename
, Qnil
));
3966 /* If we have not yet decided a coding system, check
3967 file-coding-system-alist. */
3968 Lisp_Object args
[6], coding_systems
;
3970 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3971 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3972 coding_systems
= Ffind_operation_coding_system (6, args
);
3973 if (CONSP (coding_systems
))
3974 val
= XCAR (coding_systems
);
3978 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3979 /* Ensure we set Vlast_coding_system_used. */
3980 set_coding_system
= 1;
3982 if (NILP (current_buffer
->enable_multibyte_characters
)
3984 /* We must suppress all character code conversion except for
3985 end-of-line conversion. */
3986 setup_raw_text_coding_system (&coding
);
3988 coding
.src_multibyte
= 0;
3989 coding
.dst_multibyte
3990 = !NILP (current_buffer
->enable_multibyte_characters
);
3991 coding_system_decided
= 1;
3994 /* If requested, replace the accessible part of the buffer
3995 with the file contents. Avoid replacing text at the
3996 beginning or end of the buffer that matches the file contents;
3997 that preserves markers pointing to the unchanged parts.
3999 Here we implement this feature in an optimized way
4000 for the case where code conversion is NOT needed.
4001 The following if-statement handles the case of conversion
4002 in a less optimal way.
4004 If the code conversion is "automatic" then we try using this
4005 method and hope for the best.
4006 But if we discover the need for conversion, we give up on this method
4007 and let the following if-statement handle the replace job. */
4010 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4012 /* same_at_start and same_at_end count bytes,
4013 because file access counts bytes
4014 and BEG and END count bytes. */
4015 int same_at_start
= BEGV_BYTE
;
4016 int same_at_end
= ZV_BYTE
;
4018 /* There is still a possibility we will find the need to do code
4019 conversion. If that happens, we set this variable to 1 to
4020 give up on handling REPLACE in the optimized way. */
4021 int giveup_match_end
= 0;
4023 if (XINT (beg
) != 0)
4025 if (lseek (fd
, XINT (beg
), 0) < 0)
4026 report_file_error ("Setting file position",
4027 Fcons (orig_filename
, Qnil
));
4032 /* Count how many chars at the start of the file
4033 match the text at the beginning of the buffer. */
4038 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4040 error ("IO error reading %s: %s",
4041 SDATA (orig_filename
), emacs_strerror (errno
));
4042 else if (nread
== 0)
4045 if (coding
.type
== coding_type_undecided
)
4046 detect_coding (&coding
, buffer
, nread
);
4047 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4048 /* We found that the file should be decoded somehow.
4049 Let's give up here. */
4051 giveup_match_end
= 1;
4055 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4056 detect_eol (&coding
, buffer
, nread
);
4057 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4058 && coding
.eol_type
!= CODING_EOL_LF
)
4059 /* We found that the format of eol should be decoded.
4060 Let's give up here. */
4062 giveup_match_end
= 1;
4067 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4068 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4069 same_at_start
++, bufpos
++;
4070 /* If we found a discrepancy, stop the scan.
4071 Otherwise loop around and scan the next bufferful. */
4072 if (bufpos
!= nread
)
4076 /* If the file matches the buffer completely,
4077 there's no need to replace anything. */
4078 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4082 /* Truncate the buffer to the size of the file. */
4083 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4088 /* Count how many chars at the end of the file
4089 match the text at the end of the buffer. But, if we have
4090 already found that decoding is necessary, don't waste time. */
4091 while (!giveup_match_end
)
4093 int total_read
, nread
, bufpos
, curpos
, trial
;
4095 /* At what file position are we now scanning? */
4096 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4097 /* If the entire file matches the buffer tail, stop the scan. */
4100 /* How much can we scan in the next step? */
4101 trial
= min (curpos
, sizeof buffer
);
4102 if (lseek (fd
, curpos
- trial
, 0) < 0)
4103 report_file_error ("Setting file position",
4104 Fcons (orig_filename
, Qnil
));
4106 total_read
= nread
= 0;
4107 while (total_read
< trial
)
4109 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4111 error ("IO error reading %s: %s",
4112 SDATA (orig_filename
), emacs_strerror (errno
));
4113 else if (nread
== 0)
4115 total_read
+= nread
;
4118 /* Scan this bufferful from the end, comparing with
4119 the Emacs buffer. */
4120 bufpos
= total_read
;
4122 /* Compare with same_at_start to avoid counting some buffer text
4123 as matching both at the file's beginning and at the end. */
4124 while (bufpos
> 0 && same_at_end
> same_at_start
4125 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4126 same_at_end
--, bufpos
--;
4128 /* If we found a discrepancy, stop the scan.
4129 Otherwise loop around and scan the preceding bufferful. */
4132 /* If this discrepancy is because of code conversion,
4133 we cannot use this method; giveup and try the other. */
4134 if (same_at_end
> same_at_start
4135 && FETCH_BYTE (same_at_end
- 1) >= 0200
4136 && ! NILP (current_buffer
->enable_multibyte_characters
)
4137 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4138 giveup_match_end
= 1;
4147 if (! giveup_match_end
)
4151 /* We win! We can handle REPLACE the optimized way. */
4153 /* Extend the start of non-matching text area to multibyte
4154 character boundary. */
4155 if (! NILP (current_buffer
->enable_multibyte_characters
))
4156 while (same_at_start
> BEGV_BYTE
4157 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4160 /* Extend the end of non-matching text area to multibyte
4161 character boundary. */
4162 if (! NILP (current_buffer
->enable_multibyte_characters
))
4163 while (same_at_end
< ZV_BYTE
4164 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4167 /* Don't try to reuse the same piece of text twice. */
4168 overlap
= (same_at_start
- BEGV_BYTE
4169 - (same_at_end
+ st
.st_size
- ZV
));
4171 same_at_end
+= overlap
;
4173 /* Arrange to read only the nonmatching middle part of the file. */
4174 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4175 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4177 del_range_byte (same_at_start
, same_at_end
, 0);
4178 /* Insert from the file at the proper position. */
4179 temp
= BYTE_TO_CHAR (same_at_start
);
4180 SET_PT_BOTH (temp
, same_at_start
);
4182 /* If display currently starts at beginning of line,
4183 keep it that way. */
4184 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4185 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4187 replace_handled
= 1;
4191 /* If requested, replace the accessible part of the buffer
4192 with the file contents. Avoid replacing text at the
4193 beginning or end of the buffer that matches the file contents;
4194 that preserves markers pointing to the unchanged parts.
4196 Here we implement this feature for the case where code conversion
4197 is needed, in a simple way that needs a lot of memory.
4198 The preceding if-statement handles the case of no conversion
4199 in a more optimized way. */
4200 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4202 int same_at_start
= BEGV_BYTE
;
4203 int same_at_end
= ZV_BYTE
;
4206 /* Make sure that the gap is large enough. */
4207 int bufsize
= 2 * st
.st_size
;
4208 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4211 /* First read the whole file, performing code conversion into
4212 CONVERSION_BUFFER. */
4214 if (lseek (fd
, XINT (beg
), 0) < 0)
4216 xfree (conversion_buffer
);
4217 report_file_error ("Setting file position",
4218 Fcons (orig_filename
, Qnil
));
4221 total
= st
.st_size
; /* Total bytes in the file. */
4222 how_much
= 0; /* Bytes read from file so far. */
4223 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4224 unprocessed
= 0; /* Bytes not processed in previous loop. */
4226 while (how_much
< total
)
4228 /* try is reserved in some compilers (Microsoft C) */
4229 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4230 unsigned char *destination
= read_buf
+ unprocessed
;
4233 /* Allow quitting out of the actual I/O. */
4236 this = emacs_read (fd
, destination
, trytry
);
4239 if (this < 0 || this + unprocessed
== 0)
4247 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4249 int require
, result
;
4251 this += unprocessed
;
4253 /* If we are using more space than estimated,
4254 make CONVERSION_BUFFER bigger. */
4255 require
= decoding_buffer_size (&coding
, this);
4256 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4258 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4259 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4262 /* Convert this batch with results in CONVERSION_BUFFER. */
4263 if (how_much
>= total
) /* This is the last block. */
4264 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4265 if (coding
.composing
!= COMPOSITION_DISABLED
)
4266 coding_allocate_composition_data (&coding
, BEGV
);
4267 result
= decode_coding (&coding
, read_buf
,
4268 conversion_buffer
+ inserted
,
4269 this, bufsize
- inserted
);
4271 /* Save for next iteration whatever we didn't convert. */
4272 unprocessed
= this - coding
.consumed
;
4273 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4274 if (!NILP (current_buffer
->enable_multibyte_characters
))
4275 this = coding
.produced
;
4277 this = str_as_unibyte (conversion_buffer
+ inserted
,
4284 /* At this point, INSERTED is how many characters (i.e. bytes)
4285 are present in CONVERSION_BUFFER.
4286 HOW_MUCH should equal TOTAL,
4287 or should be <= 0 if we couldn't read the file. */
4291 xfree (conversion_buffer
);
4292 coding_free_composition_data (&coding
);
4294 error ("IO error reading %s: %s",
4295 SDATA (orig_filename
), emacs_strerror (errno
));
4296 else if (how_much
== -2)
4297 error ("maximum buffer size exceeded");
4300 /* Compare the beginning of the converted file
4301 with the buffer text. */
4304 while (bufpos
< inserted
&& same_at_start
< same_at_end
4305 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4306 same_at_start
++, bufpos
++;
4308 /* If the file matches the buffer completely,
4309 there's no need to replace anything. */
4311 if (bufpos
== inserted
)
4313 xfree (conversion_buffer
);
4314 coding_free_composition_data (&coding
);
4317 /* Truncate the buffer to the size of the file. */
4318 del_range_byte (same_at_start
, same_at_end
, 0);
4323 /* Extend the start of non-matching text area to multibyte
4324 character boundary. */
4325 if (! NILP (current_buffer
->enable_multibyte_characters
))
4326 while (same_at_start
> BEGV_BYTE
4327 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4330 /* Scan this bufferful from the end, comparing with
4331 the Emacs buffer. */
4334 /* Compare with same_at_start to avoid counting some buffer text
4335 as matching both at the file's beginning and at the end. */
4336 while (bufpos
> 0 && same_at_end
> same_at_start
4337 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4338 same_at_end
--, bufpos
--;
4340 /* Extend the end of non-matching text area to multibyte
4341 character boundary. */
4342 if (! NILP (current_buffer
->enable_multibyte_characters
))
4343 while (same_at_end
< ZV_BYTE
4344 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4347 /* Don't try to reuse the same piece of text twice. */
4348 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4350 same_at_end
+= overlap
;
4352 /* If display currently starts at beginning of line,
4353 keep it that way. */
4354 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4355 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4357 /* Replace the chars that we need to replace,
4358 and update INSERTED to equal the number of bytes
4359 we are taking from the file. */
4360 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4362 if (same_at_end
!= same_at_start
)
4364 del_range_byte (same_at_start
, same_at_end
, 0);
4366 same_at_start
= GPT_BYTE
;
4370 temp
= BYTE_TO_CHAR (same_at_start
);
4372 /* Insert from the file at the proper position. */
4373 SET_PT_BOTH (temp
, same_at_start
);
4374 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4376 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4377 coding_restore_composition (&coding
, Fcurrent_buffer ());
4378 coding_free_composition_data (&coding
);
4380 /* Set `inserted' to the number of inserted characters. */
4381 inserted
= PT
- temp
;
4383 xfree (conversion_buffer
);
4392 register Lisp_Object temp
;
4394 total
= XINT (end
) - XINT (beg
);
4396 /* Make sure point-max won't overflow after this insertion. */
4397 XSETINT (temp
, total
);
4398 if (total
!= XINT (temp
))
4399 error ("Maximum buffer size exceeded");
4402 /* For a special file, all we can do is guess. */
4403 total
= READ_BUF_SIZE
;
4405 if (NILP (visit
) && total
> 0)
4406 prepare_to_modify_buffer (PT
, PT
, NULL
);
4409 if (GAP_SIZE
< total
)
4410 make_gap (total
- GAP_SIZE
);
4412 if (XINT (beg
) != 0 || !NILP (replace
))
4414 if (lseek (fd
, XINT (beg
), 0) < 0)
4415 report_file_error ("Setting file position",
4416 Fcons (orig_filename
, Qnil
));
4419 /* In the following loop, HOW_MUCH contains the total bytes read so
4420 far for a regular file, and not changed for a special file. But,
4421 before exiting the loop, it is set to a negative value if I/O
4425 /* Total bytes inserted. */
4428 /* Here, we don't do code conversion in the loop. It is done by
4429 code_convert_region after all data are read into the buffer. */
4431 int gap_size
= GAP_SIZE
;
4433 while (how_much
< total
)
4435 /* try is reserved in some compilers (Microsoft C) */
4436 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4443 /* Maybe make more room. */
4444 if (gap_size
< trytry
)
4446 make_gap (total
- gap_size
);
4447 gap_size
= GAP_SIZE
;
4450 /* Read from the file, capturing `quit'. When an
4451 error occurs, end the loop, and arrange for a quit
4452 to be signaled after decoding the text we read. */
4453 non_regular_fd
= fd
;
4454 non_regular_inserted
= inserted
;
4455 non_regular_nbytes
= trytry
;
4456 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4457 read_non_regular_quit
);
4468 /* Allow quitting out of the actual I/O. We don't make text
4469 part of the buffer until all the reading is done, so a C-g
4470 here doesn't do any harm. */
4473 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4485 /* For a regular file, where TOTAL is the real size,
4486 count HOW_MUCH to compare with it.
4487 For a special file, where TOTAL is just a buffer size,
4488 so don't bother counting in HOW_MUCH.
4489 (INSERTED is where we count the number of characters inserted.) */
4496 /* Make the text read part of the buffer. */
4497 GAP_SIZE
-= inserted
;
4499 GPT_BYTE
+= inserted
;
4501 ZV_BYTE
+= inserted
;
4506 /* Put an anchor to ensure multi-byte form ends at gap. */
4511 /* Discard the unwind protect for closing the file. */
4515 error ("IO error reading %s: %s",
4516 SDATA (orig_filename
), emacs_strerror (errno
));
4520 if (! coding_system_decided
)
4522 /* The coding system is not yet decided. Decide it by an
4523 optimized method for handling `coding:' tag.
4525 Note that we can get here only if the buffer was empty
4526 before the insertion. */
4530 if (!NILP (Vcoding_system_for_read
))
4531 val
= Vcoding_system_for_read
;
4534 /* Since we are sure that the current buffer was empty
4535 before the insertion, we can toggle
4536 enable-multibyte-characters directly here without taking
4537 care of marker adjustment and byte combining problem. By
4538 this way, we can run Lisp program safely before decoding
4539 the inserted text. */
4540 Lisp_Object unwind_data
;
4541 int count
= SPECPDL_INDEX ();
4543 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4544 Fcons (current_buffer
->undo_list
,
4545 Fcurrent_buffer ()));
4546 current_buffer
->enable_multibyte_characters
= Qnil
;
4547 current_buffer
->undo_list
= Qt
;
4548 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4550 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4552 val
= call2 (Vset_auto_coding_function
,
4553 filename
, make_number (inserted
));
4558 /* If the coding system is not yet decided, check
4559 file-coding-system-alist. */
4560 Lisp_Object args
[6], coding_systems
;
4562 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4563 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4564 coding_systems
= Ffind_operation_coding_system (6, args
);
4565 if (CONSP (coding_systems
))
4566 val
= XCAR (coding_systems
);
4568 unbind_to (count
, Qnil
);
4569 inserted
= Z_BYTE
- BEG_BYTE
;
4572 /* The following kludgy code is to avoid some compiler bug.
4574 setup_coding_system (val, &coding);
4577 struct coding_system temp_coding
;
4578 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4579 bcopy (&temp_coding
, &coding
, sizeof coding
);
4581 /* Ensure we set Vlast_coding_system_used. */
4582 set_coding_system
= 1;
4584 if (NILP (current_buffer
->enable_multibyte_characters
)
4586 /* We must suppress all character code conversion except for
4587 end-of-line conversion. */
4588 setup_raw_text_coding_system (&coding
);
4589 coding
.src_multibyte
= 0;
4590 coding
.dst_multibyte
4591 = !NILP (current_buffer
->enable_multibyte_characters
);
4595 /* Can't do this if part of the buffer might be preserved. */
4597 && (coding
.type
== coding_type_no_conversion
4598 || coding
.type
== coding_type_raw_text
))
4600 /* Visiting a file with these coding system makes the buffer
4602 current_buffer
->enable_multibyte_characters
= Qnil
;
4603 coding
.dst_multibyte
= 0;
4606 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4608 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4610 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4612 inserted
= coding
.produced_char
;
4615 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4619 /* Now INSERTED is measured in characters. */
4622 /* Use the conversion type to determine buffer-file-type
4623 (find-buffer-file-type is now used to help determine the
4625 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4626 || coding
.eol_type
== CODING_EOL_LF
)
4627 && ! CODING_REQUIRE_DECODING (&coding
))
4628 current_buffer
->buffer_file_type
= Qt
;
4630 current_buffer
->buffer_file_type
= Qnil
;
4637 if (!EQ (current_buffer
->undo_list
, Qt
))
4638 current_buffer
->undo_list
= Qnil
;
4640 stat (SDATA (filename
), &st
);
4645 current_buffer
->modtime
= st
.st_mtime
;
4646 current_buffer
->filename
= orig_filename
;
4649 SAVE_MODIFF
= MODIFF
;
4650 current_buffer
->auto_save_modified
= MODIFF
;
4651 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4652 #ifdef CLASH_DETECTION
4655 if (!NILP (current_buffer
->file_truename
))
4656 unlock_file (current_buffer
->file_truename
);
4657 unlock_file (filename
);
4659 #endif /* CLASH_DETECTION */
4661 Fsignal (Qfile_error
,
4662 Fcons (build_string ("not a regular file"),
4663 Fcons (orig_filename
, Qnil
)));
4666 if (set_coding_system
)
4667 Vlast_coding_system_used
= coding
.symbol
;
4669 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4671 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4673 if (! NILP (insval
))
4675 CHECK_NUMBER (insval
);
4676 inserted
= XFASTINT (insval
);
4680 /* Decode file format */
4683 int empty_undo_list_p
= 0;
4685 /* If we're anyway going to discard undo information, don't
4686 record it in the first place. The buffer's undo list at this
4687 point is either nil or t when visiting a file. */
4690 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4691 current_buffer
->undo_list
= Qt
;
4694 insval
= call3 (Qformat_decode
,
4695 Qnil
, make_number (inserted
), visit
);
4696 CHECK_NUMBER (insval
);
4697 inserted
= XFASTINT (insval
);
4700 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4703 /* Call after-change hooks for the inserted text, aside from the case
4704 of normal visiting (not with REPLACE), which is done in a new buffer
4705 "before" the buffer is changed. */
4706 if (inserted
> 0 && total
> 0
4707 && (NILP (visit
) || !NILP (replace
)))
4709 signal_after_change (PT
, 0, inserted
);
4710 update_compositions (PT
, PT
, CHECK_BORDER
);
4713 p
= Vafter_insert_file_functions
;
4716 insval
= call1 (XCAR (p
), make_number (inserted
));
4719 CHECK_NUMBER (insval
);
4720 inserted
= XFASTINT (insval
);
4727 && current_buffer
->modtime
== -1)
4729 /* If visiting nonexistent file, return nil. */
4730 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4734 Fsignal (Qquit
, Qnil
);
4736 /* ??? Retval needs to be dealt with in all cases consistently. */
4738 val
= Fcons (orig_filename
,
4739 Fcons (make_number (inserted
),
4742 RETURN_UNGCPRO (unbind_to (count
, val
));
4745 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4746 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4747 Lisp_Object
, Lisp_Object
));
4749 /* If build_annotations switched buffers, switch back to BUF.
4750 Kill the temporary buffer that was selected in the meantime.
4752 Since this kill only the last temporary buffer, some buffers remain
4753 not killed if build_annotations switched buffers more than once.
4757 build_annotations_unwind (buf
)
4762 if (XBUFFER (buf
) == current_buffer
)
4764 tembuf
= Fcurrent_buffer ();
4766 Fkill_buffer (tembuf
);
4770 /* Decide the coding-system to encode the data with. */
4773 choose_write_coding_system (start
, end
, filename
,
4774 append
, visit
, lockname
, coding
)
4775 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4776 struct coding_system
*coding
;
4781 && NILP (Fstring_equal (current_buffer
->filename
,
4782 current_buffer
->auto_save_file_name
)))
4784 /* We use emacs-mule for auto saving... */
4785 setup_coding_system (Qemacs_mule
, coding
);
4786 /* ... but with the special flag to indicate not to strip off
4787 leading code of eight-bit-control chars. */
4789 goto done_setup_coding
;
4791 else if (!NILP (Vcoding_system_for_write
))
4793 val
= Vcoding_system_for_write
;
4794 if (coding_system_require_warning
4795 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4796 /* Confirm that VAL can surely encode the current region. */
4797 val
= call5 (Vselect_safe_coding_system_function
,
4798 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4803 /* If the variable `buffer-file-coding-system' is set locally,
4804 it means that the file was read with some kind of code
4805 conversion or the variable is explicitly set by users. We
4806 had better write it out with the same coding system even if
4807 `enable-multibyte-characters' is nil.
4809 If it is not set locally, we anyway have to convert EOL
4810 format if the default value of `buffer-file-coding-system'
4811 tells that it is not Unix-like (LF only) format. */
4812 int using_default_coding
= 0;
4813 int force_raw_text
= 0;
4815 val
= current_buffer
->buffer_file_coding_system
;
4817 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4820 if (NILP (current_buffer
->enable_multibyte_characters
))
4826 /* Check file-coding-system-alist. */
4827 Lisp_Object args
[7], coding_systems
;
4829 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4830 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4832 coding_systems
= Ffind_operation_coding_system (7, args
);
4833 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4834 val
= XCDR (coding_systems
);
4838 && !NILP (current_buffer
->buffer_file_coding_system
))
4840 /* If we still have not decided a coding system, use the
4841 default value of buffer-file-coding-system. */
4842 val
= current_buffer
->buffer_file_coding_system
;
4843 using_default_coding
= 1;
4847 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4848 /* Confirm that VAL can surely encode the current region. */
4849 val
= call5 (Vselect_safe_coding_system_function
,
4850 start
, end
, val
, Qnil
, filename
);
4852 setup_coding_system (Fcheck_coding_system (val
), coding
);
4853 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4854 && !using_default_coding
)
4856 if (! EQ (default_buffer_file_coding
.symbol
,
4857 buffer_defaults
.buffer_file_coding_system
))
4858 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4859 &default_buffer_file_coding
);
4860 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4862 Lisp_Object subsidiaries
;
4864 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4865 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4866 if (VECTORP (subsidiaries
)
4867 && XVECTOR (subsidiaries
)->size
== 3)
4869 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4874 setup_raw_text_coding_system (coding
);
4875 goto done_setup_coding
;
4878 setup_coding_system (Fcheck_coding_system (val
), coding
);
4881 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4882 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4885 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4886 "r\nFWrite region to file: \ni\ni\ni\np",
4887 doc
: /* Write current region into specified file.
4888 When called from a program, requires three arguments:
4889 START, END and FILENAME. START and END are normally buffer positions
4890 specifying the part of the buffer to write.
4891 If START is nil, that means to use the entire buffer contents.
4892 If START is a string, then output that string to the file
4893 instead of any buffer contents; END is ignored.
4895 Optional fourth argument APPEND if non-nil means
4896 append to existing file contents (if any). If it is an integer,
4897 seek to that offset in the file before writing.
4898 Optional fifth argument VISIT, if t or a string, means
4899 set the last-save-file-modtime of buffer to this file's modtime
4900 and mark buffer not modified.
4901 If VISIT is a string, it is a second file name;
4902 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4903 VISIT is also the file name to lock and unlock for clash detection.
4904 If VISIT is neither t nor nil nor a string,
4905 that means do not display the \"Wrote file\" message.
4906 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4907 use for locking and unlocking, overriding FILENAME and VISIT.
4908 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4909 for an existing file with the same name. If MUSTBENEW is `excl',
4910 that means to get an error if the file already exists; never overwrite.
4911 If MUSTBENEW is neither nil nor `excl', that means ask for
4912 confirmation before overwriting, but do go ahead and overwrite the file
4913 if the user confirms.
4915 This does code conversion according to the value of
4916 `coding-system-for-write', `buffer-file-coding-system', or
4917 `file-coding-system-alist', and sets the variable
4918 `last-coding-system-used' to the coding system actually used. */)
4919 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4920 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4925 const unsigned char *fn
;
4928 int count
= SPECPDL_INDEX ();
4931 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4933 Lisp_Object handler
;
4934 Lisp_Object visit_file
;
4935 Lisp_Object annotations
;
4936 Lisp_Object encoded_filename
;
4937 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4938 int quietly
= !NILP (visit
);
4939 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4940 struct buffer
*given_buffer
;
4942 int buffer_file_type
= O_BINARY
;
4944 struct coding_system coding
;
4946 if (current_buffer
->base_buffer
&& visiting
)
4947 error ("Cannot do file visiting in an indirect buffer");
4949 if (!NILP (start
) && !STRINGP (start
))
4950 validate_region (&start
, &end
);
4952 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4954 filename
= Fexpand_file_name (filename
, Qnil
);
4956 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4957 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4959 if (STRINGP (visit
))
4960 visit_file
= Fexpand_file_name (visit
, Qnil
);
4962 visit_file
= filename
;
4964 if (NILP (lockname
))
4965 lockname
= visit_file
;
4969 /* If the file name has special constructs in it,
4970 call the corresponding file handler. */
4971 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4972 /* If FILENAME has no handler, see if VISIT has one. */
4973 if (NILP (handler
) && STRINGP (visit
))
4974 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4976 if (!NILP (handler
))
4979 val
= call6 (handler
, Qwrite_region
, start
, end
,
4980 filename
, append
, visit
);
4984 SAVE_MODIFF
= MODIFF
;
4985 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4986 current_buffer
->filename
= visit_file
;
4992 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4994 /* Special kludge to simplify auto-saving. */
4997 XSETFASTINT (start
, BEG
);
4998 XSETFASTINT (end
, Z
);
5002 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5003 count1
= SPECPDL_INDEX ();
5005 given_buffer
= current_buffer
;
5007 if (!STRINGP (start
))
5009 annotations
= build_annotations (start
, end
);
5011 if (current_buffer
!= given_buffer
)
5013 XSETFASTINT (start
, BEGV
);
5014 XSETFASTINT (end
, ZV
);
5020 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5022 /* Decide the coding-system to encode the data with.
5023 We used to make this choice before calling build_annotations, but that
5024 leads to problems when a write-annotate-function takes care of
5025 unsavable chars (as was the case with X-Symbol). */
5026 choose_write_coding_system (start
, end
, filename
,
5027 append
, visit
, lockname
, &coding
);
5028 Vlast_coding_system_used
= coding
.symbol
;
5030 given_buffer
= current_buffer
;
5031 if (! STRINGP (start
))
5033 annotations
= build_annotations_2 (start
, end
,
5034 coding
.pre_write_conversion
, annotations
);
5035 if (current_buffer
!= given_buffer
)
5037 XSETFASTINT (start
, BEGV
);
5038 XSETFASTINT (end
, ZV
);
5042 #ifdef CLASH_DETECTION
5045 #if 0 /* This causes trouble for GNUS. */
5046 /* If we've locked this file for some other buffer,
5047 query before proceeding. */
5048 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5049 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5052 lock_file (lockname
);
5054 #endif /* CLASH_DETECTION */
5056 encoded_filename
= ENCODE_FILE (filename
);
5058 fn
= SDATA (encoded_filename
);
5062 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5063 #else /* not DOS_NT */
5064 desc
= emacs_open (fn
, O_WRONLY
, 0);
5065 #endif /* not DOS_NT */
5067 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5069 if (auto_saving
) /* Overwrite any previous version of autosave file */
5071 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5072 desc
= emacs_open (fn
, O_RDWR
, 0);
5074 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5075 ? SDATA (current_buffer
->filename
) : 0,
5078 else /* Write to temporary name and rename if no errors */
5080 Lisp_Object temp_name
;
5081 temp_name
= Ffile_name_directory (filename
);
5083 if (!NILP (temp_name
))
5085 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5086 build_string ("$$SAVE$$")));
5087 fname
= SDATA (filename
);
5088 fn
= SDATA (temp_name
);
5089 desc
= creat_copy_attrs (fname
, fn
);
5092 /* If we can't open the temporary file, try creating a new
5093 version of the original file. VMS "creat" creates a
5094 new version rather than truncating an existing file. */
5097 desc
= creat (fn
, 0666);
5098 #if 0 /* This can clobber an existing file and fail to replace it,
5099 if the user runs out of space. */
5102 /* We can't make a new version;
5103 try to truncate and rewrite existing version if any. */
5105 desc
= emacs_open (fn
, O_RDWR
, 0);
5111 desc
= creat (fn
, 0666);
5115 desc
= emacs_open (fn
,
5116 O_WRONLY
| O_CREAT
| buffer_file_type
5117 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5118 S_IREAD
| S_IWRITE
);
5119 #else /* not DOS_NT */
5120 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5121 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5122 auto_saving
? auto_save_mode_bits
: 0666);
5123 #endif /* not DOS_NT */
5124 #endif /* not VMS */
5128 #ifdef CLASH_DETECTION
5130 if (!auto_saving
) unlock_file (lockname
);
5132 #endif /* CLASH_DETECTION */
5134 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5137 record_unwind_protect (close_file_unwind
, make_number (desc
));
5139 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5143 if (NUMBERP (append
))
5144 ret
= lseek (desc
, XINT (append
), 1);
5146 ret
= lseek (desc
, 0, 2);
5149 #ifdef CLASH_DETECTION
5150 if (!auto_saving
) unlock_file (lockname
);
5151 #endif /* CLASH_DETECTION */
5153 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5161 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5162 * if we do writes that don't end with a carriage return. Furthermore
5163 * it cannot handle writes of more then 16K. The modified
5164 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5165 * this EXCEPT for the last record (iff it doesn't end with a carriage
5166 * return). This implies that if your buffer doesn't end with a carriage
5167 * return, you get one free... tough. However it also means that if
5168 * we make two calls to sys_write (a la the following code) you can
5169 * get one at the gap as well. The easiest way to fix this (honest)
5170 * is to move the gap to the next newline (or the end of the buffer).
5175 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5176 move_gap (find_next_newline (GPT
, 1));
5178 /* Whether VMS or not, we must move the gap to the next of newline
5179 when we must put designation sequences at beginning of line. */
5180 if (INTEGERP (start
)
5181 && coding
.type
== coding_type_iso2022
5182 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5183 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5185 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5186 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5187 move_gap_both (PT
, PT_BYTE
);
5188 SET_PT_BOTH (opoint
, opoint_byte
);
5195 if (STRINGP (start
))
5197 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5198 &annotations
, &coding
);
5201 else if (XINT (start
) != XINT (end
))
5203 tem
= CHAR_TO_BYTE (XINT (start
));
5205 if (XINT (start
) < GPT
)
5207 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5208 min (GPT
, XINT (end
)) - XINT (start
),
5209 &annotations
, &coding
);
5213 if (XINT (end
) > GPT
&& !failure
)
5215 tem
= max (XINT (start
), GPT
);
5216 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5217 &annotations
, &coding
);
5223 /* If file was empty, still need to write the annotations */
5224 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5225 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5229 if (CODING_REQUIRE_FLUSHING (&coding
)
5230 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5233 /* We have to flush out a data. */
5234 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5235 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5242 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5243 Disk full in NFS may be reported here. */
5244 /* mib says that closing the file will try to write as fast as NFS can do
5245 it, and that means the fsync here is not crucial for autosave files. */
5246 if (!auto_saving
&& fsync (desc
) < 0)
5248 /* If fsync fails with EINTR, don't treat that as serious. */
5250 failure
= 1, save_errno
= errno
;
5254 /* Spurious "file has changed on disk" warnings have been
5255 observed on Suns as well.
5256 It seems that `close' can change the modtime, under nfs.
5258 (This has supposedly been fixed in Sunos 4,
5259 but who knows about all the other machines with NFS?) */
5262 /* On VMS and APOLLO, must do the stat after the close
5263 since closing changes the modtime. */
5266 /* Recall that #if defined does not work on VMS. */
5273 /* NFS can report a write failure now. */
5274 if (emacs_close (desc
) < 0)
5275 failure
= 1, save_errno
= errno
;
5278 /* If we wrote to a temporary name and had no errors, rename to real name. */
5282 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5290 /* Discard the unwind protect for close_file_unwind. */
5291 specpdl_ptr
= specpdl
+ count1
;
5292 /* Restore the original current buffer. */
5293 visit_file
= unbind_to (count
, visit_file
);
5295 #ifdef CLASH_DETECTION
5297 unlock_file (lockname
);
5298 #endif /* CLASH_DETECTION */
5300 /* Do this before reporting IO error
5301 to avoid a "file has changed on disk" warning on
5302 next attempt to save. */
5304 current_buffer
->modtime
= st
.st_mtime
;
5307 error ("IO error writing %s: %s", SDATA (filename
),
5308 emacs_strerror (save_errno
));
5312 SAVE_MODIFF
= MODIFF
;
5313 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5314 current_buffer
->filename
= visit_file
;
5315 update_mode_lines
++;
5320 && ! NILP (Fstring_equal (current_buffer
->filename
,
5321 current_buffer
->auto_save_file_name
)))
5322 SAVE_MODIFF
= MODIFF
;
5328 message_with_string ((INTEGERP (append
)
5338 Lisp_Object
merge ();
5340 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5341 doc
: /* Return t if (car A) is numerically less than (car B). */)
5345 return Flss (Fcar (a
), Fcar (b
));
5348 /* Build the complete list of annotations appropriate for writing out
5349 the text between START and END, by calling all the functions in
5350 write-region-annotate-functions and merging the lists they return.
5351 If one of these functions switches to a different buffer, we assume
5352 that buffer contains altered text. Therefore, the caller must
5353 make sure to restore the current buffer in all cases,
5354 as save-excursion would do. */
5357 build_annotations (start
, end
)
5358 Lisp_Object start
, end
;
5360 Lisp_Object annotations
;
5362 struct gcpro gcpro1
, gcpro2
;
5363 Lisp_Object original_buffer
;
5364 int i
, used_global
= 0;
5366 XSETBUFFER (original_buffer
, current_buffer
);
5369 p
= Vwrite_region_annotate_functions
;
5370 GCPRO2 (annotations
, p
);
5373 struct buffer
*given_buffer
= current_buffer
;
5374 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5375 { /* Use the global value of the hook. */
5378 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5380 p
= Fappend (2, arg
);
5383 Vwrite_region_annotations_so_far
= annotations
;
5384 res
= call2 (XCAR (p
), start
, end
);
5385 /* If the function makes a different buffer current,
5386 assume that means this buffer contains altered text to be output.
5387 Reset START and END from the buffer bounds
5388 and discard all previous annotations because they should have
5389 been dealt with by this function. */
5390 if (current_buffer
!= given_buffer
)
5392 XSETFASTINT (start
, BEGV
);
5393 XSETFASTINT (end
, ZV
);
5396 Flength (res
); /* Check basic validity of return value */
5397 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5401 /* Now do the same for annotation functions implied by the file-format */
5402 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5403 p
= current_buffer
->auto_save_file_format
;
5405 p
= current_buffer
->file_format
;
5406 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5408 struct buffer
*given_buffer
= current_buffer
;
5410 Vwrite_region_annotations_so_far
= annotations
;
5412 /* Value is either a list of annotations or nil if the function
5413 has written annotations to a temporary buffer, which is now
5415 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5416 original_buffer
, make_number (i
));
5417 if (current_buffer
!= given_buffer
)
5419 XSETFASTINT (start
, BEGV
);
5420 XSETFASTINT (end
, ZV
);
5425 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5433 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5434 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5436 struct gcpro gcpro1
;
5439 GCPRO1 (annotations
);
5440 /* At last, do the same for the function PRE_WRITE_CONVERSION
5441 implied by the current coding-system. */
5442 if (!NILP (pre_write_conversion
))
5444 struct buffer
*given_buffer
= current_buffer
;
5445 Vwrite_region_annotations_so_far
= annotations
;
5446 res
= call2 (pre_write_conversion
, start
, end
);
5448 annotations
= (current_buffer
!= given_buffer
5450 : merge (annotations
, res
, Qcar_less_than_car
));
5457 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5458 If STRING is nil, POS is the character position in the current buffer.
5459 Intersperse with them the annotations from *ANNOT
5460 which fall within the range of POS to POS + NCHARS,
5461 each at its appropriate position.
5463 We modify *ANNOT by discarding elements as we use them up.
5465 The return value is negative in case of system call failure. */
5468 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5471 register int nchars
;
5474 struct coding_system
*coding
;
5478 int lastpos
= pos
+ nchars
;
5480 while (NILP (*annot
) || CONSP (*annot
))
5482 tem
= Fcar_safe (Fcar (*annot
));
5485 nextpos
= XFASTINT (tem
);
5487 /* If there are no more annotations in this range,
5488 output the rest of the range all at once. */
5489 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5490 return e_write (desc
, string
, pos
, lastpos
, coding
);
5492 /* Output buffer text up to the next annotation's position. */
5495 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5499 /* Output the annotation. */
5500 tem
= Fcdr (Fcar (*annot
));
5503 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5506 *annot
= Fcdr (*annot
);
5511 #ifndef WRITE_BUF_SIZE
5512 #define WRITE_BUF_SIZE (16 * 1024)
5515 /* Write text in the range START and END into descriptor DESC,
5516 encoding them with coding system CODING. If STRING is nil, START
5517 and END are character positions of the current buffer, else they
5518 are indexes to the string STRING. */
5521 e_write (desc
, string
, start
, end
, coding
)
5525 struct coding_system
*coding
;
5527 register char *addr
;
5528 register int nbytes
;
5529 char buf
[WRITE_BUF_SIZE
];
5533 coding
->composing
= COMPOSITION_DISABLED
;
5534 if (coding
->composing
!= COMPOSITION_DISABLED
)
5535 coding_save_composition (coding
, start
, end
, string
);
5537 if (STRINGP (string
))
5539 addr
= SDATA (string
);
5540 nbytes
= SBYTES (string
);
5541 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5543 else if (start
< end
)
5545 /* It is assured that the gap is not in the range START and END-1. */
5546 addr
= CHAR_POS_ADDR (start
);
5547 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5548 coding
->src_multibyte
5549 = !NILP (current_buffer
->enable_multibyte_characters
);
5555 coding
->src_multibyte
= 1;
5558 /* We used to have a code for handling selective display here. But,
5559 now it is handled within encode_coding. */
5564 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5565 if (coding
->produced
> 0)
5567 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5568 if (coding
->produced
)
5574 nbytes
-= coding
->consumed
;
5575 addr
+= coding
->consumed
;
5576 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5579 /* The source text ends by an incomplete multibyte form.
5580 There's no way other than write it out as is. */
5581 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5590 start
+= coding
->consumed_char
;
5591 if (coding
->cmp_data
)
5592 coding_adjust_composition_offset (coding
, start
);
5595 if (coding
->cmp_data
)
5596 coding_free_composition_data (coding
);
5601 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5602 Sverify_visited_file_modtime
, 1, 1, 0,
5603 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5604 This means that the file has not been changed since it was visited or saved.
5605 See Info node `(elisp)Modification Time' for more details. */)
5611 Lisp_Object handler
;
5612 Lisp_Object filename
;
5617 if (!STRINGP (b
->filename
)) return Qt
;
5618 if (b
->modtime
== 0) return Qt
;
5620 /* If the file name has special constructs in it,
5621 call the corresponding file handler. */
5622 handler
= Ffind_file_name_handler (b
->filename
,
5623 Qverify_visited_file_modtime
);
5624 if (!NILP (handler
))
5625 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5627 filename
= ENCODE_FILE (b
->filename
);
5629 if (stat (SDATA (filename
), &st
) < 0)
5631 /* If the file doesn't exist now and didn't exist before,
5632 we say that it isn't modified, provided the error is a tame one. */
5633 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5638 if (st
.st_mtime
== b
->modtime
5639 /* If both are positive, accept them if they are off by one second. */
5640 || (st
.st_mtime
> 0 && b
->modtime
> 0
5641 && (st
.st_mtime
== b
->modtime
+ 1
5642 || st
.st_mtime
== b
->modtime
- 1)))
5647 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5648 Sclear_visited_file_modtime
, 0, 0, 0,
5649 doc
: /* Clear out records of last mod time of visited file.
5650 Next attempt to save will certainly not complain of a discrepancy. */)
5653 current_buffer
->modtime
= 0;
5657 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5658 Svisited_file_modtime
, 0, 0, 0,
5659 doc
: /* Return the current buffer's recorded visited file modification time.
5660 The value is a list of the form (HIGH LOW), like the time values
5661 that `file-attributes' returns. If the current buffer has no recorded
5662 file modification time, this function returns 0.
5663 See Info node `(elisp)Modification Time' for more details. */)
5667 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5669 return list2 (XCAR (tcons
), XCDR (tcons
));
5673 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5674 Sset_visited_file_modtime
, 0, 1, 0,
5675 doc
: /* Update buffer's recorded modification time from the visited file's time.
5676 Useful if the buffer was not read from the file normally
5677 or if the file itself has been changed for some known benign reason.
5678 An argument specifies the modification time value to use
5679 \(instead of that of the visited file), in the form of a list
5680 \(HIGH . LOW) or (HIGH LOW). */)
5682 Lisp_Object time_list
;
5684 if (!NILP (time_list
))
5685 current_buffer
->modtime
= cons_to_long (time_list
);
5688 register Lisp_Object filename
;
5690 Lisp_Object handler
;
5692 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5694 /* If the file name has special constructs in it,
5695 call the corresponding file handler. */
5696 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5697 if (!NILP (handler
))
5698 /* The handler can find the file name the same way we did. */
5699 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5701 filename
= ENCODE_FILE (filename
);
5703 if (stat (SDATA (filename
), &st
) >= 0)
5704 current_buffer
->modtime
= st
.st_mtime
;
5711 auto_save_error (error
)
5714 Lisp_Object args
[3], msg
;
5716 struct gcpro gcpro1
;
5718 ring_bell (XFRAME (selected_frame
));
5720 args
[0] = build_string ("Auto-saving %s: %s");
5721 args
[1] = current_buffer
->name
;
5722 args
[2] = Ferror_message_string (error
);
5723 msg
= Fformat (3, args
);
5725 nbytes
= SBYTES (msg
);
5727 for (i
= 0; i
< 3; ++i
)
5730 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5732 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5733 Fsleep_for (make_number (1), Qnil
);
5746 auto_save_mode_bits
= 0666;
5748 /* Get visited file's mode to become the auto save file's mode. */
5749 if (! NILP (current_buffer
->filename
))
5751 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5752 /* But make sure we can overwrite it later! */
5753 auto_save_mode_bits
= st
.st_mode
| 0600;
5754 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5756 /* Remote files don't cooperate with stat. */
5757 auto_save_mode_bits
= XINT (modes
) | 0600;
5761 Fwrite_region (Qnil
, Qnil
,
5762 current_buffer
->auto_save_file_name
,
5763 Qnil
, Qlambda
, Qnil
, Qnil
);
5767 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5772 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5773 | XFASTINT (XCDR (stream
))));
5778 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5781 minibuffer_auto_raise
= XINT (value
);
5786 do_auto_save_make_dir (dir
)
5789 return call2 (Qmake_directory
, dir
, Qt
);
5793 do_auto_save_eh (ignore
)
5799 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5800 doc
: /* Auto-save all buffers that need it.
5801 This is all buffers that have auto-saving enabled
5802 and are changed since last auto-saved.
5803 Auto-saving writes the buffer into a file
5804 so that your editing is not lost if the system crashes.
5805 This file is not the file you visited; that changes only when you save.
5806 Normally we run the normal hook `auto-save-hook' before saving.
5808 A non-nil NO-MESSAGE argument means do not print any message if successful.
5809 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5810 (no_message
, current_only
)
5811 Lisp_Object no_message
, current_only
;
5813 struct buffer
*old
= current_buffer
, *b
;
5814 Lisp_Object tail
, buf
;
5816 int do_handled_files
;
5819 Lisp_Object lispstream
;
5820 int count
= SPECPDL_INDEX ();
5821 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5822 int old_message_p
= 0;
5823 struct gcpro gcpro1
, gcpro2
;
5825 if (max_specpdl_size
< specpdl_size
+ 40)
5826 max_specpdl_size
= specpdl_size
+ 40;
5831 if (NILP (no_message
))
5833 old_message_p
= push_message ();
5834 record_unwind_protect (pop_message_unwind
, Qnil
);
5837 /* Ordinarily don't quit within this function,
5838 but don't make it impossible to quit (in case we get hung in I/O). */
5842 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5843 point to non-strings reached from Vbuffer_alist. */
5845 if (!NILP (Vrun_hooks
))
5846 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5848 if (STRINGP (Vauto_save_list_file_name
))
5850 Lisp_Object listfile
;
5852 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5854 /* Don't try to create the directory when shutting down Emacs,
5855 because creating the directory might signal an error, and
5856 that would leave Emacs in a strange state. */
5857 if (!NILP (Vrun_hooks
))
5861 GCPRO2 (dir
, listfile
);
5862 dir
= Ffile_name_directory (listfile
);
5863 if (NILP (Ffile_directory_p (dir
)))
5864 internal_condition_case_1 (do_auto_save_make_dir
,
5865 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5870 stream
= fopen (SDATA (listfile
), "w");
5873 /* Arrange to close that file whether or not we get an error.
5874 Also reset auto_saving to 0. */
5875 lispstream
= Fcons (Qnil
, Qnil
);
5876 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5877 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5888 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5889 record_unwind_protect (do_auto_save_unwind_1
,
5890 make_number (minibuffer_auto_raise
));
5891 minibuffer_auto_raise
= 0;
5894 /* On first pass, save all files that don't have handlers.
5895 On second pass, save all files that do have handlers.
5897 If Emacs is crashing, the handlers may tweak what is causing
5898 Emacs to crash in the first place, and it would be a shame if
5899 Emacs failed to autosave perfectly ordinary files because it
5900 couldn't handle some ange-ftp'd file. */
5902 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5903 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5905 buf
= XCDR (XCAR (tail
));
5908 /* Record all the buffers that have auto save mode
5909 in the special file that lists them. For each of these buffers,
5910 Record visited name (if any) and auto save name. */
5911 if (STRINGP (b
->auto_save_file_name
)
5912 && stream
!= NULL
&& do_handled_files
== 0)
5914 if (!NILP (b
->filename
))
5916 fwrite (SDATA (b
->filename
), 1,
5917 SBYTES (b
->filename
), stream
);
5919 putc ('\n', stream
);
5920 fwrite (SDATA (b
->auto_save_file_name
), 1,
5921 SBYTES (b
->auto_save_file_name
), stream
);
5922 putc ('\n', stream
);
5925 if (!NILP (current_only
)
5926 && b
!= current_buffer
)
5929 /* Don't auto-save indirect buffers.
5930 The base buffer takes care of it. */
5934 /* Check for auto save enabled
5935 and file changed since last auto save
5936 and file changed since last real save. */
5937 if (STRINGP (b
->auto_save_file_name
)
5938 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5939 && b
->auto_save_modified
< BUF_MODIFF (b
)
5940 /* -1 means we've turned off autosaving for a while--see below. */
5941 && XINT (b
->save_length
) >= 0
5942 && (do_handled_files
5943 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5946 EMACS_TIME before_time
, after_time
;
5948 EMACS_GET_TIME (before_time
);
5950 /* If we had a failure, don't try again for 20 minutes. */
5951 if (b
->auto_save_failure_time
>= 0
5952 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5955 if ((XFASTINT (b
->save_length
) * 10
5956 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5957 /* A short file is likely to change a large fraction;
5958 spare the user annoying messages. */
5959 && XFASTINT (b
->save_length
) > 5000
5960 /* These messages are frequent and annoying for `*mail*'. */
5961 && !EQ (b
->filename
, Qnil
)
5962 && NILP (no_message
))
5964 /* It has shrunk too much; turn off auto-saving here. */
5965 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5966 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5968 minibuffer_auto_raise
= 0;
5969 /* Turn off auto-saving until there's a real save,
5970 and prevent any more warnings. */
5971 XSETINT (b
->save_length
, -1);
5972 Fsleep_for (make_number (1), Qnil
);
5975 set_buffer_internal (b
);
5976 if (!auto_saved
&& NILP (no_message
))
5977 message1 ("Auto-saving...");
5978 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5980 b
->auto_save_modified
= BUF_MODIFF (b
);
5981 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5982 set_buffer_internal (old
);
5984 EMACS_GET_TIME (after_time
);
5986 /* If auto-save took more than 60 seconds,
5987 assume it was an NFS failure that got a timeout. */
5988 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5989 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5993 /* Prevent another auto save till enough input events come in. */
5994 record_auto_save ();
5996 if (auto_saved
&& NILP (no_message
))
6000 /* If we are going to restore an old message,
6001 give time to read ours. */
6002 sit_for (1, 0, 0, 0, 0);
6006 /* If we displayed a message and then restored a state
6007 with no message, leave a "done" message on the screen. */
6008 message1 ("Auto-saving...done");
6013 /* This restores the message-stack status. */
6014 unbind_to (count
, Qnil
);
6018 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6019 Sset_buffer_auto_saved
, 0, 0, 0,
6020 doc
: /* Mark current buffer as auto-saved with its current text.
6021 No auto-save file will be written until the buffer changes again. */)
6024 current_buffer
->auto_save_modified
= MODIFF
;
6025 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6026 current_buffer
->auto_save_failure_time
= -1;
6030 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6031 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6032 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6035 current_buffer
->auto_save_failure_time
= -1;
6039 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6041 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6044 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6047 /* Reading and completing file names */
6048 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6050 /* In the string VAL, change each $ to $$ and return the result. */
6053 double_dollars (val
)
6056 register const unsigned char *old
;
6057 register unsigned char *new;
6061 osize
= SBYTES (val
);
6063 /* Count the number of $ characters. */
6064 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6065 if (*old
++ == '$') count
++;
6069 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6072 for (n
= osize
; n
> 0; n
--)
6086 read_file_name_cleanup (arg
)
6089 return (current_buffer
->directory
= arg
);
6092 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6094 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6095 (string
, dir
, action
)
6096 Lisp_Object string
, dir
, action
;
6097 /* action is nil for complete, t for return list of completions,
6098 lambda for verify final value */
6100 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6102 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6104 CHECK_STRING (string
);
6111 /* No need to protect ACTION--we only compare it with t and nil. */
6112 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6114 if (SCHARS (string
) == 0)
6116 if (EQ (action
, Qlambda
))
6124 orig_string
= string
;
6125 string
= Fsubstitute_in_file_name (string
);
6126 changed
= NILP (Fstring_equal (string
, orig_string
));
6127 name
= Ffile_name_nondirectory (string
);
6128 val
= Ffile_name_directory (string
);
6130 realdir
= Fexpand_file_name (val
, realdir
);
6135 specdir
= Ffile_name_directory (string
);
6136 val
= Ffile_name_completion (name
, realdir
);
6141 return double_dollars (string
);
6145 if (!NILP (specdir
))
6146 val
= concat2 (specdir
, val
);
6148 return double_dollars (val
);
6151 #endif /* not VMS */
6155 if (EQ (action
, Qt
))
6157 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6161 if (NILP (Vread_file_name_predicate
)
6162 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6166 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6168 /* Brute-force speed up for directory checking:
6169 Discard strings which don't end in a slash. */
6170 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6172 Lisp_Object tem
= XCAR (all
);
6174 if (STRINGP (tem
) &&
6175 (len
= SCHARS (tem
), len
> 0) &&
6176 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6177 comp
= Fcons (tem
, comp
);
6183 /* Must do it the hard (and slow) way. */
6184 GCPRO3 (all
, comp
, specdir
);
6185 count
= SPECPDL_INDEX ();
6186 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6187 current_buffer
->directory
= realdir
;
6188 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6189 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6190 comp
= Fcons (XCAR (all
), comp
);
6191 unbind_to (count
, Qnil
);
6194 return Fnreverse (comp
);
6197 /* Only other case actually used is ACTION = lambda */
6199 /* Supposedly this helps commands such as `cd' that read directory names,
6200 but can someone explain how it helps them? -- RMS */
6201 if (SCHARS (name
) == 0)
6204 string
= Fexpand_file_name (string
, dir
);
6205 if (!NILP (Vread_file_name_predicate
))
6206 return call1 (Vread_file_name_predicate
, string
);
6207 return Ffile_exists_p (string
);
6210 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6211 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6212 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6213 The return value is only relevant for a call to `read-file-name' that happens
6214 before any other event (mouse or keypress) is handeled. */)
6217 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6218 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6227 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6228 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6229 Value is not expanded---you must call `expand-file-name' yourself.
6230 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6231 the same non-empty string that was inserted by this function.
6232 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6233 except that if INITIAL is specified, that combined with DIR is used.)
6234 If the user exits with an empty minibuffer, this function returns
6235 an empty string. (This can only happen if the user erased the
6236 pre-inserted contents or if `insert-default-directory' is nil.)
6237 Fourth arg MUSTMATCH non-nil means require existing file's name.
6238 Non-nil and non-t means also require confirmation after completion.
6239 Fifth arg INITIAL specifies text to start with.
6240 If optional sixth arg PREDICATE is non-nil, possible completions and
6241 the resulting file name must satisfy (funcall PREDICATE NAME).
6242 DIR should be an absolute directory name. It defaults to the value of
6243 `default-directory'.
6245 If this command was invoked with the mouse, use a file dialog box if
6246 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6247 provides a file dialog box.
6249 See also `read-file-name-completion-ignore-case'
6250 and `read-file-name-function'. */)
6251 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6252 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6254 Lisp_Object val
, insdef
, tem
;
6255 struct gcpro gcpro1
, gcpro2
;
6256 register char *homedir
;
6257 Lisp_Object decoded_homedir
;
6258 int replace_in_history
= 0;
6259 int add_to_history
= 0;
6263 dir
= current_buffer
->directory
;
6264 if (NILP (Ffile_name_absolute_p (dir
)))
6265 dir
= Fexpand_file_name (dir
, Qnil
);
6266 if (NILP (default_filename
))
6269 ? Fexpand_file_name (initial
, dir
)
6270 : current_buffer
->filename
);
6272 /* If dir starts with user's homedir, change that to ~. */
6273 homedir
= (char *) egetenv ("HOME");
6275 /* homedir can be NULL in temacs, since Vprocess_environment is not
6276 yet set up. We shouldn't crash in that case. */
6279 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6280 CORRECT_DIR_SEPS (homedir
);
6285 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6288 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6289 SBYTES (decoded_homedir
))
6290 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6292 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6293 dir
= concat2 (build_string ("~"), dir
);
6295 /* Likewise for default_filename. */
6297 && STRINGP (default_filename
)
6298 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6299 SBYTES (decoded_homedir
))
6300 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6303 = Fsubstring (default_filename
,
6304 make_number (SCHARS (decoded_homedir
)), Qnil
);
6305 default_filename
= concat2 (build_string ("~"), default_filename
);
6307 if (!NILP (default_filename
))
6309 CHECK_STRING (default_filename
);
6310 default_filename
= double_dollars (default_filename
);
6313 if (insert_default_directory
&& STRINGP (dir
))
6316 if (!NILP (initial
))
6318 Lisp_Object args
[2], pos
;
6322 insdef
= Fconcat (2, args
);
6323 pos
= make_number (SCHARS (double_dollars (dir
)));
6324 insdef
= Fcons (double_dollars (insdef
), pos
);
6327 insdef
= double_dollars (insdef
);
6329 else if (STRINGP (initial
))
6330 insdef
= Fcons (double_dollars (initial
), make_number (0));
6334 if (!NILP (Vread_file_name_function
))
6336 Lisp_Object args
[7];
6338 GCPRO2 (insdef
, default_filename
);
6339 args
[0] = Vread_file_name_function
;
6342 args
[3] = default_filename
;
6343 args
[4] = mustmatch
;
6345 args
[6] = predicate
;
6346 RETURN_UNGCPRO (Ffuncall (7, args
));
6349 count
= SPECPDL_INDEX ();
6350 specbind (intern ("completion-ignore-case"),
6351 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6352 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6353 specbind (intern ("read-file-name-predicate"),
6354 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6356 GCPRO2 (insdef
, default_filename
);
6358 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6359 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6361 /* If DIR contains a file name, split it. */
6363 file
= Ffile_name_nondirectory (dir
);
6364 if (SCHARS (file
) && NILP (default_filename
))
6366 default_filename
= file
;
6367 dir
= Ffile_name_directory (dir
);
6369 if (!NILP(default_filename
))
6370 default_filename
= Fexpand_file_name (default_filename
, dir
);
6371 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6372 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6377 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6378 dir
, mustmatch
, insdef
,
6379 Qfile_name_history
, default_filename
, Qnil
);
6381 tem
= Fsymbol_value (Qfile_name_history
);
6382 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6383 replace_in_history
= 1;
6385 /* If Fcompleting_read returned the inserted default string itself
6386 (rather than a new string with the same contents),
6387 it has to mean that the user typed RET with the minibuffer empty.
6388 In that case, we really want to return ""
6389 so that commands such as set-visited-file-name can distinguish. */
6390 if (EQ (val
, default_filename
))
6392 /* In this case, Fcompleting_read has not added an element
6393 to the history. Maybe we should. */
6394 if (! replace_in_history
)
6400 unbind_to (count
, Qnil
);
6403 error ("No file name specified");
6405 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6407 if (!NILP (tem
) && !NILP (default_filename
))
6408 val
= default_filename
;
6409 val
= Fsubstitute_in_file_name (val
);
6411 if (replace_in_history
)
6412 /* Replace what Fcompleting_read added to the history
6413 with what we will actually return. */
6415 Lisp_Object val1
= double_dollars (val
);
6416 tem
= Fsymbol_value (Qfile_name_history
);
6417 if (history_delete_duplicates
)
6418 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6419 XSETCAR (tem
, val1
);
6421 else if (add_to_history
)
6423 /* Add the value to the history--but not if it matches
6424 the last value already there. */
6425 Lisp_Object val1
= double_dollars (val
);
6426 tem
= Fsymbol_value (Qfile_name_history
);
6427 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6429 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6430 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6441 /* Must be set before any path manipulation is performed. */
6442 XSETFASTINT (Vdirectory_sep_char
, '/');
6449 Qoperations
= intern ("operations");
6450 Qexpand_file_name
= intern ("expand-file-name");
6451 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6452 Qdirectory_file_name
= intern ("directory-file-name");
6453 Qfile_name_directory
= intern ("file-name-directory");
6454 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6455 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6456 Qfile_name_as_directory
= intern ("file-name-as-directory");
6457 Qcopy_file
= intern ("copy-file");
6458 Qmake_directory_internal
= intern ("make-directory-internal");
6459 Qmake_directory
= intern ("make-directory");
6460 Qdelete_directory
= intern ("delete-directory");
6461 Qdelete_file
= intern ("delete-file");
6462 Qrename_file
= intern ("rename-file");
6463 Qadd_name_to_file
= intern ("add-name-to-file");
6464 Qmake_symbolic_link
= intern ("make-symbolic-link");
6465 Qfile_exists_p
= intern ("file-exists-p");
6466 Qfile_executable_p
= intern ("file-executable-p");
6467 Qfile_readable_p
= intern ("file-readable-p");
6468 Qfile_writable_p
= intern ("file-writable-p");
6469 Qfile_symlink_p
= intern ("file-symlink-p");
6470 Qaccess_file
= intern ("access-file");
6471 Qfile_directory_p
= intern ("file-directory-p");
6472 Qfile_regular_p
= intern ("file-regular-p");
6473 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6474 Qfile_modes
= intern ("file-modes");
6475 Qset_file_modes
= intern ("set-file-modes");
6476 Qset_file_times
= intern ("set-file-times");
6477 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6478 Qinsert_file_contents
= intern ("insert-file-contents");
6479 Qwrite_region
= intern ("write-region");
6480 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6481 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6482 Qauto_save_coding
= intern ("auto-save-coding");
6484 staticpro (&Qoperations
);
6485 staticpro (&Qexpand_file_name
);
6486 staticpro (&Qsubstitute_in_file_name
);
6487 staticpro (&Qdirectory_file_name
);
6488 staticpro (&Qfile_name_directory
);
6489 staticpro (&Qfile_name_nondirectory
);
6490 staticpro (&Qunhandled_file_name_directory
);
6491 staticpro (&Qfile_name_as_directory
);
6492 staticpro (&Qcopy_file
);
6493 staticpro (&Qmake_directory_internal
);
6494 staticpro (&Qmake_directory
);
6495 staticpro (&Qdelete_directory
);
6496 staticpro (&Qdelete_file
);
6497 staticpro (&Qrename_file
);
6498 staticpro (&Qadd_name_to_file
);
6499 staticpro (&Qmake_symbolic_link
);
6500 staticpro (&Qfile_exists_p
);
6501 staticpro (&Qfile_executable_p
);
6502 staticpro (&Qfile_readable_p
);
6503 staticpro (&Qfile_writable_p
);
6504 staticpro (&Qaccess_file
);
6505 staticpro (&Qfile_symlink_p
);
6506 staticpro (&Qfile_directory_p
);
6507 staticpro (&Qfile_regular_p
);
6508 staticpro (&Qfile_accessible_directory_p
);
6509 staticpro (&Qfile_modes
);
6510 staticpro (&Qset_file_modes
);
6511 staticpro (&Qset_file_times
);
6512 staticpro (&Qfile_newer_than_file_p
);
6513 staticpro (&Qinsert_file_contents
);
6514 staticpro (&Qwrite_region
);
6515 staticpro (&Qverify_visited_file_modtime
);
6516 staticpro (&Qset_visited_file_modtime
);
6517 staticpro (&Qauto_save_coding
);
6519 Qfile_name_history
= intern ("file-name-history");
6520 Fset (Qfile_name_history
, Qnil
);
6521 staticpro (&Qfile_name_history
);
6523 Qfile_error
= intern ("file-error");
6524 staticpro (&Qfile_error
);
6525 Qfile_already_exists
= intern ("file-already-exists");
6526 staticpro (&Qfile_already_exists
);
6527 Qfile_date_error
= intern ("file-date-error");
6528 staticpro (&Qfile_date_error
);
6529 Qexcl
= intern ("excl");
6533 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6534 staticpro (&Qfind_buffer_file_type
);
6537 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6538 doc
: /* *Coding system for encoding file names.
6539 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6540 Vfile_name_coding_system
= Qnil
;
6542 DEFVAR_LISP ("default-file-name-coding-system",
6543 &Vdefault_file_name_coding_system
,
6544 doc
: /* Default coding system for encoding file names.
6545 This variable is used only when `file-name-coding-system' is nil.
6547 This variable is set/changed by the command `set-language-environment'.
6548 User should not set this variable manually,
6549 instead use `file-name-coding-system' to get a constant encoding
6550 of file names regardless of the current language environment. */);
6551 Vdefault_file_name_coding_system
= Qnil
;
6553 Qformat_decode
= intern ("format-decode");
6554 staticpro (&Qformat_decode
);
6555 Qformat_annotate_function
= intern ("format-annotate-function");
6556 staticpro (&Qformat_annotate_function
);
6557 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6558 staticpro (&Qafter_insert_file_set_coding
);
6560 Qcar_less_than_car
= intern ("car-less-than-car");
6561 staticpro (&Qcar_less_than_car
);
6563 Fput (Qfile_error
, Qerror_conditions
,
6564 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6565 Fput (Qfile_error
, Qerror_message
,
6566 build_string ("File error"));
6568 Fput (Qfile_already_exists
, Qerror_conditions
,
6569 Fcons (Qfile_already_exists
,
6570 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6571 Fput (Qfile_already_exists
, Qerror_message
,
6572 build_string ("File already exists"));
6574 Fput (Qfile_date_error
, Qerror_conditions
,
6575 Fcons (Qfile_date_error
,
6576 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6577 Fput (Qfile_date_error
, Qerror_message
,
6578 build_string ("Cannot set file date"));
6580 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6581 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6582 Vread_file_name_function
= Qnil
;
6584 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6585 doc
: /* Current predicate used by `read-file-name-internal'. */);
6586 Vread_file_name_predicate
= Qnil
;
6588 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6589 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6590 #if defined VMS || defined DOS_NT || defined MAC_OS
6591 read_file_name_completion_ignore_case
= 1;
6593 read_file_name_completion_ignore_case
= 0;
6596 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6597 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6598 If the initial minibuffer contents are non-empty, you can usually
6599 request a default filename by typing RETURN without editing. For some
6600 commands, exiting with an empty minibuffer has a special meaning,
6601 such as making the current buffer visit no file in the case of
6602 `set-visited-file-name'.
6603 If this variable is non-nil, the minibuffer contents are always
6604 initially non-empty and typing RETURN without editing will fetch the
6605 default name, if one is provided. Note however that this default name
6606 is not necessarily the name originally inserted in the minibuffer, if
6607 that is just the default directory.
6608 If this variable is nil, the minibuffer often starts out empty. In
6609 that case you may have to explicitly fetch the next history element to
6610 request the default name. */);
6611 insert_default_directory
= 1;
6613 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6614 doc
: /* *Non-nil means write new files with record format `stmlf'.
6615 nil means use format `var'. This variable is meaningful only on VMS. */);
6616 vms_stmlf_recfm
= 0;
6618 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6619 doc
: /* Directory separator character for built-in functions that return file names.
6620 The value is always ?/. Don't use this variable, just use `/'. */);
6622 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6623 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6624 If a file name matches REGEXP, then all I/O on that file is done by calling
6627 The first argument given to HANDLER is the name of the I/O primitive
6628 to be handled; the remaining arguments are the arguments that were
6629 passed to that primitive. For example, if you do
6630 (file-exists-p FILENAME)
6631 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6632 (funcall HANDLER 'file-exists-p FILENAME)
6633 The function `find-file-name-handler' checks this list for a handler
6634 for its argument. */);
6635 Vfile_name_handler_alist
= Qnil
;
6637 DEFVAR_LISP ("set-auto-coding-function",
6638 &Vset_auto_coding_function
,
6639 doc
: /* If non-nil, a function to call to decide a coding system of file.
6640 Two arguments are passed to this function: the file name
6641 and the length of a file contents following the point.
6642 This function should return a coding system to decode the file contents.
6643 It should check the file name against `auto-coding-alist'.
6644 If no coding system is decided, it should check a coding system
6645 specified in the heading lines with the format:
6646 -*- ... coding: CODING-SYSTEM; ... -*-
6647 or local variable spec of the tailing lines with `coding:' tag. */);
6648 Vset_auto_coding_function
= Qnil
;
6650 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6651 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6652 Each is passed one argument, the number of characters inserted.
6653 It should return the new character count, and leave point the same.
6654 If `insert-file-contents' is intercepted by a handler from
6655 `file-name-handler-alist', that handler is responsible for calling the
6656 functions in `after-insert-file-functions' if appropriate. */);
6657 Vafter_insert_file_functions
= Qnil
;
6659 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6660 doc
: /* A list of functions to be called at the start of `write-region'.
6661 Each is passed two arguments, START and END as for `write-region'.
6662 These are usually two numbers but not always; see the documentation
6663 for `write-region'. The function should return a list of pairs
6664 of the form (POSITION . STRING), consisting of strings to be effectively
6665 inserted at the specified positions of the file being written (1 means to
6666 insert before the first byte written). The POSITIONs must be sorted into
6667 increasing order. If there are several functions in the list, the several
6668 lists are merged destructively. Alternatively, the function can return
6669 with a different buffer current; in that case it should pay attention
6670 to the annotations returned by previous functions and listed in
6671 `write-region-annotations-so-far'.*/);
6672 Vwrite_region_annotate_functions
= Qnil
;
6673 staticpro (&Qwrite_region_annotate_functions
);
6674 Qwrite_region_annotate_functions
6675 = intern ("write-region-annotate-functions");
6677 DEFVAR_LISP ("write-region-annotations-so-far",
6678 &Vwrite_region_annotations_so_far
,
6679 doc
: /* When an annotation function is called, this holds the previous annotations.
6680 These are the annotations made by other annotation functions
6681 that were already called. See also `write-region-annotate-functions'. */);
6682 Vwrite_region_annotations_so_far
= Qnil
;
6684 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6685 doc
: /* A list of file name handlers that temporarily should not be used.
6686 This applies only to the operation `inhibit-file-name-operation'. */);
6687 Vinhibit_file_name_handlers
= Qnil
;
6689 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6690 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6691 Vinhibit_file_name_operation
= Qnil
;
6693 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6694 doc
: /* File name in which we write a list of all auto save file names.
6695 This variable is initialized automatically from `auto-save-list-file-prefix'
6696 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6697 a non-nil value. */);
6698 Vauto_save_list_file_name
= Qnil
;
6700 defsubr (&Sfind_file_name_handler
);
6701 defsubr (&Sfile_name_directory
);
6702 defsubr (&Sfile_name_nondirectory
);
6703 defsubr (&Sunhandled_file_name_directory
);
6704 defsubr (&Sfile_name_as_directory
);
6705 defsubr (&Sdirectory_file_name
);
6706 defsubr (&Smake_temp_name
);
6707 defsubr (&Sexpand_file_name
);
6708 defsubr (&Ssubstitute_in_file_name
);
6709 defsubr (&Scopy_file
);
6710 defsubr (&Smake_directory_internal
);
6711 defsubr (&Sdelete_directory
);
6712 defsubr (&Sdelete_file
);
6713 defsubr (&Srename_file
);
6714 defsubr (&Sadd_name_to_file
);
6716 defsubr (&Smake_symbolic_link
);
6717 #endif /* S_IFLNK */
6719 defsubr (&Sdefine_logical_name
);
6722 defsubr (&Ssysnetunam
);
6723 #endif /* HPUX_NET */
6724 defsubr (&Sfile_name_absolute_p
);
6725 defsubr (&Sfile_exists_p
);
6726 defsubr (&Sfile_executable_p
);
6727 defsubr (&Sfile_readable_p
);
6728 defsubr (&Sfile_writable_p
);
6729 defsubr (&Saccess_file
);
6730 defsubr (&Sfile_symlink_p
);
6731 defsubr (&Sfile_directory_p
);
6732 defsubr (&Sfile_accessible_directory_p
);
6733 defsubr (&Sfile_regular_p
);
6734 defsubr (&Sfile_modes
);
6735 defsubr (&Sset_file_modes
);
6736 defsubr (&Sset_file_times
);
6737 defsubr (&Sset_default_file_modes
);
6738 defsubr (&Sdefault_file_modes
);
6739 defsubr (&Sfile_newer_than_file_p
);
6740 defsubr (&Sinsert_file_contents
);
6741 defsubr (&Swrite_region
);
6742 defsubr (&Scar_less_than_car
);
6743 defsubr (&Sverify_visited_file_modtime
);
6744 defsubr (&Sclear_visited_file_modtime
);
6745 defsubr (&Svisited_file_modtime
);
6746 defsubr (&Sset_visited_file_modtime
);
6747 defsubr (&Sdo_auto_save
);
6748 defsubr (&Sset_buffer_auto_saved
);
6749 defsubr (&Sclear_buffer_auto_save_failure
);
6750 defsubr (&Srecent_auto_save_p
);
6752 defsubr (&Sread_file_name_internal
);
6753 defsubr (&Sread_file_name
);
6754 defsubr (&Snext_read_file_uses_dialog_p
);
6757 defsubr (&Sunix_sync
);
6761 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6762 (do not change this comment) */