1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
80 #include "blockinput.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 /* Set by auto_save_1 if an error occurred during the last auto-save. */
163 int auto_save_error_occurred
;
165 /* The symbol bound to coding-system-for-read when
166 insert-file-contents is called for recovering a file. This is not
167 an actual coding system name, but just an indicator to tell
168 insert-file-contents to use `emacs-mule' with a special flag for
169 auto saving and recovering a file. */
170 Lisp_Object Qauto_save_coding
;
172 /* Coding system for file names, or nil if none. */
173 Lisp_Object Vfile_name_coding_system
;
175 /* Coding system for file names used only when
176 Vfile_name_coding_system is nil. */
177 Lisp_Object Vdefault_file_name_coding_system
;
179 /* Alist of elements (REGEXP . HANDLER) for file names
180 whose I/O is done with a special handler. */
181 Lisp_Object Vfile_name_handler_alist
;
183 /* Property name of a file name handler,
184 which gives a list of operations it handles.. */
185 Lisp_Object Qoperations
;
187 /* Lisp functions for translating file formats */
188 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
190 /* Function to be called to decide a coding system of a reading file. */
191 Lisp_Object Vset_auto_coding_function
;
193 /* Functions to be called to process text properties in inserted file. */
194 Lisp_Object Vafter_insert_file_functions
;
196 /* Lisp function for setting buffer-file-coding-system and the
197 multibyteness of the current buffer after inserting a file. */
198 Lisp_Object Qafter_insert_file_set_coding
;
200 /* Functions to be called to create text property annotations for file. */
201 Lisp_Object Vwrite_region_annotate_functions
;
202 Lisp_Object Qwrite_region_annotate_functions
;
204 /* During build_annotations, each time an annotation function is called,
205 this holds the annotations made by the previous functions. */
206 Lisp_Object Vwrite_region_annotations_so_far
;
208 /* File name in which we write a list of all our auto save files. */
209 Lisp_Object Vauto_save_list_file_name
;
211 /* Whether or not files are auto-saved into themselves. */
212 Lisp_Object Vauto_save_visited_file_name
;
214 /* Function to call to read a file name. */
215 Lisp_Object Vread_file_name_function
;
217 /* Current predicate used by read_file_name_internal. */
218 Lisp_Object Vread_file_name_predicate
;
220 /* Nonzero means completion ignores case when reading file name. */
221 int read_file_name_completion_ignore_case
;
223 /* Nonzero means, when reading a filename in the minibuffer,
224 start out by inserting the default directory into the minibuffer. */
225 int insert_default_directory
;
227 /* On VMS, nonzero means write new files with record format stmlf.
228 Zero means use var format. */
231 /* On NT, specifies the directory separator character, used (eg.) when
232 expanding file names. This can be bound to / or \. */
233 Lisp_Object Vdirectory_sep_char
;
236 /* Nonzero means skip the call to fsync in Fwrite-region. */
237 int write_region_inhibit_fsync
;
240 extern Lisp_Object Vuser_login_name
;
243 extern Lisp_Object Vw32_get_true_file_attributes
;
246 extern int minibuf_level
;
248 extern int minibuffer_auto_raise
;
250 extern int history_delete_duplicates
;
252 /* These variables describe handlers that have "already" had a chance
253 to handle the current operation.
255 Vinhibit_file_name_handlers is a list of file name handlers.
256 Vinhibit_file_name_operation is the operation being handled.
257 If we try to handle that operation, we ignore those handlers. */
259 static Lisp_Object Vinhibit_file_name_handlers
;
260 static Lisp_Object Vinhibit_file_name_operation
;
262 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
264 Lisp_Object Qfile_name_history
;
266 Lisp_Object Qcar_less_than_car
;
268 static int a_write
P_ ((int, Lisp_Object
, int, int,
269 Lisp_Object
*, struct coding_system
*));
270 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
274 report_file_error (string
, data
)
278 Lisp_Object errstring
;
281 synchronize_system_messages_locale ();
282 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
283 Vlocale_coding_system
, 0);
289 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
292 /* System error messages are capitalized. Downcase the initial
293 unless it is followed by a slash. */
294 if (SREF (errstring
, 1) != '/')
295 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
297 xsignal (Qfile_error
,
298 Fcons (build_string (string
), Fcons (errstring
, data
)));
303 close_file_unwind (fd
)
306 emacs_close (XFASTINT (fd
));
310 /* Restore point, having saved it as a marker. */
313 restore_point_unwind (location
)
314 Lisp_Object location
;
316 Fgoto_char (location
);
317 Fset_marker (location
, Qnil
, Qnil
);
321 Lisp_Object Qexpand_file_name
;
322 Lisp_Object Qsubstitute_in_file_name
;
323 Lisp_Object Qdirectory_file_name
;
324 Lisp_Object Qfile_name_directory
;
325 Lisp_Object Qfile_name_nondirectory
;
326 Lisp_Object Qunhandled_file_name_directory
;
327 Lisp_Object Qfile_name_as_directory
;
328 Lisp_Object Qcopy_file
;
329 Lisp_Object Qmake_directory_internal
;
330 Lisp_Object Qmake_directory
;
331 Lisp_Object Qdelete_directory
;
332 Lisp_Object Qdelete_file
;
333 Lisp_Object Qrename_file
;
334 Lisp_Object Qadd_name_to_file
;
335 Lisp_Object Qmake_symbolic_link
;
336 Lisp_Object Qfile_exists_p
;
337 Lisp_Object Qfile_executable_p
;
338 Lisp_Object Qfile_readable_p
;
339 Lisp_Object Qfile_writable_p
;
340 Lisp_Object Qfile_symlink_p
;
341 Lisp_Object Qaccess_file
;
342 Lisp_Object Qfile_directory_p
;
343 Lisp_Object Qfile_regular_p
;
344 Lisp_Object Qfile_accessible_directory_p
;
345 Lisp_Object Qfile_modes
;
346 Lisp_Object Qset_file_modes
;
347 Lisp_Object Qset_file_times
;
348 Lisp_Object Qfile_newer_than_file_p
;
349 Lisp_Object Qinsert_file_contents
;
350 Lisp_Object Qwrite_region
;
351 Lisp_Object Qverify_visited_file_modtime
;
352 Lisp_Object Qset_visited_file_modtime
;
354 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
355 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
356 Otherwise, return nil.
357 A file name is handled if one of the regular expressions in
358 `file-name-handler-alist' matches it.
360 If OPERATION equals `inhibit-file-name-operation', then we ignore
361 any handlers that are members of `inhibit-file-name-handlers',
362 but we still do run any other handlers. This lets handlers
363 use the standard functions without calling themselves recursively. */)
364 (filename
, operation
)
365 Lisp_Object filename
, operation
;
367 /* This function must not munge the match data. */
368 Lisp_Object chain
, inhibited_handlers
, result
;
372 CHECK_STRING (filename
);
374 if (EQ (operation
, Vinhibit_file_name_operation
))
375 inhibited_handlers
= Vinhibit_file_name_handlers
;
377 inhibited_handlers
= Qnil
;
379 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
380 chain
= XCDR (chain
))
386 Lisp_Object string
= XCAR (elt
);
388 Lisp_Object handler
= XCDR (elt
);
389 Lisp_Object operations
= Qnil
;
391 if (SYMBOLP (handler
))
392 operations
= Fget (handler
, Qoperations
);
395 && (match_pos
= fast_string_match (string
, filename
)) > pos
396 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
400 handler
= XCDR (elt
);
401 tem
= Fmemq (handler
, inhibited_handlers
);
415 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
417 doc
: /* Return the directory component in file name FILENAME.
418 Return nil if FILENAME does not include a directory.
419 Otherwise return a directory name.
420 Given a Unix syntax file name, returns a string ending in slash;
421 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
423 Lisp_Object filename
;
426 register const unsigned char *beg
;
428 register unsigned char *beg
;
430 register const unsigned char *p
;
433 CHECK_STRING (filename
);
435 /* If the file name has special constructs in it,
436 call the corresponding file handler. */
437 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
439 return call2 (handler
, Qfile_name_directory
, filename
);
441 filename
= FILE_SYSTEM_CASE (filename
);
442 beg
= SDATA (filename
);
444 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
446 p
= beg
+ SBYTES (filename
);
448 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
450 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
453 /* only recognise drive specifier at the beginning */
455 /* handle the "/:d:foo" and "/:foo" cases correctly */
456 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
457 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
464 /* Expansion of "c:" to drive and default directory. */
467 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
468 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
469 unsigned char *r
= res
;
471 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
473 strncpy (res
, beg
, 2);
478 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
480 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
483 p
= beg
+ strlen (beg
);
486 CORRECT_DIR_SEPS (beg
);
489 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
492 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
493 Sfile_name_nondirectory
, 1, 1, 0,
494 doc
: /* Return file name FILENAME sans its directory.
495 For example, in a Unix-syntax file name,
496 this is everything after the last slash,
497 or the entire name if it contains no slash. */)
499 Lisp_Object filename
;
501 register const unsigned char *beg
, *p
, *end
;
504 CHECK_STRING (filename
);
506 /* If the file name has special constructs in it,
507 call the corresponding file handler. */
508 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
510 return call2 (handler
, Qfile_name_nondirectory
, filename
);
512 beg
= SDATA (filename
);
513 end
= p
= beg
+ SBYTES (filename
);
515 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
517 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
520 /* only recognise drive specifier at beginning */
522 /* handle the "/:d:foo" case correctly */
523 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
528 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
531 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
532 Sunhandled_file_name_directory
, 1, 1, 0,
533 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
534 A `directly usable' directory name is one that may be used without the
535 intervention of any file handler.
536 If FILENAME is a directly usable file itself, return
537 \(file-name-directory FILENAME).
538 The `call-process' and `start-process' functions use this function to
539 get a current directory to run processes in. */)
541 Lisp_Object filename
;
545 /* If the file name has special constructs in it,
546 call the corresponding file handler. */
547 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
549 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
551 return Ffile_name_directory (filename
);
556 file_name_as_directory (out
, in
)
559 int size
= strlen (in
) - 1;
572 /* Is it already a directory string? */
573 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
575 /* Is it a VMS directory file name? If so, hack VMS syntax. */
576 else if (! index (in
, '/')
577 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
578 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
579 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
580 || ! strncmp (&in
[size
- 5], ".dir", 4))
581 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
582 && in
[size
] == '1')))
584 register char *p
, *dot
;
588 dir:x.dir --> dir:[x]
589 dir:[x]y.dir --> dir:[x.y] */
591 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
594 strncpy (out
, in
, p
- in
);
613 dot
= index (p
, '.');
616 /* blindly remove any extension */
617 size
= strlen (out
) + (dot
- p
);
618 strncat (out
, p
, dot
- p
);
629 /* For Unix syntax, Append a slash if necessary */
630 if (!IS_DIRECTORY_SEP (out
[size
]))
632 /* Cannot use DIRECTORY_SEP, which could have any value */
634 out
[size
+ 2] = '\0';
637 CORRECT_DIR_SEPS (out
);
643 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
644 Sfile_name_as_directory
, 1, 1, 0,
645 doc
: /* Return a string representing the file name FILE interpreted as a directory.
646 This operation exists because a directory is also a file, but its name as
647 a directory is different from its name as a file.
648 The result can be used as the value of `default-directory'
649 or passed as second argument to `expand-file-name'.
650 For a Unix-syntax file name, just appends a slash.
651 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
662 /* If the file name has special constructs in it,
663 call the corresponding file handler. */
664 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
666 return call2 (handler
, Qfile_name_as_directory
, file
);
668 buf
= (char *) alloca (SBYTES (file
) + 10);
669 file_name_as_directory (buf
, SDATA (file
));
670 return make_specified_string (buf
, -1, strlen (buf
),
671 STRING_MULTIBYTE (file
));
675 * Convert from directory name to filename.
677 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
678 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
679 * On UNIX, it's simple: just make sure there isn't a terminating /
681 * Value is nonzero if the string output is different from the input.
685 directory_file_name (src
, dst
)
693 struct FAB fab
= cc$rms_fab
;
694 struct NAM nam
= cc$rms_nam
;
695 char esa
[NAM$C_MAXRSS
];
700 if (! index (src
, '/')
701 && (src
[slen
- 1] == ']'
702 || src
[slen
- 1] == ':'
703 || src
[slen
- 1] == '>'))
705 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
707 fab
.fab$b_fns
= slen
;
708 fab
.fab$l_nam
= &nam
;
709 fab
.fab$l_fop
= FAB$M_NAM
;
712 nam
.nam$b_ess
= sizeof esa
;
713 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
715 /* We call SYS$PARSE to handle such things as [--] for us. */
716 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
718 slen
= nam
.nam$b_esl
;
719 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
724 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
726 /* what about when we have logical_name:???? */
727 if (src
[slen
- 1] == ':')
728 { /* Xlate logical name and see what we get */
729 ptr
= strcpy (dst
, src
); /* upper case for getenv */
732 if ('a' <= *ptr
&& *ptr
<= 'z')
736 dst
[slen
- 1] = 0; /* remove colon */
737 if (!(src
= egetenv (dst
)))
739 /* should we jump to the beginning of this procedure?
740 Good points: allows us to use logical names that xlate
742 Bad points: can be a problem if we just translated to a device
744 For now, I'll punt and always expect VMS names, and hope for
747 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
748 { /* no recursion here! */
754 { /* not a directory spec */
759 bracket
= src
[slen
- 1];
761 /* If bracket is ']' or '>', bracket - 2 is the corresponding
763 ptr
= index (src
, bracket
- 2);
765 { /* no opening bracket */
769 if (!(rptr
= rindex (src
, '.')))
772 strncpy (dst
, src
, slen
);
776 dst
[slen
++] = bracket
;
781 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
782 then translate the device and recurse. */
783 if (dst
[slen
- 1] == ':'
784 && dst
[slen
- 2] != ':' /* skip decnet nodes */
785 && strcmp (src
+ slen
, "[000000]") == 0)
787 dst
[slen
- 1] = '\0';
788 if ((ptr
= egetenv (dst
))
789 && (rlen
= strlen (ptr
) - 1) > 0
790 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
791 && ptr
[rlen
- 1] == '.')
793 char * buf
= (char *) alloca (strlen (ptr
) + 1);
797 return directory_file_name (buf
, dst
);
802 strcat (dst
, "[000000]");
806 rlen
= strlen (rptr
) - 1;
807 strncat (dst
, rptr
, rlen
);
808 dst
[slen
+ rlen
] = '\0';
809 strcat (dst
, ".DIR.1");
813 /* Process as Unix format: just remove any final slash.
814 But leave "/" unchanged; do not change it to "". */
817 /* Handle // as root for apollo's. */
818 if ((slen
> 2 && dst
[slen
- 1] == '/')
819 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
823 && IS_DIRECTORY_SEP (dst
[slen
- 1])
825 && !IS_ANY_SEP (dst
[slen
- 2])
831 CORRECT_DIR_SEPS (dst
);
836 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
838 doc
: /* Returns the file name of the directory named DIRECTORY.
839 This is the name of the file that holds the data for the directory DIRECTORY.
840 This operation exists because a directory is also a file, but its name as
841 a directory is different from its name as a file.
842 In Unix-syntax, this function just removes the final slash.
843 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
844 it returns a file name such as \"[X]Y.DIR.1\". */)
846 Lisp_Object directory
;
851 CHECK_STRING (directory
);
853 if (NILP (directory
))
856 /* If the file name has special constructs in it,
857 call the corresponding file handler. */
858 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
860 return call2 (handler
, Qdirectory_file_name
, directory
);
863 /* 20 extra chars is insufficient for VMS, since we might perform a
864 logical name translation. an equivalence string can be up to 255
865 chars long, so grab that much extra space... - sss */
866 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
868 buf
= (char *) alloca (SBYTES (directory
) + 20);
870 directory_file_name (SDATA (directory
), buf
);
871 return make_specified_string (buf
, -1, strlen (buf
),
872 STRING_MULTIBYTE (directory
));
875 static char make_temp_name_tbl
[64] =
877 'A','B','C','D','E','F','G','H',
878 'I','J','K','L','M','N','O','P',
879 'Q','R','S','T','U','V','W','X',
880 'Y','Z','a','b','c','d','e','f',
881 'g','h','i','j','k','l','m','n',
882 'o','p','q','r','s','t','u','v',
883 'w','x','y','z','0','1','2','3',
884 '4','5','6','7','8','9','-','_'
887 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
889 /* Value is a temporary file name starting with PREFIX, a string.
891 The Emacs process number forms part of the result, so there is
892 no danger of generating a name being used by another process.
893 In addition, this function makes an attempt to choose a name
894 which has no existing file. To make this work, PREFIX should be
895 an absolute file name.
897 BASE64_P non-zero means add the pid as 3 characters in base64
898 encoding. In this case, 6 characters will be added to PREFIX to
899 form the file name. Otherwise, if Emacs is running on a system
900 with long file names, add the pid as a decimal number.
902 This function signals an error if no unique file name could be
906 make_temp_name (prefix
, base64_p
)
913 unsigned char *p
, *data
;
917 CHECK_STRING (prefix
);
919 /* VAL is created by adding 6 characters to PREFIX. The first
920 three are the PID of this process, in base 64, and the second
921 three are incremented if the file already exists. This ensures
922 262144 unique file names per PID per PREFIX. */
924 pid
= (int) getpid ();
928 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
929 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
930 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
935 #ifdef HAVE_LONG_FILE_NAMES
936 sprintf (pidbuf
, "%d", pid
);
937 pidlen
= strlen (pidbuf
);
939 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
940 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
941 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
946 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
947 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
948 if (!STRING_MULTIBYTE (prefix
))
949 STRING_SET_UNIBYTE (val
);
951 bcopy(SDATA (prefix
), data
, len
);
954 bcopy (pidbuf
, p
, pidlen
);
957 /* Here we try to minimize useless stat'ing when this function is
958 invoked many times successively with the same PREFIX. We achieve
959 this by initializing count to a random value, and incrementing it
962 We don't want make-temp-name to be called while dumping,
963 because then make_temp_name_count_initialized_p would get set
964 and then make_temp_name_count would not be set when Emacs starts. */
966 if (!make_temp_name_count_initialized_p
)
968 make_temp_name_count
= (unsigned) time (NULL
);
969 make_temp_name_count_initialized_p
= 1;
975 unsigned num
= make_temp_name_count
;
977 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
978 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
979 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
981 /* Poor man's congruential RN generator. Replace with
982 ++make_temp_name_count for debugging. */
983 make_temp_name_count
+= 25229;
984 make_temp_name_count
%= 225307;
986 if (stat (data
, &ignored
) < 0)
988 /* We want to return only if errno is ENOENT. */
992 /* The error here is dubious, but there is little else we
993 can do. The alternatives are to return nil, which is
994 as bad as (and in many cases worse than) throwing the
995 error, or to ignore the error, which will likely result
996 in looping through 225307 stat's, which is not only
997 dog-slow, but also useless since it will fallback to
998 the errow below, anyway. */
999 report_file_error ("Cannot create temporary name for prefix",
1000 Fcons (prefix
, Qnil
));
1005 error ("Cannot create temporary name for prefix `%s'",
1011 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1012 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1013 The Emacs process number forms part of the result,
1014 so there is no danger of generating a name being used by another process.
1016 In addition, this function makes an attempt to choose a name
1017 which has no existing file. To make this work,
1018 PREFIX should be an absolute file name.
1020 There is a race condition between calling `make-temp-name' and creating the
1021 file which opens all kinds of security holes. For that reason, you should
1022 probably use `make-temp-file' instead, except in three circumstances:
1024 * If you are creating the file in the user's home directory.
1025 * If you are creating a directory rather than an ordinary file.
1026 * If you are taking special precautions as `make-temp-file' does. */)
1030 return make_temp_name (prefix
, 0);
1035 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1036 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1037 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1038 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1039 the current buffer's value of `default-directory' is used.
1040 File name components that are `.' are removed, and
1041 so are file name components followed by `..', along with the `..' itself;
1042 note that these simplifications are done without checking the resulting
1043 file names in the file system.
1044 An initial `~/' expands to your home directory.
1045 An initial `~USER/' expands to USER's home directory.
1046 See also the function `substitute-in-file-name'. */)
1047 (name
, default_directory
)
1048 Lisp_Object name
, default_directory
;
1052 register unsigned char *newdir
, *p
, *o
;
1054 unsigned char *target
;
1057 unsigned char * colon
= 0;
1058 unsigned char * close
= 0;
1059 unsigned char * slash
= 0;
1060 unsigned char * brack
= 0;
1061 int lbrack
= 0, rbrack
= 0;
1066 int collapse_newdir
= 1;
1070 Lisp_Object handler
, result
;
1074 CHECK_STRING (name
);
1076 /* If the file name has special constructs in it,
1077 call the corresponding file handler. */
1078 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1079 if (!NILP (handler
))
1080 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1082 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1083 if (NILP (default_directory
))
1084 default_directory
= current_buffer
->directory
;
1085 if (! STRINGP (default_directory
))
1088 /* "/" is not considered a root directory on DOS_NT, so using "/"
1089 here causes an infinite recursion in, e.g., the following:
1091 (let (default-directory)
1092 (expand-file-name "a"))
1094 To avoid this, we set default_directory to the root of the
1096 extern char *emacs_root_dir (void);
1098 default_directory
= build_string (emacs_root_dir ());
1100 default_directory
= build_string ("/");
1104 if (!NILP (default_directory
))
1106 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1107 if (!NILP (handler
))
1108 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1111 o
= SDATA (default_directory
);
1113 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1114 It would be better to do this down below where we actually use
1115 default_directory. Unfortunately, calling Fexpand_file_name recursively
1116 could invoke GC, and the strings might be relocated. This would
1117 be annoying because we have pointers into strings lying around
1118 that would need adjusting, and people would add new pointers to
1119 the code and forget to adjust them, resulting in intermittent bugs.
1120 Putting this call here avoids all that crud.
1122 The EQ test avoids infinite recursion. */
1123 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1124 /* Save time in some common cases - as long as default_directory
1125 is not relative, it can be canonicalized with name below (if it
1126 is needed at all) without requiring it to be expanded now. */
1128 /* Detect MSDOS file names with drive specifiers. */
1129 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1131 /* Detect Windows file names in UNC format. */
1132 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1134 #else /* not DOS_NT */
1135 /* Detect Unix absolute file names (/... alone is not absolute on
1137 && ! (IS_DIRECTORY_SEP (o
[0]))
1138 #endif /* not DOS_NT */
1141 struct gcpro gcpro1
;
1144 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1148 name
= FILE_SYSTEM_CASE (name
);
1150 multibyte
= STRING_MULTIBYTE (name
);
1152 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
1153 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1156 /* Note if special escape prefix is present, but remove for now. */
1157 if (nm
[0] == '/' && nm
[1] == ':')
1163 /* Find and remove drive specifier if present; this makes nm absolute
1164 even if the rest of the name appears to be relative. Only look for
1165 drive specifier at the beginning. */
1166 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1173 /* If we see "c://somedir", we want to strip the first slash after the
1174 colon when stripping the drive letter. Otherwise, this expands to
1176 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1178 #endif /* WINDOWSNT */
1182 /* Discard any previous drive specifier if nm is now in UNC format. */
1183 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1189 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1190 none are found, we can probably return right away. We will avoid
1191 allocating a new string if name is already fully expanded. */
1193 IS_DIRECTORY_SEP (nm
[0])
1195 && drive
&& !is_escaped
1198 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1205 /* If it turns out that the filename we want to return is just a
1206 suffix of FILENAME, we don't need to go through and edit
1207 things; we just need to construct a new string using data
1208 starting at the middle of FILENAME. If we set lose to a
1209 non-zero value, that means we've discovered that we can't do
1216 /* Since we know the name is absolute, we can assume that each
1217 element starts with a "/". */
1219 /* "." and ".." are hairy. */
1220 if (IS_DIRECTORY_SEP (p
[0])
1222 && (IS_DIRECTORY_SEP (p
[2])
1224 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1227 /* We want to replace multiple `/' in a row with a single
1230 && IS_DIRECTORY_SEP (p
[0])
1231 && IS_DIRECTORY_SEP (p
[1]))
1238 /* if dev:[dir]/, move nm to / */
1239 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1240 nm
= (brack
? brack
+ 1 : colon
+ 1);
1241 lbrack
= rbrack
= 0;
1248 #ifdef NO_HYPHENS_IN_FILENAMES
1249 if (lbrack
== rbrack
)
1251 /* Avoid clobbering negative version numbers. */
1256 #endif /* NO_HYPHENS_IN_FILENAMES */
1258 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1259 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1261 #ifdef NO_HYPHENS_IN_FILENAMES
1264 #endif /* NO_HYPHENS_IN_FILENAMES */
1265 /* count open brackets, reset close bracket pointer */
1266 if (p
[0] == '[' || p
[0] == '<')
1267 lbrack
++, brack
= 0;
1268 /* count close brackets, set close bracket pointer */
1269 if (p
[0] == ']' || p
[0] == '>')
1270 rbrack
++, brack
= p
;
1271 /* detect ][ or >< */
1272 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1274 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1275 nm
= p
+ 1, lose
= 1;
1276 if (p
[0] == ':' && (colon
|| slash
))
1277 /* if dev1:[dir]dev2:, move nm to dev2: */
1283 /* if /name/dev:, move nm to dev: */
1286 /* if node::dev:, move colon following dev */
1287 else if (colon
&& colon
[-1] == ':')
1289 /* if dev1:dev2:, move nm to dev2: */
1290 else if (colon
&& colon
[-1] != ':')
1295 if (p
[0] == ':' && !colon
)
1301 if (lbrack
== rbrack
)
1304 else if (p
[0] == '.')
1312 if (index (nm
, '/'))
1314 nm
= sys_translate_unix (nm
);
1315 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1319 /* Make sure directories are all separated with / or \ as
1320 desired, but avoid allocation of a new string when not
1322 CORRECT_DIR_SEPS (nm
);
1324 if (IS_DIRECTORY_SEP (nm
[1]))
1326 if (strcmp (nm
, SDATA (name
)) != 0)
1327 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1331 /* drive must be set, so this is okay */
1332 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1336 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1337 temp
[0] = DRIVE_LETTER (drive
);
1338 name
= concat2 (build_string (temp
), name
);
1341 #else /* not DOS_NT */
1342 if (strcmp (nm
, SDATA (name
)) == 0)
1344 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1345 #endif /* not DOS_NT */
1349 /* At this point, nm might or might not be an absolute file name. We
1350 need to expand ~ or ~user if present, otherwise prefix nm with
1351 default_directory if nm is not absolute, and finally collapse /./
1352 and /foo/../ sequences.
1354 We set newdir to be the appropriate prefix if one is needed:
1355 - the relevant user directory if nm starts with ~ or ~user
1356 - the specified drive's working dir (DOS/NT only) if nm does not
1358 - the value of default_directory.
1360 Note that these prefixes are not guaranteed to be absolute (except
1361 for the working dir of a drive). Therefore, to ensure we always
1362 return an absolute name, if the final prefix is not absolute we
1363 append it to the current working directory. */
1367 if (nm
[0] == '~') /* prefix ~ */
1369 if (IS_DIRECTORY_SEP (nm
[1])
1373 || nm
[1] == 0) /* ~ by itself */
1377 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1378 newdir
= (unsigned char *) "";
1380 /* egetenv may return a unibyte string, which will bite us since
1381 we expect the directory to be multibyte. */
1382 tem
= build_string (newdir
);
1383 if (!STRING_MULTIBYTE (tem
))
1385 hdir
= DECODE_FILE (tem
);
1386 newdir
= SDATA (hdir
);
1389 collapse_newdir
= 0;
1392 nm
++; /* Don't leave the slash in nm. */
1395 else /* ~user/filename */
1397 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1402 o
= (unsigned char *) alloca (p
- nm
+ 1);
1403 bcopy ((char *) nm
, o
, p
- nm
);
1407 pw
= (struct passwd
*) getpwnam (o
+ 1);
1411 newdir
= (unsigned char *) pw
-> pw_dir
;
1413 nm
= p
+ 1; /* skip the terminator */
1417 collapse_newdir
= 0;
1422 /* If we don't find a user of that name, leave the name
1423 unchanged; don't move nm forward to p. */
1428 /* On DOS and Windows, nm is absolute if a drive name was specified;
1429 use the drive's current directory as the prefix if needed. */
1430 if (!newdir
&& drive
)
1432 /* Get default directory if needed to make nm absolute. */
1433 if (!IS_DIRECTORY_SEP (nm
[0]))
1435 newdir
= alloca (MAXPATHLEN
+ 1);
1436 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1441 /* Either nm starts with /, or drive isn't mounted. */
1442 newdir
= alloca (4);
1443 newdir
[0] = DRIVE_LETTER (drive
);
1451 /* Finally, if no prefix has been specified and nm is not absolute,
1452 then it must be expanded relative to default_directory. */
1456 /* /... alone is not absolute on DOS and Windows. */
1457 && !IS_DIRECTORY_SEP (nm
[0])
1460 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1467 newdir
= SDATA (default_directory
);
1468 multibyte
|= STRING_MULTIBYTE (default_directory
);
1470 /* Note if special escape prefix is present, but remove for now. */
1471 if (newdir
[0] == '/' && newdir
[1] == ':')
1482 /* First ensure newdir is an absolute name. */
1484 /* Detect MSDOS file names with drive specifiers. */
1485 ! (IS_DRIVE (newdir
[0])
1486 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1488 /* Detect Windows file names in UNC format. */
1489 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1493 /* Effectively, let newdir be (expand-file-name newdir cwd).
1494 Because of the admonition against calling expand-file-name
1495 when we have pointers into lisp strings, we accomplish this
1496 indirectly by prepending newdir to nm if necessary, and using
1497 cwd (or the wd of newdir's drive) as the new newdir. */
1499 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1504 if (!IS_DIRECTORY_SEP (nm
[0]))
1506 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1507 file_name_as_directory (tmp
, newdir
);
1511 newdir
= alloca (MAXPATHLEN
+ 1);
1514 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1521 /* Strip off drive name from prefix, if present. */
1522 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1528 /* Keep only a prefix from newdir if nm starts with slash
1529 (//server/share for UNC, nothing otherwise). */
1530 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1533 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1535 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1537 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1539 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1551 /* Get rid of any slash at the end of newdir, unless newdir is
1552 just / or // (an incomplete UNC name). */
1553 length
= strlen (newdir
);
1554 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1556 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1560 unsigned char *temp
= (unsigned char *) alloca (length
);
1561 bcopy (newdir
, temp
, length
- 1);
1562 temp
[length
- 1] = 0;
1570 /* Now concatenate the directory and name to new space in the stack frame */
1571 tlen
+= strlen (nm
) + 1;
1573 /* Reserve space for drive specifier and escape prefix, since either
1574 or both may need to be inserted. (The Microsoft x86 compiler
1575 produces incorrect code if the following two lines are combined.) */
1576 target
= (unsigned char *) alloca (tlen
+ 4);
1578 #else /* not DOS_NT */
1579 target
= (unsigned char *) alloca (tlen
);
1580 #endif /* not DOS_NT */
1586 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1589 /* If newdir is effectively "C:/", then the drive letter will have
1590 been stripped and newdir will be "/". Concatenating with an
1591 absolute directory in nm produces "//", which will then be
1592 incorrectly treated as a network share. Ignore newdir in
1593 this case (keeping the drive letter). */
1594 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1595 && newdir
[1] == '\0'))
1597 strcpy (target
, newdir
);
1601 file_name_as_directory (target
, newdir
);
1604 strcat (target
, nm
);
1606 if (index (target
, '/'))
1607 strcpy (target
, sys_translate_unix (target
));
1610 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1612 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1621 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1627 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1628 /* brackets are offset from each other by 2 */
1631 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1632 /* convert [foo][bar] to [bar] */
1633 while (o
[-1] != '[' && o
[-1] != '<')
1635 else if (*p
== '-' && *o
!= '.')
1638 else if (p
[0] == '-' && o
[-1] == '.'
1639 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1640 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1644 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1645 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1647 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1649 /* else [foo.-] ==> [-] */
1653 #ifdef NO_HYPHENS_IN_FILENAMES
1655 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1656 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1658 #endif /* NO_HYPHENS_IN_FILENAMES */
1662 if (!IS_DIRECTORY_SEP (*p
))
1666 else if (p
[1] == '.'
1667 && (IS_DIRECTORY_SEP (p
[2])
1670 /* If "/." is the entire filename, keep the "/". Otherwise,
1671 just delete the whole "/.". */
1672 if (o
== target
&& p
[2] == '\0')
1676 else if (p
[1] == '.' && p
[2] == '.'
1677 /* `/../' is the "superroot" on certain file systems.
1678 Turned off on DOS_NT systems because they have no
1679 "superroot" and because this causes us to produce
1680 file names like "d:/../foo" which fail file-related
1681 functions of the underlying OS. (To reproduce, try a
1682 long series of "../../" in default_directory, longer
1683 than the number of levels from the root.) */
1687 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1689 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1691 /* Keep initial / only if this is the whole name. */
1692 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1696 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1697 /* Collapse multiple `/' in a row. */
1703 #endif /* not VMS */
1707 /* At last, set drive name. */
1709 /* Except for network file name. */
1710 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1711 #endif /* WINDOWSNT */
1713 if (!drive
) abort ();
1715 target
[0] = DRIVE_LETTER (drive
);
1718 /* Reinsert the escape prefix if required. */
1725 CORRECT_DIR_SEPS (target
);
1728 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1730 /* Again look to see if the file name has special constructs in it
1731 and perhaps call the corresponding file handler. This is needed
1732 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1733 the ".." component gives us "/user@host:/bar/../baz" which needs
1734 to be expanded again. */
1735 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1736 if (!NILP (handler
))
1737 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1743 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1744 This is the old version of expand-file-name, before it was thoroughly
1745 rewritten for Emacs 10.31. We leave this version here commented-out,
1746 because the code is very complex and likely to have subtle bugs. If
1747 bugs _are_ found, it might be of interest to look at the old code and
1748 see what did it do in the relevant situation.
1750 Don't remove this code: it's true that it will be accessible via CVS,
1751 but a few years from deletion, people will forget it is there. */
1753 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1754 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1755 "Convert FILENAME to absolute, and canonicalize it.\n\
1756 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1757 \(does not start with slash); if DEFAULT is nil or missing,\n\
1758 the current buffer's value of default-directory is used.\n\
1759 Filenames containing `.' or `..' as components are simplified;\n\
1760 initial `~/' expands to your home directory.\n\
1761 See also the function `substitute-in-file-name'.")
1763 Lisp_Object name
, defalt
;
1767 register unsigned char *newdir
, *p
, *o
;
1769 unsigned char *target
;
1773 unsigned char * colon
= 0;
1774 unsigned char * close
= 0;
1775 unsigned char * slash
= 0;
1776 unsigned char * brack
= 0;
1777 int lbrack
= 0, rbrack
= 0;
1781 CHECK_STRING (name
);
1784 /* Filenames on VMS are always upper case. */
1785 name
= Fupcase (name
);
1790 /* If nm is absolute, flush ...// and detect /./ and /../.
1791 If no /./ or /../ we can return right away. */
1803 if (p
[0] == '/' && p
[1] == '/'
1805 /* // at start of filename is meaningful on Apollo system. */
1810 if (p
[0] == '/' && p
[1] == '~')
1811 nm
= p
+ 1, lose
= 1;
1812 if (p
[0] == '/' && p
[1] == '.'
1813 && (p
[2] == '/' || p
[2] == 0
1814 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1820 /* if dev:[dir]/, move nm to / */
1821 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1822 nm
= (brack
? brack
+ 1 : colon
+ 1);
1823 lbrack
= rbrack
= 0;
1831 /* VMS pre V4.4,convert '-'s in filenames. */
1832 if (lbrack
== rbrack
)
1834 if (dots
< 2) /* this is to allow negative version numbers */
1840 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1841 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1847 /* count open brackets, reset close bracket pointer */
1848 if (p
[0] == '[' || p
[0] == '<')
1849 lbrack
++, brack
= 0;
1850 /* count close brackets, set close bracket pointer */
1851 if (p
[0] == ']' || p
[0] == '>')
1852 rbrack
++, brack
= p
;
1853 /* detect ][ or >< */
1854 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1856 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1857 nm
= p
+ 1, lose
= 1;
1858 if (p
[0] == ':' && (colon
|| slash
))
1859 /* if dev1:[dir]dev2:, move nm to dev2: */
1865 /* If /name/dev:, move nm to dev: */
1868 /* If node::dev:, move colon following dev */
1869 else if (colon
&& colon
[-1] == ':')
1871 /* If dev1:dev2:, move nm to dev2: */
1872 else if (colon
&& colon
[-1] != ':')
1877 if (p
[0] == ':' && !colon
)
1883 if (lbrack
== rbrack
)
1886 else if (p
[0] == '.')
1894 if (index (nm
, '/'))
1895 return build_string (sys_translate_unix (nm
));
1897 if (nm
== SDATA (name
))
1899 return build_string (nm
);
1903 /* Now determine directory to start with and put it in NEWDIR */
1907 if (nm
[0] == '~') /* prefix ~ */
1912 || nm
[1] == 0)/* ~/filename */
1914 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1915 newdir
= (unsigned char *) "";
1918 nm
++; /* Don't leave the slash in nm. */
1921 else /* ~user/filename */
1923 /* Get past ~ to user */
1924 unsigned char *user
= nm
+ 1;
1925 /* Find end of name. */
1926 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1927 int len
= ptr
? ptr
- user
: strlen (user
);
1929 unsigned char *ptr1
= index (user
, ':');
1930 if (ptr1
!= 0 && ptr1
- user
< len
)
1933 /* Copy the user name into temp storage. */
1934 o
= (unsigned char *) alloca (len
+ 1);
1935 bcopy ((char *) user
, o
, len
);
1938 /* Look up the user name. */
1940 pw
= (struct passwd
*) getpwnam (o
+ 1);
1943 error ("\"%s\" isn't a registered user", o
+ 1);
1945 newdir
= (unsigned char *) pw
->pw_dir
;
1947 /* Discard the user name from NM. */
1954 #endif /* not VMS */
1958 defalt
= current_buffer
->directory
;
1959 CHECK_STRING (defalt
);
1960 newdir
= SDATA (defalt
);
1963 /* Now concatenate the directory and name to new space in the stack frame */
1965 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1966 target
= (unsigned char *) alloca (tlen
);
1972 if (nm
[0] == 0 || nm
[0] == '/')
1973 strcpy (target
, newdir
);
1976 file_name_as_directory (target
, newdir
);
1979 strcat (target
, nm
);
1981 if (index (target
, '/'))
1982 strcpy (target
, sys_translate_unix (target
));
1985 /* Now canonicalize by removing /. and /foo/.. if they appear */
1993 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1999 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
2000 /* brackets are offset from each other by 2 */
2003 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
2004 /* convert [foo][bar] to [bar] */
2005 while (o
[-1] != '[' && o
[-1] != '<')
2007 else if (*p
== '-' && *o
!= '.')
2010 else if (p
[0] == '-' && o
[-1] == '.'
2011 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2012 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2016 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2017 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2019 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2021 /* else [foo.-] ==> [-] */
2027 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2028 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2038 else if (!strncmp (p
, "//", 2)
2040 /* // at start of filename is meaningful in Apollo system. */
2048 else if (p
[0] == '/' && p
[1] == '.'
2049 && (p
[2] == '/' || p
[2] == 0))
2051 else if (!strncmp (p
, "/..", 3)
2052 /* `/../' is the "superroot" on certain file systems. */
2054 && (p
[3] == '/' || p
[3] == 0))
2056 while (o
!= target
&& *--o
!= '/')
2059 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2063 if (o
== target
&& *o
== '/')
2071 #endif /* not VMS */
2074 return make_string (target
, o
- target
);
2078 /* If /~ or // appears, discard everything through first slash. */
2080 file_name_absolute_p (filename
)
2081 const unsigned char *filename
;
2084 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2086 /* ??? This criterion is probably wrong for '<'. */
2087 || index (filename
, ':') || index (filename
, '<')
2088 || (*filename
== '[' && (filename
[1] != '-'
2089 || (filename
[2] != '.' && filename
[2] != ']'))
2090 && filename
[1] != '.')
2093 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2094 && IS_DIRECTORY_SEP (filename
[2]))
2099 static unsigned char *
2100 search_embedded_absfilename (nm
, endp
)
2101 unsigned char *nm
, *endp
;
2103 unsigned char *p
, *s
;
2105 for (p
= nm
+ 1; p
< endp
; p
++)
2109 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2111 || IS_DIRECTORY_SEP (p
[-1]))
2112 && file_name_absolute_p (p
)
2113 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2114 /* // at start of file name is meaningful in Apollo,
2115 WindowsNT and Cygwin systems. */
2116 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2117 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2120 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2125 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2127 unsigned char *o
= alloca (s
- p
+ 1);
2129 bcopy (p
, o
, s
- p
);
2132 /* If we have ~user and `user' exists, discard
2133 everything up to ~. But if `user' does not exist, leave
2134 ~user alone, it might be a literal file name. */
2136 pw
= getpwnam (o
+ 1);
2148 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2149 Ssubstitute_in_file_name
, 1, 1, 0,
2150 doc
: /* Substitute environment variables referred to in FILENAME.
2151 `$FOO' where FOO is an environment variable name means to substitute
2152 the value of that variable. The variable name should be terminated
2153 with a character not a letter, digit or underscore; otherwise, enclose
2154 the entire variable name in braces.
2155 If `/~' appears, all of FILENAME through that `/' is discarded.
2157 On VMS, `$' substitution is not done; this function does little and only
2158 duplicates what `expand-file-name' does. */)
2160 Lisp_Object filename
;
2164 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2165 unsigned char *target
= NULL
;
2167 int substituted
= 0;
2169 Lisp_Object handler
;
2171 CHECK_STRING (filename
);
2173 /* If the file name has special constructs in it,
2174 call the corresponding file handler. */
2175 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2176 if (!NILP (handler
))
2177 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2179 nm
= SDATA (filename
);
2181 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2182 CORRECT_DIR_SEPS (nm
);
2183 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2185 endp
= nm
+ SBYTES (filename
);
2187 /* If /~ or // appears, discard everything through first slash. */
2188 p
= search_embedded_absfilename (nm
, endp
);
2190 /* Start over with the new string, so we check the file-name-handler
2191 again. Important with filenames like "/home/foo//:/hello///there"
2192 which whould substitute to "/:/hello///there" rather than "/there". */
2193 return Fsubstitute_in_file_name
2194 (make_specified_string (p
, -1, endp
- p
,
2195 STRING_MULTIBYTE (filename
)));
2201 /* See if any variables are substituted into the string
2202 and find the total length of their values in `total' */
2204 for (p
= nm
; p
!= endp
;)
2214 /* "$$" means a single "$" */
2223 while (p
!= endp
&& *p
!= '}') p
++;
2224 if (*p
!= '}') goto missingclose
;
2230 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2234 /* Copy out the variable name */
2235 target
= (unsigned char *) alloca (s
- o
+ 1);
2236 strncpy (target
, o
, s
- o
);
2239 strupr (target
); /* $home == $HOME etc. */
2242 /* Get variable value */
2243 o
= (unsigned char *) egetenv (target
);
2245 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2246 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2256 /* If substitution required, recopy the string and do it */
2257 /* Make space in stack frame for the new copy */
2258 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2261 /* Copy the rest of the name through, replacing $ constructs with values */
2278 while (p
!= endp
&& *p
!= '}') p
++;
2279 if (*p
!= '}') goto missingclose
;
2285 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2289 /* Copy out the variable name */
2290 target
= (unsigned char *) alloca (s
- o
+ 1);
2291 strncpy (target
, o
, s
- o
);
2294 strupr (target
); /* $home == $HOME etc. */
2297 /* Get variable value */
2298 o
= (unsigned char *) egetenv (target
);
2302 strcpy (x
, target
); x
+= strlen (target
);
2304 else if (STRING_MULTIBYTE (filename
))
2306 /* If the original string is multibyte,
2307 convert what we substitute into multibyte. */
2310 int c
= unibyte_char_to_multibyte (*o
++);
2311 x
+= CHAR_STRING (c
, x
);
2323 /* If /~ or // appears, discard everything through first slash. */
2324 while ((p
= search_embedded_absfilename (xnm
, x
)))
2325 /* This time we do not start over because we've already expanded envvars
2326 and replaced $$ with $. Maybe we should start over as well, but we'd
2327 need to quote some $ to $$ first. */
2330 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2333 error ("Bad format environment-variable substitution");
2335 error ("Missing \"}\" in environment-variable substitution");
2337 error ("Substituting nonexistent environment variable \"%s\"", target
);
2340 #endif /* not VMS */
2344 /* A slightly faster and more convenient way to get
2345 (directory-file-name (expand-file-name FOO)). */
2348 expand_and_dir_to_file (filename
, defdir
)
2349 Lisp_Object filename
, defdir
;
2351 register Lisp_Object absname
;
2353 absname
= Fexpand_file_name (filename
, defdir
);
2356 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2357 if (c
== ':' || c
== ']' || c
== '>')
2358 absname
= Fdirectory_file_name (absname
);
2361 /* Remove final slash, if any (unless this is the root dir).
2362 stat behaves differently depending! */
2363 if (SCHARS (absname
) > 1
2364 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2365 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2366 /* We cannot take shortcuts; they might be wrong for magic file names. */
2367 absname
= Fdirectory_file_name (absname
);
2372 /* Signal an error if the file ABSNAME already exists.
2373 If INTERACTIVE is nonzero, ask the user whether to proceed,
2374 and bypass the error if the user says to go ahead.
2375 QUERYSTRING is a name for the action that is being considered
2378 *STATPTR is used to store the stat information if the file exists.
2379 If the file does not exist, STATPTR->st_mode is set to 0.
2380 If STATPTR is null, we don't store into it.
2382 If QUICK is nonzero, we ask for y or n, not yes or no. */
2385 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2386 Lisp_Object absname
;
2387 unsigned char *querystring
;
2389 struct stat
*statptr
;
2392 register Lisp_Object tem
, encoded_filename
;
2393 struct stat statbuf
;
2394 struct gcpro gcpro1
;
2396 encoded_filename
= ENCODE_FILE (absname
);
2398 /* stat is a good way to tell whether the file exists,
2399 regardless of what access permissions it has. */
2400 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2403 xsignal2 (Qfile_already_exists
,
2404 build_string ("File already exists"), absname
);
2406 tem
= format2 ("File %s already exists; %s anyway? ",
2407 absname
, build_string (querystring
));
2409 tem
= Fy_or_n_p (tem
);
2411 tem
= do_yes_or_no_p (tem
);
2414 xsignal2 (Qfile_already_exists
,
2415 build_string ("File already exists"), absname
);
2422 statptr
->st_mode
= 0;
2427 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2428 "fCopy file: \nGCopy %s to file: \np\nP",
2429 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2430 If NEWNAME names a directory, copy FILE there.
2432 This function always sets the file modes of the output file to match
2435 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2436 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2437 signal a `file-already-exists' error without overwriting. If
2438 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2439 about overwriting; this is what happens in interactive use with M-x.
2440 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2443 Fourth arg KEEP-TIME non-nil means give the output file the same
2444 last-modified time as the old one. (This works on only some systems.)
2446 A prefix arg makes KEEP-TIME non-nil.
2448 If PRESERVE-UID-GID is non-nil, we try to transfer the
2449 uid and gid of FILE to NEWNAME. */)
2450 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2451 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2452 Lisp_Object preserve_uid_gid
;
2455 char buf
[16 * 1024];
2456 struct stat st
, out_st
;
2457 Lisp_Object handler
;
2458 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2459 int count
= SPECPDL_INDEX ();
2460 int input_file_statable_p
;
2461 Lisp_Object encoded_file
, encoded_newname
;
2463 encoded_file
= encoded_newname
= Qnil
;
2464 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2465 CHECK_STRING (file
);
2466 CHECK_STRING (newname
);
2468 if (!NILP (Ffile_directory_p (newname
)))
2469 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2471 newname
= Fexpand_file_name (newname
, Qnil
);
2473 file
= Fexpand_file_name (file
, Qnil
);
2475 /* If the input file name has special constructs in it,
2476 call the corresponding file handler. */
2477 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2478 /* Likewise for output file name. */
2480 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2481 if (!NILP (handler
))
2482 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2483 ok_if_already_exists
, keep_time
));
2485 encoded_file
= ENCODE_FILE (file
);
2486 encoded_newname
= ENCODE_FILE (newname
);
2488 if (NILP (ok_if_already_exists
)
2489 || INTEGERP (ok_if_already_exists
))
2490 barf_or_query_if_file_exists (newname
, "copy to it",
2491 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2492 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2496 if (!CopyFile (SDATA (encoded_file
),
2497 SDATA (encoded_newname
),
2499 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2500 /* CopyFile retains the timestamp by default. */
2501 else if (NILP (keep_time
))
2507 EMACS_GET_TIME (now
);
2508 filename
= SDATA (encoded_newname
);
2510 /* Ensure file is writable while its modified time is set. */
2511 attributes
= GetFileAttributes (filename
);
2512 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2513 if (set_file_times (filename
, now
, now
))
2515 /* Restore original attributes. */
2516 SetFileAttributes (filename
, attributes
);
2517 xsignal2 (Qfile_date_error
,
2518 build_string ("Cannot set file date"), newname
);
2520 /* Restore original attributes. */
2521 SetFileAttributes (filename
, attributes
);
2523 #else /* not WINDOWSNT */
2525 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2529 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2531 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2533 /* We can only copy regular files and symbolic links. Other files are not
2535 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2537 #if !defined (MSDOS) || __DJGPP__ > 1
2538 if (out_st
.st_mode
!= 0
2539 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2542 report_file_error ("Input and output files are the same",
2543 Fcons (file
, Fcons (newname
, Qnil
)));
2547 #if defined (S_ISREG) && defined (S_ISLNK)
2548 if (input_file_statable_p
)
2550 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2552 #if defined (EISDIR)
2553 /* Get a better looking error message. */
2556 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2559 #endif /* S_ISREG && S_ISLNK */
2562 /* Create the copy file with the same record format as the input file */
2563 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2566 /* System's default file type was set to binary by _fmode in emacs.c. */
2567 ofd
= emacs_open (SDATA (encoded_newname
),
2568 O_WRONLY
| O_TRUNC
| O_CREAT
2569 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2570 S_IREAD
| S_IWRITE
);
2571 #else /* not MSDOS */
2572 ofd
= emacs_open (SDATA (encoded_newname
),
2573 O_WRONLY
| O_TRUNC
| O_CREAT
2574 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2576 #endif /* not MSDOS */
2579 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2581 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2585 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2586 if (emacs_write (ofd
, buf
, n
) != n
)
2587 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2591 /* Preserve the original file modes, and if requested, also its
2593 if (input_file_statable_p
)
2595 if (! NILP (preserve_uid_gid
))
2596 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2597 fchmod (ofd
, st
.st_mode
& 07777);
2599 #endif /* not MSDOS */
2601 /* Closing the output clobbers the file times on some systems. */
2602 if (emacs_close (ofd
) < 0)
2603 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2605 if (input_file_statable_p
)
2607 if (!NILP (keep_time
))
2609 EMACS_TIME atime
, mtime
;
2610 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2611 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2612 if (set_file_times (SDATA (encoded_newname
),
2614 xsignal2 (Qfile_date_error
,
2615 build_string ("Cannot set file date"), newname
);
2621 #if defined (__DJGPP__) && __DJGPP__ > 1
2622 if (input_file_statable_p
)
2624 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2625 and if it can't, it tells so. Otherwise, under MSDOS we usually
2626 get only the READ bit, which will make the copied file read-only,
2627 so it's better not to chmod at all. */
2628 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2629 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2631 #endif /* DJGPP version 2 or newer */
2632 #endif /* not WINDOWSNT */
2634 /* Discard the unwind protects. */
2635 specpdl_ptr
= specpdl
+ count
;
2641 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2642 Smake_directory_internal
, 1, 1, 0,
2643 doc
: /* Create a new directory named DIRECTORY. */)
2645 Lisp_Object directory
;
2647 const unsigned char *dir
;
2648 Lisp_Object handler
;
2649 Lisp_Object encoded_dir
;
2651 CHECK_STRING (directory
);
2652 directory
= Fexpand_file_name (directory
, Qnil
);
2654 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2655 if (!NILP (handler
))
2656 return call2 (handler
, Qmake_directory_internal
, directory
);
2658 encoded_dir
= ENCODE_FILE (directory
);
2660 dir
= SDATA (encoded_dir
);
2663 if (mkdir (dir
) != 0)
2665 if (mkdir (dir
, 0777) != 0)
2667 report_file_error ("Creating directory", list1 (directory
));
2672 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2673 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2675 Lisp_Object directory
;
2677 const unsigned char *dir
;
2678 Lisp_Object handler
;
2679 Lisp_Object encoded_dir
;
2681 CHECK_STRING (directory
);
2682 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2684 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2685 if (!NILP (handler
))
2686 return call2 (handler
, Qdelete_directory
, directory
);
2688 encoded_dir
= ENCODE_FILE (directory
);
2690 dir
= SDATA (encoded_dir
);
2692 if (rmdir (dir
) != 0)
2693 report_file_error ("Removing directory", list1 (directory
));
2698 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2699 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2700 If file has multiple names, it continues to exist with the other names. */)
2702 Lisp_Object filename
;
2704 Lisp_Object handler
;
2705 Lisp_Object encoded_file
;
2706 struct gcpro gcpro1
;
2709 if (!NILP (Ffile_directory_p (filename
))
2710 && NILP (Ffile_symlink_p (filename
)))
2711 xsignal2 (Qfile_error
,
2712 build_string ("Removing old name: is a directory"),
2715 filename
= Fexpand_file_name (filename
, Qnil
);
2717 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2718 if (!NILP (handler
))
2719 return call2 (handler
, Qdelete_file
, filename
);
2721 encoded_file
= ENCODE_FILE (filename
);
2723 if (0 > unlink (SDATA (encoded_file
)))
2724 report_file_error ("Removing old name", list1 (filename
));
2729 internal_delete_file_1 (ignore
)
2735 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2738 internal_delete_file (filename
)
2739 Lisp_Object filename
;
2742 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2743 Qt
, internal_delete_file_1
);
2747 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2748 "fRename file: \nGRename %s to file: \np",
2749 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2750 If file has names other than FILE, it continues to have those names.
2751 Signals a `file-already-exists' error if a file NEWNAME already exists
2752 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2753 A number as third arg means request confirmation if NEWNAME already exists.
2754 This is what happens in interactive use with M-x. */)
2755 (file
, newname
, ok_if_already_exists
)
2756 Lisp_Object file
, newname
, ok_if_already_exists
;
2758 Lisp_Object handler
;
2759 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2760 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2762 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2763 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2764 CHECK_STRING (file
);
2765 CHECK_STRING (newname
);
2766 file
= Fexpand_file_name (file
, Qnil
);
2768 if ((!NILP (Ffile_directory_p (newname
)))
2770 /* If the file names are identical but for the case,
2771 don't attempt to move directory to itself. */
2772 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2775 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2777 newname
= Fexpand_file_name (newname
, Qnil
);
2779 /* If the file name has special constructs in it,
2780 call the corresponding file handler. */
2781 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2783 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2784 if (!NILP (handler
))
2785 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2786 file
, newname
, ok_if_already_exists
));
2788 encoded_file
= ENCODE_FILE (file
);
2789 encoded_newname
= ENCODE_FILE (newname
);
2792 /* If the file names are identical but for the case, don't ask for
2793 confirmation: they simply want to change the letter-case of the
2795 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2797 if (NILP (ok_if_already_exists
)
2798 || INTEGERP (ok_if_already_exists
))
2799 barf_or_query_if_file_exists (newname
, "rename to it",
2800 INTEGERP (ok_if_already_exists
), 0, 0);
2802 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2804 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2805 || 0 > unlink (SDATA (encoded_file
)))
2811 symlink_target
= Ffile_symlink_p (file
);
2812 if (! NILP (symlink_target
))
2813 Fmake_symbolic_link (symlink_target
, newname
,
2814 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2817 Fcopy_file (file
, newname
,
2818 /* We have already prompted if it was an integer,
2819 so don't have copy-file prompt again. */
2820 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2823 Fdelete_file (file
);
2826 report_file_error ("Renaming", list2 (file
, newname
));
2832 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2833 "fAdd name to file: \nGName to add to %s: \np",
2834 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2835 Signals a `file-already-exists' error if a file NEWNAME already exists
2836 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2837 A number as third arg means request confirmation if NEWNAME already exists.
2838 This is what happens in interactive use with M-x. */)
2839 (file
, newname
, ok_if_already_exists
)
2840 Lisp_Object file
, newname
, ok_if_already_exists
;
2842 Lisp_Object handler
;
2843 Lisp_Object encoded_file
, encoded_newname
;
2844 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2846 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2847 encoded_file
= encoded_newname
= Qnil
;
2848 CHECK_STRING (file
);
2849 CHECK_STRING (newname
);
2850 file
= Fexpand_file_name (file
, Qnil
);
2852 if (!NILP (Ffile_directory_p (newname
)))
2853 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2855 newname
= Fexpand_file_name (newname
, Qnil
);
2857 /* If the file name has special constructs in it,
2858 call the corresponding file handler. */
2859 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2860 if (!NILP (handler
))
2861 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2862 newname
, ok_if_already_exists
));
2864 /* If the new name has special constructs in it,
2865 call the corresponding file handler. */
2866 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2867 if (!NILP (handler
))
2868 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2869 newname
, ok_if_already_exists
));
2871 encoded_file
= ENCODE_FILE (file
);
2872 encoded_newname
= ENCODE_FILE (newname
);
2874 if (NILP (ok_if_already_exists
)
2875 || INTEGERP (ok_if_already_exists
))
2876 barf_or_query_if_file_exists (newname
, "make it a new name",
2877 INTEGERP (ok_if_already_exists
), 0, 0);
2879 unlink (SDATA (newname
));
2880 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2881 report_file_error ("Adding new name", list2 (file
, newname
));
2887 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2888 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2889 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2890 Both args must be strings.
2891 Signals a `file-already-exists' error if a file LINKNAME already exists
2892 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2893 A number as third arg means request confirmation if LINKNAME already exists.
2894 This happens for interactive use with M-x. */)
2895 (filename
, linkname
, ok_if_already_exists
)
2896 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2898 Lisp_Object handler
;
2899 Lisp_Object encoded_filename
, encoded_linkname
;
2900 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2902 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2903 encoded_filename
= encoded_linkname
= Qnil
;
2904 CHECK_STRING (filename
);
2905 CHECK_STRING (linkname
);
2906 /* If the link target has a ~, we must expand it to get
2907 a truly valid file name. Otherwise, do not expand;
2908 we want to permit links to relative file names. */
2909 if (SREF (filename
, 0) == '~')
2910 filename
= Fexpand_file_name (filename
, Qnil
);
2912 if (!NILP (Ffile_directory_p (linkname
)))
2913 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2915 linkname
= Fexpand_file_name (linkname
, Qnil
);
2917 /* If the file name has special constructs in it,
2918 call the corresponding file handler. */
2919 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2920 if (!NILP (handler
))
2921 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2922 linkname
, ok_if_already_exists
));
2924 /* If the new link name has special constructs in it,
2925 call the corresponding file handler. */
2926 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2927 if (!NILP (handler
))
2928 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2929 linkname
, ok_if_already_exists
));
2932 encoded_filename
= ENCODE_FILE (filename
);
2933 encoded_linkname
= ENCODE_FILE (linkname
);
2935 if (NILP (ok_if_already_exists
)
2936 || INTEGERP (ok_if_already_exists
))
2937 barf_or_query_if_file_exists (linkname
, "make it a link",
2938 INTEGERP (ok_if_already_exists
), 0, 0);
2939 if (0 > symlink (SDATA (encoded_filename
),
2940 SDATA (encoded_linkname
)))
2942 /* If we didn't complain already, silently delete existing file. */
2943 if (errno
== EEXIST
)
2945 unlink (SDATA (encoded_linkname
));
2946 if (0 <= symlink (SDATA (encoded_filename
),
2947 SDATA (encoded_linkname
)))
2954 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2961 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2963 #endif /* S_IFLNK */
2968 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2969 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2970 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2971 If STRING is nil or a null string, the logical name NAME is deleted. */)
2976 CHECK_STRING (name
);
2978 delete_logical_name (SDATA (name
));
2981 CHECK_STRING (string
);
2983 if (SCHARS (string
) == 0)
2984 delete_logical_name (SDATA (name
));
2986 define_logical_name (SDATA (name
), SDATA (string
));
2995 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2996 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2998 Lisp_Object path
, login
;
3002 CHECK_STRING (path
);
3003 CHECK_STRING (login
);
3005 netresult
= netunam (SDATA (path
), SDATA (login
));
3007 if (netresult
== -1)
3012 #endif /* HPUX_NET */
3014 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3016 doc
: /* Return t if file FILENAME specifies an absolute file name.
3017 On Unix, this is a name starting with a `/' or a `~'. */)
3019 Lisp_Object filename
;
3021 CHECK_STRING (filename
);
3022 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3025 /* Return nonzero if file FILENAME exists and can be executed. */
3028 check_executable (filename
)
3032 int len
= strlen (filename
);
3035 if (stat (filename
, &st
) < 0)
3037 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3038 return ((st
.st_mode
& S_IEXEC
) != 0);
3040 return (S_ISREG (st
.st_mode
)
3042 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3043 || stricmp (suffix
, ".exe") == 0
3044 || stricmp (suffix
, ".bat") == 0)
3045 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3046 #endif /* not WINDOWSNT */
3047 #else /* not DOS_NT */
3048 #ifdef HAVE_EUIDACCESS
3049 return (euidaccess (filename
, 1) >= 0);
3051 /* Access isn't quite right because it uses the real uid
3052 and we really want to test with the effective uid.
3053 But Unix doesn't give us a right way to do it. */
3054 return (access (filename
, 1) >= 0);
3056 #endif /* not DOS_NT */
3059 /* Return nonzero if file FILENAME exists and can be written. */
3062 check_writable (filename
)
3067 if (stat (filename
, &st
) < 0)
3069 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3070 #else /* not MSDOS */
3071 #ifdef HAVE_EUIDACCESS
3072 return (euidaccess (filename
, 2) >= 0);
3074 /* Access isn't quite right because it uses the real uid
3075 and we really want to test with the effective uid.
3076 But Unix doesn't give us a right way to do it.
3077 Opening with O_WRONLY could work for an ordinary file,
3078 but would lose for directories. */
3079 return (access (filename
, 2) >= 0);
3081 #endif /* not MSDOS */
3084 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3085 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3086 See also `file-readable-p' and `file-attributes'.
3087 This returns nil for a symlink to a nonexistent file.
3088 Use `file-symlink-p' to test for such links. */)
3090 Lisp_Object filename
;
3092 Lisp_Object absname
;
3093 Lisp_Object handler
;
3094 struct stat statbuf
;
3096 CHECK_STRING (filename
);
3097 absname
= Fexpand_file_name (filename
, Qnil
);
3099 /* If the file name has special constructs in it,
3100 call the corresponding file handler. */
3101 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3102 if (!NILP (handler
))
3103 return call2 (handler
, Qfile_exists_p
, absname
);
3105 absname
= ENCODE_FILE (absname
);
3107 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3110 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3111 doc
: /* Return t if FILENAME can be executed by you.
3112 For a directory, this means you can access files in that directory. */)
3114 Lisp_Object filename
;
3116 Lisp_Object absname
;
3117 Lisp_Object handler
;
3119 CHECK_STRING (filename
);
3120 absname
= Fexpand_file_name (filename
, Qnil
);
3122 /* If the file name has special constructs in it,
3123 call the corresponding file handler. */
3124 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3125 if (!NILP (handler
))
3126 return call2 (handler
, Qfile_executable_p
, absname
);
3128 absname
= ENCODE_FILE (absname
);
3130 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3133 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3134 doc
: /* Return t if file FILENAME exists and you can read it.
3135 See also `file-exists-p' and `file-attributes'. */)
3137 Lisp_Object filename
;
3139 Lisp_Object absname
;
3140 Lisp_Object handler
;
3143 struct stat statbuf
;
3145 CHECK_STRING (filename
);
3146 absname
= Fexpand_file_name (filename
, Qnil
);
3148 /* If the file name has special constructs in it,
3149 call the corresponding file handler. */
3150 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3151 if (!NILP (handler
))
3152 return call2 (handler
, Qfile_readable_p
, absname
);
3154 absname
= ENCODE_FILE (absname
);
3156 #if defined(DOS_NT) || defined(macintosh)
3157 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3159 if (access (SDATA (absname
), 0) == 0)
3162 #else /* not DOS_NT and not macintosh */
3164 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3165 /* Opening a fifo without O_NONBLOCK can wait.
3166 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3167 except in the case of a fifo, on a system which handles it. */
3168 desc
= stat (SDATA (absname
), &statbuf
);
3171 if (S_ISFIFO (statbuf
.st_mode
))
3172 flags
|= O_NONBLOCK
;
3174 desc
= emacs_open (SDATA (absname
), flags
, 0);
3179 #endif /* not DOS_NT and not macintosh */
3182 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3184 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3185 doc
: /* Return t if file FILENAME can be written or created by you. */)
3187 Lisp_Object filename
;
3189 Lisp_Object absname
, dir
, encoded
;
3190 Lisp_Object handler
;
3191 struct stat statbuf
;
3193 CHECK_STRING (filename
);
3194 absname
= Fexpand_file_name (filename
, Qnil
);
3196 /* If the file name has special constructs in it,
3197 call the corresponding file handler. */
3198 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3199 if (!NILP (handler
))
3200 return call2 (handler
, Qfile_writable_p
, absname
);
3202 encoded
= ENCODE_FILE (absname
);
3203 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3204 return (check_writable (SDATA (encoded
))
3207 dir
= Ffile_name_directory (absname
);
3210 dir
= Fdirectory_file_name (dir
);
3214 dir
= Fdirectory_file_name (dir
);
3217 dir
= ENCODE_FILE (dir
);
3219 /* The read-only attribute of the parent directory doesn't affect
3220 whether a file or directory can be created within it. Some day we
3221 should check ACLs though, which do affect this. */
3222 if (stat (SDATA (dir
), &statbuf
) < 0)
3224 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3226 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3231 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3232 doc
: /* Access file FILENAME, and get an error if that does not work.
3233 The second argument STRING is used in the error message.
3234 If there is no error, returns nil. */)
3236 Lisp_Object filename
, string
;
3238 Lisp_Object handler
, encoded_filename
, absname
;
3241 CHECK_STRING (filename
);
3242 absname
= Fexpand_file_name (filename
, Qnil
);
3244 CHECK_STRING (string
);
3246 /* If the file name has special constructs in it,
3247 call the corresponding file handler. */
3248 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3249 if (!NILP (handler
))
3250 return call3 (handler
, Qaccess_file
, absname
, string
);
3252 encoded_filename
= ENCODE_FILE (absname
);
3254 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3256 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3262 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3263 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3264 The value is the link target, as a string.
3265 Otherwise it returns nil.
3267 This function returns t when given the name of a symlink that
3268 points to a nonexistent file. */)
3270 Lisp_Object filename
;
3272 Lisp_Object handler
;
3274 CHECK_STRING (filename
);
3275 filename
= Fexpand_file_name (filename
, Qnil
);
3277 /* If the file name has special constructs in it,
3278 call the corresponding file handler. */
3279 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3280 if (!NILP (handler
))
3281 return call2 (handler
, Qfile_symlink_p
, filename
);
3290 filename
= ENCODE_FILE (filename
);
3297 buf
= (char *) xrealloc (buf
, bufsize
);
3298 bzero (buf
, bufsize
);
3301 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3305 /* HP-UX reports ERANGE if buffer is too small. */
3306 if (errno
== ERANGE
)
3316 while (valsize
>= bufsize
);
3318 val
= make_string (buf
, valsize
);
3319 if (buf
[0] == '/' && index (buf
, ':'))
3320 val
= concat2 (build_string ("/:"), val
);
3322 val
= DECODE_FILE (val
);
3325 #else /* not S_IFLNK */
3327 #endif /* not S_IFLNK */
3330 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3331 doc
: /* Return t if FILENAME names an existing directory.
3332 Symbolic links to directories count as directories.
3333 See `file-symlink-p' to distinguish symlinks. */)
3335 Lisp_Object filename
;
3337 register Lisp_Object absname
;
3339 Lisp_Object handler
;
3341 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3343 /* If the file name has special constructs in it,
3344 call the corresponding file handler. */
3345 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3346 if (!NILP (handler
))
3347 return call2 (handler
, Qfile_directory_p
, absname
);
3349 absname
= ENCODE_FILE (absname
);
3351 if (stat (SDATA (absname
), &st
) < 0)
3353 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3356 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3357 doc
: /* Return t if file FILENAME names a directory you can open.
3358 For the value to be t, FILENAME must specify the name of a directory as a file,
3359 and the directory must allow you to open files in it. In order to use a
3360 directory as a buffer's current directory, this predicate must return true.
3361 A directory name spec may be given instead; then the value is t
3362 if the directory so specified exists and really is a readable and
3363 searchable directory. */)
3365 Lisp_Object filename
;
3367 Lisp_Object handler
;
3369 struct gcpro gcpro1
;
3371 /* If the file name has special constructs in it,
3372 call the corresponding file handler. */
3373 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3374 if (!NILP (handler
))
3375 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3378 tem
= (NILP (Ffile_directory_p (filename
))
3379 || NILP (Ffile_executable_p (filename
)));
3381 return tem
? Qnil
: Qt
;
3384 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3385 doc
: /* Return t if FILENAME names a regular file.
3386 This is the sort of file that holds an ordinary stream of data bytes.
3387 Symbolic links to regular files count as regular files.
3388 See `file-symlink-p' to distinguish symlinks. */)
3390 Lisp_Object filename
;
3392 register Lisp_Object absname
;
3394 Lisp_Object handler
;
3396 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3398 /* If the file name has special constructs in it,
3399 call the corresponding file handler. */
3400 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3401 if (!NILP (handler
))
3402 return call2 (handler
, Qfile_regular_p
, absname
);
3404 absname
= ENCODE_FILE (absname
);
3409 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3411 /* Tell stat to use expensive method to get accurate info. */
3412 Vw32_get_true_file_attributes
= Qt
;
3413 result
= stat (SDATA (absname
), &st
);
3414 Vw32_get_true_file_attributes
= tem
;
3418 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3421 if (stat (SDATA (absname
), &st
) < 0)
3423 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3427 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3428 doc
: /* Return mode bits of file named FILENAME, as an integer.
3429 Return nil, if file does not exist or is not accessible. */)
3431 Lisp_Object filename
;
3433 Lisp_Object absname
;
3435 Lisp_Object handler
;
3437 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3439 /* If the file name has special constructs in it,
3440 call the corresponding file handler. */
3441 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3442 if (!NILP (handler
))
3443 return call2 (handler
, Qfile_modes
, absname
);
3445 absname
= ENCODE_FILE (absname
);
3447 if (stat (SDATA (absname
), &st
) < 0)
3449 #if defined (MSDOS) && __DJGPP__ < 2
3450 if (check_executable (SDATA (absname
)))
3451 st
.st_mode
|= S_IEXEC
;
3452 #endif /* MSDOS && __DJGPP__ < 2 */
3454 return make_number (st
.st_mode
& 07777);
3457 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3458 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3459 Only the 12 low bits of MODE are used. */)
3461 Lisp_Object filename
, mode
;
3463 Lisp_Object absname
, encoded_absname
;
3464 Lisp_Object handler
;
3466 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3467 CHECK_NUMBER (mode
);
3469 /* If the file name has special constructs in it,
3470 call the corresponding file handler. */
3471 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3472 if (!NILP (handler
))
3473 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3475 encoded_absname
= ENCODE_FILE (absname
);
3477 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3478 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3483 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3484 doc
: /* Set the file permission bits for newly created files.
3485 The argument MODE should be an integer; only the low 9 bits are used.
3486 This setting is inherited by subprocesses. */)
3490 CHECK_NUMBER (mode
);
3492 umask ((~ XINT (mode
)) & 0777);
3497 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3498 doc
: /* Return the default file protection for created files.
3499 The value is an integer. */)
3505 realmask
= umask (0);
3508 XSETINT (value
, (~ realmask
) & 0777);
3512 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3514 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3515 doc
: /* Set times of file FILENAME to TIME.
3516 Set both access and modification times.
3517 Return t on success, else nil.
3518 Use the current time if TIME is nil. TIME is in the format of
3521 Lisp_Object filename
, time
;
3523 Lisp_Object absname
, encoded_absname
;
3524 Lisp_Object handler
;
3528 if (! lisp_time_argument (time
, &sec
, &usec
))
3529 error ("Invalid time specification");
3531 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3533 /* If the file name has special constructs in it,
3534 call the corresponding file handler. */
3535 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3536 if (!NILP (handler
))
3537 return call3 (handler
, Qset_file_times
, absname
, time
);
3539 encoded_absname
= ENCODE_FILE (absname
);
3544 EMACS_SET_SECS (t
, sec
);
3545 EMACS_SET_USECS (t
, usec
);
3547 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3552 /* Setting times on a directory always fails. */
3553 if (stat (SDATA (encoded_absname
), &st
) == 0
3554 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3557 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3566 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3567 doc
: /* Tell Unix to finish all pending disk updates. */)
3574 #endif /* HAVE_SYNC */
3576 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3577 doc
: /* Return t if file FILE1 is newer than file FILE2.
3578 If FILE1 does not exist, the answer is nil;
3579 otherwise, if FILE2 does not exist, the answer is t. */)
3581 Lisp_Object file1
, file2
;
3583 Lisp_Object absname1
, absname2
;
3586 Lisp_Object handler
;
3587 struct gcpro gcpro1
, gcpro2
;
3589 CHECK_STRING (file1
);
3590 CHECK_STRING (file2
);
3593 GCPRO2 (absname1
, file2
);
3594 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3595 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3598 /* If the file name has special constructs in it,
3599 call the corresponding file handler. */
3600 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3602 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3603 if (!NILP (handler
))
3604 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3606 GCPRO2 (absname1
, absname2
);
3607 absname1
= ENCODE_FILE (absname1
);
3608 absname2
= ENCODE_FILE (absname2
);
3611 if (stat (SDATA (absname1
), &st
) < 0)
3614 mtime1
= st
.st_mtime
;
3616 if (stat (SDATA (absname2
), &st
) < 0)
3619 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3623 Lisp_Object Qfind_buffer_file_type
;
3626 #ifndef READ_BUF_SIZE
3627 #define READ_BUF_SIZE (64 << 10)
3630 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3632 /* This function is called after Lisp functions to decide a coding
3633 system are called, or when they cause an error. Before they are
3634 called, the current buffer is set unibyte and it contains only a
3635 newly inserted text (thus the buffer was empty before the
3638 The functions may set markers, overlays, text properties, or even
3639 alter the buffer contents, change the current buffer.
3641 Here, we reset all those changes by:
3642 o set back the current buffer.
3643 o move all markers and overlays to BEG.
3644 o remove all text properties.
3645 o set back the buffer multibyteness. */
3648 decide_coding_unwind (unwind_data
)
3649 Lisp_Object unwind_data
;
3651 Lisp_Object multibyte
, undo_list
, buffer
;
3653 multibyte
= XCAR (unwind_data
);
3654 unwind_data
= XCDR (unwind_data
);
3655 undo_list
= XCAR (unwind_data
);
3656 buffer
= XCDR (unwind_data
);
3658 if (current_buffer
!= XBUFFER (buffer
))
3659 set_buffer_internal (XBUFFER (buffer
));
3660 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3661 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3662 BUF_INTERVALS (current_buffer
) = 0;
3663 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3665 /* Now we are safe to change the buffer's multibyteness directly. */
3666 current_buffer
->enable_multibyte_characters
= multibyte
;
3667 current_buffer
->undo_list
= undo_list
;
3673 /* Used to pass values from insert-file-contents to read_non_regular. */
3675 static int non_regular_fd
;
3676 static int non_regular_inserted
;
3677 static int non_regular_nbytes
;
3680 /* Read from a non-regular file.
3681 Read non_regular_trytry bytes max from non_regular_fd.
3682 Non_regular_inserted specifies where to put the read bytes.
3683 Value is the number of bytes read. */
3692 nbytes
= emacs_read (non_regular_fd
,
3693 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3694 non_regular_nbytes
);
3696 return make_number (nbytes
);
3700 /* Condition-case handler used when reading from non-regular files
3701 in insert-file-contents. */
3704 read_non_regular_quit ()
3710 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3712 doc
: /* Insert contents of file FILENAME after point.
3713 Returns list of absolute file name and number of characters inserted.
3714 If second argument VISIT is non-nil, the buffer's visited filename
3715 and last save file modtime are set, and it is marked unmodified.
3716 If visiting and the file does not exist, visiting is completed
3717 before the error is signaled.
3718 The optional third and fourth arguments BEG and END
3719 specify what portion of the file to insert.
3720 These arguments count bytes in the file, not characters in the buffer.
3721 If VISIT is non-nil, BEG and END must be nil.
3723 If optional fifth argument REPLACE is non-nil,
3724 it means replace the current buffer contents (in the accessible portion)
3725 with the file contents. This is better than simply deleting and inserting
3726 the whole thing because (1) it preserves some marker positions
3727 and (2) it puts less data in the undo list.
3728 When REPLACE is non-nil, the value is the number of characters actually read,
3729 which is often less than the number of characters to be read.
3731 This does code conversion according to the value of
3732 `coding-system-for-read' or `file-coding-system-alist',
3733 and sets the variable `last-coding-system-used' to the coding system
3735 (filename
, visit
, beg
, end
, replace
)
3736 Lisp_Object filename
, visit
, beg
, end
, replace
;
3741 register int how_much
;
3742 register int unprocessed
;
3743 int count
= SPECPDL_INDEX ();
3744 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3745 Lisp_Object handler
, val
, insval
, orig_filename
;
3748 int not_regular
= 0;
3749 unsigned char read_buf
[READ_BUF_SIZE
];
3750 struct coding_system coding
;
3751 unsigned char buffer
[1 << 14];
3752 int replace_handled
= 0;
3753 int set_coding_system
= 0;
3754 int coding_system_decided
= 0;
3756 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3757 int we_locked_file
= 0;
3759 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3760 error ("Cannot do file visiting in an indirect buffer");
3762 if (!NILP (current_buffer
->read_only
))
3763 Fbarf_if_buffer_read_only ();
3767 orig_filename
= Qnil
;
3769 GCPRO4 (filename
, val
, p
, orig_filename
);
3771 CHECK_STRING (filename
);
3772 filename
= Fexpand_file_name (filename
, Qnil
);
3774 /* If the file name has special constructs in it,
3775 call the corresponding file handler. */
3776 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3777 if (!NILP (handler
))
3779 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3780 visit
, beg
, end
, replace
);
3781 if (CONSP (val
) && CONSP (XCDR (val
)))
3782 inserted
= XINT (XCAR (XCDR (val
)));
3786 orig_filename
= filename
;
3787 filename
= ENCODE_FILE (filename
);
3793 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3795 /* Tell stat to use expensive method to get accurate info. */
3796 Vw32_get_true_file_attributes
= Qt
;
3797 total
= stat (SDATA (filename
), &st
);
3798 Vw32_get_true_file_attributes
= tem
;
3803 if (stat (SDATA (filename
), &st
) < 0)
3805 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3806 || fstat (fd
, &st
) < 0)
3807 #endif /* not APOLLO */
3808 #endif /* WINDOWSNT */
3810 if (fd
>= 0) emacs_close (fd
);
3813 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3816 if (!NILP (Vcoding_system_for_read
))
3817 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3822 /* This code will need to be changed in order to work on named
3823 pipes, and it's probably just not worth it. So we should at
3824 least signal an error. */
3825 if (!S_ISREG (st
.st_mode
))
3832 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3833 xsignal2 (Qfile_error
,
3834 build_string ("not a regular file"), orig_filename
);
3839 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3842 /* Replacement should preserve point as it preserves markers. */
3843 if (!NILP (replace
))
3844 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3846 record_unwind_protect (close_file_unwind
, make_number (fd
));
3848 /* Supposedly happens on VMS. */
3849 /* Can happen on any platform that uses long as type of off_t, but allows
3850 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3851 give a message suitable for the latter case. */
3852 if (! not_regular
&& st
.st_size
< 0)
3853 error ("Maximum buffer size exceeded");
3855 /* Prevent redisplay optimizations. */
3856 current_buffer
->clip_changed
= 1;
3860 if (!NILP (beg
) || !NILP (end
))
3861 error ("Attempt to visit less than an entire file");
3862 if (BEG
< Z
&& NILP (replace
))
3863 error ("Cannot do file visiting in a non-empty buffer");
3869 XSETFASTINT (beg
, 0);
3877 XSETINT (end
, st
.st_size
);
3879 /* Arithmetic overflow can occur if an Emacs integer cannot
3880 represent the file size, or if the calculations below
3881 overflow. The calculations below double the file size
3882 twice, so check that it can be multiplied by 4 safely. */
3883 if (XINT (end
) != st
.st_size
3884 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3885 error ("Maximum buffer size exceeded");
3887 /* The file size returned from stat may be zero, but data
3888 may be readable nonetheless, for example when this is a
3889 file in the /proc filesystem. */
3890 if (st
.st_size
== 0)
3891 XSETINT (end
, READ_BUF_SIZE
);
3895 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3897 /* We use emacs-mule for auto saving... */
3898 setup_coding_system (Qemacs_mule
, &coding
);
3899 /* ... but with the special flag to indicate to read in a
3900 multibyte sequence for eight-bit-control char as is. */
3902 coding
.src_multibyte
= 0;
3903 coding
.dst_multibyte
3904 = !NILP (current_buffer
->enable_multibyte_characters
);
3905 coding
.eol_type
= CODING_EOL_LF
;
3906 coding_system_decided
= 1;
3910 /* Decide the coding system to use for reading the file now
3911 because we can't use an optimized method for handling
3912 `coding:' tag if the current buffer is not empty. */
3916 if (!NILP (Vcoding_system_for_read
))
3917 val
= Vcoding_system_for_read
;
3920 /* Don't try looking inside a file for a coding system
3921 specification if it is not seekable. */
3922 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3924 /* Find a coding system specified in the heading two
3925 lines or in the tailing several lines of the file.
3926 We assume that the 1K-byte and 3K-byte for heading
3927 and tailing respectively are sufficient for this
3931 if (st
.st_size
<= (1024 * 4))
3932 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3935 nread
= emacs_read (fd
, read_buf
, 1024);
3938 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3939 report_file_error ("Setting file position",
3940 Fcons (orig_filename
, Qnil
));
3941 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3946 error ("IO error reading %s: %s",
3947 SDATA (orig_filename
), emacs_strerror (errno
));
3950 struct buffer
*prev
= current_buffer
;
3954 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3956 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3957 buf
= XBUFFER (buffer
);
3959 delete_all_overlays (buf
);
3960 buf
->directory
= current_buffer
->directory
;
3961 buf
->read_only
= Qnil
;
3962 buf
->filename
= Qnil
;
3963 buf
->undo_list
= Qt
;
3964 eassert (buf
->overlays_before
== NULL
);
3965 eassert (buf
->overlays_after
== NULL
);
3967 set_buffer_internal (buf
);
3969 buf
->enable_multibyte_characters
= Qnil
;
3971 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3972 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3973 val
= call2 (Vset_auto_coding_function
,
3974 filename
, make_number (nread
));
3975 set_buffer_internal (prev
);
3977 /* Discard the unwind protect for recovering the
3981 /* Rewind the file for the actual read done later. */
3982 if (lseek (fd
, 0, 0) < 0)
3983 report_file_error ("Setting file position",
3984 Fcons (orig_filename
, Qnil
));
3990 /* If we have not yet decided a coding system, check
3991 file-coding-system-alist. */
3992 Lisp_Object args
[6], coding_systems
;
3994 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3995 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3996 coding_systems
= Ffind_operation_coding_system (6, args
);
3997 if (CONSP (coding_systems
))
3998 val
= XCAR (coding_systems
);
4002 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4003 /* Ensure we set Vlast_coding_system_used. */
4004 set_coding_system
= 1;
4006 if (NILP (current_buffer
->enable_multibyte_characters
)
4008 /* We must suppress all character code conversion except for
4009 end-of-line conversion. */
4010 setup_raw_text_coding_system (&coding
);
4012 coding
.src_multibyte
= 0;
4013 coding
.dst_multibyte
4014 = !NILP (current_buffer
->enable_multibyte_characters
);
4015 coding_system_decided
= 1;
4018 /* If requested, replace the accessible part of the buffer
4019 with the file contents. Avoid replacing text at the
4020 beginning or end of the buffer that matches the file contents;
4021 that preserves markers pointing to the unchanged parts.
4023 Here we implement this feature in an optimized way
4024 for the case where code conversion is NOT needed.
4025 The following if-statement handles the case of conversion
4026 in a less optimal way.
4028 If the code conversion is "automatic" then we try using this
4029 method and hope for the best.
4030 But if we discover the need for conversion, we give up on this method
4031 and let the following if-statement handle the replace job. */
4034 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4036 /* same_at_start and same_at_end count bytes,
4037 because file access counts bytes
4038 and BEG and END count bytes. */
4039 int same_at_start
= BEGV_BYTE
;
4040 int same_at_end
= ZV_BYTE
;
4042 /* There is still a possibility we will find the need to do code
4043 conversion. If that happens, we set this variable to 1 to
4044 give up on handling REPLACE in the optimized way. */
4045 int giveup_match_end
= 0;
4047 if (XINT (beg
) != 0)
4049 if (lseek (fd
, XINT (beg
), 0) < 0)
4050 report_file_error ("Setting file position",
4051 Fcons (orig_filename
, Qnil
));
4056 /* Count how many chars at the start of the file
4057 match the text at the beginning of the buffer. */
4062 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4064 error ("IO error reading %s: %s",
4065 SDATA (orig_filename
), emacs_strerror (errno
));
4066 else if (nread
== 0)
4069 if (coding
.type
== coding_type_undecided
)
4070 detect_coding (&coding
, buffer
, nread
);
4071 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4072 /* We found that the file should be decoded somehow.
4073 Let's give up here. */
4075 giveup_match_end
= 1;
4079 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4080 detect_eol (&coding
, buffer
, nread
);
4081 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4082 && coding
.eol_type
!= CODING_EOL_LF
)
4083 /* We found that the format of eol should be decoded.
4084 Let's give up here. */
4086 giveup_match_end
= 1;
4091 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4092 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4093 same_at_start
++, bufpos
++;
4094 /* If we found a discrepancy, stop the scan.
4095 Otherwise loop around and scan the next bufferful. */
4096 if (bufpos
!= nread
)
4100 /* If the file matches the buffer completely,
4101 there's no need to replace anything. */
4102 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4106 /* Truncate the buffer to the size of the file. */
4107 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4112 /* Count how many chars at the end of the file
4113 match the text at the end of the buffer. But, if we have
4114 already found that decoding is necessary, don't waste time. */
4115 while (!giveup_match_end
)
4117 int total_read
, nread
, bufpos
, curpos
, trial
;
4119 /* At what file position are we now scanning? */
4120 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4121 /* If the entire file matches the buffer tail, stop the scan. */
4124 /* How much can we scan in the next step? */
4125 trial
= min (curpos
, sizeof buffer
);
4126 if (lseek (fd
, curpos
- trial
, 0) < 0)
4127 report_file_error ("Setting file position",
4128 Fcons (orig_filename
, Qnil
));
4130 total_read
= nread
= 0;
4131 while (total_read
< trial
)
4133 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4135 error ("IO error reading %s: %s",
4136 SDATA (orig_filename
), emacs_strerror (errno
));
4137 else if (nread
== 0)
4139 total_read
+= nread
;
4142 /* Scan this bufferful from the end, comparing with
4143 the Emacs buffer. */
4144 bufpos
= total_read
;
4146 /* Compare with same_at_start to avoid counting some buffer text
4147 as matching both at the file's beginning and at the end. */
4148 while (bufpos
> 0 && same_at_end
> same_at_start
4149 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4150 same_at_end
--, bufpos
--;
4152 /* If we found a discrepancy, stop the scan.
4153 Otherwise loop around and scan the preceding bufferful. */
4156 /* If this discrepancy is because of code conversion,
4157 we cannot use this method; giveup and try the other. */
4158 if (same_at_end
> same_at_start
4159 && FETCH_BYTE (same_at_end
- 1) >= 0200
4160 && ! NILP (current_buffer
->enable_multibyte_characters
)
4161 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4162 giveup_match_end
= 1;
4171 if (! giveup_match_end
)
4175 /* We win! We can handle REPLACE the optimized way. */
4177 /* Extend the start of non-matching text area to multibyte
4178 character boundary. */
4179 if (! NILP (current_buffer
->enable_multibyte_characters
))
4180 while (same_at_start
> BEGV_BYTE
4181 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4184 /* Extend the end of non-matching text area to multibyte
4185 character boundary. */
4186 if (! NILP (current_buffer
->enable_multibyte_characters
))
4187 while (same_at_end
< ZV_BYTE
4188 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4191 /* Don't try to reuse the same piece of text twice. */
4192 overlap
= (same_at_start
- BEGV_BYTE
4193 - (same_at_end
+ st
.st_size
- ZV
));
4195 same_at_end
+= overlap
;
4197 /* Arrange to read only the nonmatching middle part of the file. */
4198 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4199 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4201 del_range_byte (same_at_start
, same_at_end
, 0);
4202 /* Insert from the file at the proper position. */
4203 temp
= BYTE_TO_CHAR (same_at_start
);
4204 SET_PT_BOTH (temp
, same_at_start
);
4206 /* If display currently starts at beginning of line,
4207 keep it that way. */
4208 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4209 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4211 replace_handled
= 1;
4215 /* If requested, replace the accessible part of the buffer
4216 with the file contents. Avoid replacing text at the
4217 beginning or end of the buffer that matches the file contents;
4218 that preserves markers pointing to the unchanged parts.
4220 Here we implement this feature for the case where code conversion
4221 is needed, in a simple way that needs a lot of memory.
4222 The preceding if-statement handles the case of no conversion
4223 in a more optimized way. */
4224 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4226 int same_at_start
= BEGV_BYTE
;
4227 int same_at_end
= ZV_BYTE
;
4230 /* Make sure that the gap is large enough. */
4231 int bufsize
= 2 * st
.st_size
;
4232 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4235 /* First read the whole file, performing code conversion into
4236 CONVERSION_BUFFER. */
4238 if (lseek (fd
, XINT (beg
), 0) < 0)
4240 xfree (conversion_buffer
);
4241 report_file_error ("Setting file position",
4242 Fcons (orig_filename
, Qnil
));
4245 total
= st
.st_size
; /* Total bytes in the file. */
4246 how_much
= 0; /* Bytes read from file so far. */
4247 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4248 unprocessed
= 0; /* Bytes not processed in previous loop. */
4250 while (how_much
< total
)
4252 /* try is reserved in some compilers (Microsoft C) */
4253 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4254 unsigned char *destination
= read_buf
+ unprocessed
;
4257 /* Allow quitting out of the actual I/O. */
4260 this = emacs_read (fd
, destination
, trytry
);
4263 if (this < 0 || this + unprocessed
== 0)
4271 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4273 int require
, result
;
4275 this += unprocessed
;
4277 /* If we are using more space than estimated,
4278 make CONVERSION_BUFFER bigger. */
4279 require
= decoding_buffer_size (&coding
, this);
4280 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4282 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4283 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4286 /* Convert this batch with results in CONVERSION_BUFFER. */
4287 if (how_much
>= total
) /* This is the last block. */
4288 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4289 if (coding
.composing
!= COMPOSITION_DISABLED
)
4290 coding_allocate_composition_data (&coding
, BEGV
);
4291 result
= decode_coding (&coding
, read_buf
,
4292 conversion_buffer
+ inserted
,
4293 this, bufsize
- inserted
);
4295 /* Save for next iteration whatever we didn't convert. */
4296 unprocessed
= this - coding
.consumed
;
4297 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4298 if (!NILP (current_buffer
->enable_multibyte_characters
))
4299 this = coding
.produced
;
4301 this = str_as_unibyte (conversion_buffer
+ inserted
,
4308 /* At this point, INSERTED is how many characters (i.e. bytes)
4309 are present in CONVERSION_BUFFER.
4310 HOW_MUCH should equal TOTAL,
4311 or should be <= 0 if we couldn't read the file. */
4315 xfree (conversion_buffer
);
4316 coding_free_composition_data (&coding
);
4317 error ("IO error reading %s: %s",
4318 SDATA (orig_filename
), emacs_strerror (errno
));
4321 /* Compare the beginning of the converted file
4322 with the buffer text. */
4325 while (bufpos
< inserted
&& same_at_start
< same_at_end
4326 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4327 same_at_start
++, bufpos
++;
4329 /* If the file matches the buffer completely,
4330 there's no need to replace anything. */
4332 if (bufpos
== inserted
)
4334 xfree (conversion_buffer
);
4335 coding_free_composition_data (&coding
);
4338 /* Truncate the buffer to the size of the file. */
4339 del_range_byte (same_at_start
, same_at_end
, 0);
4344 /* Extend the start of non-matching text area to multibyte
4345 character boundary. */
4346 if (! NILP (current_buffer
->enable_multibyte_characters
))
4347 while (same_at_start
> BEGV_BYTE
4348 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4351 /* Scan this bufferful from the end, comparing with
4352 the Emacs buffer. */
4355 /* Compare with same_at_start to avoid counting some buffer text
4356 as matching both at the file's beginning and at the end. */
4357 while (bufpos
> 0 && same_at_end
> same_at_start
4358 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4359 same_at_end
--, bufpos
--;
4361 /* Extend the end of non-matching text area to multibyte
4362 character boundary. */
4363 if (! NILP (current_buffer
->enable_multibyte_characters
))
4364 while (same_at_end
< ZV_BYTE
4365 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4368 /* Don't try to reuse the same piece of text twice. */
4369 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4371 same_at_end
+= overlap
;
4373 /* If display currently starts at beginning of line,
4374 keep it that way. */
4375 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4376 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4378 /* Replace the chars that we need to replace,
4379 and update INSERTED to equal the number of bytes
4380 we are taking from the file. */
4381 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4383 if (same_at_end
!= same_at_start
)
4385 del_range_byte (same_at_start
, same_at_end
, 0);
4387 same_at_start
= GPT_BYTE
;
4391 temp
= BYTE_TO_CHAR (same_at_start
);
4393 /* Insert from the file at the proper position. */
4394 SET_PT_BOTH (temp
, same_at_start
);
4395 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4397 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4398 coding_restore_composition (&coding
, Fcurrent_buffer ());
4399 coding_free_composition_data (&coding
);
4401 /* Set `inserted' to the number of inserted characters. */
4402 inserted
= PT
- temp
;
4403 /* Set point before the inserted characters. */
4404 SET_PT_BOTH (temp
, same_at_start
);
4406 xfree (conversion_buffer
);
4415 register Lisp_Object temp
;
4417 total
= XINT (end
) - XINT (beg
);
4419 /* Make sure point-max won't overflow after this insertion. */
4420 XSETINT (temp
, total
);
4421 if (total
!= XINT (temp
))
4422 error ("Maximum buffer size exceeded");
4425 /* For a special file, all we can do is guess. */
4426 total
= READ_BUF_SIZE
;
4428 if (NILP (visit
) && inserted
> 0)
4430 #ifdef CLASH_DETECTION
4431 if (!NILP (current_buffer
->file_truename
)
4432 /* Make binding buffer-file-name to nil effective. */
4433 && !NILP (current_buffer
->filename
)
4434 && SAVE_MODIFF
>= MODIFF
)
4436 #endif /* CLASH_DETECTION */
4437 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4441 if (GAP_SIZE
< total
)
4442 make_gap (total
- GAP_SIZE
);
4444 if (XINT (beg
) != 0 || !NILP (replace
))
4446 if (lseek (fd
, XINT (beg
), 0) < 0)
4447 report_file_error ("Setting file position",
4448 Fcons (orig_filename
, Qnil
));
4451 /* In the following loop, HOW_MUCH contains the total bytes read so
4452 far for a regular file, and not changed for a special file. But,
4453 before exiting the loop, it is set to a negative value if I/O
4457 /* Total bytes inserted. */
4460 /* Here, we don't do code conversion in the loop. It is done by
4461 code_convert_region after all data are read into the buffer. */
4463 int gap_size
= GAP_SIZE
;
4465 while (how_much
< total
)
4467 /* try is reserved in some compilers (Microsoft C) */
4468 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4475 /* Maybe make more room. */
4476 if (gap_size
< trytry
)
4478 make_gap (total
- gap_size
);
4479 gap_size
= GAP_SIZE
;
4482 /* Read from the file, capturing `quit'. When an
4483 error occurs, end the loop, and arrange for a quit
4484 to be signaled after decoding the text we read. */
4485 non_regular_fd
= fd
;
4486 non_regular_inserted
= inserted
;
4487 non_regular_nbytes
= trytry
;
4488 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4489 read_non_regular_quit
);
4500 /* Allow quitting out of the actual I/O. We don't make text
4501 part of the buffer until all the reading is done, so a C-g
4502 here doesn't do any harm. */
4505 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4517 /* For a regular file, where TOTAL is the real size,
4518 count HOW_MUCH to compare with it.
4519 For a special file, where TOTAL is just a buffer size,
4520 so don't bother counting in HOW_MUCH.
4521 (INSERTED is where we count the number of characters inserted.) */
4528 /* Now we have read all the file data into the gap.
4529 If it was empty, undo marking the buffer modified. */
4533 #ifdef CLASH_DETECTION
4535 unlock_file (current_buffer
->file_truename
);
4537 Vdeactivate_mark
= old_Vdeactivate_mark
;
4540 Vdeactivate_mark
= Qt
;
4542 /* Make the text read part of the buffer. */
4543 GAP_SIZE
-= inserted
;
4545 GPT_BYTE
+= inserted
;
4547 ZV_BYTE
+= inserted
;
4552 /* Put an anchor to ensure multi-byte form ends at gap. */
4557 /* Discard the unwind protect for closing the file. */
4561 error ("IO error reading %s: %s",
4562 SDATA (orig_filename
), emacs_strerror (errno
));
4566 if (! coding_system_decided
)
4568 /* The coding system is not yet decided. Decide it by an
4569 optimized method for handling `coding:' tag.
4571 Note that we can get here only if the buffer was empty
4572 before the insertion. */
4576 if (!NILP (Vcoding_system_for_read
))
4577 val
= Vcoding_system_for_read
;
4580 /* Since we are sure that the current buffer was empty
4581 before the insertion, we can toggle
4582 enable-multibyte-characters directly here without taking
4583 care of marker adjustment and byte combining problem. By
4584 this way, we can run Lisp program safely before decoding
4585 the inserted text. */
4586 Lisp_Object unwind_data
;
4587 int count
= SPECPDL_INDEX ();
4589 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4590 Fcons (current_buffer
->undo_list
,
4591 Fcurrent_buffer ()));
4592 current_buffer
->enable_multibyte_characters
= Qnil
;
4593 current_buffer
->undo_list
= Qt
;
4594 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4596 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4598 val
= call2 (Vset_auto_coding_function
,
4599 filename
, make_number (inserted
));
4604 /* If the coding system is not yet decided, check
4605 file-coding-system-alist. */
4606 Lisp_Object args
[6], coding_systems
;
4608 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4609 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4610 coding_systems
= Ffind_operation_coding_system (6, args
);
4611 if (CONSP (coding_systems
))
4612 val
= XCAR (coding_systems
);
4614 unbind_to (count
, Qnil
);
4615 inserted
= Z_BYTE
- BEG_BYTE
;
4618 /* The following kludgy code is to avoid some compiler bug.
4620 setup_coding_system (val, &coding);
4623 struct coding_system temp_coding
;
4624 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4625 bcopy (&temp_coding
, &coding
, sizeof coding
);
4627 /* Ensure we set Vlast_coding_system_used. */
4628 set_coding_system
= 1;
4630 if (NILP (current_buffer
->enable_multibyte_characters
)
4632 /* We must suppress all character code conversion except for
4633 end-of-line conversion. */
4634 setup_raw_text_coding_system (&coding
);
4635 coding
.src_multibyte
= 0;
4636 coding
.dst_multibyte
4637 = !NILP (current_buffer
->enable_multibyte_characters
);
4641 /* Can't do this if part of the buffer might be preserved. */
4643 && (coding
.type
== coding_type_no_conversion
4644 || coding
.type
== coding_type_raw_text
))
4646 /* Visiting a file with these coding system makes the buffer
4648 current_buffer
->enable_multibyte_characters
= Qnil
;
4649 coding
.dst_multibyte
= 0;
4652 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4654 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4656 if (coding
.type
== coding_type_ccl
)
4657 coding
.spec
.ccl
.decoder
.quit_silently
= 1;
4658 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4660 if (coding
.type
== coding_type_ccl
)
4661 coding
.spec
.ccl
.decoder
.quit_silently
= 0;
4662 if (coding
.result
== CODING_FINISH_INTERRUPT
)
4664 /* Fixme: It is better that we report that the decoding
4665 was interruppted by the user, and the current buffer
4666 contents doesn't reflect the file correctly. */
4667 Fsignal (Qquit
, Qnil
);
4669 inserted
= coding
.produced_char
;
4672 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4676 /* Now INSERTED is measured in characters. */
4679 /* Use the conversion type to determine buffer-file-type
4680 (find-buffer-file-type is now used to help determine the
4682 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4683 || coding
.eol_type
== CODING_EOL_LF
)
4684 && ! CODING_REQUIRE_DECODING (&coding
))
4685 current_buffer
->buffer_file_type
= Qt
;
4687 current_buffer
->buffer_file_type
= Qnil
;
4694 if (!EQ (current_buffer
->undo_list
, Qt
))
4695 current_buffer
->undo_list
= Qnil
;
4697 stat (SDATA (filename
), &st
);
4702 current_buffer
->modtime
= st
.st_mtime
;
4703 current_buffer
->filename
= orig_filename
;
4706 SAVE_MODIFF
= MODIFF
;
4707 current_buffer
->auto_save_modified
= MODIFF
;
4708 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4709 #ifdef CLASH_DETECTION
4712 if (!NILP (current_buffer
->file_truename
))
4713 unlock_file (current_buffer
->file_truename
);
4714 unlock_file (filename
);
4716 #endif /* CLASH_DETECTION */
4718 xsignal2 (Qfile_error
,
4719 build_string ("not a regular file"), orig_filename
);
4722 if (set_coding_system
)
4723 Vlast_coding_system_used
= coding
.symbol
;
4725 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4727 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4729 if (! NILP (insval
))
4731 CHECK_NUMBER (insval
);
4732 inserted
= XFASTINT (insval
);
4736 /* Decode file format */
4739 int empty_undo_list_p
= 0;
4741 /* If we're anyway going to discard undo information, don't
4742 record it in the first place. The buffer's undo list at this
4743 point is either nil or t when visiting a file. */
4746 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4747 current_buffer
->undo_list
= Qt
;
4750 insval
= call3 (Qformat_decode
,
4751 Qnil
, make_number (inserted
), visit
);
4752 CHECK_NUMBER (insval
);
4753 inserted
= XFASTINT (insval
);
4756 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4759 /* Call after-change hooks for the inserted text, aside from the case
4760 of normal visiting (not with REPLACE), which is done in a new buffer
4761 "before" the buffer is changed. */
4762 if (inserted
> 0 && total
> 0
4763 && (NILP (visit
) || !NILP (replace
)))
4765 signal_after_change (PT
, 0, inserted
);
4766 update_compositions (PT
, PT
, CHECK_BORDER
);
4769 p
= Vafter_insert_file_functions
;
4772 insval
= call1 (XCAR (p
), make_number (inserted
));
4775 CHECK_NUMBER (insval
);
4776 inserted
= XFASTINT (insval
);
4783 && current_buffer
->modtime
== -1)
4785 /* If visiting nonexistent file, return nil. */
4786 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4790 Fsignal (Qquit
, Qnil
);
4792 /* ??? Retval needs to be dealt with in all cases consistently. */
4794 val
= Fcons (orig_filename
,
4795 Fcons (make_number (inserted
),
4798 RETURN_UNGCPRO (unbind_to (count
, val
));
4801 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4802 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4803 Lisp_Object
, Lisp_Object
));
4805 /* If build_annotations switched buffers, switch back to BUF.
4806 Kill the temporary buffer that was selected in the meantime.
4808 Since this kill only the last temporary buffer, some buffers remain
4809 not killed if build_annotations switched buffers more than once.
4813 build_annotations_unwind (buf
)
4818 if (XBUFFER (buf
) == current_buffer
)
4820 tembuf
= Fcurrent_buffer ();
4822 Fkill_buffer (tembuf
);
4826 /* Decide the coding-system to encode the data with. */
4829 choose_write_coding_system (start
, end
, filename
,
4830 append
, visit
, lockname
, coding
)
4831 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4832 struct coding_system
*coding
;
4837 && NILP (Fstring_equal (current_buffer
->filename
,
4838 current_buffer
->auto_save_file_name
)))
4840 /* We use emacs-mule for auto saving... */
4841 setup_coding_system (Qemacs_mule
, coding
);
4842 /* ... but with the special flag to indicate not to strip off
4843 leading code of eight-bit-control chars. */
4845 /* We force LF for end-of-line because that is faster. */
4846 coding
->eol_type
= CODING_EOL_LF
;
4847 goto done_setup_coding
;
4849 else if (!NILP (Vcoding_system_for_write
))
4851 val
= Vcoding_system_for_write
;
4852 if (coding_system_require_warning
4853 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4854 /* Confirm that VAL can surely encode the current region. */
4855 val
= call5 (Vselect_safe_coding_system_function
,
4856 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4861 /* If the variable `buffer-file-coding-system' is set locally,
4862 it means that the file was read with some kind of code
4863 conversion or the variable is explicitly set by users. We
4864 had better write it out with the same coding system even if
4865 `enable-multibyte-characters' is nil.
4867 If it is not set locally, we anyway have to convert EOL
4868 format if the default value of `buffer-file-coding-system'
4869 tells that it is not Unix-like (LF only) format. */
4870 int using_default_coding
= 0;
4871 int force_raw_text
= 0;
4873 val
= current_buffer
->buffer_file_coding_system
;
4875 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4878 if (NILP (current_buffer
->enable_multibyte_characters
))
4884 /* Check file-coding-system-alist. */
4885 Lisp_Object args
[7], coding_systems
;
4887 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4888 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4890 coding_systems
= Ffind_operation_coding_system (7, args
);
4891 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4892 val
= XCDR (coding_systems
);
4896 && !NILP (current_buffer
->buffer_file_coding_system
))
4898 /* If we still have not decided a coding system, use the
4899 default value of buffer-file-coding-system. */
4900 val
= current_buffer
->buffer_file_coding_system
;
4901 using_default_coding
= 1;
4905 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4906 /* Confirm that VAL can surely encode the current region. */
4907 val
= call5 (Vselect_safe_coding_system_function
,
4908 start
, end
, val
, Qnil
, filename
);
4910 setup_coding_system (Fcheck_coding_system (val
), coding
);
4911 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4912 && !using_default_coding
)
4914 if (! EQ (default_buffer_file_coding
.symbol
,
4915 buffer_defaults
.buffer_file_coding_system
))
4916 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4917 &default_buffer_file_coding
);
4918 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4920 Lisp_Object subsidiaries
;
4922 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4923 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4924 if (VECTORP (subsidiaries
)
4925 && XVECTOR (subsidiaries
)->size
== 3)
4927 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4932 setup_raw_text_coding_system (coding
);
4933 goto done_setup_coding
;
4936 setup_coding_system (Fcheck_coding_system (val
), coding
);
4939 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4940 coding
->eol_type
= system_eol_type
;
4941 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4942 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4945 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4946 "r\nFWrite region to file: \ni\ni\ni\np",
4947 doc
: /* Write current region into specified file.
4948 When called from a program, requires three arguments:
4949 START, END and FILENAME. START and END are normally buffer positions
4950 specifying the part of the buffer to write.
4951 If START is nil, that means to use the entire buffer contents.
4952 If START is a string, then output that string to the file
4953 instead of any buffer contents; END is ignored.
4955 Optional fourth argument APPEND if non-nil means
4956 append to existing file contents (if any). If it is an integer,
4957 seek to that offset in the file before writing.
4958 Optional fifth argument VISIT, if t or a string, means
4959 set the last-save-file-modtime of buffer to this file's modtime
4960 and mark buffer not modified.
4961 If VISIT is a string, it is a second file name;
4962 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4963 VISIT is also the file name to lock and unlock for clash detection.
4964 If VISIT is neither t nor nil nor a string,
4965 that means do not display the \"Wrote file\" message.
4966 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4967 use for locking and unlocking, overriding FILENAME and VISIT.
4968 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4969 for an existing file with the same name. If MUSTBENEW is `excl',
4970 that means to get an error if the file already exists; never overwrite.
4971 If MUSTBENEW is neither nil nor `excl', that means ask for
4972 confirmation before overwriting, but do go ahead and overwrite the file
4973 if the user confirms.
4975 This does code conversion according to the value of
4976 `coding-system-for-write', `buffer-file-coding-system', or
4977 `file-coding-system-alist', and sets the variable
4978 `last-coding-system-used' to the coding system actually used. */)
4979 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4980 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4985 const unsigned char *fn
;
4988 int count
= SPECPDL_INDEX ();
4991 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4993 Lisp_Object handler
;
4994 Lisp_Object visit_file
;
4995 Lisp_Object annotations
;
4996 Lisp_Object encoded_filename
;
4997 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4998 int quietly
= !NILP (visit
);
4999 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5000 struct buffer
*given_buffer
;
5002 int buffer_file_type
= O_BINARY
;
5004 struct coding_system coding
;
5006 if (current_buffer
->base_buffer
&& visiting
)
5007 error ("Cannot do file visiting in an indirect buffer");
5009 if (!NILP (start
) && !STRINGP (start
))
5010 validate_region (&start
, &end
);
5013 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5015 filename
= Fexpand_file_name (filename
, Qnil
);
5017 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5018 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5020 if (STRINGP (visit
))
5021 visit_file
= Fexpand_file_name (visit
, Qnil
);
5023 visit_file
= filename
;
5025 if (NILP (lockname
))
5026 lockname
= visit_file
;
5030 /* If the file name has special constructs in it,
5031 call the corresponding file handler. */
5032 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5033 /* If FILENAME has no handler, see if VISIT has one. */
5034 if (NILP (handler
) && STRINGP (visit
))
5035 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5037 if (!NILP (handler
))
5040 val
= call6 (handler
, Qwrite_region
, start
, end
,
5041 filename
, append
, visit
);
5045 SAVE_MODIFF
= MODIFF
;
5046 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5047 current_buffer
->filename
= visit_file
;
5053 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5055 /* Special kludge to simplify auto-saving. */
5058 XSETFASTINT (start
, BEG
);
5059 XSETFASTINT (end
, Z
);
5063 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5064 count1
= SPECPDL_INDEX ();
5066 given_buffer
= current_buffer
;
5068 if (!STRINGP (start
))
5070 annotations
= build_annotations (start
, end
);
5072 if (current_buffer
!= given_buffer
)
5074 XSETFASTINT (start
, BEGV
);
5075 XSETFASTINT (end
, ZV
);
5081 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5083 /* Decide the coding-system to encode the data with.
5084 We used to make this choice before calling build_annotations, but that
5085 leads to problems when a write-annotate-function takes care of
5086 unsavable chars (as was the case with X-Symbol). */
5087 choose_write_coding_system (start
, end
, filename
,
5088 append
, visit
, lockname
, &coding
);
5089 Vlast_coding_system_used
= coding
.symbol
;
5091 given_buffer
= current_buffer
;
5092 if (! STRINGP (start
))
5094 annotations
= build_annotations_2 (start
, end
,
5095 coding
.pre_write_conversion
, annotations
);
5096 if (current_buffer
!= given_buffer
)
5098 XSETFASTINT (start
, BEGV
);
5099 XSETFASTINT (end
, ZV
);
5103 #ifdef CLASH_DETECTION
5106 #if 0 /* This causes trouble for GNUS. */
5107 /* If we've locked this file for some other buffer,
5108 query before proceeding. */
5109 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5110 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5113 lock_file (lockname
);
5115 #endif /* CLASH_DETECTION */
5117 encoded_filename
= ENCODE_FILE (filename
);
5119 fn
= SDATA (encoded_filename
);
5123 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5124 #else /* not DOS_NT */
5125 desc
= emacs_open (fn
, O_WRONLY
, 0);
5126 #endif /* not DOS_NT */
5128 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5130 if (auto_saving
) /* Overwrite any previous version of autosave file */
5132 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5133 desc
= emacs_open (fn
, O_RDWR
, 0);
5135 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5136 ? SDATA (current_buffer
->filename
) : 0,
5139 else /* Write to temporary name and rename if no errors */
5141 Lisp_Object temp_name
;
5142 temp_name
= Ffile_name_directory (filename
);
5144 if (!NILP (temp_name
))
5146 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5147 build_string ("$$SAVE$$")));
5148 fname
= SDATA (filename
);
5149 fn
= SDATA (temp_name
);
5150 desc
= creat_copy_attrs (fname
, fn
);
5153 /* If we can't open the temporary file, try creating a new
5154 version of the original file. VMS "creat" creates a
5155 new version rather than truncating an existing file. */
5158 desc
= creat (fn
, 0666);
5159 #if 0 /* This can clobber an existing file and fail to replace it,
5160 if the user runs out of space. */
5163 /* We can't make a new version;
5164 try to truncate and rewrite existing version if any. */
5166 desc
= emacs_open (fn
, O_RDWR
, 0);
5172 desc
= creat (fn
, 0666);
5176 desc
= emacs_open (fn
,
5177 O_WRONLY
| O_CREAT
| buffer_file_type
5178 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5179 S_IREAD
| S_IWRITE
);
5180 #else /* not DOS_NT */
5181 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5182 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5183 auto_saving
? auto_save_mode_bits
: 0666);
5184 #endif /* not DOS_NT */
5185 #endif /* not VMS */
5189 #ifdef CLASH_DETECTION
5191 if (!auto_saving
) unlock_file (lockname
);
5193 #endif /* CLASH_DETECTION */
5195 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5198 record_unwind_protect (close_file_unwind
, make_number (desc
));
5200 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5204 if (NUMBERP (append
))
5205 ret
= lseek (desc
, XINT (append
), 1);
5207 ret
= lseek (desc
, 0, 2);
5210 #ifdef CLASH_DETECTION
5211 if (!auto_saving
) unlock_file (lockname
);
5212 #endif /* CLASH_DETECTION */
5214 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5222 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5223 * if we do writes that don't end with a carriage return. Furthermore
5224 * it cannot handle writes of more then 16K. The modified
5225 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5226 * this EXCEPT for the last record (if it doesn't end with a carriage
5227 * return). This implies that if your buffer doesn't end with a carriage
5228 * return, you get one free... tough. However it also means that if
5229 * we make two calls to sys_write (a la the following code) you can
5230 * get one at the gap as well. The easiest way to fix this (honest)
5231 * is to move the gap to the next newline (or the end of the buffer).
5236 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5237 move_gap (find_next_newline (GPT
, 1));
5239 /* Whether VMS or not, we must move the gap to the next of newline
5240 when we must put designation sequences at beginning of line. */
5241 if (INTEGERP (start
)
5242 && coding
.type
== coding_type_iso2022
5243 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5244 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5246 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5247 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5248 move_gap_both (PT
, PT_BYTE
);
5249 SET_PT_BOTH (opoint
, opoint_byte
);
5256 if (STRINGP (start
))
5258 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5259 &annotations
, &coding
);
5262 else if (XINT (start
) != XINT (end
))
5264 tem
= CHAR_TO_BYTE (XINT (start
));
5266 if (XINT (start
) < GPT
)
5268 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5269 min (GPT
, XINT (end
)) - XINT (start
),
5270 &annotations
, &coding
);
5274 if (XINT (end
) > GPT
&& !failure
)
5276 tem
= max (XINT (start
), GPT
);
5277 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5278 &annotations
, &coding
);
5284 /* If file was empty, still need to write the annotations */
5285 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5286 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5290 if (CODING_REQUIRE_FLUSHING (&coding
)
5291 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5294 /* We have to flush out a data. */
5295 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5296 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5303 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5304 Disk full in NFS may be reported here. */
5305 /* mib says that closing the file will try to write as fast as NFS can do
5306 it, and that means the fsync here is not crucial for autosave files. */
5307 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5309 /* If fsync fails with EINTR, don't treat that as serious. Also
5310 ignore EINVAL which happens when fsync is not supported on this
5312 if (errno
!= EINTR
&& errno
!= EINVAL
)
5313 failure
= 1, save_errno
= errno
;
5317 /* Spurious "file has changed on disk" warnings have been
5318 observed on Suns as well.
5319 It seems that `close' can change the modtime, under nfs.
5321 (This has supposedly been fixed in Sunos 4,
5322 but who knows about all the other machines with NFS?) */
5325 /* On VMS and APOLLO, must do the stat after the close
5326 since closing changes the modtime. */
5329 /* Recall that #if defined does not work on VMS. */
5336 /* NFS can report a write failure now. */
5337 if (emacs_close (desc
) < 0)
5338 failure
= 1, save_errno
= errno
;
5341 /* If we wrote to a temporary name and had no errors, rename to real name. */
5345 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5353 /* Discard the unwind protect for close_file_unwind. */
5354 specpdl_ptr
= specpdl
+ count1
;
5355 /* Restore the original current buffer. */
5356 visit_file
= unbind_to (count
, visit_file
);
5358 #ifdef CLASH_DETECTION
5360 unlock_file (lockname
);
5361 #endif /* CLASH_DETECTION */
5363 /* Do this before reporting IO error
5364 to avoid a "file has changed on disk" warning on
5365 next attempt to save. */
5367 current_buffer
->modtime
= st
.st_mtime
;
5370 error ("IO error writing %s: %s", SDATA (filename
),
5371 emacs_strerror (save_errno
));
5375 SAVE_MODIFF
= MODIFF
;
5376 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5377 current_buffer
->filename
= visit_file
;
5378 update_mode_lines
++;
5383 && ! NILP (Fstring_equal (current_buffer
->filename
,
5384 current_buffer
->auto_save_file_name
)))
5385 SAVE_MODIFF
= MODIFF
;
5391 message_with_string ((INTEGERP (append
)
5401 Lisp_Object
merge ();
5403 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5404 doc
: /* Return t if (car A) is numerically less than (car B). */)
5408 return Flss (Fcar (a
), Fcar (b
));
5411 /* Build the complete list of annotations appropriate for writing out
5412 the text between START and END, by calling all the functions in
5413 write-region-annotate-functions and merging the lists they return.
5414 If one of these functions switches to a different buffer, we assume
5415 that buffer contains altered text. Therefore, the caller must
5416 make sure to restore the current buffer in all cases,
5417 as save-excursion would do. */
5420 build_annotations (start
, end
)
5421 Lisp_Object start
, end
;
5423 Lisp_Object annotations
;
5425 struct gcpro gcpro1
, gcpro2
;
5426 Lisp_Object original_buffer
;
5427 int i
, used_global
= 0;
5429 XSETBUFFER (original_buffer
, current_buffer
);
5432 p
= Vwrite_region_annotate_functions
;
5433 GCPRO2 (annotations
, p
);
5436 struct buffer
*given_buffer
= current_buffer
;
5437 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5438 { /* Use the global value of the hook. */
5441 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5443 p
= Fappend (2, arg
);
5446 Vwrite_region_annotations_so_far
= annotations
;
5447 res
= call2 (XCAR (p
), start
, end
);
5448 /* If the function makes a different buffer current,
5449 assume that means this buffer contains altered text to be output.
5450 Reset START and END from the buffer bounds
5451 and discard all previous annotations because they should have
5452 been dealt with by this function. */
5453 if (current_buffer
!= given_buffer
)
5455 XSETFASTINT (start
, BEGV
);
5456 XSETFASTINT (end
, ZV
);
5459 Flength (res
); /* Check basic validity of return value */
5460 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5464 /* Now do the same for annotation functions implied by the file-format */
5465 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5466 p
= current_buffer
->auto_save_file_format
;
5468 p
= current_buffer
->file_format
;
5469 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5471 struct buffer
*given_buffer
= current_buffer
;
5473 Vwrite_region_annotations_so_far
= annotations
;
5475 /* Value is either a list of annotations or nil if the function
5476 has written annotations to a temporary buffer, which is now
5478 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5479 original_buffer
, make_number (i
));
5480 if (current_buffer
!= given_buffer
)
5482 XSETFASTINT (start
, BEGV
);
5483 XSETFASTINT (end
, ZV
);
5488 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5496 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5497 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5499 struct gcpro gcpro1
;
5502 GCPRO1 (annotations
);
5503 /* At last, do the same for the function PRE_WRITE_CONVERSION
5504 implied by the current coding-system. */
5505 if (!NILP (pre_write_conversion
))
5507 struct buffer
*given_buffer
= current_buffer
;
5508 Vwrite_region_annotations_so_far
= annotations
;
5509 res
= call2 (pre_write_conversion
, start
, end
);
5511 annotations
= (current_buffer
!= given_buffer
5513 : merge (annotations
, res
, Qcar_less_than_car
));
5520 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5521 If STRING is nil, POS is the character position in the current buffer.
5522 Intersperse with them the annotations from *ANNOT
5523 which fall within the range of POS to POS + NCHARS,
5524 each at its appropriate position.
5526 We modify *ANNOT by discarding elements as we use them up.
5528 The return value is negative in case of system call failure. */
5531 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5534 register int nchars
;
5537 struct coding_system
*coding
;
5541 int lastpos
= pos
+ nchars
;
5543 while (NILP (*annot
) || CONSP (*annot
))
5545 tem
= Fcar_safe (Fcar (*annot
));
5548 nextpos
= XFASTINT (tem
);
5550 /* If there are no more annotations in this range,
5551 output the rest of the range all at once. */
5552 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5553 return e_write (desc
, string
, pos
, lastpos
, coding
);
5555 /* Output buffer text up to the next annotation's position. */
5558 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5562 /* Output the annotation. */
5563 tem
= Fcdr (Fcar (*annot
));
5566 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5569 *annot
= Fcdr (*annot
);
5574 #ifndef WRITE_BUF_SIZE
5575 #define WRITE_BUF_SIZE (16 * 1024)
5578 /* Write text in the range START and END into descriptor DESC,
5579 encoding them with coding system CODING. If STRING is nil, START
5580 and END are character positions of the current buffer, else they
5581 are indexes to the string STRING. */
5584 e_write (desc
, string
, start
, end
, coding
)
5588 struct coding_system
*coding
;
5590 register char *addr
;
5591 register int nbytes
;
5592 char buf
[WRITE_BUF_SIZE
];
5596 coding
->composing
= COMPOSITION_DISABLED
;
5597 if (coding
->composing
!= COMPOSITION_DISABLED
)
5598 coding_save_composition (coding
, start
, end
, string
);
5600 if (STRINGP (string
))
5602 addr
= SDATA (string
);
5603 nbytes
= SBYTES (string
);
5604 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5606 else if (start
< end
)
5608 /* It is assured that the gap is not in the range START and END-1. */
5609 addr
= CHAR_POS_ADDR (start
);
5610 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5611 coding
->src_multibyte
5612 = !NILP (current_buffer
->enable_multibyte_characters
);
5618 coding
->src_multibyte
= 1;
5621 /* We used to have a code for handling selective display here. But,
5622 now it is handled within encode_coding. */
5627 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5628 if (coding
->produced
> 0)
5630 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5631 if (coding
->produced
)
5637 nbytes
-= coding
->consumed
;
5638 addr
+= coding
->consumed
;
5639 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5642 /* The source text ends by an incomplete multibyte form.
5643 There's no way other than write it out as is. */
5644 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5653 start
+= coding
->consumed_char
;
5654 if (coding
->cmp_data
)
5655 coding_adjust_composition_offset (coding
, start
);
5658 if (coding
->cmp_data
)
5659 coding_free_composition_data (coding
);
5664 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5665 Sverify_visited_file_modtime
, 1, 1, 0,
5666 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5667 This means that the file has not been changed since it was visited or saved.
5668 See Info node `(elisp)Modification Time' for more details. */)
5674 Lisp_Object handler
;
5675 Lisp_Object filename
;
5680 if (!STRINGP (b
->filename
)) return Qt
;
5681 if (b
->modtime
== 0) return Qt
;
5683 /* If the file name has special constructs in it,
5684 call the corresponding file handler. */
5685 handler
= Ffind_file_name_handler (b
->filename
,
5686 Qverify_visited_file_modtime
);
5687 if (!NILP (handler
))
5688 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5690 filename
= ENCODE_FILE (b
->filename
);
5692 if (stat (SDATA (filename
), &st
) < 0)
5694 /* If the file doesn't exist now and didn't exist before,
5695 we say that it isn't modified, provided the error is a tame one. */
5696 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5701 if (st
.st_mtime
== b
->modtime
5702 /* If both are positive, accept them if they are off by one second. */
5703 || (st
.st_mtime
> 0 && b
->modtime
> 0
5704 && (st
.st_mtime
== b
->modtime
+ 1
5705 || st
.st_mtime
== b
->modtime
- 1)))
5710 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5711 Sclear_visited_file_modtime
, 0, 0, 0,
5712 doc
: /* Clear out records of last mod time of visited file.
5713 Next attempt to save will certainly not complain of a discrepancy. */)
5716 current_buffer
->modtime
= 0;
5720 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5721 Svisited_file_modtime
, 0, 0, 0,
5722 doc
: /* Return the current buffer's recorded visited file modification time.
5723 The value is a list of the form (HIGH LOW), like the time values
5724 that `file-attributes' returns. If the current buffer has no recorded
5725 file modification time, this function returns 0.
5726 See Info node `(elisp)Modification Time' for more details. */)
5729 if (! current_buffer
->modtime
)
5730 return make_number (0);
5731 return make_time ((time_t) current_buffer
->modtime
);
5734 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5735 Sset_visited_file_modtime
, 0, 1, 0,
5736 doc
: /* Update buffer's recorded modification time from the visited file's time.
5737 Useful if the buffer was not read from the file normally
5738 or if the file itself has been changed for some known benign reason.
5739 An argument specifies the modification time value to use
5740 \(instead of that of the visited file), in the form of a list
5741 \(HIGH . LOW) or (HIGH LOW). */)
5743 Lisp_Object time_list
;
5745 if (!NILP (time_list
))
5746 current_buffer
->modtime
= cons_to_long (time_list
);
5749 register Lisp_Object filename
;
5751 Lisp_Object handler
;
5753 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5755 /* If the file name has special constructs in it,
5756 call the corresponding file handler. */
5757 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5758 if (!NILP (handler
))
5759 /* The handler can find the file name the same way we did. */
5760 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5762 filename
= ENCODE_FILE (filename
);
5764 if (stat (SDATA (filename
), &st
) >= 0)
5765 current_buffer
->modtime
= st
.st_mtime
;
5772 auto_save_error (error
)
5775 Lisp_Object args
[3], msg
;
5777 struct gcpro gcpro1
;
5781 auto_save_error_occurred
= 1;
5785 args
[0] = build_string ("Auto-saving %s: %s");
5786 args
[1] = current_buffer
->name
;
5787 args
[2] = Ferror_message_string (error
);
5788 msg
= Fformat (3, args
);
5790 nbytes
= SBYTES (msg
);
5791 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5792 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5794 for (i
= 0; i
< 3; ++i
)
5797 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5799 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5800 Fsleep_for (make_number (1), Qnil
);
5814 auto_save_mode_bits
= 0666;
5816 /* Get visited file's mode to become the auto save file's mode. */
5817 if (! NILP (current_buffer
->filename
))
5819 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5820 /* But make sure we can overwrite it later! */
5821 auto_save_mode_bits
= st
.st_mode
| 0600;
5822 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5824 /* Remote files don't cooperate with stat. */
5825 auto_save_mode_bits
= XINT (modes
) | 0600;
5829 Fwrite_region (Qnil
, Qnil
, current_buffer
->auto_save_file_name
, Qnil
,
5830 NILP (Vauto_save_visited_file_name
) ? Qlambda
: Qt
,
5835 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5838 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5850 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5853 minibuffer_auto_raise
= XINT (value
);
5858 do_auto_save_make_dir (dir
)
5863 call2 (Qmake_directory
, dir
, Qt
);
5864 XSETFASTINT (mode
, 0700);
5865 return Fset_file_modes (dir
, mode
);
5869 do_auto_save_eh (ignore
)
5875 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5876 doc
: /* Auto-save all buffers that need it.
5877 This is all buffers that have auto-saving enabled
5878 and are changed since last auto-saved.
5879 Auto-saving writes the buffer into a file
5880 so that your editing is not lost if the system crashes.
5881 This file is not the file you visited; that changes only when you save.
5882 Normally we run the normal hook `auto-save-hook' before saving.
5884 A non-nil NO-MESSAGE argument means do not print any message if successful.
5885 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5886 (no_message
, current_only
)
5887 Lisp_Object no_message
, current_only
;
5889 struct buffer
*old
= current_buffer
, *b
;
5890 Lisp_Object tail
, buf
;
5892 int do_handled_files
;
5894 FILE *stream
= NULL
;
5895 int count
= SPECPDL_INDEX ();
5896 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5897 int old_message_p
= 0;
5898 struct gcpro gcpro1
, gcpro2
;
5900 if (max_specpdl_size
< specpdl_size
+ 40)
5901 max_specpdl_size
= specpdl_size
+ 40;
5906 if (NILP (no_message
))
5908 old_message_p
= push_message ();
5909 record_unwind_protect (pop_message_unwind
, Qnil
);
5912 /* Ordinarily don't quit within this function,
5913 but don't make it impossible to quit (in case we get hung in I/O). */
5917 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5918 point to non-strings reached from Vbuffer_alist. */
5920 if (!NILP (Vrun_hooks
))
5921 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5923 if (STRINGP (Vauto_save_list_file_name
))
5925 Lisp_Object listfile
;
5927 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5929 /* Don't try to create the directory when shutting down Emacs,
5930 because creating the directory might signal an error, and
5931 that would leave Emacs in a strange state. */
5932 if (!NILP (Vrun_hooks
))
5936 GCPRO2 (dir
, listfile
);
5937 dir
= Ffile_name_directory (listfile
);
5938 if (NILP (Ffile_directory_p (dir
)))
5939 internal_condition_case_1 (do_auto_save_make_dir
,
5940 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5945 stream
= fopen (SDATA (listfile
), "w");
5948 record_unwind_protect (do_auto_save_unwind
,
5949 make_save_value (stream
, 0));
5950 record_unwind_protect (do_auto_save_unwind_1
,
5951 make_number (minibuffer_auto_raise
));
5952 minibuffer_auto_raise
= 0;
5954 auto_save_error_occurred
= 0;
5956 /* On first pass, save all files that don't have handlers.
5957 On second pass, save all files that do have handlers.
5959 If Emacs is crashing, the handlers may tweak what is causing
5960 Emacs to crash in the first place, and it would be a shame if
5961 Emacs failed to autosave perfectly ordinary files because it
5962 couldn't handle some ange-ftp'd file. */
5964 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5965 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5967 buf
= XCDR (XCAR (tail
));
5970 /* Record all the buffers that have auto save mode
5971 in the special file that lists them. For each of these buffers,
5972 Record visited name (if any) and auto save name. */
5973 if (STRINGP (b
->auto_save_file_name
)
5974 && stream
!= NULL
&& do_handled_files
== 0)
5977 if (!NILP (b
->filename
))
5979 fwrite (SDATA (b
->filename
), 1,
5980 SBYTES (b
->filename
), stream
);
5982 putc ('\n', stream
);
5983 fwrite (SDATA (b
->auto_save_file_name
), 1,
5984 SBYTES (b
->auto_save_file_name
), stream
);
5985 putc ('\n', stream
);
5989 if (!NILP (current_only
)
5990 && b
!= current_buffer
)
5993 /* Don't auto-save indirect buffers.
5994 The base buffer takes care of it. */
5998 /* Check for auto save enabled
5999 and file changed since last auto save
6000 and file changed since last real save. */
6001 if (STRINGP (b
->auto_save_file_name
)
6002 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
6003 && b
->auto_save_modified
< BUF_MODIFF (b
)
6004 /* -1 means we've turned off autosaving for a while--see below. */
6005 && XINT (b
->save_length
) >= 0
6006 && (do_handled_files
6007 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
6010 EMACS_TIME before_time
, after_time
;
6012 EMACS_GET_TIME (before_time
);
6014 /* If we had a failure, don't try again for 20 minutes. */
6015 if (b
->auto_save_failure_time
>= 0
6016 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6019 if ((XFASTINT (b
->save_length
) * 10
6020 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6021 /* A short file is likely to change a large fraction;
6022 spare the user annoying messages. */
6023 && XFASTINT (b
->save_length
) > 5000
6024 /* These messages are frequent and annoying for `*mail*'. */
6025 && !EQ (b
->filename
, Qnil
)
6026 && NILP (no_message
))
6028 /* It has shrunk too much; turn off auto-saving here. */
6029 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6030 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6032 minibuffer_auto_raise
= 0;
6033 /* Turn off auto-saving until there's a real save,
6034 and prevent any more warnings. */
6035 XSETINT (b
->save_length
, -1);
6036 Fsleep_for (make_number (1), Qnil
);
6039 set_buffer_internal (b
);
6040 if (!auto_saved
&& NILP (no_message
))
6041 message1 ("Auto-saving...");
6042 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6044 b
->auto_save_modified
= BUF_MODIFF (b
);
6045 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6046 set_buffer_internal (old
);
6048 EMACS_GET_TIME (after_time
);
6050 /* If auto-save took more than 60 seconds,
6051 assume it was an NFS failure that got a timeout. */
6052 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6053 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6057 /* Prevent another auto save till enough input events come in. */
6058 record_auto_save ();
6060 if (auto_saved
&& NILP (no_message
))
6064 /* If we are going to restore an old message,
6065 give time to read ours. */
6066 sit_for (make_number (1), 0, 0);
6069 else if (!auto_save_error_occurred
)
6070 /* Don't overwrite the error message if an error occurred.
6071 If we displayed a message and then restored a state
6072 with no message, leave a "done" message on the screen. */
6073 message1 ("Auto-saving...done");
6078 /* This restores the message-stack status. */
6079 unbind_to (count
, Qnil
);
6083 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6084 Sset_buffer_auto_saved
, 0, 0, 0,
6085 doc
: /* Mark current buffer as auto-saved with its current text.
6086 No auto-save file will be written until the buffer changes again. */)
6089 current_buffer
->auto_save_modified
= MODIFF
;
6090 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6091 current_buffer
->auto_save_failure_time
= -1;
6095 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6096 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6097 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6100 current_buffer
->auto_save_failure_time
= -1;
6104 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6106 doc
: /* Return t if current buffer has been auto-saved recently.
6107 More precisely, if it has been auto-saved since last read from or saved
6108 in the visited file. If the buffer has no visited file,
6109 then any auto-save counts as "recent". */)
6112 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6115 /* Reading and completing file names */
6116 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6117 extern Lisp_Object Qcompletion_ignore_case
;
6119 /* In the string VAL, change each $ to $$ and return the result. */
6122 double_dollars (val
)
6125 register const unsigned char *old
;
6126 register unsigned char *new;
6130 osize
= SBYTES (val
);
6132 /* Count the number of $ characters. */
6133 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6134 if (*old
++ == '$') count
++;
6138 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6141 for (n
= osize
; n
> 0; n
--)
6155 read_file_name_cleanup (arg
)
6158 return (current_buffer
->directory
= arg
);
6161 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6163 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6164 (string
, dir
, action
)
6165 Lisp_Object string
, dir
, action
;
6166 /* action is nil for complete, t for return list of completions,
6167 lambda for verify final value */
6169 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6171 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6173 CHECK_STRING (string
);
6180 /* No need to protect ACTION--we only compare it with t and nil. */
6181 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6183 if (SCHARS (string
) == 0)
6185 if (EQ (action
, Qlambda
))
6193 orig_string
= string
;
6194 string
= Fsubstitute_in_file_name (string
);
6195 changed
= NILP (Fstring_equal (string
, orig_string
));
6196 name
= Ffile_name_nondirectory (string
);
6197 val
= Ffile_name_directory (string
);
6199 realdir
= Fexpand_file_name (val
, realdir
);
6204 specdir
= Ffile_name_directory (string
);
6205 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6210 return double_dollars (string
);
6214 if (!NILP (specdir
))
6215 val
= concat2 (specdir
, val
);
6217 return double_dollars (val
);
6220 #endif /* not VMS */
6224 if (EQ (action
, Qt
))
6226 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6230 if (NILP (Vread_file_name_predicate
)
6231 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6235 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6237 /* Brute-force speed up for directory checking:
6238 Discard strings which don't end in a slash. */
6239 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6241 Lisp_Object tem
= XCAR (all
);
6244 && (len
= SBYTES (tem
), len
> 0)
6245 && IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6246 comp
= Fcons (tem
, comp
);
6252 /* Must do it the hard (and slow) way. */
6254 GCPRO3 (all
, comp
, specdir
);
6255 count
= SPECPDL_INDEX ();
6256 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6257 current_buffer
->directory
= realdir
;
6258 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6260 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6262 comp
= Fcons (XCAR (all
), comp
);
6264 unbind_to (count
, Qnil
);
6267 return Fnreverse (comp
);
6270 /* Only other case actually used is ACTION = lambda */
6272 /* Supposedly this helps commands such as `cd' that read directory names,
6273 but can someone explain how it helps them? -- RMS */
6274 if (SCHARS (name
) == 0)
6277 string
= Fexpand_file_name (string
, dir
);
6278 if (!NILP (Vread_file_name_predicate
))
6279 return call1 (Vread_file_name_predicate
, string
);
6280 return Ffile_exists_p (string
);
6283 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6284 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6285 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6286 The return value is only relevant for a call to `read-file-name' that happens
6287 before any other event (mouse or keypress) is handeled. */)
6290 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6291 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6300 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6301 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6302 Value is not expanded---you must call `expand-file-name' yourself.
6303 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6304 the same non-empty string that was inserted by this function.
6305 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6306 except that if INITIAL is specified, that combined with DIR is used.)
6307 If the user exits with an empty minibuffer, this function returns
6308 an empty string. (This can only happen if the user erased the
6309 pre-inserted contents or if `insert-default-directory' is nil.)
6310 Fourth arg MUSTMATCH non-nil means require existing file's name.
6311 Non-nil and non-t means also require confirmation after completion.
6312 Fifth arg INITIAL specifies text to start with.
6313 If optional sixth arg PREDICATE is non-nil, possible completions and
6314 the resulting file name must satisfy (funcall PREDICATE NAME).
6315 DIR should be an absolute directory name. It defaults to the value of
6316 `default-directory'.
6318 If this command was invoked with the mouse, use a file dialog box if
6319 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6320 provides a file dialog box.
6322 See also `read-file-name-completion-ignore-case'
6323 and `read-file-name-function'. */)
6324 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6325 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6327 Lisp_Object val
, insdef
, tem
;
6328 struct gcpro gcpro1
, gcpro2
;
6329 register char *homedir
;
6330 Lisp_Object decoded_homedir
;
6331 int replace_in_history
= 0;
6332 int add_to_history
= 0;
6336 dir
= current_buffer
->directory
;
6337 if (NILP (Ffile_name_absolute_p (dir
)))
6338 dir
= Fexpand_file_name (dir
, Qnil
);
6339 if (NILP (default_filename
))
6342 ? Fexpand_file_name (initial
, dir
)
6343 : current_buffer
->filename
);
6345 /* If dir starts with user's homedir, change that to ~. */
6346 homedir
= (char *) egetenv ("HOME");
6348 /* homedir can be NULL in temacs, since Vprocess_environment is not
6349 yet set up. We shouldn't crash in that case. */
6352 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6353 CORRECT_DIR_SEPS (homedir
);
6358 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6361 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6362 SBYTES (decoded_homedir
))
6363 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6365 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6366 dir
= concat2 (build_string ("~"), dir
);
6368 /* Likewise for default_filename. */
6370 && STRINGP (default_filename
)
6371 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6372 SBYTES (decoded_homedir
))
6373 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6376 = Fsubstring (default_filename
,
6377 make_number (SCHARS (decoded_homedir
)), Qnil
);
6378 default_filename
= concat2 (build_string ("~"), default_filename
);
6380 if (!NILP (default_filename
))
6382 CHECK_STRING (default_filename
);
6383 default_filename
= double_dollars (default_filename
);
6386 if (insert_default_directory
&& STRINGP (dir
))
6389 if (!NILP (initial
))
6391 Lisp_Object args
[2], pos
;
6395 insdef
= Fconcat (2, args
);
6396 pos
= make_number (SCHARS (double_dollars (dir
)));
6397 insdef
= Fcons (double_dollars (insdef
), pos
);
6400 insdef
= double_dollars (insdef
);
6402 else if (STRINGP (initial
))
6403 insdef
= Fcons (double_dollars (initial
), make_number (0));
6407 if (!NILP (Vread_file_name_function
))
6409 Lisp_Object args
[7];
6411 GCPRO2 (insdef
, default_filename
);
6412 args
[0] = Vread_file_name_function
;
6415 args
[3] = default_filename
;
6416 args
[4] = mustmatch
;
6418 args
[6] = predicate
;
6419 RETURN_UNGCPRO (Ffuncall (7, args
));
6422 count
= SPECPDL_INDEX ();
6423 specbind (Qcompletion_ignore_case
,
6424 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6425 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6426 specbind (intern ("read-file-name-predicate"),
6427 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6429 GCPRO2 (insdef
, default_filename
);
6431 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6432 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6434 /* If DIR contains a file name, split it. */
6436 file
= Ffile_name_nondirectory (dir
);
6437 if (SCHARS (file
) && NILP (default_filename
))
6439 default_filename
= file
;
6440 dir
= Ffile_name_directory (dir
);
6442 if (!NILP(default_filename
))
6443 default_filename
= Fexpand_file_name (default_filename
, dir
);
6444 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6445 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6450 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6451 dir
, mustmatch
, insdef
,
6452 Qfile_name_history
, default_filename
, Qnil
);
6454 tem
= Fsymbol_value (Qfile_name_history
);
6455 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6456 replace_in_history
= 1;
6458 /* If Fcompleting_read returned the inserted default string itself
6459 (rather than a new string with the same contents),
6460 it has to mean that the user typed RET with the minibuffer empty.
6461 In that case, we really want to return ""
6462 so that commands such as set-visited-file-name can distinguish. */
6463 if (EQ (val
, default_filename
))
6465 /* In this case, Fcompleting_read has not added an element
6466 to the history. Maybe we should. */
6467 if (! replace_in_history
)
6473 unbind_to (count
, Qnil
);
6476 error ("No file name specified");
6478 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6480 if (!NILP (tem
) && !NILP (default_filename
))
6481 val
= default_filename
;
6482 val
= Fsubstitute_in_file_name (val
);
6484 if (replace_in_history
)
6485 /* Replace what Fcompleting_read added to the history
6486 with what we will actually return. */
6488 Lisp_Object val1
= double_dollars (val
);
6489 tem
= Fsymbol_value (Qfile_name_history
);
6490 if (history_delete_duplicates
)
6491 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6492 XSETCAR (tem
, val1
);
6494 else if (add_to_history
)
6496 /* Add the value to the history--but not if it matches
6497 the last value already there. */
6498 Lisp_Object val1
= double_dollars (val
);
6499 tem
= Fsymbol_value (Qfile_name_history
);
6500 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6502 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6503 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6514 /* Must be set before any path manipulation is performed. */
6515 XSETFASTINT (Vdirectory_sep_char
, '/');
6522 Qoperations
= intern ("operations");
6523 Qexpand_file_name
= intern ("expand-file-name");
6524 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6525 Qdirectory_file_name
= intern ("directory-file-name");
6526 Qfile_name_directory
= intern ("file-name-directory");
6527 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6528 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6529 Qfile_name_as_directory
= intern ("file-name-as-directory");
6530 Qcopy_file
= intern ("copy-file");
6531 Qmake_directory_internal
= intern ("make-directory-internal");
6532 Qmake_directory
= intern ("make-directory");
6533 Qdelete_directory
= intern ("delete-directory");
6534 Qdelete_file
= intern ("delete-file");
6535 Qrename_file
= intern ("rename-file");
6536 Qadd_name_to_file
= intern ("add-name-to-file");
6537 Qmake_symbolic_link
= intern ("make-symbolic-link");
6538 Qfile_exists_p
= intern ("file-exists-p");
6539 Qfile_executable_p
= intern ("file-executable-p");
6540 Qfile_readable_p
= intern ("file-readable-p");
6541 Qfile_writable_p
= intern ("file-writable-p");
6542 Qfile_symlink_p
= intern ("file-symlink-p");
6543 Qaccess_file
= intern ("access-file");
6544 Qfile_directory_p
= intern ("file-directory-p");
6545 Qfile_regular_p
= intern ("file-regular-p");
6546 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6547 Qfile_modes
= intern ("file-modes");
6548 Qset_file_modes
= intern ("set-file-modes");
6549 Qset_file_times
= intern ("set-file-times");
6550 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6551 Qinsert_file_contents
= intern ("insert-file-contents");
6552 Qwrite_region
= intern ("write-region");
6553 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6554 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6555 Qauto_save_coding
= intern ("auto-save-coding");
6557 staticpro (&Qoperations
);
6558 staticpro (&Qexpand_file_name
);
6559 staticpro (&Qsubstitute_in_file_name
);
6560 staticpro (&Qdirectory_file_name
);
6561 staticpro (&Qfile_name_directory
);
6562 staticpro (&Qfile_name_nondirectory
);
6563 staticpro (&Qunhandled_file_name_directory
);
6564 staticpro (&Qfile_name_as_directory
);
6565 staticpro (&Qcopy_file
);
6566 staticpro (&Qmake_directory_internal
);
6567 staticpro (&Qmake_directory
);
6568 staticpro (&Qdelete_directory
);
6569 staticpro (&Qdelete_file
);
6570 staticpro (&Qrename_file
);
6571 staticpro (&Qadd_name_to_file
);
6572 staticpro (&Qmake_symbolic_link
);
6573 staticpro (&Qfile_exists_p
);
6574 staticpro (&Qfile_executable_p
);
6575 staticpro (&Qfile_readable_p
);
6576 staticpro (&Qfile_writable_p
);
6577 staticpro (&Qaccess_file
);
6578 staticpro (&Qfile_symlink_p
);
6579 staticpro (&Qfile_directory_p
);
6580 staticpro (&Qfile_regular_p
);
6581 staticpro (&Qfile_accessible_directory_p
);
6582 staticpro (&Qfile_modes
);
6583 staticpro (&Qset_file_modes
);
6584 staticpro (&Qset_file_times
);
6585 staticpro (&Qfile_newer_than_file_p
);
6586 staticpro (&Qinsert_file_contents
);
6587 staticpro (&Qwrite_region
);
6588 staticpro (&Qverify_visited_file_modtime
);
6589 staticpro (&Qset_visited_file_modtime
);
6590 staticpro (&Qauto_save_coding
);
6592 Qfile_name_history
= intern ("file-name-history");
6593 Fset (Qfile_name_history
, Qnil
);
6594 staticpro (&Qfile_name_history
);
6596 Qfile_error
= intern ("file-error");
6597 staticpro (&Qfile_error
);
6598 Qfile_already_exists
= intern ("file-already-exists");
6599 staticpro (&Qfile_already_exists
);
6600 Qfile_date_error
= intern ("file-date-error");
6601 staticpro (&Qfile_date_error
);
6602 Qexcl
= intern ("excl");
6606 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6607 staticpro (&Qfind_buffer_file_type
);
6610 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6611 doc
: /* *Coding system for encoding file names.
6612 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6613 Vfile_name_coding_system
= Qnil
;
6615 DEFVAR_LISP ("default-file-name-coding-system",
6616 &Vdefault_file_name_coding_system
,
6617 doc
: /* Default coding system for encoding file names.
6618 This variable is used only when `file-name-coding-system' is nil.
6620 This variable is set/changed by the command `set-language-environment'.
6621 User should not set this variable manually,
6622 instead use `file-name-coding-system' to get a constant encoding
6623 of file names regardless of the current language environment. */);
6624 Vdefault_file_name_coding_system
= Qnil
;
6626 Qformat_decode
= intern ("format-decode");
6627 staticpro (&Qformat_decode
);
6628 Qformat_annotate_function
= intern ("format-annotate-function");
6629 staticpro (&Qformat_annotate_function
);
6630 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6631 staticpro (&Qafter_insert_file_set_coding
);
6633 Qcar_less_than_car
= intern ("car-less-than-car");
6634 staticpro (&Qcar_less_than_car
);
6636 Fput (Qfile_error
, Qerror_conditions
,
6637 list2 (Qfile_error
, Qerror
));
6638 Fput (Qfile_error
, Qerror_message
,
6639 build_string ("File error"));
6641 Fput (Qfile_already_exists
, Qerror_conditions
,
6642 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6643 Fput (Qfile_already_exists
, Qerror_message
,
6644 build_string ("File already exists"));
6646 Fput (Qfile_date_error
, Qerror_conditions
,
6647 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6648 Fput (Qfile_date_error
, Qerror_message
,
6649 build_string ("Cannot set file date"));
6651 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6652 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6653 Vread_file_name_function
= Qnil
;
6655 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6656 doc
: /* Current predicate used by `read-file-name-internal'. */);
6657 Vread_file_name_predicate
= Qnil
;
6659 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6660 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6661 #if defined VMS || defined DOS_NT || defined MAC_OS
6662 read_file_name_completion_ignore_case
= 1;
6664 read_file_name_completion_ignore_case
= 0;
6667 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6668 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6670 When the initial minibuffer contents show a name of a file or a directory,
6671 typing RETURN without editing the initial contents is equivalent to typing
6672 the default file name.
6674 If this variable is non-nil, the minibuffer contents are always
6675 initially non-empty, and typing RETURN without editing will fetch the
6676 default name, if one is provided. Note however that this default name
6677 is not necessarily the same as initial contents inserted in the minibuffer,
6678 if the initial contents is just the default directory.
6680 If this variable is nil, the minibuffer often starts out empty. In
6681 that case you may have to explicitly fetch the next history element to
6682 request the default name; typing RETURN without editing will leave
6683 the minibuffer empty.
6685 For some commands, exiting with an empty minibuffer has a special meaning,
6686 such as making the current buffer visit no file in the case of
6687 `set-visited-file-name'. */);
6688 insert_default_directory
= 1;
6690 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6691 doc
: /* *Non-nil means write new files with record format `stmlf'.
6692 nil means use format `var'. This variable is meaningful only on VMS. */);
6693 vms_stmlf_recfm
= 0;
6695 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6696 doc
: /* Directory separator character for built-in functions that return file names.
6697 The value is always ?/. Don't use this variable, just use `/'. */);
6699 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6700 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6701 If a file name matches REGEXP, then all I/O on that file is done by calling
6704 The first argument given to HANDLER is the name of the I/O primitive
6705 to be handled; the remaining arguments are the arguments that were
6706 passed to that primitive. For example, if you do
6707 (file-exists-p FILENAME)
6708 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6709 (funcall HANDLER 'file-exists-p FILENAME)
6710 The function `find-file-name-handler' checks this list for a handler
6711 for its argument. */);
6712 Vfile_name_handler_alist
= Qnil
;
6714 DEFVAR_LISP ("set-auto-coding-function",
6715 &Vset_auto_coding_function
,
6716 doc
: /* If non-nil, a function to call to decide a coding system of file.
6717 Two arguments are passed to this function: the file name
6718 and the length of a file contents following the point.
6719 This function should return a coding system to decode the file contents.
6720 It should check the file name against `auto-coding-alist'.
6721 If no coding system is decided, it should check a coding system
6722 specified in the heading lines with the format:
6723 -*- ... coding: CODING-SYSTEM; ... -*-
6724 or local variable spec of the tailing lines with `coding:' tag. */);
6725 Vset_auto_coding_function
= Qnil
;
6727 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6728 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6729 Each is passed one argument, the number of characters inserted.
6730 It should return the new character count, and leave point the same.
6731 If `insert-file-contents' is intercepted by a handler from
6732 `file-name-handler-alist', that handler is responsible for calling the
6733 functions in `after-insert-file-functions' if appropriate. */);
6734 Vafter_insert_file_functions
= Qnil
;
6736 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6737 doc
: /* A list of functions to be called at the start of `write-region'.
6738 Each is passed two arguments, START and END as for `write-region'.
6739 These are usually two numbers but not always; see the documentation
6740 for `write-region'. The function should return a list of pairs
6741 of the form (POSITION . STRING), consisting of strings to be effectively
6742 inserted at the specified positions of the file being written (1 means to
6743 insert before the first byte written). The POSITIONs must be sorted into
6744 increasing order. If there are several functions in the list, the several
6745 lists are merged destructively. Alternatively, the function can return
6746 with a different buffer current; in that case it should pay attention
6747 to the annotations returned by previous functions and listed in
6748 `write-region-annotations-so-far'.*/);
6749 Vwrite_region_annotate_functions
= Qnil
;
6750 staticpro (&Qwrite_region_annotate_functions
);
6751 Qwrite_region_annotate_functions
6752 = intern ("write-region-annotate-functions");
6754 DEFVAR_LISP ("write-region-annotations-so-far",
6755 &Vwrite_region_annotations_so_far
,
6756 doc
: /* When an annotation function is called, this holds the previous annotations.
6757 These are the annotations made by other annotation functions
6758 that were already called. See also `write-region-annotate-functions'. */);
6759 Vwrite_region_annotations_so_far
= Qnil
;
6761 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6762 doc
: /* A list of file name handlers that temporarily should not be used.
6763 This applies only to the operation `inhibit-file-name-operation'. */);
6764 Vinhibit_file_name_handlers
= Qnil
;
6766 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6767 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6768 Vinhibit_file_name_operation
= Qnil
;
6770 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6771 doc
: /* File name in which we write a list of all auto save file names.
6772 This variable is initialized automatically from `auto-save-list-file-prefix'
6773 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6774 a non-nil value. */);
6775 Vauto_save_list_file_name
= Qnil
;
6777 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name
,
6778 doc
: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6779 Normally auto-save files are written under other names. */);
6780 Vauto_save_visited_file_name
= Qnil
;
6783 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6784 doc
: /* *Non-nil means don't call fsync in `write-region'.
6785 This variable affects calls to `write-region' as well as save commands.
6786 A non-nil value may result in data loss! */);
6787 write_region_inhibit_fsync
= 0;
6790 defsubr (&Sfind_file_name_handler
);
6791 defsubr (&Sfile_name_directory
);
6792 defsubr (&Sfile_name_nondirectory
);
6793 defsubr (&Sunhandled_file_name_directory
);
6794 defsubr (&Sfile_name_as_directory
);
6795 defsubr (&Sdirectory_file_name
);
6796 defsubr (&Smake_temp_name
);
6797 defsubr (&Sexpand_file_name
);
6798 defsubr (&Ssubstitute_in_file_name
);
6799 defsubr (&Scopy_file
);
6800 defsubr (&Smake_directory_internal
);
6801 defsubr (&Sdelete_directory
);
6802 defsubr (&Sdelete_file
);
6803 defsubr (&Srename_file
);
6804 defsubr (&Sadd_name_to_file
);
6805 defsubr (&Smake_symbolic_link
);
6807 defsubr (&Sdefine_logical_name
);
6810 defsubr (&Ssysnetunam
);
6811 #endif /* HPUX_NET */
6812 defsubr (&Sfile_name_absolute_p
);
6813 defsubr (&Sfile_exists_p
);
6814 defsubr (&Sfile_executable_p
);
6815 defsubr (&Sfile_readable_p
);
6816 defsubr (&Sfile_writable_p
);
6817 defsubr (&Saccess_file
);
6818 defsubr (&Sfile_symlink_p
);
6819 defsubr (&Sfile_directory_p
);
6820 defsubr (&Sfile_accessible_directory_p
);
6821 defsubr (&Sfile_regular_p
);
6822 defsubr (&Sfile_modes
);
6823 defsubr (&Sset_file_modes
);
6824 defsubr (&Sset_file_times
);
6825 defsubr (&Sset_default_file_modes
);
6826 defsubr (&Sdefault_file_modes
);
6827 defsubr (&Sfile_newer_than_file_p
);
6828 defsubr (&Sinsert_file_contents
);
6829 defsubr (&Swrite_region
);
6830 defsubr (&Scar_less_than_car
);
6831 defsubr (&Sverify_visited_file_modtime
);
6832 defsubr (&Sclear_visited_file_modtime
);
6833 defsubr (&Svisited_file_modtime
);
6834 defsubr (&Sset_visited_file_modtime
);
6835 defsubr (&Sdo_auto_save
);
6836 defsubr (&Sset_buffer_auto_saved
);
6837 defsubr (&Sclear_buffer_auto_save_failure
);
6838 defsubr (&Srecent_auto_save_p
);
6840 defsubr (&Sread_file_name_internal
);
6841 defsubr (&Sread_file_name
);
6842 defsubr (&Snext_read_file_uses_dialog_p
);
6845 defsubr (&Sunix_sync
);
6849 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6850 (do not change this comment) */