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 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"
82 #include "dispextern.h"
89 #endif /* not WINDOWSNT */
93 #include <sys/param.h>
101 #define CORRECT_DIR_SEPS(s) \
102 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
103 else unixtodos_filename (s); \
105 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
106 redirector allows the six letters between 'Z' and 'a' as well. */
108 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
111 #define IS_DRIVE(x) isalpha (x)
113 /* Need to lower-case the drive letter, or else expanded
114 filenames will sometimes compare inequal, because
115 `expand-file-name' doesn't always down-case the drive letter. */
116 #define DRIVE_LETTER(x) (tolower (x))
137 #include "commands.h"
138 extern int use_dialog_box
;
139 extern int use_file_dialog
;
153 #ifndef FILE_SYSTEM_CASE
154 #define FILE_SYSTEM_CASE(filename) (filename)
157 /* Nonzero during writing of auto-save files */
160 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
161 a new file with the same mode as the original */
162 int auto_save_mode_bits
;
164 /* The symbol bound to coding-system-for-read when
165 insert-file-contents is called for recovering a file. This is not
166 an actual coding system name, but just an indicator to tell
167 insert-file-contents to use `emacs-mule' with a special flag for
168 auto saving and recovering a file. */
169 Lisp_Object Qauto_save_coding
;
171 /* Coding system for file names, or nil if none. */
172 Lisp_Object Vfile_name_coding_system
;
174 /* Coding system for file names used only when
175 Vfile_name_coding_system is nil. */
176 Lisp_Object Vdefault_file_name_coding_system
;
178 /* Alist of elements (REGEXP . HANDLER) for file names
179 whose I/O is done with a special handler. */
180 Lisp_Object Vfile_name_handler_alist
;
182 /* Property name of a file name handler,
183 which gives a list of operations it handles.. */
184 Lisp_Object Qoperations
;
186 /* Lisp functions for translating file formats */
187 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
189 /* Function to be called to decide a coding system of a reading file. */
190 Lisp_Object Vset_auto_coding_function
;
192 /* Functions to be called to process text properties in inserted file. */
193 Lisp_Object Vafter_insert_file_functions
;
195 /* Lisp function for setting buffer-file-coding-system and the
196 multibyteness of the current buffer after inserting a file. */
197 Lisp_Object Qafter_insert_file_set_coding
;
199 /* Functions to be called to create text property annotations for file. */
200 Lisp_Object Vwrite_region_annotate_functions
;
201 Lisp_Object Qwrite_region_annotate_functions
;
203 /* During build_annotations, each time an annotation function is called,
204 this holds the annotations made by the previous functions. */
205 Lisp_Object Vwrite_region_annotations_so_far
;
207 /* File name in which we write a list of all our auto save files. */
208 Lisp_Object Vauto_save_list_file_name
;
210 /* Function to call to read a file name. */
211 Lisp_Object Vread_file_name_function
;
213 /* Current predicate used by read_file_name_internal. */
214 Lisp_Object Vread_file_name_predicate
;
216 /* Nonzero means completion ignores case when reading file name. */
217 int read_file_name_completion_ignore_case
;
219 /* Nonzero means, when reading a filename in the minibuffer,
220 start out by inserting the default directory into the minibuffer. */
221 int insert_default_directory
;
223 /* On VMS, nonzero means write new files with record format stmlf.
224 Zero means use var format. */
227 /* On NT, specifies the directory separator character, used (eg.) when
228 expanding file names. This can be bound to / or \. */
229 Lisp_Object Vdirectory_sep_char
;
232 /* Nonzero means skip the call to fsync in Fwrite-region. */
233 int write_region_inhibit_fsync
;
236 extern Lisp_Object Vuser_login_name
;
239 extern Lisp_Object Vw32_get_true_file_attributes
;
242 extern int minibuf_level
;
244 extern int minibuffer_auto_raise
;
246 extern int history_delete_duplicates
;
248 /* These variables describe handlers that have "already" had a chance
249 to handle the current operation.
251 Vinhibit_file_name_handlers is a list of file name handlers.
252 Vinhibit_file_name_operation is the operation being handled.
253 If we try to handle that operation, we ignore those handlers. */
255 static Lisp_Object Vinhibit_file_name_handlers
;
256 static Lisp_Object Vinhibit_file_name_operation
;
258 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
260 Lisp_Object Qfile_name_history
;
262 Lisp_Object Qcar_less_than_car
;
264 static int a_write
P_ ((int, Lisp_Object
, int, int,
265 Lisp_Object
*, struct coding_system
*));
266 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
270 report_file_error (string
, data
)
274 Lisp_Object errstring
;
277 synchronize_system_messages_locale ();
278 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
279 Vlocale_coding_system
, 0);
285 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
288 /* System error messages are capitalized. Downcase the initial
289 unless it is followed by a slash. */
290 if (SREF (errstring
, 1) != '/')
291 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
293 xsignal (Qfile_error
,
294 Fcons (build_string (string
), Fcons (errstring
, data
)));
299 close_file_unwind (fd
)
302 emacs_close (XFASTINT (fd
));
306 /* Restore point, having saved it as a marker. */
309 restore_point_unwind (location
)
310 Lisp_Object location
;
312 Fgoto_char (location
);
313 Fset_marker (location
, Qnil
, Qnil
);
317 Lisp_Object Qexpand_file_name
;
318 Lisp_Object Qsubstitute_in_file_name
;
319 Lisp_Object Qdirectory_file_name
;
320 Lisp_Object Qfile_name_directory
;
321 Lisp_Object Qfile_name_nondirectory
;
322 Lisp_Object Qunhandled_file_name_directory
;
323 Lisp_Object Qfile_name_as_directory
;
324 Lisp_Object Qcopy_file
;
325 Lisp_Object Qmake_directory_internal
;
326 Lisp_Object Qmake_directory
;
327 Lisp_Object Qdelete_directory
;
328 Lisp_Object Qdelete_file
;
329 Lisp_Object Qrename_file
;
330 Lisp_Object Qadd_name_to_file
;
331 Lisp_Object Qmake_symbolic_link
;
332 Lisp_Object Qfile_exists_p
;
333 Lisp_Object Qfile_executable_p
;
334 Lisp_Object Qfile_readable_p
;
335 Lisp_Object Qfile_writable_p
;
336 Lisp_Object Qfile_symlink_p
;
337 Lisp_Object Qaccess_file
;
338 Lisp_Object Qfile_directory_p
;
339 Lisp_Object Qfile_regular_p
;
340 Lisp_Object Qfile_accessible_directory_p
;
341 Lisp_Object Qfile_modes
;
342 Lisp_Object Qset_file_modes
;
343 Lisp_Object Qset_file_times
;
344 Lisp_Object Qfile_newer_than_file_p
;
345 Lisp_Object Qinsert_file_contents
;
346 Lisp_Object Qwrite_region
;
347 Lisp_Object Qverify_visited_file_modtime
;
348 Lisp_Object Qset_visited_file_modtime
;
350 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
351 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
352 Otherwise, return nil.
353 A file name is handled if one of the regular expressions in
354 `file-name-handler-alist' matches it.
356 If OPERATION equals `inhibit-file-name-operation', then we ignore
357 any handlers that are members of `inhibit-file-name-handlers',
358 but we still do run any other handlers. This lets handlers
359 use the standard functions without calling themselves recursively. */)
360 (filename
, operation
)
361 Lisp_Object filename
, operation
;
363 /* This function must not munge the match data. */
364 Lisp_Object chain
, inhibited_handlers
, result
;
368 CHECK_STRING (filename
);
370 if (EQ (operation
, Vinhibit_file_name_operation
))
371 inhibited_handlers
= Vinhibit_file_name_handlers
;
373 inhibited_handlers
= Qnil
;
375 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
376 chain
= XCDR (chain
))
382 Lisp_Object string
= XCAR (elt
);
384 Lisp_Object handler
= XCDR (elt
);
385 Lisp_Object operations
= Qnil
;
387 if (SYMBOLP (handler
))
388 operations
= Fget (handler
, Qoperations
);
391 && (match_pos
= fast_string_match (string
, filename
)) > pos
392 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
396 handler
= XCDR (elt
);
397 tem
= Fmemq (handler
, inhibited_handlers
);
411 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
413 doc
: /* Return the directory component in file name FILENAME.
414 Return nil if FILENAME does not include a directory.
415 Otherwise return a directory spec.
416 Given a Unix syntax file name, returns a string ending in slash;
417 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
419 Lisp_Object filename
;
422 register const unsigned char *beg
;
424 register unsigned char *beg
;
426 register const unsigned char *p
;
429 CHECK_STRING (filename
);
431 /* If the file name has special constructs in it,
432 call the corresponding file handler. */
433 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
435 return call2 (handler
, Qfile_name_directory
, filename
);
437 filename
= FILE_SYSTEM_CASE (filename
);
438 beg
= SDATA (filename
);
440 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
442 p
= beg
+ SBYTES (filename
);
444 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
446 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
449 /* only recognise drive specifier at the beginning */
451 /* handle the "/:d:foo" and "/:foo" cases correctly */
452 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
453 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
460 /* Expansion of "c:" to drive and default directory. */
463 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
464 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
465 unsigned char *r
= res
;
467 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
469 strncpy (res
, beg
, 2);
474 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
476 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
479 p
= beg
+ strlen (beg
);
482 CORRECT_DIR_SEPS (beg
);
485 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
488 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
489 Sfile_name_nondirectory
, 1, 1, 0,
490 doc
: /* Return file name FILENAME sans its directory.
491 For example, in a Unix-syntax file name,
492 this is everything after the last slash,
493 or the entire name if it contains no slash. */)
495 Lisp_Object filename
;
497 register const unsigned char *beg
, *p
, *end
;
500 CHECK_STRING (filename
);
502 /* If the file name has special constructs in it,
503 call the corresponding file handler. */
504 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
506 return call2 (handler
, Qfile_name_nondirectory
, filename
);
508 beg
= SDATA (filename
);
509 end
= p
= beg
+ SBYTES (filename
);
511 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
513 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
516 /* only recognise drive specifier at beginning */
518 /* handle the "/:d:foo" case correctly */
519 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
524 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
527 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
528 Sunhandled_file_name_directory
, 1, 1, 0,
529 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
530 A `directly usable' directory name is one that may be used without the
531 intervention of any file handler.
532 If FILENAME is a directly usable file itself, return
533 \(file-name-directory FILENAME).
534 The `call-process' and `start-process' functions use this function to
535 get a current directory to run processes in. */)
537 Lisp_Object filename
;
541 /* If the file name has special constructs in it,
542 call the corresponding file handler. */
543 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
545 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
547 return Ffile_name_directory (filename
);
552 file_name_as_directory (out
, in
)
555 int size
= strlen (in
) - 1;
568 /* Is it already a directory string? */
569 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
571 /* Is it a VMS directory file name? If so, hack VMS syntax. */
572 else if (! index (in
, '/')
573 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
574 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
575 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
576 || ! strncmp (&in
[size
- 5], ".dir", 4))
577 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
578 && in
[size
] == '1')))
580 register char *p
, *dot
;
584 dir:x.dir --> dir:[x]
585 dir:[x]y.dir --> dir:[x.y] */
587 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
590 strncpy (out
, in
, p
- in
);
609 dot
= index (p
, '.');
612 /* blindly remove any extension */
613 size
= strlen (out
) + (dot
- p
);
614 strncat (out
, p
, dot
- p
);
625 /* For Unix syntax, Append a slash if necessary */
626 if (!IS_DIRECTORY_SEP (out
[size
]))
628 /* Cannot use DIRECTORY_SEP, which could have any value */
630 out
[size
+ 2] = '\0';
633 CORRECT_DIR_SEPS (out
);
639 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
640 Sfile_name_as_directory
, 1, 1, 0,
641 doc
: /* Return a string representing the file name FILE interpreted as a directory.
642 This operation exists because a directory is also a file, but its name as
643 a directory is different from its name as a file.
644 The result can be used as the value of `default-directory'
645 or passed as second argument to `expand-file-name'.
646 For a Unix-syntax file name, just appends a slash.
647 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
658 /* If the file name has special constructs in it,
659 call the corresponding file handler. */
660 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
662 return call2 (handler
, Qfile_name_as_directory
, file
);
664 buf
= (char *) alloca (SBYTES (file
) + 10);
665 file_name_as_directory (buf
, SDATA (file
));
666 return make_specified_string (buf
, -1, strlen (buf
),
667 STRING_MULTIBYTE (file
));
671 * Convert from directory name to filename.
673 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
674 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
675 * On UNIX, it's simple: just make sure there isn't a terminating /
677 * Value is nonzero if the string output is different from the input.
681 directory_file_name (src
, dst
)
689 struct FAB fab
= cc$rms_fab
;
690 struct NAM nam
= cc$rms_nam
;
691 char esa
[NAM$C_MAXRSS
];
696 if (! index (src
, '/')
697 && (src
[slen
- 1] == ']'
698 || src
[slen
- 1] == ':'
699 || src
[slen
- 1] == '>'))
701 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
703 fab
.fab$b_fns
= slen
;
704 fab
.fab$l_nam
= &nam
;
705 fab
.fab$l_fop
= FAB$M_NAM
;
708 nam
.nam$b_ess
= sizeof esa
;
709 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
711 /* We call SYS$PARSE to handle such things as [--] for us. */
712 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
714 slen
= nam
.nam$b_esl
;
715 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
720 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
722 /* what about when we have logical_name:???? */
723 if (src
[slen
- 1] == ':')
724 { /* Xlate logical name and see what we get */
725 ptr
= strcpy (dst
, src
); /* upper case for getenv */
728 if ('a' <= *ptr
&& *ptr
<= 'z')
732 dst
[slen
- 1] = 0; /* remove colon */
733 if (!(src
= egetenv (dst
)))
735 /* should we jump to the beginning of this procedure?
736 Good points: allows us to use logical names that xlate
738 Bad points: can be a problem if we just translated to a device
740 For now, I'll punt and always expect VMS names, and hope for
743 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
744 { /* no recursion here! */
750 { /* not a directory spec */
755 bracket
= src
[slen
- 1];
757 /* If bracket is ']' or '>', bracket - 2 is the corresponding
759 ptr
= index (src
, bracket
- 2);
761 { /* no opening bracket */
765 if (!(rptr
= rindex (src
, '.')))
768 strncpy (dst
, src
, slen
);
772 dst
[slen
++] = bracket
;
777 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
778 then translate the device and recurse. */
779 if (dst
[slen
- 1] == ':'
780 && dst
[slen
- 2] != ':' /* skip decnet nodes */
781 && strcmp (src
+ slen
, "[000000]") == 0)
783 dst
[slen
- 1] = '\0';
784 if ((ptr
= egetenv (dst
))
785 && (rlen
= strlen (ptr
) - 1) > 0
786 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
787 && ptr
[rlen
- 1] == '.')
789 char * buf
= (char *) alloca (strlen (ptr
) + 1);
793 return directory_file_name (buf
, dst
);
798 strcat (dst
, "[000000]");
802 rlen
= strlen (rptr
) - 1;
803 strncat (dst
, rptr
, rlen
);
804 dst
[slen
+ rlen
] = '\0';
805 strcat (dst
, ".DIR.1");
809 /* Process as Unix format: just remove any final slash.
810 But leave "/" unchanged; do not change it to "". */
813 /* Handle // as root for apollo's. */
814 if ((slen
> 2 && dst
[slen
- 1] == '/')
815 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
819 && IS_DIRECTORY_SEP (dst
[slen
- 1])
821 && !IS_ANY_SEP (dst
[slen
- 2])
827 CORRECT_DIR_SEPS (dst
);
832 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
834 doc
: /* Returns the file name of the directory named DIRECTORY.
835 This is the name of the file that holds the data for the directory DIRECTORY.
836 This operation exists because a directory is also a file, but its name as
837 a directory is different from its name as a file.
838 In Unix-syntax, this function just removes the final slash.
839 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
840 it returns a file name such as \"[X]Y.DIR.1\". */)
842 Lisp_Object directory
;
847 CHECK_STRING (directory
);
849 if (NILP (directory
))
852 /* If the file name has special constructs in it,
853 call the corresponding file handler. */
854 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
856 return call2 (handler
, Qdirectory_file_name
, directory
);
859 /* 20 extra chars is insufficient for VMS, since we might perform a
860 logical name translation. an equivalence string can be up to 255
861 chars long, so grab that much extra space... - sss */
862 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
864 buf
= (char *) alloca (SBYTES (directory
) + 20);
866 directory_file_name (SDATA (directory
), buf
);
867 return make_specified_string (buf
, -1, strlen (buf
),
868 STRING_MULTIBYTE (directory
));
871 static char make_temp_name_tbl
[64] =
873 'A','B','C','D','E','F','G','H',
874 'I','J','K','L','M','N','O','P',
875 'Q','R','S','T','U','V','W','X',
876 'Y','Z','a','b','c','d','e','f',
877 'g','h','i','j','k','l','m','n',
878 'o','p','q','r','s','t','u','v',
879 'w','x','y','z','0','1','2','3',
880 '4','5','6','7','8','9','-','_'
883 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
885 /* Value is a temporary file name starting with PREFIX, a string.
887 The Emacs process number forms part of the result, so there is
888 no danger of generating a name being used by another process.
889 In addition, this function makes an attempt to choose a name
890 which has no existing file. To make this work, PREFIX should be
891 an absolute file name.
893 BASE64_P non-zero means add the pid as 3 characters in base64
894 encoding. In this case, 6 characters will be added to PREFIX to
895 form the file name. Otherwise, if Emacs is running on a system
896 with long file names, add the pid as a decimal number.
898 This function signals an error if no unique file name could be
902 make_temp_name (prefix
, base64_p
)
909 unsigned char *p
, *data
;
913 CHECK_STRING (prefix
);
915 /* VAL is created by adding 6 characters to PREFIX. The first
916 three are the PID of this process, in base 64, and the second
917 three are incremented if the file already exists. This ensures
918 262144 unique file names per PID per PREFIX. */
920 pid
= (int) getpid ();
924 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
925 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
931 #ifdef HAVE_LONG_FILE_NAMES
932 sprintf (pidbuf
, "%d", pid
);
933 pidlen
= strlen (pidbuf
);
935 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
936 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
937 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
942 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
943 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
944 if (!STRING_MULTIBYTE (prefix
))
945 STRING_SET_UNIBYTE (val
);
947 bcopy(SDATA (prefix
), data
, len
);
950 bcopy (pidbuf
, p
, pidlen
);
953 /* Here we try to minimize useless stat'ing when this function is
954 invoked many times successively with the same PREFIX. We achieve
955 this by initializing count to a random value, and incrementing it
958 We don't want make-temp-name to be called while dumping,
959 because then make_temp_name_count_initialized_p would get set
960 and then make_temp_name_count would not be set when Emacs starts. */
962 if (!make_temp_name_count_initialized_p
)
964 make_temp_name_count
= (unsigned) time (NULL
);
965 make_temp_name_count_initialized_p
= 1;
971 unsigned num
= make_temp_name_count
;
973 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
974 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
975 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
977 /* Poor man's congruential RN generator. Replace with
978 ++make_temp_name_count for debugging. */
979 make_temp_name_count
+= 25229;
980 make_temp_name_count
%= 225307;
982 if (stat (data
, &ignored
) < 0)
984 /* We want to return only if errno is ENOENT. */
988 /* The error here is dubious, but there is little else we
989 can do. The alternatives are to return nil, which is
990 as bad as (and in many cases worse than) throwing the
991 error, or to ignore the error, which will likely result
992 in looping through 225307 stat's, which is not only
993 dog-slow, but also useless since it will fallback to
994 the errow below, anyway. */
995 report_file_error ("Cannot create temporary name for prefix",
996 Fcons (prefix
, Qnil
));
1001 error ("Cannot create temporary name for prefix `%s'",
1007 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1008 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1009 The Emacs process number forms part of the result,
1010 so there is no danger of generating a name being used by another process.
1012 In addition, this function makes an attempt to choose a name
1013 which has no existing file. To make this work,
1014 PREFIX should be an absolute file name.
1016 There is a race condition between calling `make-temp-name' and creating the
1017 file which opens all kinds of security holes. For that reason, you should
1018 probably use `make-temp-file' instead, except in three circumstances:
1020 * If you are creating the file in the user's home directory.
1021 * If you are creating a directory rather than an ordinary file.
1022 * If you are taking special precautions as `make-temp-file' does. */)
1026 return make_temp_name (prefix
, 0);
1031 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1032 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1033 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1034 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1035 the current buffer's value of `default-directory' is used.
1036 File name components that are `.' are removed, and
1037 so are file name components followed by `..', along with the `..' itself;
1038 note that these simplifications are done without checking the resulting
1039 file names in the file system.
1040 An initial `~/' expands to your home directory.
1041 An initial `~USER/' expands to USER's home directory.
1042 See also the function `substitute-in-file-name'. */)
1043 (name
, default_directory
)
1044 Lisp_Object name
, default_directory
;
1048 register unsigned char *newdir
, *p
, *o
;
1050 unsigned char *target
;
1053 unsigned char * colon
= 0;
1054 unsigned char * close
= 0;
1055 unsigned char * slash
= 0;
1056 unsigned char * brack
= 0;
1057 int lbrack
= 0, rbrack
= 0;
1062 int collapse_newdir
= 1;
1066 Lisp_Object handler
, result
;
1069 CHECK_STRING (name
);
1071 /* If the file name has special constructs in it,
1072 call the corresponding file handler. */
1073 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1074 if (!NILP (handler
))
1075 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1077 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1078 if (NILP (default_directory
))
1079 default_directory
= current_buffer
->directory
;
1080 if (! STRINGP (default_directory
))
1083 /* "/" is not considered a root directory on DOS_NT, so using "/"
1084 here causes an infinite recursion in, e.g., the following:
1086 (let (default-directory)
1087 (expand-file-name "a"))
1089 To avoid this, we set default_directory to the root of the
1091 extern char *emacs_root_dir (void);
1093 default_directory
= build_string (emacs_root_dir ());
1095 default_directory
= build_string ("/");
1099 if (!NILP (default_directory
))
1101 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1102 if (!NILP (handler
))
1103 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1106 o
= SDATA (default_directory
);
1108 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1109 It would be better to do this down below where we actually use
1110 default_directory. Unfortunately, calling Fexpand_file_name recursively
1111 could invoke GC, and the strings might be relocated. This would
1112 be annoying because we have pointers into strings lying around
1113 that would need adjusting, and people would add new pointers to
1114 the code and forget to adjust them, resulting in intermittent bugs.
1115 Putting this call here avoids all that crud.
1117 The EQ test avoids infinite recursion. */
1118 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1119 /* Save time in some common cases - as long as default_directory
1120 is not relative, it can be canonicalized with name below (if it
1121 is needed at all) without requiring it to be expanded now. */
1123 /* Detect MSDOS file names with drive specifiers. */
1124 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1126 /* Detect Windows file names in UNC format. */
1127 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1129 #else /* not DOS_NT */
1130 /* Detect Unix absolute file names (/... alone is not absolute on
1132 && ! (IS_DIRECTORY_SEP (o
[0]))
1133 #endif /* not DOS_NT */
1136 struct gcpro gcpro1
;
1139 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1143 name
= FILE_SYSTEM_CASE (name
);
1145 multibyte
= STRING_MULTIBYTE (name
);
1148 /* We will force directory separators to be either all \ or /, so make
1149 a local copy to modify, even if there ends up being no change. */
1150 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1152 /* Note if special escape prefix is present, but remove for now. */
1153 if (nm
[0] == '/' && nm
[1] == ':')
1159 /* Find and remove drive specifier if present; this makes nm absolute
1160 even if the rest of the name appears to be relative. Only look for
1161 drive specifier at the beginning. */
1162 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1169 /* If we see "c://somedir", we want to strip the first slash after the
1170 colon when stripping the drive letter. Otherwise, this expands to
1172 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1174 #endif /* WINDOWSNT */
1178 /* Discard any previous drive specifier if nm is now in UNC format. */
1179 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1185 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1186 none are found, we can probably return right away. We will avoid
1187 allocating a new string if name is already fully expanded. */
1189 IS_DIRECTORY_SEP (nm
[0])
1191 && drive
&& !is_escaped
1194 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1201 /* If it turns out that the filename we want to return is just a
1202 suffix of FILENAME, we don't need to go through and edit
1203 things; we just need to construct a new string using data
1204 starting at the middle of FILENAME. If we set lose to a
1205 non-zero value, that means we've discovered that we can't do
1212 /* Since we know the name is absolute, we can assume that each
1213 element starts with a "/". */
1215 /* "." and ".." are hairy. */
1216 if (IS_DIRECTORY_SEP (p
[0])
1218 && (IS_DIRECTORY_SEP (p
[2])
1220 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1223 /* We want to replace multiple `/' in a row with a single
1226 && IS_DIRECTORY_SEP (p
[0])
1227 && IS_DIRECTORY_SEP (p
[1]))
1234 /* if dev:[dir]/, move nm to / */
1235 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1236 nm
= (brack
? brack
+ 1 : colon
+ 1);
1237 lbrack
= rbrack
= 0;
1244 #ifdef NO_HYPHENS_IN_FILENAMES
1245 if (lbrack
== rbrack
)
1247 /* Avoid clobbering negative version numbers. */
1252 #endif /* NO_HYPHENS_IN_FILENAMES */
1254 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1255 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1257 #ifdef NO_HYPHENS_IN_FILENAMES
1260 #endif /* NO_HYPHENS_IN_FILENAMES */
1261 /* count open brackets, reset close bracket pointer */
1262 if (p
[0] == '[' || p
[0] == '<')
1263 lbrack
++, brack
= 0;
1264 /* count close brackets, set close bracket pointer */
1265 if (p
[0] == ']' || p
[0] == '>')
1266 rbrack
++, brack
= p
;
1267 /* detect ][ or >< */
1268 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1270 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1271 nm
= p
+ 1, lose
= 1;
1272 if (p
[0] == ':' && (colon
|| slash
))
1273 /* if dev1:[dir]dev2:, move nm to dev2: */
1279 /* if /name/dev:, move nm to dev: */
1282 /* if node::dev:, move colon following dev */
1283 else if (colon
&& colon
[-1] == ':')
1285 /* if dev1:dev2:, move nm to dev2: */
1286 else if (colon
&& colon
[-1] != ':')
1291 if (p
[0] == ':' && !colon
)
1297 if (lbrack
== rbrack
)
1300 else if (p
[0] == '.')
1308 if (index (nm
, '/'))
1310 nm
= sys_translate_unix (nm
);
1311 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1315 /* Make sure directories are all separated with / or \ as
1316 desired, but avoid allocation of a new string when not
1318 CORRECT_DIR_SEPS (nm
);
1320 if (IS_DIRECTORY_SEP (nm
[1]))
1322 if (strcmp (nm
, SDATA (name
)) != 0)
1323 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1327 /* drive must be set, so this is okay */
1328 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1332 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1333 temp
[0] = DRIVE_LETTER (drive
);
1334 name
= concat2 (build_string (temp
), name
);
1337 #else /* not DOS_NT */
1338 if (nm
== SDATA (name
))
1340 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1341 #endif /* not DOS_NT */
1345 /* At this point, nm might or might not be an absolute file name. We
1346 need to expand ~ or ~user if present, otherwise prefix nm with
1347 default_directory if nm is not absolute, and finally collapse /./
1348 and /foo/../ sequences.
1350 We set newdir to be the appropriate prefix if one is needed:
1351 - the relevant user directory if nm starts with ~ or ~user
1352 - the specified drive's working dir (DOS/NT only) if nm does not
1354 - the value of default_directory.
1356 Note that these prefixes are not guaranteed to be absolute (except
1357 for the working dir of a drive). Therefore, to ensure we always
1358 return an absolute name, if the final prefix is not absolute we
1359 append it to the current working directory. */
1363 if (nm
[0] == '~') /* prefix ~ */
1365 if (IS_DIRECTORY_SEP (nm
[1])
1369 || nm
[1] == 0) /* ~ by itself */
1371 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1372 newdir
= (unsigned char *) "";
1375 collapse_newdir
= 0;
1378 nm
++; /* Don't leave the slash in nm. */
1381 else /* ~user/filename */
1383 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1388 o
= (unsigned char *) alloca (p
- nm
+ 1);
1389 bcopy ((char *) nm
, o
, p
- nm
);
1393 pw
= (struct passwd
*) getpwnam (o
+ 1);
1397 newdir
= (unsigned char *) pw
-> pw_dir
;
1399 nm
= p
+ 1; /* skip the terminator */
1403 collapse_newdir
= 0;
1408 /* If we don't find a user of that name, leave the name
1409 unchanged; don't move nm forward to p. */
1414 /* On DOS and Windows, nm is absolute if a drive name was specified;
1415 use the drive's current directory as the prefix if needed. */
1416 if (!newdir
&& drive
)
1418 /* Get default directory if needed to make nm absolute. */
1419 if (!IS_DIRECTORY_SEP (nm
[0]))
1421 newdir
= alloca (MAXPATHLEN
+ 1);
1422 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1427 /* Either nm starts with /, or drive isn't mounted. */
1428 newdir
= alloca (4);
1429 newdir
[0] = DRIVE_LETTER (drive
);
1437 /* Finally, if no prefix has been specified and nm is not absolute,
1438 then it must be expanded relative to default_directory. */
1442 /* /... alone is not absolute on DOS and Windows. */
1443 && !IS_DIRECTORY_SEP (nm
[0])
1446 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1453 newdir
= SDATA (default_directory
);
1454 multibyte
|= STRING_MULTIBYTE (default_directory
);
1456 /* Note if special escape prefix is present, but remove for now. */
1457 if (newdir
[0] == '/' && newdir
[1] == ':')
1468 /* First ensure newdir is an absolute name. */
1470 /* Detect MSDOS file names with drive specifiers. */
1471 ! (IS_DRIVE (newdir
[0])
1472 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1474 /* Detect Windows file names in UNC format. */
1475 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1479 /* Effectively, let newdir be (expand-file-name newdir cwd).
1480 Because of the admonition against calling expand-file-name
1481 when we have pointers into lisp strings, we accomplish this
1482 indirectly by prepending newdir to nm if necessary, and using
1483 cwd (or the wd of newdir's drive) as the new newdir. */
1485 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1490 if (!IS_DIRECTORY_SEP (nm
[0]))
1492 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1493 file_name_as_directory (tmp
, newdir
);
1497 newdir
= alloca (MAXPATHLEN
+ 1);
1500 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1507 /* Strip off drive name from prefix, if present. */
1508 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1514 /* Keep only a prefix from newdir if nm starts with slash
1515 (//server/share for UNC, nothing otherwise). */
1516 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1519 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1521 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1523 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1525 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1537 /* Get rid of any slash at the end of newdir, unless newdir is
1538 just / or // (an incomplete UNC name). */
1539 length
= strlen (newdir
);
1540 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1542 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1546 unsigned char *temp
= (unsigned char *) alloca (length
);
1547 bcopy (newdir
, temp
, length
- 1);
1548 temp
[length
- 1] = 0;
1556 /* Now concatenate the directory and name to new space in the stack frame */
1557 tlen
+= strlen (nm
) + 1;
1559 /* Reserve space for drive specifier and escape prefix, since either
1560 or both may need to be inserted. (The Microsoft x86 compiler
1561 produces incorrect code if the following two lines are combined.) */
1562 target
= (unsigned char *) alloca (tlen
+ 4);
1564 #else /* not DOS_NT */
1565 target
= (unsigned char *) alloca (tlen
);
1566 #endif /* not DOS_NT */
1572 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1575 /* If newdir is effectively "C:/", then the drive letter will have
1576 been stripped and newdir will be "/". Concatenating with an
1577 absolute directory in nm produces "//", which will then be
1578 incorrectly treated as a network share. Ignore newdir in
1579 this case (keeping the drive letter). */
1580 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1581 && newdir
[1] == '\0'))
1583 strcpy (target
, newdir
);
1587 file_name_as_directory (target
, newdir
);
1590 strcat (target
, nm
);
1592 if (index (target
, '/'))
1593 strcpy (target
, sys_translate_unix (target
));
1596 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1598 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1607 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1613 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1614 /* brackets are offset from each other by 2 */
1617 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1618 /* convert [foo][bar] to [bar] */
1619 while (o
[-1] != '[' && o
[-1] != '<')
1621 else if (*p
== '-' && *o
!= '.')
1624 else if (p
[0] == '-' && o
[-1] == '.'
1625 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1626 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1630 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1631 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1633 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1635 /* else [foo.-] ==> [-] */
1639 #ifdef NO_HYPHENS_IN_FILENAMES
1641 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1642 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1644 #endif /* NO_HYPHENS_IN_FILENAMES */
1648 if (!IS_DIRECTORY_SEP (*p
))
1652 else if (p
[1] == '.'
1653 && (IS_DIRECTORY_SEP (p
[2])
1656 /* If "/." is the entire filename, keep the "/". Otherwise,
1657 just delete the whole "/.". */
1658 if (o
== target
&& p
[2] == '\0')
1662 else if (p
[1] == '.' && p
[2] == '.'
1663 /* `/../' is the "superroot" on certain file systems.
1664 Turned off on DOS_NT systems because they have no
1665 "superroot" and because this causes us to produce
1666 file names like "d:/../foo" which fail file-related
1667 functions of the underlying OS. (To reproduce, try a
1668 long series of "../../" in default_directory, longer
1669 than the number of levels from the root.) */
1673 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1675 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1677 /* Keep initial / only if this is the whole name. */
1678 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1682 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1683 /* Collapse multiple `/' in a row. */
1689 #endif /* not VMS */
1693 /* At last, set drive name. */
1695 /* Except for network file name. */
1696 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1697 #endif /* WINDOWSNT */
1699 if (!drive
) abort ();
1701 target
[0] = DRIVE_LETTER (drive
);
1704 /* Reinsert the escape prefix if required. */
1711 CORRECT_DIR_SEPS (target
);
1714 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1716 /* Again look to see if the file name has special constructs in it
1717 and perhaps call the corresponding file handler. This is needed
1718 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1719 the ".." component gives us "/user@host:/bar/../baz" which needs
1720 to be expanded again. */
1721 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1722 if (!NILP (handler
))
1723 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1729 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1730 This is the old version of expand-file-name, before it was thoroughly
1731 rewritten for Emacs 10.31. We leave this version here commented-out,
1732 because the code is very complex and likely to have subtle bugs. If
1733 bugs _are_ found, it might be of interest to look at the old code and
1734 see what did it do in the relevant situation.
1736 Don't remove this code: it's true that it will be accessible via CVS,
1737 but a few years from deletion, people will forget it is there. */
1739 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1740 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1741 "Convert FILENAME to absolute, and canonicalize it.\n\
1742 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1743 \(does not start with slash); if DEFAULT is nil or missing,\n\
1744 the current buffer's value of default-directory is used.\n\
1745 Filenames containing `.' or `..' as components are simplified;\n\
1746 initial `~/' expands to your home directory.\n\
1747 See also the function `substitute-in-file-name'.")
1749 Lisp_Object name
, defalt
;
1753 register unsigned char *newdir
, *p
, *o
;
1755 unsigned char *target
;
1759 unsigned char * colon
= 0;
1760 unsigned char * close
= 0;
1761 unsigned char * slash
= 0;
1762 unsigned char * brack
= 0;
1763 int lbrack
= 0, rbrack
= 0;
1767 CHECK_STRING (name
);
1770 /* Filenames on VMS are always upper case. */
1771 name
= Fupcase (name
);
1776 /* If nm is absolute, flush ...// and detect /./ and /../.
1777 If no /./ or /../ we can return right away. */
1789 if (p
[0] == '/' && p
[1] == '/'
1791 /* // at start of filename is meaningful on Apollo system. */
1796 if (p
[0] == '/' && p
[1] == '~')
1797 nm
= p
+ 1, lose
= 1;
1798 if (p
[0] == '/' && p
[1] == '.'
1799 && (p
[2] == '/' || p
[2] == 0
1800 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1806 /* if dev:[dir]/, move nm to / */
1807 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1808 nm
= (brack
? brack
+ 1 : colon
+ 1);
1809 lbrack
= rbrack
= 0;
1817 /* VMS pre V4.4,convert '-'s in filenames. */
1818 if (lbrack
== rbrack
)
1820 if (dots
< 2) /* this is to allow negative version numbers */
1826 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1827 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1833 /* count open brackets, reset close bracket pointer */
1834 if (p
[0] == '[' || p
[0] == '<')
1835 lbrack
++, brack
= 0;
1836 /* count close brackets, set close bracket pointer */
1837 if (p
[0] == ']' || p
[0] == '>')
1838 rbrack
++, brack
= p
;
1839 /* detect ][ or >< */
1840 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1842 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1843 nm
= p
+ 1, lose
= 1;
1844 if (p
[0] == ':' && (colon
|| slash
))
1845 /* if dev1:[dir]dev2:, move nm to dev2: */
1851 /* If /name/dev:, move nm to dev: */
1854 /* If node::dev:, move colon following dev */
1855 else if (colon
&& colon
[-1] == ':')
1857 /* If dev1:dev2:, move nm to dev2: */
1858 else if (colon
&& colon
[-1] != ':')
1863 if (p
[0] == ':' && !colon
)
1869 if (lbrack
== rbrack
)
1872 else if (p
[0] == '.')
1880 if (index (nm
, '/'))
1881 return build_string (sys_translate_unix (nm
));
1883 if (nm
== SDATA (name
))
1885 return build_string (nm
);
1889 /* Now determine directory to start with and put it in NEWDIR */
1893 if (nm
[0] == '~') /* prefix ~ */
1898 || nm
[1] == 0)/* ~/filename */
1900 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1901 newdir
= (unsigned char *) "";
1904 nm
++; /* Don't leave the slash in nm. */
1907 else /* ~user/filename */
1909 /* Get past ~ to user */
1910 unsigned char *user
= nm
+ 1;
1911 /* Find end of name. */
1912 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1913 int len
= ptr
? ptr
- user
: strlen (user
);
1915 unsigned char *ptr1
= index (user
, ':');
1916 if (ptr1
!= 0 && ptr1
- user
< len
)
1919 /* Copy the user name into temp storage. */
1920 o
= (unsigned char *) alloca (len
+ 1);
1921 bcopy ((char *) user
, o
, len
);
1924 /* Look up the user name. */
1926 pw
= (struct passwd
*) getpwnam (o
+ 1);
1929 error ("\"%s\" isn't a registered user", o
+ 1);
1931 newdir
= (unsigned char *) pw
->pw_dir
;
1933 /* Discard the user name from NM. */
1940 #endif /* not VMS */
1944 defalt
= current_buffer
->directory
;
1945 CHECK_STRING (defalt
);
1946 newdir
= SDATA (defalt
);
1949 /* Now concatenate the directory and name to new space in the stack frame */
1951 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1952 target
= (unsigned char *) alloca (tlen
);
1958 if (nm
[0] == 0 || nm
[0] == '/')
1959 strcpy (target
, newdir
);
1962 file_name_as_directory (target
, newdir
);
1965 strcat (target
, nm
);
1967 if (index (target
, '/'))
1968 strcpy (target
, sys_translate_unix (target
));
1971 /* Now canonicalize by removing /. and /foo/.. if they appear */
1979 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1985 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1986 /* brackets are offset from each other by 2 */
1989 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1990 /* convert [foo][bar] to [bar] */
1991 while (o
[-1] != '[' && o
[-1] != '<')
1993 else if (*p
== '-' && *o
!= '.')
1996 else if (p
[0] == '-' && o
[-1] == '.'
1997 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1998 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2002 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2003 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2005 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2007 /* else [foo.-] ==> [-] */
2013 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2014 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2024 else if (!strncmp (p
, "//", 2)
2026 /* // at start of filename is meaningful in Apollo system. */
2034 else if (p
[0] == '/' && p
[1] == '.'
2035 && (p
[2] == '/' || p
[2] == 0))
2037 else if (!strncmp (p
, "/..", 3)
2038 /* `/../' is the "superroot" on certain file systems. */
2040 && (p
[3] == '/' || p
[3] == 0))
2042 while (o
!= target
&& *--o
!= '/')
2045 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2049 if (o
== target
&& *o
== '/')
2057 #endif /* not VMS */
2060 return make_string (target
, o
- target
);
2064 /* If /~ or // appears, discard everything through first slash. */
2066 file_name_absolute_p (filename
)
2067 const unsigned char *filename
;
2070 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2072 /* ??? This criterion is probably wrong for '<'. */
2073 || index (filename
, ':') || index (filename
, '<')
2074 || (*filename
== '[' && (filename
[1] != '-'
2075 || (filename
[2] != '.' && filename
[2] != ']'))
2076 && filename
[1] != '.')
2079 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2080 && IS_DIRECTORY_SEP (filename
[2]))
2085 static unsigned char *
2086 search_embedded_absfilename (nm
, endp
)
2087 unsigned char *nm
, *endp
;
2089 unsigned char *p
, *s
;
2091 for (p
= nm
+ 1; p
< endp
; p
++)
2095 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2097 || IS_DIRECTORY_SEP (p
[-1]))
2098 && file_name_absolute_p (p
)
2099 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2100 /* // at start of file name is meaningful in Apollo,
2101 WindowsNT and Cygwin systems. */
2102 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2103 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2106 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2111 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2113 unsigned char *o
= alloca (s
- p
+ 1);
2115 bcopy (p
, o
, s
- p
);
2118 /* If we have ~user and `user' exists, discard
2119 everything up to ~. But if `user' does not exist, leave
2120 ~user alone, it might be a literal file name. */
2122 pw
= getpwnam (o
+ 1);
2134 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2135 Ssubstitute_in_file_name
, 1, 1, 0,
2136 doc
: /* Substitute environment variables referred to in FILENAME.
2137 `$FOO' where FOO is an environment variable name means to substitute
2138 the value of that variable. The variable name should be terminated
2139 with a character not a letter, digit or underscore; otherwise, enclose
2140 the entire variable name in braces.
2141 If `/~' appears, all of FILENAME through that `/' is discarded.
2143 On VMS, `$' substitution is not done; this function does little and only
2144 duplicates what `expand-file-name' does. */)
2146 Lisp_Object filename
;
2150 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2151 unsigned char *target
= NULL
;
2153 int substituted
= 0;
2155 Lisp_Object handler
;
2157 CHECK_STRING (filename
);
2159 /* If the file name has special constructs in it,
2160 call the corresponding file handler. */
2161 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2162 if (!NILP (handler
))
2163 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2165 nm
= SDATA (filename
);
2167 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2168 CORRECT_DIR_SEPS (nm
);
2169 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2171 endp
= nm
+ SBYTES (filename
);
2173 /* If /~ or // appears, discard everything through first slash. */
2174 p
= search_embedded_absfilename (nm
, endp
);
2176 /* Start over with the new string, so we check the file-name-handler
2177 again. Important with filenames like "/home/foo//:/hello///there"
2178 which whould substitute to "/:/hello///there" rather than "/there". */
2179 return Fsubstitute_in_file_name
2180 (make_specified_string (p
, -1, endp
- p
,
2181 STRING_MULTIBYTE (filename
)));
2187 /* See if any variables are substituted into the string
2188 and find the total length of their values in `total' */
2190 for (p
= nm
; p
!= endp
;)
2200 /* "$$" means a single "$" */
2209 while (p
!= endp
&& *p
!= '}') p
++;
2210 if (*p
!= '}') goto missingclose
;
2216 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2220 /* Copy out the variable name */
2221 target
= (unsigned char *) alloca (s
- o
+ 1);
2222 strncpy (target
, o
, s
- o
);
2225 strupr (target
); /* $home == $HOME etc. */
2228 /* Get variable value */
2229 o
= (unsigned char *) egetenv (target
);
2232 total
+= strlen (o
);
2242 /* If substitution required, recopy the string and do it */
2243 /* Make space in stack frame for the new copy */
2244 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2247 /* Copy the rest of the name through, replacing $ constructs with values */
2264 while (p
!= endp
&& *p
!= '}') p
++;
2265 if (*p
!= '}') goto missingclose
;
2271 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2275 /* Copy out the variable name */
2276 target
= (unsigned char *) alloca (s
- o
+ 1);
2277 strncpy (target
, o
, s
- o
);
2280 strupr (target
); /* $home == $HOME etc. */
2283 /* Get variable value */
2284 o
= (unsigned char *) egetenv (target
);
2288 strcpy (x
, target
); x
+= strlen (target
);
2290 else if (STRING_MULTIBYTE (filename
))
2292 /* If the original string is multibyte,
2293 convert what we substitute into multibyte. */
2296 int c
= unibyte_char_to_multibyte (*o
++);
2297 x
+= CHAR_STRING (c
, x
);
2309 /* If /~ or // appears, discard everything through first slash. */
2310 while ((p
= search_embedded_absfilename (xnm
, x
)))
2311 /* This time we do not start over because we've already expanded envvars
2312 and replaced $$ with $. Maybe we should start over as well, but we'd
2313 need to quote some $ to $$ first. */
2316 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2319 error ("Bad format environment-variable substitution");
2321 error ("Missing \"}\" in environment-variable substitution");
2323 error ("Substituting nonexistent environment variable \"%s\"", target
);
2326 #endif /* not VMS */
2330 /* A slightly faster and more convenient way to get
2331 (directory-file-name (expand-file-name FOO)). */
2334 expand_and_dir_to_file (filename
, defdir
)
2335 Lisp_Object filename
, defdir
;
2337 register Lisp_Object absname
;
2339 absname
= Fexpand_file_name (filename
, defdir
);
2342 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2343 if (c
== ':' || c
== ']' || c
== '>')
2344 absname
= Fdirectory_file_name (absname
);
2347 /* Remove final slash, if any (unless this is the root dir).
2348 stat behaves differently depending! */
2349 if (SCHARS (absname
) > 1
2350 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2351 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2352 /* We cannot take shortcuts; they might be wrong for magic file names. */
2353 absname
= Fdirectory_file_name (absname
);
2358 /* Signal an error if the file ABSNAME already exists.
2359 If INTERACTIVE is nonzero, ask the user whether to proceed,
2360 and bypass the error if the user says to go ahead.
2361 QUERYSTRING is a name for the action that is being considered
2364 *STATPTR is used to store the stat information if the file exists.
2365 If the file does not exist, STATPTR->st_mode is set to 0.
2366 If STATPTR is null, we don't store into it.
2368 If QUICK is nonzero, we ask for y or n, not yes or no. */
2371 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2372 Lisp_Object absname
;
2373 unsigned char *querystring
;
2375 struct stat
*statptr
;
2378 register Lisp_Object tem
, encoded_filename
;
2379 struct stat statbuf
;
2380 struct gcpro gcpro1
;
2382 encoded_filename
= ENCODE_FILE (absname
);
2384 /* stat is a good way to tell whether the file exists,
2385 regardless of what access permissions it has. */
2386 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2389 xsignal2 (Qfile_already_exists
,
2390 build_string ("File already exists"), absname
);
2392 tem
= format2 ("File %s already exists; %s anyway? ",
2393 absname
, build_string (querystring
));
2395 tem
= Fy_or_n_p (tem
);
2397 tem
= do_yes_or_no_p (tem
);
2400 xsignal2 (Qfile_already_exists
,
2401 build_string ("File already exists"), absname
);
2408 statptr
->st_mode
= 0;
2413 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2414 "fCopy file: \nGCopy %s to file: \np\nP",
2415 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2416 If NEWNAME names a directory, copy FILE there.
2418 This function always sets the file modes of the output file to match
2421 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2422 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2423 signal a `file-already-exists' error without overwriting. If
2424 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2425 about overwriting; this is what happens in interactive use with M-x.
2426 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2429 Fourth arg KEEP-TIME non-nil means give the output file the same
2430 last-modified time as the old one. (This works on only some systems.)
2432 A prefix arg makes KEEP-TIME non-nil.
2434 If PRESERVE-UID-GID is non-nil, we try to transfer the
2435 uid and gid of FILE to NEWNAME. */)
2436 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2437 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2438 Lisp_Object preserve_uid_gid
;
2441 char buf
[16 * 1024];
2442 struct stat st
, out_st
;
2443 Lisp_Object handler
;
2444 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2445 int count
= SPECPDL_INDEX ();
2446 int input_file_statable_p
;
2447 Lisp_Object encoded_file
, encoded_newname
;
2449 encoded_file
= encoded_newname
= Qnil
;
2450 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2451 CHECK_STRING (file
);
2452 CHECK_STRING (newname
);
2454 if (!NILP (Ffile_directory_p (newname
)))
2455 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2457 newname
= Fexpand_file_name (newname
, Qnil
);
2459 file
= Fexpand_file_name (file
, Qnil
);
2461 /* If the input file name has special constructs in it,
2462 call the corresponding file handler. */
2463 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2464 /* Likewise for output file name. */
2466 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2467 if (!NILP (handler
))
2468 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2469 ok_if_already_exists
, keep_time
));
2471 encoded_file
= ENCODE_FILE (file
);
2472 encoded_newname
= ENCODE_FILE (newname
);
2474 if (NILP (ok_if_already_exists
)
2475 || INTEGERP (ok_if_already_exists
))
2476 barf_or_query_if_file_exists (newname
, "copy to it",
2477 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2478 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2482 if (!CopyFile (SDATA (encoded_file
),
2483 SDATA (encoded_newname
),
2485 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2486 /* CopyFile retains the timestamp by default. */
2487 else if (NILP (keep_time
))
2493 EMACS_GET_TIME (now
);
2494 filename
= SDATA (encoded_newname
);
2496 /* Ensure file is writable while its modified time is set. */
2497 attributes
= GetFileAttributes (filename
);
2498 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2499 if (set_file_times (filename
, now
, now
))
2501 /* Restore original attributes. */
2502 SetFileAttributes (filename
, attributes
);
2503 xsignal2 (Qfile_date_error
,
2504 build_string ("Cannot set file date"), newname
);
2506 /* Restore original attributes. */
2507 SetFileAttributes (filename
, attributes
);
2509 #else /* not WINDOWSNT */
2511 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2515 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2517 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2519 /* We can only copy regular files and symbolic links. Other files are not
2521 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2523 #if !defined (MSDOS) || __DJGPP__ > 1
2524 if (out_st
.st_mode
!= 0
2525 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2528 report_file_error ("Input and output files are the same",
2529 Fcons (file
, Fcons (newname
, Qnil
)));
2533 #if defined (S_ISREG) && defined (S_ISLNK)
2534 if (input_file_statable_p
)
2536 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2538 #if defined (EISDIR)
2539 /* Get a better looking error message. */
2542 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2545 #endif /* S_ISREG && S_ISLNK */
2548 /* Create the copy file with the same record format as the input file */
2549 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2552 /* System's default file type was set to binary by _fmode in emacs.c. */
2553 ofd
= emacs_open (SDATA (encoded_newname
),
2554 O_WRONLY
| O_TRUNC
| O_CREAT
2555 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2556 S_IREAD
| S_IWRITE
);
2557 #else /* not MSDOS */
2558 ofd
= emacs_open (SDATA (encoded_newname
),
2559 O_WRONLY
| O_TRUNC
| O_CREAT
2560 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2562 #endif /* not MSDOS */
2565 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2567 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2571 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2572 if (emacs_write (ofd
, buf
, n
) != n
)
2573 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2577 /* Preserve the original file modes, and if requested, also its
2579 if (input_file_statable_p
)
2581 if (! NILP (preserve_uid_gid
))
2582 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2583 fchmod (ofd
, st
.st_mode
& 07777);
2585 #endif /* not MSDOS */
2587 /* Closing the output clobbers the file times on some systems. */
2588 if (emacs_close (ofd
) < 0)
2589 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2591 if (input_file_statable_p
)
2593 if (!NILP (keep_time
))
2595 EMACS_TIME atime
, mtime
;
2596 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2597 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2598 if (set_file_times (SDATA (encoded_newname
),
2600 xsignal2 (Qfile_date_error
,
2601 build_string ("Cannot set file date"), newname
);
2607 #if defined (__DJGPP__) && __DJGPP__ > 1
2608 if (input_file_statable_p
)
2610 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2611 and if it can't, it tells so. Otherwise, under MSDOS we usually
2612 get only the READ bit, which will make the copied file read-only,
2613 so it's better not to chmod at all. */
2614 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2615 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2617 #endif /* DJGPP version 2 or newer */
2618 #endif /* not WINDOWSNT */
2620 /* Discard the unwind protects. */
2621 specpdl_ptr
= specpdl
+ count
;
2627 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2628 Smake_directory_internal
, 1, 1, 0,
2629 doc
: /* Create a new directory named DIRECTORY. */)
2631 Lisp_Object directory
;
2633 const unsigned char *dir
;
2634 Lisp_Object handler
;
2635 Lisp_Object encoded_dir
;
2637 CHECK_STRING (directory
);
2638 directory
= Fexpand_file_name (directory
, Qnil
);
2640 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2641 if (!NILP (handler
))
2642 return call2 (handler
, Qmake_directory_internal
, directory
);
2644 encoded_dir
= ENCODE_FILE (directory
);
2646 dir
= SDATA (encoded_dir
);
2649 if (mkdir (dir
) != 0)
2651 if (mkdir (dir
, 0777) != 0)
2653 report_file_error ("Creating directory", list1 (directory
));
2658 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2659 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2661 Lisp_Object directory
;
2663 const unsigned char *dir
;
2664 Lisp_Object handler
;
2665 Lisp_Object encoded_dir
;
2667 CHECK_STRING (directory
);
2668 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2670 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2671 if (!NILP (handler
))
2672 return call2 (handler
, Qdelete_directory
, directory
);
2674 encoded_dir
= ENCODE_FILE (directory
);
2676 dir
= SDATA (encoded_dir
);
2678 if (rmdir (dir
) != 0)
2679 report_file_error ("Removing directory", list1 (directory
));
2684 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2685 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2686 If file has multiple names, it continues to exist with the other names. */)
2688 Lisp_Object filename
;
2690 Lisp_Object handler
;
2691 Lisp_Object encoded_file
;
2692 struct gcpro gcpro1
;
2695 if (!NILP (Ffile_directory_p (filename
))
2696 && NILP (Ffile_symlink_p (filename
)))
2697 xsignal2 (Qfile_error
,
2698 build_string ("Removing old name: is a directory"),
2701 filename
= Fexpand_file_name (filename
, Qnil
);
2703 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2704 if (!NILP (handler
))
2705 return call2 (handler
, Qdelete_file
, filename
);
2707 encoded_file
= ENCODE_FILE (filename
);
2709 if (0 > unlink (SDATA (encoded_file
)))
2710 report_file_error ("Removing old name", list1 (filename
));
2715 internal_delete_file_1 (ignore
)
2721 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2724 internal_delete_file (filename
)
2725 Lisp_Object filename
;
2728 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2729 Qt
, internal_delete_file_1
);
2733 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2734 "fRename file: \nGRename %s to file: \np",
2735 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2736 If file has names other than FILE, it continues to have those names.
2737 Signals a `file-already-exists' error if a file NEWNAME already exists
2738 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2739 A number as third arg means request confirmation if NEWNAME already exists.
2740 This is what happens in interactive use with M-x. */)
2741 (file
, newname
, ok_if_already_exists
)
2742 Lisp_Object file
, newname
, ok_if_already_exists
;
2744 Lisp_Object handler
;
2745 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2746 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2748 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2749 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2750 CHECK_STRING (file
);
2751 CHECK_STRING (newname
);
2752 file
= Fexpand_file_name (file
, Qnil
);
2754 if ((!NILP (Ffile_directory_p (newname
)))
2756 /* If the file names are identical but for the case,
2757 don't attempt to move directory to itself. */
2758 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2761 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2763 newname
= Fexpand_file_name (newname
, Qnil
);
2765 /* If the file name has special constructs in it,
2766 call the corresponding file handler. */
2767 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2769 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2770 if (!NILP (handler
))
2771 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2772 file
, newname
, ok_if_already_exists
));
2774 encoded_file
= ENCODE_FILE (file
);
2775 encoded_newname
= ENCODE_FILE (newname
);
2778 /* If the file names are identical but for the case, don't ask for
2779 confirmation: they simply want to change the letter-case of the
2781 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2783 if (NILP (ok_if_already_exists
)
2784 || INTEGERP (ok_if_already_exists
))
2785 barf_or_query_if_file_exists (newname
, "rename to it",
2786 INTEGERP (ok_if_already_exists
), 0, 0);
2788 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2790 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2791 || 0 > unlink (SDATA (encoded_file
)))
2797 symlink_target
= Ffile_symlink_p (file
);
2798 if (! NILP (symlink_target
))
2799 Fmake_symbolic_link (symlink_target
, newname
,
2800 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2803 Fcopy_file (file
, newname
,
2804 /* We have already prompted if it was an integer,
2805 so don't have copy-file prompt again. */
2806 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2809 Fdelete_file (file
);
2812 report_file_error ("Renaming", list2 (file
, newname
));
2818 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2819 "fAdd name to file: \nGName to add to %s: \np",
2820 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2821 Signals a `file-already-exists' error if a file NEWNAME already exists
2822 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2823 A number as third arg means request confirmation if NEWNAME already exists.
2824 This is what happens in interactive use with M-x. */)
2825 (file
, newname
, ok_if_already_exists
)
2826 Lisp_Object file
, newname
, ok_if_already_exists
;
2828 Lisp_Object handler
;
2829 Lisp_Object encoded_file
, encoded_newname
;
2830 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2832 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2833 encoded_file
= encoded_newname
= Qnil
;
2834 CHECK_STRING (file
);
2835 CHECK_STRING (newname
);
2836 file
= Fexpand_file_name (file
, Qnil
);
2838 if (!NILP (Ffile_directory_p (newname
)))
2839 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2841 newname
= Fexpand_file_name (newname
, Qnil
);
2843 /* If the file name has special constructs in it,
2844 call the corresponding file handler. */
2845 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2846 if (!NILP (handler
))
2847 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2848 newname
, ok_if_already_exists
));
2850 /* If the new name has special constructs in it,
2851 call the corresponding file handler. */
2852 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2853 if (!NILP (handler
))
2854 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2855 newname
, ok_if_already_exists
));
2857 encoded_file
= ENCODE_FILE (file
);
2858 encoded_newname
= ENCODE_FILE (newname
);
2860 if (NILP (ok_if_already_exists
)
2861 || INTEGERP (ok_if_already_exists
))
2862 barf_or_query_if_file_exists (newname
, "make it a new name",
2863 INTEGERP (ok_if_already_exists
), 0, 0);
2865 unlink (SDATA (newname
));
2866 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2867 report_file_error ("Adding new name", list2 (file
, newname
));
2874 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2875 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2876 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2877 Both args must be strings.
2878 Signals a `file-already-exists' error if a file LINKNAME already exists
2879 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2880 A number as third arg means request confirmation if LINKNAME already exists.
2881 This happens for interactive use with M-x. */)
2882 (filename
, linkname
, ok_if_already_exists
)
2883 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2885 Lisp_Object handler
;
2886 Lisp_Object encoded_filename
, encoded_linkname
;
2887 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2889 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2890 encoded_filename
= encoded_linkname
= Qnil
;
2891 CHECK_STRING (filename
);
2892 CHECK_STRING (linkname
);
2893 /* If the link target has a ~, we must expand it to get
2894 a truly valid file name. Otherwise, do not expand;
2895 we want to permit links to relative file names. */
2896 if (SREF (filename
, 0) == '~')
2897 filename
= Fexpand_file_name (filename
, Qnil
);
2899 if (!NILP (Ffile_directory_p (linkname
)))
2900 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2902 linkname
= Fexpand_file_name (linkname
, Qnil
);
2904 /* If the file name has special constructs in it,
2905 call the corresponding file handler. */
2906 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2907 if (!NILP (handler
))
2908 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2909 linkname
, ok_if_already_exists
));
2911 /* If the new link name has special constructs in it,
2912 call the corresponding file handler. */
2913 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2914 if (!NILP (handler
))
2915 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2916 linkname
, ok_if_already_exists
));
2918 encoded_filename
= ENCODE_FILE (filename
);
2919 encoded_linkname
= ENCODE_FILE (linkname
);
2921 if (NILP (ok_if_already_exists
)
2922 || INTEGERP (ok_if_already_exists
))
2923 barf_or_query_if_file_exists (linkname
, "make it a link",
2924 INTEGERP (ok_if_already_exists
), 0, 0);
2925 if (0 > symlink (SDATA (encoded_filename
),
2926 SDATA (encoded_linkname
)))
2928 /* If we didn't complain already, silently delete existing file. */
2929 if (errno
== EEXIST
)
2931 unlink (SDATA (encoded_linkname
));
2932 if (0 <= symlink (SDATA (encoded_filename
),
2933 SDATA (encoded_linkname
)))
2940 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2945 #endif /* S_IFLNK */
2949 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2950 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2951 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2952 If STRING is nil or a null string, the logical name NAME is deleted. */)
2957 CHECK_STRING (name
);
2959 delete_logical_name (SDATA (name
));
2962 CHECK_STRING (string
);
2964 if (SCHARS (string
) == 0)
2965 delete_logical_name (SDATA (name
));
2967 define_logical_name (SDATA (name
), SDATA (string
));
2976 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2977 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2979 Lisp_Object path
, login
;
2983 CHECK_STRING (path
);
2984 CHECK_STRING (login
);
2986 netresult
= netunam (SDATA (path
), SDATA (login
));
2988 if (netresult
== -1)
2993 #endif /* HPUX_NET */
2995 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2997 doc
: /* Return t if file FILENAME specifies an absolute file name.
2998 On Unix, this is a name starting with a `/' or a `~'. */)
3000 Lisp_Object filename
;
3002 CHECK_STRING (filename
);
3003 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3006 /* Return nonzero if file FILENAME exists and can be executed. */
3009 check_executable (filename
)
3013 int len
= strlen (filename
);
3016 if (stat (filename
, &st
) < 0)
3018 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3019 return ((st
.st_mode
& S_IEXEC
) != 0);
3021 return (S_ISREG (st
.st_mode
)
3023 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3024 || stricmp (suffix
, ".exe") == 0
3025 || stricmp (suffix
, ".bat") == 0)
3026 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3027 #endif /* not WINDOWSNT */
3028 #else /* not DOS_NT */
3029 #ifdef HAVE_EUIDACCESS
3030 return (euidaccess (filename
, 1) >= 0);
3032 /* Access isn't quite right because it uses the real uid
3033 and we really want to test with the effective uid.
3034 But Unix doesn't give us a right way to do it. */
3035 return (access (filename
, 1) >= 0);
3037 #endif /* not DOS_NT */
3040 /* Return nonzero if file FILENAME exists and can be written. */
3043 check_writable (filename
)
3048 if (stat (filename
, &st
) < 0)
3050 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3051 #else /* not MSDOS */
3052 #ifdef HAVE_EUIDACCESS
3053 return (euidaccess (filename
, 2) >= 0);
3055 /* Access isn't quite right because it uses the real uid
3056 and we really want to test with the effective uid.
3057 But Unix doesn't give us a right way to do it.
3058 Opening with O_WRONLY could work for an ordinary file,
3059 but would lose for directories. */
3060 return (access (filename
, 2) >= 0);
3062 #endif /* not MSDOS */
3065 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3066 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3067 See also `file-readable-p' and `file-attributes'.
3068 This returns nil for a symlink to a nonexistent file.
3069 Use `file-symlink-p' to test for such links. */)
3071 Lisp_Object filename
;
3073 Lisp_Object absname
;
3074 Lisp_Object handler
;
3075 struct stat statbuf
;
3077 CHECK_STRING (filename
);
3078 absname
= Fexpand_file_name (filename
, Qnil
);
3080 /* If the file name has special constructs in it,
3081 call the corresponding file handler. */
3082 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3083 if (!NILP (handler
))
3084 return call2 (handler
, Qfile_exists_p
, absname
);
3086 absname
= ENCODE_FILE (absname
);
3088 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3091 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3092 doc
: /* Return t if FILENAME can be executed by you.
3093 For a directory, this means you can access files in that directory. */)
3095 Lisp_Object filename
;
3097 Lisp_Object absname
;
3098 Lisp_Object handler
;
3100 CHECK_STRING (filename
);
3101 absname
= Fexpand_file_name (filename
, Qnil
);
3103 /* If the file name has special constructs in it,
3104 call the corresponding file handler. */
3105 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3106 if (!NILP (handler
))
3107 return call2 (handler
, Qfile_executable_p
, absname
);
3109 absname
= ENCODE_FILE (absname
);
3111 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3114 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3115 doc
: /* Return t if file FILENAME exists and you can read it.
3116 See also `file-exists-p' and `file-attributes'. */)
3118 Lisp_Object filename
;
3120 Lisp_Object absname
;
3121 Lisp_Object handler
;
3124 struct stat statbuf
;
3126 CHECK_STRING (filename
);
3127 absname
= Fexpand_file_name (filename
, Qnil
);
3129 /* If the file name has special constructs in it,
3130 call the corresponding file handler. */
3131 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3132 if (!NILP (handler
))
3133 return call2 (handler
, Qfile_readable_p
, absname
);
3135 absname
= ENCODE_FILE (absname
);
3137 #if defined(DOS_NT) || defined(macintosh)
3138 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3140 if (access (SDATA (absname
), 0) == 0)
3143 #else /* not DOS_NT and not macintosh */
3145 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3146 /* Opening a fifo without O_NONBLOCK can wait.
3147 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3148 except in the case of a fifo, on a system which handles it. */
3149 desc
= stat (SDATA (absname
), &statbuf
);
3152 if (S_ISFIFO (statbuf
.st_mode
))
3153 flags
|= O_NONBLOCK
;
3155 desc
= emacs_open (SDATA (absname
), flags
, 0);
3160 #endif /* not DOS_NT and not macintosh */
3163 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3165 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3166 doc
: /* Return t if file FILENAME can be written or created by you. */)
3168 Lisp_Object filename
;
3170 Lisp_Object absname
, dir
, encoded
;
3171 Lisp_Object handler
;
3172 struct stat statbuf
;
3174 CHECK_STRING (filename
);
3175 absname
= Fexpand_file_name (filename
, Qnil
);
3177 /* If the file name has special constructs in it,
3178 call the corresponding file handler. */
3179 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3180 if (!NILP (handler
))
3181 return call2 (handler
, Qfile_writable_p
, absname
);
3183 encoded
= ENCODE_FILE (absname
);
3184 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3185 return (check_writable (SDATA (encoded
))
3188 dir
= Ffile_name_directory (absname
);
3191 dir
= Fdirectory_file_name (dir
);
3195 dir
= Fdirectory_file_name (dir
);
3198 dir
= ENCODE_FILE (dir
);
3200 /* The read-only attribute of the parent directory doesn't affect
3201 whether a file or directory can be created within it. Some day we
3202 should check ACLs though, which do affect this. */
3203 if (stat (SDATA (dir
), &statbuf
) < 0)
3205 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3207 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3212 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3213 doc
: /* Access file FILENAME, and get an error if that does not work.
3214 The second argument STRING is used in the error message.
3215 If there is no error, returns nil. */)
3217 Lisp_Object filename
, string
;
3219 Lisp_Object handler
, encoded_filename
, absname
;
3222 CHECK_STRING (filename
);
3223 absname
= Fexpand_file_name (filename
, Qnil
);
3225 CHECK_STRING (string
);
3227 /* If the file name has special constructs in it,
3228 call the corresponding file handler. */
3229 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3230 if (!NILP (handler
))
3231 return call3 (handler
, Qaccess_file
, absname
, string
);
3233 encoded_filename
= ENCODE_FILE (absname
);
3235 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3237 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3243 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3244 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3245 The value is the link target, as a string.
3246 Otherwise it returns nil.
3248 This function returns t when given the name of a symlink that
3249 points to a nonexistent file. */)
3251 Lisp_Object filename
;
3253 Lisp_Object handler
;
3255 CHECK_STRING (filename
);
3256 filename
= Fexpand_file_name (filename
, Qnil
);
3258 /* If the file name has special constructs in it,
3259 call the corresponding file handler. */
3260 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3261 if (!NILP (handler
))
3262 return call2 (handler
, Qfile_symlink_p
, filename
);
3271 filename
= ENCODE_FILE (filename
);
3278 buf
= (char *) xrealloc (buf
, bufsize
);
3279 bzero (buf
, bufsize
);
3282 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3286 /* HP-UX reports ERANGE if buffer is too small. */
3287 if (errno
== ERANGE
)
3297 while (valsize
>= bufsize
);
3299 val
= make_string (buf
, valsize
);
3300 if (buf
[0] == '/' && index (buf
, ':'))
3301 val
= concat2 (build_string ("/:"), val
);
3303 val
= DECODE_FILE (val
);
3306 #else /* not S_IFLNK */
3308 #endif /* not S_IFLNK */
3311 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3312 doc
: /* Return t if FILENAME names an existing directory.
3313 Symbolic links to directories count as directories.
3314 See `file-symlink-p' to distinguish symlinks. */)
3316 Lisp_Object filename
;
3318 register Lisp_Object absname
;
3320 Lisp_Object handler
;
3322 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3324 /* If the file name has special constructs in it,
3325 call the corresponding file handler. */
3326 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3327 if (!NILP (handler
))
3328 return call2 (handler
, Qfile_directory_p
, absname
);
3330 absname
= ENCODE_FILE (absname
);
3332 if (stat (SDATA (absname
), &st
) < 0)
3334 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3337 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3338 doc
: /* Return t if file FILENAME names a directory you can open.
3339 For the value to be t, FILENAME must specify the name of a directory as a file,
3340 and the directory must allow you to open files in it. In order to use a
3341 directory as a buffer's current directory, this predicate must return true.
3342 A directory name spec may be given instead; then the value is t
3343 if the directory so specified exists and really is a readable and
3344 searchable directory. */)
3346 Lisp_Object filename
;
3348 Lisp_Object handler
;
3350 struct gcpro gcpro1
;
3352 /* If the file name has special constructs in it,
3353 call the corresponding file handler. */
3354 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3355 if (!NILP (handler
))
3356 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3359 tem
= (NILP (Ffile_directory_p (filename
))
3360 || NILP (Ffile_executable_p (filename
)));
3362 return tem
? Qnil
: Qt
;
3365 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3366 doc
: /* Return t if FILENAME names a regular file.
3367 This is the sort of file that holds an ordinary stream of data bytes.
3368 Symbolic links to regular files count as regular files.
3369 See `file-symlink-p' to distinguish symlinks. */)
3371 Lisp_Object filename
;
3373 register Lisp_Object absname
;
3375 Lisp_Object handler
;
3377 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3379 /* If the file name has special constructs in it,
3380 call the corresponding file handler. */
3381 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3382 if (!NILP (handler
))
3383 return call2 (handler
, Qfile_regular_p
, absname
);
3385 absname
= ENCODE_FILE (absname
);
3390 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3392 /* Tell stat to use expensive method to get accurate info. */
3393 Vw32_get_true_file_attributes
= Qt
;
3394 result
= stat (SDATA (absname
), &st
);
3395 Vw32_get_true_file_attributes
= tem
;
3399 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3402 if (stat (SDATA (absname
), &st
) < 0)
3404 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3408 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3409 doc
: /* Return mode bits of file named FILENAME, as an integer.
3410 Return nil, if file does not exist or is not accessible. */)
3412 Lisp_Object filename
;
3414 Lisp_Object absname
;
3416 Lisp_Object handler
;
3418 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3420 /* If the file name has special constructs in it,
3421 call the corresponding file handler. */
3422 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3423 if (!NILP (handler
))
3424 return call2 (handler
, Qfile_modes
, absname
);
3426 absname
= ENCODE_FILE (absname
);
3428 if (stat (SDATA (absname
), &st
) < 0)
3430 #if defined (MSDOS) && __DJGPP__ < 2
3431 if (check_executable (SDATA (absname
)))
3432 st
.st_mode
|= S_IEXEC
;
3433 #endif /* MSDOS && __DJGPP__ < 2 */
3435 return make_number (st
.st_mode
& 07777);
3438 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3439 "(let ((file (read-file-name \"File: \"))) \
3440 (list file (read-file-modes nil file)))",
3441 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3442 Only the 12 low bits of MODE are used. */)
3444 Lisp_Object filename
, mode
;
3446 Lisp_Object absname
, encoded_absname
;
3447 Lisp_Object handler
;
3449 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3450 CHECK_NUMBER (mode
);
3452 /* If the file name has special constructs in it,
3453 call the corresponding file handler. */
3454 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3455 if (!NILP (handler
))
3456 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3458 encoded_absname
= ENCODE_FILE (absname
);
3460 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3461 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3466 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3467 doc
: /* Set the file permission bits for newly created files.
3468 The argument MODE should be an integer; only the low 9 bits are used.
3469 This setting is inherited by subprocesses. */)
3473 CHECK_NUMBER (mode
);
3475 umask ((~ XINT (mode
)) & 0777);
3480 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3481 doc
: /* Return the default file protection for created files.
3482 The value is an integer. */)
3488 realmask
= umask (0);
3491 XSETINT (value
, (~ realmask
) & 0777);
3495 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3497 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3498 doc
: /* Set times of file FILENAME to TIME.
3499 Set both access and modification times.
3500 Return t on success, else nil.
3501 Use the current time if TIME is nil. TIME is in the format of
3504 Lisp_Object filename
, time
;
3506 Lisp_Object absname
, encoded_absname
;
3507 Lisp_Object handler
;
3511 if (! lisp_time_argument (time
, &sec
, &usec
))
3512 error ("Invalid time specification");
3514 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3516 /* If the file name has special constructs in it,
3517 call the corresponding file handler. */
3518 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3519 if (!NILP (handler
))
3520 return call3 (handler
, Qset_file_times
, absname
, time
);
3522 encoded_absname
= ENCODE_FILE (absname
);
3527 EMACS_SET_SECS (t
, sec
);
3528 EMACS_SET_USECS (t
, usec
);
3530 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3535 /* Setting times on a directory always fails. */
3536 if (stat (SDATA (encoded_absname
), &st
) == 0
3537 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3540 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3549 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3550 doc
: /* Tell Unix to finish all pending disk updates. */)
3557 #endif /* HAVE_SYNC */
3559 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3560 doc
: /* Return t if file FILE1 is newer than file FILE2.
3561 If FILE1 does not exist, the answer is nil;
3562 otherwise, if FILE2 does not exist, the answer is t. */)
3564 Lisp_Object file1
, file2
;
3566 Lisp_Object absname1
, absname2
;
3569 Lisp_Object handler
;
3570 struct gcpro gcpro1
, gcpro2
;
3572 CHECK_STRING (file1
);
3573 CHECK_STRING (file2
);
3576 GCPRO2 (absname1
, file2
);
3577 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3578 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3581 /* If the file name has special constructs in it,
3582 call the corresponding file handler. */
3583 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3585 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3586 if (!NILP (handler
))
3587 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3589 GCPRO2 (absname1
, absname2
);
3590 absname1
= ENCODE_FILE (absname1
);
3591 absname2
= ENCODE_FILE (absname2
);
3594 if (stat (SDATA (absname1
), &st
) < 0)
3597 mtime1
= st
.st_mtime
;
3599 if (stat (SDATA (absname2
), &st
) < 0)
3602 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3606 Lisp_Object Qfind_buffer_file_type
;
3609 #ifndef READ_BUF_SIZE
3610 #define READ_BUF_SIZE (64 << 10)
3613 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3615 /* This function is called after Lisp functions to decide a coding
3616 system are called, or when they cause an error. Before they are
3617 called, the current buffer is set unibyte and it contains only a
3618 newly inserted text (thus the buffer was empty before the
3621 The functions may set markers, overlays, text properties, or even
3622 alter the buffer contents, change the current buffer.
3624 Here, we reset all those changes by:
3625 o set back the current buffer.
3626 o move all markers and overlays to BEG.
3627 o remove all text properties.
3628 o set back the buffer multibyteness. */
3631 decide_coding_unwind (unwind_data
)
3632 Lisp_Object unwind_data
;
3634 Lisp_Object multibyte
, undo_list
, buffer
;
3636 multibyte
= XCAR (unwind_data
);
3637 unwind_data
= XCDR (unwind_data
);
3638 undo_list
= XCAR (unwind_data
);
3639 buffer
= XCDR (unwind_data
);
3641 if (current_buffer
!= XBUFFER (buffer
))
3642 set_buffer_internal (XBUFFER (buffer
));
3643 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3644 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3645 BUF_INTERVALS (current_buffer
) = 0;
3646 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3648 /* Now we are safe to change the buffer's multibyteness directly. */
3649 current_buffer
->enable_multibyte_characters
= multibyte
;
3650 current_buffer
->undo_list
= undo_list
;
3656 /* Used to pass values from insert-file-contents to read_non_regular. */
3658 static int non_regular_fd
;
3659 static int non_regular_inserted
;
3660 static int non_regular_nbytes
;
3663 /* Read from a non-regular file.
3664 Read non_regular_trytry bytes max from non_regular_fd.
3665 Non_regular_inserted specifies where to put the read bytes.
3666 Value is the number of bytes read. */
3675 nbytes
= emacs_read (non_regular_fd
,
3676 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3677 non_regular_nbytes
);
3679 return make_number (nbytes
);
3683 /* Condition-case handler used when reading from non-regular files
3684 in insert-file-contents. */
3687 read_non_regular_quit ()
3693 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3695 doc
: /* Insert contents of file FILENAME after point.
3696 Returns list of absolute file name and number of characters inserted.
3697 If second argument VISIT is non-nil, the buffer's visited filename and
3698 last save file modtime are set, and it is marked unmodified. If
3699 visiting and the file does not exist, visiting is completed before the
3702 The optional third and fourth arguments BEG and END specify what portion
3703 of the file to insert. These arguments count bytes in the file, not
3704 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3706 If optional fifth argument REPLACE is non-nil, replace the current
3707 buffer contents (in the accessible portion) with the file contents.
3708 This is better than simply deleting and inserting the whole thing
3709 because (1) it preserves some marker positions and (2) it puts less data
3710 in the undo list. When REPLACE is non-nil, the second return value is
3711 the number of characters that replace previous buffer contents.
3713 This function does code conversion according to the value of
3714 `coding-system-for-read' or `file-coding-system-alist', and sets the
3715 variable `last-coding-system-used' to the coding system actually used. */)
3716 (filename
, visit
, beg
, end
, replace
)
3717 Lisp_Object filename
, visit
, beg
, end
, replace
;
3722 register int how_much
;
3723 register int unprocessed
;
3724 int count
= SPECPDL_INDEX ();
3725 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3726 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3729 int not_regular
= 0;
3730 unsigned char read_buf
[READ_BUF_SIZE
];
3731 struct coding_system coding
;
3732 unsigned char buffer
[1 << 14];
3733 int replace_handled
= 0;
3734 int set_coding_system
= 0;
3735 int coding_system_decided
= 0;
3737 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3738 int we_locked_file
= 0;
3740 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3741 error ("Cannot do file visiting in an indirect buffer");
3743 if (!NILP (current_buffer
->read_only
))
3744 Fbarf_if_buffer_read_only ();
3748 orig_filename
= Qnil
;
3751 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3753 CHECK_STRING (filename
);
3754 filename
= Fexpand_file_name (filename
, Qnil
);
3756 /* If the file name has special constructs in it,
3757 call the corresponding file handler. */
3758 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3759 if (!NILP (handler
))
3761 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3762 visit
, beg
, end
, replace
);
3763 if (CONSP (val
) && CONSP (XCDR (val
)))
3764 inserted
= XINT (XCAR (XCDR (val
)));
3768 orig_filename
= filename
;
3769 filename
= ENCODE_FILE (filename
);
3775 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3777 /* Tell stat to use expensive method to get accurate info. */
3778 Vw32_get_true_file_attributes
= Qt
;
3779 total
= stat (SDATA (filename
), &st
);
3780 Vw32_get_true_file_attributes
= tem
;
3785 if (stat (SDATA (filename
), &st
) < 0)
3787 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3788 || fstat (fd
, &st
) < 0)
3789 #endif /* not APOLLO */
3790 #endif /* WINDOWSNT */
3792 if (fd
>= 0) emacs_close (fd
);
3795 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3798 if (!NILP (Vcoding_system_for_read
))
3799 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3804 /* This code will need to be changed in order to work on named
3805 pipes, and it's probably just not worth it. So we should at
3806 least signal an error. */
3807 if (!S_ISREG (st
.st_mode
))
3814 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3815 xsignal2 (Qfile_error
,
3816 build_string ("not a regular file"), orig_filename
);
3821 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3824 /* Replacement should preserve point as it preserves markers. */
3825 if (!NILP (replace
))
3826 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3828 record_unwind_protect (close_file_unwind
, make_number (fd
));
3830 /* Supposedly happens on VMS. */
3831 /* Can happen on any platform that uses long as type of off_t, but allows
3832 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3833 give a message suitable for the latter case. */
3834 if (! not_regular
&& st
.st_size
< 0)
3835 error ("Maximum buffer size exceeded");
3837 /* Prevent redisplay optimizations. */
3838 current_buffer
->clip_changed
= 1;
3842 if (!NILP (beg
) || !NILP (end
))
3843 error ("Attempt to visit less than an entire file");
3844 if (BEG
< Z
&& NILP (replace
))
3845 error ("Cannot do file visiting in a non-empty buffer");
3851 XSETFASTINT (beg
, 0);
3859 XSETINT (end
, st
.st_size
);
3861 /* Arithmetic overflow can occur if an Emacs integer cannot
3862 represent the file size, or if the calculations below
3863 overflow. The calculations below double the file size
3864 twice, so check that it can be multiplied by 4 safely. */
3865 if (XINT (end
) != st
.st_size
3866 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3867 error ("Maximum buffer size exceeded");
3869 /* The file size returned from stat may be zero, but data
3870 may be readable nonetheless, for example when this is a
3871 file in the /proc filesystem. */
3872 if (st
.st_size
== 0)
3873 XSETINT (end
, READ_BUF_SIZE
);
3877 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3879 /* We use emacs-mule for auto saving... */
3880 setup_coding_system (Qemacs_mule
, &coding
);
3881 /* ... but with the special flag to indicate to read in a
3882 multibyte sequence for eight-bit-control char as is. */
3884 coding
.src_multibyte
= 0;
3885 coding
.dst_multibyte
3886 = !NILP (current_buffer
->enable_multibyte_characters
);
3887 coding
.eol_type
= CODING_EOL_LF
;
3888 coding_system_decided
= 1;
3892 /* Decide the coding system to use for reading the file now
3893 because we can't use an optimized method for handling
3894 `coding:' tag if the current buffer is not empty. */
3898 if (!NILP (Vcoding_system_for_read
))
3899 val
= Vcoding_system_for_read
;
3902 /* Don't try looking inside a file for a coding system
3903 specification if it is not seekable. */
3904 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3906 /* Find a coding system specified in the heading two
3907 lines or in the tailing several lines of the file.
3908 We assume that the 1K-byte and 3K-byte for heading
3909 and tailing respectively are sufficient for this
3913 if (st
.st_size
<= (1024 * 4))
3914 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3917 nread
= emacs_read (fd
, read_buf
, 1024);
3920 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3921 report_file_error ("Setting file position",
3922 Fcons (orig_filename
, Qnil
));
3923 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3928 error ("IO error reading %s: %s",
3929 SDATA (orig_filename
), emacs_strerror (errno
));
3932 struct buffer
*prev
= current_buffer
;
3936 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3938 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3939 buf
= XBUFFER (buffer
);
3941 delete_all_overlays (buf
);
3942 buf
->directory
= current_buffer
->directory
;
3943 buf
->read_only
= Qnil
;
3944 buf
->filename
= Qnil
;
3945 buf
->undo_list
= Qt
;
3946 eassert (buf
->overlays_before
== NULL
);
3947 eassert (buf
->overlays_after
== NULL
);
3949 set_buffer_internal (buf
);
3951 buf
->enable_multibyte_characters
= Qnil
;
3953 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3954 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3955 val
= call2 (Vset_auto_coding_function
,
3956 filename
, make_number (nread
));
3957 set_buffer_internal (prev
);
3959 /* Discard the unwind protect for recovering the
3963 /* Rewind the file for the actual read done later. */
3964 if (lseek (fd
, 0, 0) < 0)
3965 report_file_error ("Setting file position",
3966 Fcons (orig_filename
, Qnil
));
3972 /* If we have not yet decided a coding system, check
3973 file-coding-system-alist. */
3974 Lisp_Object args
[6], coding_systems
;
3976 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3977 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3978 coding_systems
= Ffind_operation_coding_system (6, args
);
3979 if (CONSP (coding_systems
))
3980 val
= XCAR (coding_systems
);
3984 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3985 /* Ensure we set Vlast_coding_system_used. */
3986 set_coding_system
= 1;
3988 if (NILP (current_buffer
->enable_multibyte_characters
)
3990 /* We must suppress all character code conversion except for
3991 end-of-line conversion. */
3992 setup_raw_text_coding_system (&coding
);
3994 coding
.src_multibyte
= 0;
3995 coding
.dst_multibyte
3996 = !NILP (current_buffer
->enable_multibyte_characters
);
3997 coding_system_decided
= 1;
4000 /* If requested, replace the accessible part of the buffer
4001 with the file contents. Avoid replacing text at the
4002 beginning or end of the buffer that matches the file contents;
4003 that preserves markers pointing to the unchanged parts.
4005 Here we implement this feature in an optimized way
4006 for the case where code conversion is NOT needed.
4007 The following if-statement handles the case of conversion
4008 in a less optimal way.
4010 If the code conversion is "automatic" then we try using this
4011 method and hope for the best.
4012 But if we discover the need for conversion, we give up on this method
4013 and let the following if-statement handle the replace job. */
4016 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4018 /* same_at_start and same_at_end count bytes,
4019 because file access counts bytes
4020 and BEG and END count bytes. */
4021 int same_at_start
= BEGV_BYTE
;
4022 int same_at_end
= ZV_BYTE
;
4024 /* There is still a possibility we will find the need to do code
4025 conversion. If that happens, we set this variable to 1 to
4026 give up on handling REPLACE in the optimized way. */
4027 int giveup_match_end
= 0;
4029 if (XINT (beg
) != 0)
4031 if (lseek (fd
, XINT (beg
), 0) < 0)
4032 report_file_error ("Setting file position",
4033 Fcons (orig_filename
, Qnil
));
4038 /* Count how many chars at the start of the file
4039 match the text at the beginning of the buffer. */
4044 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4046 error ("IO error reading %s: %s",
4047 SDATA (orig_filename
), emacs_strerror (errno
));
4048 else if (nread
== 0)
4051 if (coding
.type
== coding_type_undecided
)
4052 detect_coding (&coding
, buffer
, nread
);
4053 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4054 /* We found that the file should be decoded somehow.
4055 Let's give up here. */
4057 giveup_match_end
= 1;
4061 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4062 detect_eol (&coding
, buffer
, nread
);
4063 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4064 && coding
.eol_type
!= CODING_EOL_LF
)
4065 /* We found that the format of eol should be decoded.
4066 Let's give up here. */
4068 giveup_match_end
= 1;
4073 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4074 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4075 same_at_start
++, bufpos
++;
4076 /* If we found a discrepancy, stop the scan.
4077 Otherwise loop around and scan the next bufferful. */
4078 if (bufpos
!= nread
)
4082 /* If the file matches the buffer completely,
4083 there's no need to replace anything. */
4084 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4088 /* Truncate the buffer to the size of the file. */
4089 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4094 /* Count how many chars at the end of the file
4095 match the text at the end of the buffer. But, if we have
4096 already found that decoding is necessary, don't waste time. */
4097 while (!giveup_match_end
)
4099 int total_read
, nread
, bufpos
, curpos
, trial
;
4101 /* At what file position are we now scanning? */
4102 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4103 /* If the entire file matches the buffer tail, stop the scan. */
4106 /* How much can we scan in the next step? */
4107 trial
= min (curpos
, sizeof buffer
);
4108 if (lseek (fd
, curpos
- trial
, 0) < 0)
4109 report_file_error ("Setting file position",
4110 Fcons (orig_filename
, Qnil
));
4112 total_read
= nread
= 0;
4113 while (total_read
< trial
)
4115 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4117 error ("IO error reading %s: %s",
4118 SDATA (orig_filename
), emacs_strerror (errno
));
4119 else if (nread
== 0)
4121 total_read
+= nread
;
4124 /* Scan this bufferful from the end, comparing with
4125 the Emacs buffer. */
4126 bufpos
= total_read
;
4128 /* Compare with same_at_start to avoid counting some buffer text
4129 as matching both at the file's beginning and at the end. */
4130 while (bufpos
> 0 && same_at_end
> same_at_start
4131 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4132 same_at_end
--, bufpos
--;
4134 /* If we found a discrepancy, stop the scan.
4135 Otherwise loop around and scan the preceding bufferful. */
4138 /* If this discrepancy is because of code conversion,
4139 we cannot use this method; giveup and try the other. */
4140 if (same_at_end
> same_at_start
4141 && FETCH_BYTE (same_at_end
- 1) >= 0200
4142 && ! NILP (current_buffer
->enable_multibyte_characters
)
4143 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4144 giveup_match_end
= 1;
4153 if (! giveup_match_end
)
4157 /* We win! We can handle REPLACE the optimized way. */
4159 /* Extend the start of non-matching text area to multibyte
4160 character boundary. */
4161 if (! NILP (current_buffer
->enable_multibyte_characters
))
4162 while (same_at_start
> BEGV_BYTE
4163 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4166 /* Extend the end of non-matching text area to multibyte
4167 character boundary. */
4168 if (! NILP (current_buffer
->enable_multibyte_characters
))
4169 while (same_at_end
< ZV_BYTE
4170 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4173 /* Don't try to reuse the same piece of text twice. */
4174 overlap
= (same_at_start
- BEGV_BYTE
4175 - (same_at_end
+ st
.st_size
- ZV
));
4177 same_at_end
+= overlap
;
4179 /* Arrange to read only the nonmatching middle part of the file. */
4180 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4181 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4183 del_range_byte (same_at_start
, same_at_end
, 0);
4184 /* Insert from the file at the proper position. */
4185 temp
= BYTE_TO_CHAR (same_at_start
);
4186 SET_PT_BOTH (temp
, same_at_start
);
4188 /* If display currently starts at beginning of line,
4189 keep it that way. */
4190 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4191 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4193 replace_handled
= 1;
4197 /* If requested, replace the accessible part of the buffer
4198 with the file contents. Avoid replacing text at the
4199 beginning or end of the buffer that matches the file contents;
4200 that preserves markers pointing to the unchanged parts.
4202 Here we implement this feature for the case where code conversion
4203 is needed, in a simple way that needs a lot of memory.
4204 The preceding if-statement handles the case of no conversion
4205 in a more optimized way. */
4206 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4208 int same_at_start
= BEGV_BYTE
;
4209 int same_at_end
= ZV_BYTE
;
4212 /* Make sure that the gap is large enough. */
4213 int bufsize
= 2 * st
.st_size
;
4214 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4217 /* First read the whole file, performing code conversion into
4218 CONVERSION_BUFFER. */
4220 if (lseek (fd
, XINT (beg
), 0) < 0)
4222 xfree (conversion_buffer
);
4223 report_file_error ("Setting file position",
4224 Fcons (orig_filename
, Qnil
));
4227 total
= st
.st_size
; /* Total bytes in the file. */
4228 how_much
= 0; /* Bytes read from file so far. */
4229 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4230 unprocessed
= 0; /* Bytes not processed in previous loop. */
4232 while (how_much
< total
)
4234 /* try is reserved in some compilers (Microsoft C) */
4235 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4236 unsigned char *destination
= read_buf
+ unprocessed
;
4239 /* Allow quitting out of the actual I/O. */
4242 this = emacs_read (fd
, destination
, trytry
);
4245 if (this < 0 || this + unprocessed
== 0)
4253 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4255 int require
, result
;
4257 this += unprocessed
;
4259 /* If we are using more space than estimated,
4260 make CONVERSION_BUFFER bigger. */
4261 require
= decoding_buffer_size (&coding
, this);
4262 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4264 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4265 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4268 /* Convert this batch with results in CONVERSION_BUFFER. */
4269 if (how_much
>= total
) /* This is the last block. */
4270 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4271 if (coding
.composing
!= COMPOSITION_DISABLED
)
4272 coding_allocate_composition_data (&coding
, BEGV
);
4273 result
= decode_coding (&coding
, read_buf
,
4274 conversion_buffer
+ inserted
,
4275 this, bufsize
- inserted
);
4277 /* Save for next iteration whatever we didn't convert. */
4278 unprocessed
= this - coding
.consumed
;
4279 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4280 if (!NILP (current_buffer
->enable_multibyte_characters
))
4281 this = coding
.produced
;
4283 this = str_as_unibyte (conversion_buffer
+ inserted
,
4290 /* At this point, INSERTED is how many characters (i.e. bytes)
4291 are present in CONVERSION_BUFFER.
4292 HOW_MUCH should equal TOTAL,
4293 or should be <= 0 if we couldn't read the file. */
4297 xfree (conversion_buffer
);
4298 coding_free_composition_data (&coding
);
4299 error ("IO error reading %s: %s",
4300 SDATA (orig_filename
), emacs_strerror (errno
));
4303 /* Compare the beginning of the converted file
4304 with the buffer text. */
4307 while (bufpos
< inserted
&& same_at_start
< same_at_end
4308 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4309 same_at_start
++, bufpos
++;
4311 /* If the file matches the buffer completely,
4312 there's no need to replace anything. */
4314 if (bufpos
== inserted
)
4316 xfree (conversion_buffer
);
4317 coding_free_composition_data (&coding
);
4320 /* Truncate the buffer to the size of the file. */
4321 del_range_byte (same_at_start
, same_at_end
, 0);
4326 /* Extend the start of non-matching text area to multibyte
4327 character boundary. */
4328 if (! NILP (current_buffer
->enable_multibyte_characters
))
4329 while (same_at_start
> BEGV_BYTE
4330 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4333 /* Scan this bufferful from the end, comparing with
4334 the Emacs buffer. */
4337 /* Compare with same_at_start to avoid counting some buffer text
4338 as matching both at the file's beginning and at the end. */
4339 while (bufpos
> 0 && same_at_end
> same_at_start
4340 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4341 same_at_end
--, bufpos
--;
4343 /* Extend the end of non-matching text area to multibyte
4344 character boundary. */
4345 if (! NILP (current_buffer
->enable_multibyte_characters
))
4346 while (same_at_end
< ZV_BYTE
4347 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4350 /* Don't try to reuse the same piece of text twice. */
4351 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4353 same_at_end
+= overlap
;
4355 /* If display currently starts at beginning of line,
4356 keep it that way. */
4357 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4358 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4360 /* Replace the chars that we need to replace,
4361 and update INSERTED to equal the number of bytes
4362 we are taking from the file. */
4363 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4365 if (same_at_end
!= same_at_start
)
4367 del_range_byte (same_at_start
, same_at_end
, 0);
4369 same_at_start
= GPT_BYTE
;
4373 temp
= BYTE_TO_CHAR (same_at_start
);
4375 /* Insert from the file at the proper position. */
4376 SET_PT_BOTH (temp
, same_at_start
);
4377 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4379 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4380 coding_restore_composition (&coding
, Fcurrent_buffer ());
4381 coding_free_composition_data (&coding
);
4383 /* Set `inserted' to the number of inserted characters. */
4384 inserted
= PT
- temp
;
4385 /* Set point before the inserted characters. */
4386 SET_PT_BOTH (temp
, same_at_start
);
4388 xfree (conversion_buffer
);
4397 register Lisp_Object temp
;
4399 total
= XINT (end
) - XINT (beg
);
4401 /* Make sure point-max won't overflow after this insertion. */
4402 XSETINT (temp
, total
);
4403 if (total
!= XINT (temp
))
4404 error ("Maximum buffer size exceeded");
4407 /* For a special file, all we can do is guess. */
4408 total
= READ_BUF_SIZE
;
4410 if (NILP (visit
) && inserted
> 0)
4412 #ifdef CLASH_DETECTION
4413 if (!NILP (current_buffer
->file_truename
)
4414 /* Make binding buffer-file-name to nil effective. */
4415 && !NILP (current_buffer
->filename
)
4416 && SAVE_MODIFF
>= MODIFF
)
4418 #endif /* CLASH_DETECTION */
4419 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4423 if (GAP_SIZE
< total
)
4424 make_gap (total
- GAP_SIZE
);
4426 if (XINT (beg
) != 0 || !NILP (replace
))
4428 if (lseek (fd
, XINT (beg
), 0) < 0)
4429 report_file_error ("Setting file position",
4430 Fcons (orig_filename
, Qnil
));
4433 /* In the following loop, HOW_MUCH contains the total bytes read so
4434 far for a regular file, and not changed for a special file. But,
4435 before exiting the loop, it is set to a negative value if I/O
4439 /* Total bytes inserted. */
4442 /* Here, we don't do code conversion in the loop. It is done by
4443 code_convert_region after all data are read into the buffer. */
4445 int gap_size
= GAP_SIZE
;
4447 while (how_much
< total
)
4449 /* try is reserved in some compilers (Microsoft C) */
4450 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4457 /* Maybe make more room. */
4458 if (gap_size
< trytry
)
4460 make_gap (total
- gap_size
);
4461 gap_size
= GAP_SIZE
;
4464 /* Read from the file, capturing `quit'. When an
4465 error occurs, end the loop, and arrange for a quit
4466 to be signaled after decoding the text we read. */
4467 non_regular_fd
= fd
;
4468 non_regular_inserted
= inserted
;
4469 non_regular_nbytes
= trytry
;
4470 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4471 read_non_regular_quit
);
4482 /* Allow quitting out of the actual I/O. We don't make text
4483 part of the buffer until all the reading is done, so a C-g
4484 here doesn't do any harm. */
4487 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4499 /* For a regular file, where TOTAL is the real size,
4500 count HOW_MUCH to compare with it.
4501 For a special file, where TOTAL is just a buffer size,
4502 so don't bother counting in HOW_MUCH.
4503 (INSERTED is where we count the number of characters inserted.) */
4510 /* Now we have read all the file data into the gap.
4511 If it was empty, undo marking the buffer modified. */
4515 #ifdef CLASH_DETECTION
4517 unlock_file (current_buffer
->file_truename
);
4519 Vdeactivate_mark
= old_Vdeactivate_mark
;
4522 Vdeactivate_mark
= Qt
;
4524 /* Make the text read part of the buffer. */
4525 GAP_SIZE
-= inserted
;
4527 GPT_BYTE
+= inserted
;
4529 ZV_BYTE
+= inserted
;
4534 /* Put an anchor to ensure multi-byte form ends at gap. */
4539 /* Discard the unwind protect for closing the file. */
4543 error ("IO error reading %s: %s",
4544 SDATA (orig_filename
), emacs_strerror (errno
));
4548 if (! coding_system_decided
)
4550 /* The coding system is not yet decided. Decide it by an
4551 optimized method for handling `coding:' tag.
4553 Note that we can get here only if the buffer was empty
4554 before the insertion. */
4558 if (!NILP (Vcoding_system_for_read
))
4559 val
= Vcoding_system_for_read
;
4562 /* Since we are sure that the current buffer was empty
4563 before the insertion, we can toggle
4564 enable-multibyte-characters directly here without taking
4565 care of marker adjustment and byte combining problem. By
4566 this way, we can run Lisp program safely before decoding
4567 the inserted text. */
4568 Lisp_Object unwind_data
;
4569 int count
= SPECPDL_INDEX ();
4571 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4572 Fcons (current_buffer
->undo_list
,
4573 Fcurrent_buffer ()));
4574 current_buffer
->enable_multibyte_characters
= Qnil
;
4575 current_buffer
->undo_list
= Qt
;
4576 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4578 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4580 val
= call2 (Vset_auto_coding_function
,
4581 filename
, make_number (inserted
));
4586 /* If the coding system is not yet decided, check
4587 file-coding-system-alist. */
4588 Lisp_Object args
[6], coding_systems
;
4590 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4591 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4592 coding_systems
= Ffind_operation_coding_system (6, args
);
4593 if (CONSP (coding_systems
))
4594 val
= XCAR (coding_systems
);
4596 unbind_to (count
, Qnil
);
4597 inserted
= Z_BYTE
- BEG_BYTE
;
4600 /* The following kludgy code is to avoid some compiler bug.
4602 setup_coding_system (val, &coding);
4605 struct coding_system temp_coding
;
4606 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4607 bcopy (&temp_coding
, &coding
, sizeof coding
);
4609 /* Ensure we set Vlast_coding_system_used. */
4610 set_coding_system
= 1;
4612 if (NILP (current_buffer
->enable_multibyte_characters
)
4614 /* We must suppress all character code conversion except for
4615 end-of-line conversion. */
4616 setup_raw_text_coding_system (&coding
);
4617 coding
.src_multibyte
= 0;
4618 coding
.dst_multibyte
4619 = !NILP (current_buffer
->enable_multibyte_characters
);
4623 /* Can't do this if part of the buffer might be preserved. */
4625 && (coding
.type
== coding_type_no_conversion
4626 || coding
.type
== coding_type_raw_text
))
4628 /* Visiting a file with these coding system makes the buffer
4630 current_buffer
->enable_multibyte_characters
= Qnil
;
4631 coding
.dst_multibyte
= 0;
4634 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4636 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4638 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4640 inserted
= coding
.produced_char
;
4643 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4647 /* Now INSERTED is measured in characters. */
4650 /* Use the conversion type to determine buffer-file-type
4651 (find-buffer-file-type is now used to help determine the
4653 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4654 || coding
.eol_type
== CODING_EOL_LF
)
4655 && ! CODING_REQUIRE_DECODING (&coding
))
4656 current_buffer
->buffer_file_type
= Qt
;
4658 current_buffer
->buffer_file_type
= Qnil
;
4665 if (!EQ (current_buffer
->undo_list
, Qt
))
4666 current_buffer
->undo_list
= Qnil
;
4668 stat (SDATA (filename
), &st
);
4673 current_buffer
->modtime
= st
.st_mtime
;
4674 current_buffer
->filename
= orig_filename
;
4677 SAVE_MODIFF
= MODIFF
;
4678 current_buffer
->auto_save_modified
= MODIFF
;
4679 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4680 #ifdef CLASH_DETECTION
4683 if (!NILP (current_buffer
->file_truename
))
4684 unlock_file (current_buffer
->file_truename
);
4685 unlock_file (filename
);
4687 #endif /* CLASH_DETECTION */
4689 xsignal2 (Qfile_error
,
4690 build_string ("not a regular file"), orig_filename
);
4693 if (set_coding_system
)
4694 Vlast_coding_system_used
= coding
.symbol
;
4696 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4698 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4700 if (! NILP (insval
))
4702 CHECK_NUMBER (insval
);
4703 inserted
= XFASTINT (insval
);
4707 /* Decode file format */
4710 /* Don't run point motion or modification hooks when decoding. */
4711 int count
= SPECPDL_INDEX ();
4712 specbind (Qinhibit_point_motion_hooks
, Qt
);
4713 specbind (Qinhibit_modification_hooks
, Qt
);
4715 /* Save old undo list and don't record undo for decoding. */
4716 old_undo
= current_buffer
->undo_list
;
4717 current_buffer
->undo_list
= Qt
;
4721 insval
= call3 (Qformat_decode
,
4722 Qnil
, make_number (inserted
), visit
);
4723 CHECK_NUMBER (insval
);
4724 inserted
= XFASTINT (insval
);
4728 /* If REPLACE is non-nil and we succeeded in not replacing the
4729 beginning or end of the buffer text with the file's contents,
4730 call format-decode with `point' positioned at the beginning of
4731 the buffer and `inserted' equalling the number of characters
4732 in the buffer. Otherwise, format-decode might fail to
4733 correctly analyze the beginning or end of the buffer. Hence
4734 we temporarily save `point' and `inserted' here and restore
4735 `point' iff format-decode did not insert or delete any text.
4736 Otherwise we leave `point' at point-min. */
4738 int opoint_byte
= PT_BYTE
;
4739 int oinserted
= ZV
- BEGV
;
4740 int ochars_modiff
= CHARS_MODIFF
;
4742 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4743 insval
= call3 (Qformat_decode
,
4744 Qnil
, make_number (oinserted
), visit
);
4745 CHECK_NUMBER (insval
);
4746 if (ochars_modiff
== CHARS_MODIFF
)
4747 /* format_decode didn't modify buffer's characters => move
4748 point back to position before inserted text and leave
4749 value of inserted alone. */
4750 SET_PT_BOTH (opoint
, opoint_byte
);
4752 /* format_decode modified buffer's characters => consider
4753 entire buffer changed and leave point at point-min. */
4754 inserted
= XFASTINT (insval
);
4757 /* For consistency with format-decode call these now iff inserted > 0
4758 (martin 2007-06-28) */
4759 p
= Vafter_insert_file_functions
;
4764 insval
= call1 (XCAR (p
), make_number (inserted
));
4767 CHECK_NUMBER (insval
);
4768 inserted
= XFASTINT (insval
);
4773 /* For the rationale of this see the comment on format-decode above. */
4775 int opoint_byte
= PT_BYTE
;
4776 int oinserted
= ZV
- BEGV
;
4777 int ochars_modiff
= CHARS_MODIFF
;
4779 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4780 insval
= call1 (XCAR (p
), make_number (oinserted
));
4783 CHECK_NUMBER (insval
);
4784 if (ochars_modiff
== CHARS_MODIFF
)
4785 /* after_insert_file_functions didn't modify
4786 buffer's characters => move point back to
4787 position before inserted text and leave value of
4789 SET_PT_BOTH (opoint
, opoint_byte
);
4791 /* after_insert_file_functions did modify buffer's
4792 characters => consider entire buffer changed and
4793 leave point at point-min. */
4794 inserted
= XFASTINT (insval
);
4804 Lisp_Object lbeg
, lend
;
4806 XSETINT (lend
, PT
+ inserted
);
4807 if (CONSP (old_undo
))
4809 Lisp_Object tem
= XCAR (old_undo
);
4810 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4811 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4812 /* In the non-visiting case record only the final insertion. */
4813 current_buffer
->undo_list
=
4814 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4818 /* If undo_list was Qt before, keep it that way.
4819 Otherwise start with an empty undo_list. */
4820 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4822 unbind_to (count
, Qnil
);
4825 /* Call after-change hooks for the inserted text, aside from the case
4826 of normal visiting (not with REPLACE), which is done in a new buffer
4827 "before" the buffer is changed. */
4828 if (inserted
> 0 && total
> 0
4829 && (NILP (visit
) || !NILP (replace
)))
4831 signal_after_change (PT
, 0, inserted
);
4832 update_compositions (PT
, PT
, CHECK_BORDER
);
4836 && current_buffer
->modtime
== -1)
4838 /* If visiting nonexistent file, return nil. */
4839 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4843 Fsignal (Qquit
, Qnil
);
4845 /* ??? Retval needs to be dealt with in all cases consistently. */
4847 val
= Fcons (orig_filename
,
4848 Fcons (make_number (inserted
),
4851 RETURN_UNGCPRO (unbind_to (count
, val
));
4854 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4855 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4856 Lisp_Object
, Lisp_Object
));
4858 /* If build_annotations switched buffers, switch back to BUF.
4859 Kill the temporary buffer that was selected in the meantime.
4861 Since this kill only the last temporary buffer, some buffers remain
4862 not killed if build_annotations switched buffers more than once.
4866 build_annotations_unwind (buf
)
4871 if (XBUFFER (buf
) == current_buffer
)
4873 tembuf
= Fcurrent_buffer ();
4875 Fkill_buffer (tembuf
);
4879 /* Decide the coding-system to encode the data with. */
4882 choose_write_coding_system (start
, end
, filename
,
4883 append
, visit
, lockname
, coding
)
4884 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4885 struct coding_system
*coding
;
4890 && NILP (Fstring_equal (current_buffer
->filename
,
4891 current_buffer
->auto_save_file_name
)))
4893 /* We use emacs-mule for auto saving... */
4894 setup_coding_system (Qemacs_mule
, coding
);
4895 /* ... but with the special flag to indicate not to strip off
4896 leading code of eight-bit-control chars. */
4898 /* We force LF for end-of-line because that is faster. */
4899 coding
->eol_type
= CODING_EOL_LF
;
4900 goto done_setup_coding
;
4902 else if (!NILP (Vcoding_system_for_write
))
4904 val
= Vcoding_system_for_write
;
4905 if (coding_system_require_warning
4906 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4907 /* Confirm that VAL can surely encode the current region. */
4908 val
= call5 (Vselect_safe_coding_system_function
,
4909 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4914 /* If the variable `buffer-file-coding-system' is set locally,
4915 it means that the file was read with some kind of code
4916 conversion or the variable is explicitly set by users. We
4917 had better write it out with the same coding system even if
4918 `enable-multibyte-characters' is nil.
4920 If it is not set locally, we anyway have to convert EOL
4921 format if the default value of `buffer-file-coding-system'
4922 tells that it is not Unix-like (LF only) format. */
4923 int using_default_coding
= 0;
4924 int force_raw_text
= 0;
4926 val
= current_buffer
->buffer_file_coding_system
;
4928 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4931 if (NILP (current_buffer
->enable_multibyte_characters
))
4937 /* Check file-coding-system-alist. */
4938 Lisp_Object args
[7], coding_systems
;
4940 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4941 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4943 coding_systems
= Ffind_operation_coding_system (7, args
);
4944 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4945 val
= XCDR (coding_systems
);
4949 && !NILP (current_buffer
->buffer_file_coding_system
))
4951 /* If we still have not decided a coding system, use the
4952 default value of buffer-file-coding-system. */
4953 val
= current_buffer
->buffer_file_coding_system
;
4954 using_default_coding
= 1;
4958 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4959 /* Confirm that VAL can surely encode the current region. */
4960 val
= call5 (Vselect_safe_coding_system_function
,
4961 start
, end
, val
, Qnil
, filename
);
4963 setup_coding_system (Fcheck_coding_system (val
), coding
);
4964 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4965 && !using_default_coding
)
4967 if (! EQ (default_buffer_file_coding
.symbol
,
4968 buffer_defaults
.buffer_file_coding_system
))
4969 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4970 &default_buffer_file_coding
);
4971 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4973 Lisp_Object subsidiaries
;
4975 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4976 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4977 if (VECTORP (subsidiaries
)
4978 && XVECTOR (subsidiaries
)->size
== 3)
4980 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4985 setup_raw_text_coding_system (coding
);
4986 goto done_setup_coding
;
4989 setup_coding_system (Fcheck_coding_system (val
), coding
);
4992 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4993 coding
->eol_type
= system_eol_type
;
4994 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4995 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4998 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4999 "r\nFWrite region to file: \ni\ni\ni\np",
5000 doc
: /* Write current region into specified file.
5001 When called from a program, requires three arguments:
5002 START, END and FILENAME. START and END are normally buffer positions
5003 specifying the part of the buffer to write.
5004 If START is nil, that means to use the entire buffer contents.
5005 If START is a string, then output that string to the file
5006 instead of any buffer contents; END is ignored.
5008 Optional fourth argument APPEND if non-nil means
5009 append to existing file contents (if any). If it is an integer,
5010 seek to that offset in the file before writing.
5011 Optional fifth argument VISIT, if t or a string, means
5012 set the last-save-file-modtime of buffer to this file's modtime
5013 and mark buffer not modified.
5014 If VISIT is a string, it is a second file name;
5015 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
5016 VISIT is also the file name to lock and unlock for clash detection.
5017 If VISIT is neither t nor nil nor a string,
5018 that means do not display the \"Wrote file\" message.
5019 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
5020 use for locking and unlocking, overriding FILENAME and VISIT.
5021 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
5022 for an existing file with the same name. If MUSTBENEW is `excl',
5023 that means to get an error if the file already exists; never overwrite.
5024 If MUSTBENEW is neither nil nor `excl', that means ask for
5025 confirmation before overwriting, but do go ahead and overwrite the file
5026 if the user confirms.
5028 This does code conversion according to the value of
5029 `coding-system-for-write', `buffer-file-coding-system', or
5030 `file-coding-system-alist', and sets the variable
5031 `last-coding-system-used' to the coding system actually used. */)
5032 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
5033 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
5038 const unsigned char *fn
;
5041 int count
= SPECPDL_INDEX ();
5044 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
5046 Lisp_Object handler
;
5047 Lisp_Object visit_file
;
5048 Lisp_Object annotations
;
5049 Lisp_Object encoded_filename
;
5050 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5051 int quietly
= !NILP (visit
);
5052 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5053 struct buffer
*given_buffer
;
5055 int buffer_file_type
= O_BINARY
;
5057 struct coding_system coding
;
5059 if (current_buffer
->base_buffer
&& visiting
)
5060 error ("Cannot do file visiting in an indirect buffer");
5062 if (!NILP (start
) && !STRINGP (start
))
5063 validate_region (&start
, &end
);
5066 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5068 filename
= Fexpand_file_name (filename
, Qnil
);
5070 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5071 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5073 if (STRINGP (visit
))
5074 visit_file
= Fexpand_file_name (visit
, Qnil
);
5076 visit_file
= filename
;
5078 if (NILP (lockname
))
5079 lockname
= visit_file
;
5083 /* If the file name has special constructs in it,
5084 call the corresponding file handler. */
5085 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5086 /* If FILENAME has no handler, see if VISIT has one. */
5087 if (NILP (handler
) && STRINGP (visit
))
5088 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5090 if (!NILP (handler
))
5093 val
= call6 (handler
, Qwrite_region
, start
, end
,
5094 filename
, append
, visit
);
5098 SAVE_MODIFF
= MODIFF
;
5099 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5100 current_buffer
->filename
= visit_file
;
5106 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5108 /* Special kludge to simplify auto-saving. */
5111 XSETFASTINT (start
, BEG
);
5112 XSETFASTINT (end
, Z
);
5116 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5117 count1
= SPECPDL_INDEX ();
5119 given_buffer
= current_buffer
;
5121 if (!STRINGP (start
))
5123 annotations
= build_annotations (start
, end
);
5125 if (current_buffer
!= given_buffer
)
5127 XSETFASTINT (start
, BEGV
);
5128 XSETFASTINT (end
, ZV
);
5134 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5136 /* Decide the coding-system to encode the data with.
5137 We used to make this choice before calling build_annotations, but that
5138 leads to problems when a write-annotate-function takes care of
5139 unsavable chars (as was the case with X-Symbol). */
5140 choose_write_coding_system (start
, end
, filename
,
5141 append
, visit
, lockname
, &coding
);
5142 Vlast_coding_system_used
= coding
.symbol
;
5144 given_buffer
= current_buffer
;
5145 if (! STRINGP (start
))
5147 annotations
= build_annotations_2 (start
, end
,
5148 coding
.pre_write_conversion
, annotations
);
5149 if (current_buffer
!= given_buffer
)
5151 XSETFASTINT (start
, BEGV
);
5152 XSETFASTINT (end
, ZV
);
5156 #ifdef CLASH_DETECTION
5159 #if 0 /* This causes trouble for GNUS. */
5160 /* If we've locked this file for some other buffer,
5161 query before proceeding. */
5162 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5163 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5166 lock_file (lockname
);
5168 #endif /* CLASH_DETECTION */
5170 encoded_filename
= ENCODE_FILE (filename
);
5172 fn
= SDATA (encoded_filename
);
5176 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5177 #else /* not DOS_NT */
5178 desc
= emacs_open (fn
, O_WRONLY
, 0);
5179 #endif /* not DOS_NT */
5181 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5183 if (auto_saving
) /* Overwrite any previous version of autosave file */
5185 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5186 desc
= emacs_open (fn
, O_RDWR
, 0);
5188 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5189 ? SDATA (current_buffer
->filename
) : 0,
5192 else /* Write to temporary name and rename if no errors */
5194 Lisp_Object temp_name
;
5195 temp_name
= Ffile_name_directory (filename
);
5197 if (!NILP (temp_name
))
5199 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5200 build_string ("$$SAVE$$")));
5201 fname
= SDATA (filename
);
5202 fn
= SDATA (temp_name
);
5203 desc
= creat_copy_attrs (fname
, fn
);
5206 /* If we can't open the temporary file, try creating a new
5207 version of the original file. VMS "creat" creates a
5208 new version rather than truncating an existing file. */
5211 desc
= creat (fn
, 0666);
5212 #if 0 /* This can clobber an existing file and fail to replace it,
5213 if the user runs out of space. */
5216 /* We can't make a new version;
5217 try to truncate and rewrite existing version if any. */
5219 desc
= emacs_open (fn
, O_RDWR
, 0);
5225 desc
= creat (fn
, 0666);
5229 desc
= emacs_open (fn
,
5230 O_WRONLY
| O_CREAT
| buffer_file_type
5231 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5232 S_IREAD
| S_IWRITE
);
5233 #else /* not DOS_NT */
5234 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5235 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5236 auto_saving
? auto_save_mode_bits
: 0666);
5237 #endif /* not DOS_NT */
5238 #endif /* not VMS */
5242 #ifdef CLASH_DETECTION
5244 if (!auto_saving
) unlock_file (lockname
);
5246 #endif /* CLASH_DETECTION */
5248 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5251 record_unwind_protect (close_file_unwind
, make_number (desc
));
5253 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5257 if (NUMBERP (append
))
5258 ret
= lseek (desc
, XINT (append
), 1);
5260 ret
= lseek (desc
, 0, 2);
5263 #ifdef CLASH_DETECTION
5264 if (!auto_saving
) unlock_file (lockname
);
5265 #endif /* CLASH_DETECTION */
5267 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5275 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5276 * if we do writes that don't end with a carriage return. Furthermore
5277 * it cannot handle writes of more then 16K. The modified
5278 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5279 * this EXCEPT for the last record (if it doesn't end with a carriage
5280 * return). This implies that if your buffer doesn't end with a carriage
5281 * return, you get one free... tough. However it also means that if
5282 * we make two calls to sys_write (a la the following code) you can
5283 * get one at the gap as well. The easiest way to fix this (honest)
5284 * is to move the gap to the next newline (or the end of the buffer).
5289 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5290 move_gap (find_next_newline (GPT
, 1));
5292 /* Whether VMS or not, we must move the gap to the next of newline
5293 when we must put designation sequences at beginning of line. */
5294 if (INTEGERP (start
)
5295 && coding
.type
== coding_type_iso2022
5296 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5297 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5299 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5300 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5301 move_gap_both (PT
, PT_BYTE
);
5302 SET_PT_BOTH (opoint
, opoint_byte
);
5309 if (STRINGP (start
))
5311 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5312 &annotations
, &coding
);
5315 else if (XINT (start
) != XINT (end
))
5317 tem
= CHAR_TO_BYTE (XINT (start
));
5319 if (XINT (start
) < GPT
)
5321 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5322 min (GPT
, XINT (end
)) - XINT (start
),
5323 &annotations
, &coding
);
5327 if (XINT (end
) > GPT
&& !failure
)
5329 tem
= max (XINT (start
), GPT
);
5330 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5331 &annotations
, &coding
);
5337 /* If file was empty, still need to write the annotations */
5338 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5339 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5343 if (CODING_REQUIRE_FLUSHING (&coding
)
5344 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5347 /* We have to flush out a data. */
5348 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5349 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5356 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5357 Disk full in NFS may be reported here. */
5358 /* mib says that closing the file will try to write as fast as NFS can do
5359 it, and that means the fsync here is not crucial for autosave files. */
5360 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5362 /* If fsync fails with EINTR, don't treat that as serious. Also
5363 ignore EINVAL which happens when fsync is not supported on this
5365 if (errno
!= EINTR
&& errno
!= EINVAL
)
5366 failure
= 1, save_errno
= errno
;
5370 /* Spurious "file has changed on disk" warnings have been
5371 observed on Suns as well.
5372 It seems that `close' can change the modtime, under nfs.
5374 (This has supposedly been fixed in Sunos 4,
5375 but who knows about all the other machines with NFS?) */
5378 /* On VMS and APOLLO, must do the stat after the close
5379 since closing changes the modtime. */
5382 /* Recall that #if defined does not work on VMS. */
5389 /* NFS can report a write failure now. */
5390 if (emacs_close (desc
) < 0)
5391 failure
= 1, save_errno
= errno
;
5394 /* If we wrote to a temporary name and had no errors, rename to real name. */
5398 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5406 /* Discard the unwind protect for close_file_unwind. */
5407 specpdl_ptr
= specpdl
+ count1
;
5408 /* Restore the original current buffer. */
5409 visit_file
= unbind_to (count
, visit_file
);
5411 #ifdef CLASH_DETECTION
5413 unlock_file (lockname
);
5414 #endif /* CLASH_DETECTION */
5416 /* Do this before reporting IO error
5417 to avoid a "file has changed on disk" warning on
5418 next attempt to save. */
5420 current_buffer
->modtime
= st
.st_mtime
;
5423 error ("IO error writing %s: %s", SDATA (filename
),
5424 emacs_strerror (save_errno
));
5428 SAVE_MODIFF
= MODIFF
;
5429 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5430 current_buffer
->filename
= visit_file
;
5431 update_mode_lines
++;
5436 && ! NILP (Fstring_equal (current_buffer
->filename
,
5437 current_buffer
->auto_save_file_name
)))
5438 SAVE_MODIFF
= MODIFF
;
5444 message_with_string ((INTEGERP (append
)
5454 Lisp_Object
merge ();
5456 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5457 doc
: /* Return t if (car A) is numerically less than (car B). */)
5461 return Flss (Fcar (a
), Fcar (b
));
5464 /* Build the complete list of annotations appropriate for writing out
5465 the text between START and END, by calling all the functions in
5466 write-region-annotate-functions and merging the lists they return.
5467 If one of these functions switches to a different buffer, we assume
5468 that buffer contains altered text. Therefore, the caller must
5469 make sure to restore the current buffer in all cases,
5470 as save-excursion would do. */
5473 build_annotations (start
, end
)
5474 Lisp_Object start
, end
;
5476 Lisp_Object annotations
;
5478 struct gcpro gcpro1
, gcpro2
;
5479 Lisp_Object original_buffer
;
5480 int i
, used_global
= 0;
5482 XSETBUFFER (original_buffer
, current_buffer
);
5485 p
= Vwrite_region_annotate_functions
;
5486 GCPRO2 (annotations
, p
);
5489 struct buffer
*given_buffer
= current_buffer
;
5490 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5491 { /* Use the global value of the hook. */
5494 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5496 p
= Fappend (2, arg
);
5499 Vwrite_region_annotations_so_far
= annotations
;
5500 res
= call2 (XCAR (p
), start
, end
);
5501 /* If the function makes a different buffer current,
5502 assume that means this buffer contains altered text to be output.
5503 Reset START and END from the buffer bounds
5504 and discard all previous annotations because they should have
5505 been dealt with by this function. */
5506 if (current_buffer
!= given_buffer
)
5508 XSETFASTINT (start
, BEGV
);
5509 XSETFASTINT (end
, ZV
);
5512 Flength (res
); /* Check basic validity of return value */
5513 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5517 /* Now do the same for annotation functions implied by the file-format */
5518 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5519 p
= current_buffer
->auto_save_file_format
;
5521 p
= current_buffer
->file_format
;
5522 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5524 struct buffer
*given_buffer
= current_buffer
;
5526 Vwrite_region_annotations_so_far
= annotations
;
5528 /* Value is either a list of annotations or nil if the function
5529 has written annotations to a temporary buffer, which is now
5531 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5532 original_buffer
, make_number (i
));
5533 if (current_buffer
!= given_buffer
)
5535 XSETFASTINT (start
, BEGV
);
5536 XSETFASTINT (end
, ZV
);
5541 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5549 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5550 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5552 struct gcpro gcpro1
;
5555 GCPRO1 (annotations
);
5556 /* At last, do the same for the function PRE_WRITE_CONVERSION
5557 implied by the current coding-system. */
5558 if (!NILP (pre_write_conversion
))
5560 struct buffer
*given_buffer
= current_buffer
;
5561 Vwrite_region_annotations_so_far
= annotations
;
5562 res
= call2 (pre_write_conversion
, start
, end
);
5564 annotations
= (current_buffer
!= given_buffer
5566 : merge (annotations
, res
, Qcar_less_than_car
));
5573 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5574 If STRING is nil, POS is the character position in the current buffer.
5575 Intersperse with them the annotations from *ANNOT
5576 which fall within the range of POS to POS + NCHARS,
5577 each at its appropriate position.
5579 We modify *ANNOT by discarding elements as we use them up.
5581 The return value is negative in case of system call failure. */
5584 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5587 register int nchars
;
5590 struct coding_system
*coding
;
5594 int lastpos
= pos
+ nchars
;
5596 while (NILP (*annot
) || CONSP (*annot
))
5598 tem
= Fcar_safe (Fcar (*annot
));
5601 nextpos
= XFASTINT (tem
);
5603 /* If there are no more annotations in this range,
5604 output the rest of the range all at once. */
5605 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5606 return e_write (desc
, string
, pos
, lastpos
, coding
);
5608 /* Output buffer text up to the next annotation's position. */
5611 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5615 /* Output the annotation. */
5616 tem
= Fcdr (Fcar (*annot
));
5619 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5622 *annot
= Fcdr (*annot
);
5627 #ifndef WRITE_BUF_SIZE
5628 #define WRITE_BUF_SIZE (16 * 1024)
5631 /* Write text in the range START and END into descriptor DESC,
5632 encoding them with coding system CODING. If STRING is nil, START
5633 and END are character positions of the current buffer, else they
5634 are indexes to the string STRING. */
5637 e_write (desc
, string
, start
, end
, coding
)
5641 struct coding_system
*coding
;
5643 register char *addr
;
5644 register int nbytes
;
5645 char buf
[WRITE_BUF_SIZE
];
5649 coding
->composing
= COMPOSITION_DISABLED
;
5650 if (coding
->composing
!= COMPOSITION_DISABLED
)
5651 coding_save_composition (coding
, start
, end
, string
);
5653 if (STRINGP (string
))
5655 addr
= SDATA (string
);
5656 nbytes
= SBYTES (string
);
5657 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5659 else if (start
< end
)
5661 /* It is assured that the gap is not in the range START and END-1. */
5662 addr
= CHAR_POS_ADDR (start
);
5663 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5664 coding
->src_multibyte
5665 = !NILP (current_buffer
->enable_multibyte_characters
);
5671 coding
->src_multibyte
= 1;
5674 /* We used to have a code for handling selective display here. But,
5675 now it is handled within encode_coding. */
5680 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5681 if (coding
->produced
> 0)
5683 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5684 if (coding
->produced
)
5690 nbytes
-= coding
->consumed
;
5691 addr
+= coding
->consumed
;
5692 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5695 /* The source text ends by an incomplete multibyte form.
5696 There's no way other than write it out as is. */
5697 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5706 start
+= coding
->consumed_char
;
5707 if (coding
->cmp_data
)
5708 coding_adjust_composition_offset (coding
, start
);
5711 if (coding
->cmp_data
)
5712 coding_free_composition_data (coding
);
5717 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5718 Sverify_visited_file_modtime
, 1, 1, 0,
5719 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5720 This means that the file has not been changed since it was visited or saved.
5721 See Info node `(elisp)Modification Time' for more details. */)
5727 Lisp_Object handler
;
5728 Lisp_Object filename
;
5733 if (!STRINGP (b
->filename
)) return Qt
;
5734 if (b
->modtime
== 0) return Qt
;
5736 /* If the file name has special constructs in it,
5737 call the corresponding file handler. */
5738 handler
= Ffind_file_name_handler (b
->filename
,
5739 Qverify_visited_file_modtime
);
5740 if (!NILP (handler
))
5741 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5743 filename
= ENCODE_FILE (b
->filename
);
5745 if (stat (SDATA (filename
), &st
) < 0)
5747 /* If the file doesn't exist now and didn't exist before,
5748 we say that it isn't modified, provided the error is a tame one. */
5749 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5754 if (st
.st_mtime
== b
->modtime
5755 /* If both are positive, accept them if they are off by one second. */
5756 || (st
.st_mtime
> 0 && b
->modtime
> 0
5757 && (st
.st_mtime
== b
->modtime
+ 1
5758 || st
.st_mtime
== b
->modtime
- 1)))
5763 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5764 Sclear_visited_file_modtime
, 0, 0, 0,
5765 doc
: /* Clear out records of last mod time of visited file.
5766 Next attempt to save will certainly not complain of a discrepancy. */)
5769 current_buffer
->modtime
= 0;
5773 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5774 Svisited_file_modtime
, 0, 0, 0,
5775 doc
: /* Return the current buffer's recorded visited file modification time.
5776 The value is a list of the form (HIGH LOW), like the time values
5777 that `file-attributes' returns. If the current buffer has no recorded
5778 file modification time, this function returns 0.
5779 See Info node `(elisp)Modification Time' for more details. */)
5782 if (! current_buffer
->modtime
)
5783 return make_number (0);
5784 return make_time ((time_t) current_buffer
->modtime
);
5787 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5788 Sset_visited_file_modtime
, 0, 1, 0,
5789 doc
: /* Update buffer's recorded modification time from the visited file's time.
5790 Useful if the buffer was not read from the file normally
5791 or if the file itself has been changed for some known benign reason.
5792 An argument specifies the modification time value to use
5793 \(instead of that of the visited file), in the form of a list
5794 \(HIGH . LOW) or (HIGH LOW). */)
5796 Lisp_Object time_list
;
5798 if (!NILP (time_list
))
5799 current_buffer
->modtime
= cons_to_long (time_list
);
5802 register Lisp_Object filename
;
5804 Lisp_Object handler
;
5806 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5808 /* If the file name has special constructs in it,
5809 call the corresponding file handler. */
5810 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5811 if (!NILP (handler
))
5812 /* The handler can find the file name the same way we did. */
5813 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5815 filename
= ENCODE_FILE (filename
);
5817 if (stat (SDATA (filename
), &st
) >= 0)
5818 current_buffer
->modtime
= st
.st_mtime
;
5825 auto_save_error (error
)
5828 Lisp_Object args
[3], msg
;
5830 struct gcpro gcpro1
;
5834 ring_bell (XFRAME (selected_frame
));
5836 args
[0] = build_string ("Auto-saving %s: %s");
5837 args
[1] = current_buffer
->name
;
5838 args
[2] = Ferror_message_string (error
);
5839 msg
= Fformat (3, args
);
5841 nbytes
= SBYTES (msg
);
5842 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5843 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5845 for (i
= 0; i
< 3; ++i
)
5848 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5850 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5851 Fsleep_for (make_number (1), Qnil
);
5865 auto_save_mode_bits
= 0666;
5867 /* Get visited file's mode to become the auto save file's mode. */
5868 if (! NILP (current_buffer
->filename
))
5870 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5871 /* But make sure we can overwrite it later! */
5872 auto_save_mode_bits
= st
.st_mode
| 0600;
5873 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5875 /* Remote files don't cooperate with stat. */
5876 auto_save_mode_bits
= XINT (modes
) | 0600;
5880 Fwrite_region (Qnil
, Qnil
,
5881 current_buffer
->auto_save_file_name
,
5882 Qnil
, Qlambda
, Qnil
, Qnil
);
5886 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5889 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5901 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5904 minibuffer_auto_raise
= XINT (value
);
5909 do_auto_save_make_dir (dir
)
5914 call2 (Qmake_directory
, dir
, Qt
);
5915 XSETFASTINT (mode
, 0700);
5916 return Fset_file_modes (dir
, mode
);
5920 do_auto_save_eh (ignore
)
5926 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5927 doc
: /* Auto-save all buffers that need it.
5928 This is all buffers that have auto-saving enabled
5929 and are changed since last auto-saved.
5930 Auto-saving writes the buffer into a file
5931 so that your editing is not lost if the system crashes.
5932 This file is not the file you visited; that changes only when you save.
5933 Normally we run the normal hook `auto-save-hook' before saving.
5935 A non-nil NO-MESSAGE argument means do not print any message if successful.
5936 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5937 (no_message
, current_only
)
5938 Lisp_Object no_message
, current_only
;
5940 struct buffer
*old
= current_buffer
, *b
;
5941 Lisp_Object tail
, buf
;
5943 int do_handled_files
;
5945 FILE *stream
= NULL
;
5946 int count
= SPECPDL_INDEX ();
5947 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5948 int old_message_p
= 0;
5949 struct gcpro gcpro1
, gcpro2
;
5951 if (max_specpdl_size
< specpdl_size
+ 40)
5952 max_specpdl_size
= specpdl_size
+ 40;
5957 if (NILP (no_message
))
5959 old_message_p
= push_message ();
5960 record_unwind_protect (pop_message_unwind
, Qnil
);
5963 /* Ordinarily don't quit within this function,
5964 but don't make it impossible to quit (in case we get hung in I/O). */
5968 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5969 point to non-strings reached from Vbuffer_alist. */
5971 if (!NILP (Vrun_hooks
))
5972 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5974 if (STRINGP (Vauto_save_list_file_name
))
5976 Lisp_Object listfile
;
5978 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5980 /* Don't try to create the directory when shutting down Emacs,
5981 because creating the directory might signal an error, and
5982 that would leave Emacs in a strange state. */
5983 if (!NILP (Vrun_hooks
))
5987 GCPRO2 (dir
, listfile
);
5988 dir
= Ffile_name_directory (listfile
);
5989 if (NILP (Ffile_directory_p (dir
)))
5990 internal_condition_case_1 (do_auto_save_make_dir
,
5991 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5996 stream
= fopen (SDATA (listfile
), "w");
5999 record_unwind_protect (do_auto_save_unwind
,
6000 make_save_value (stream
, 0));
6001 record_unwind_protect (do_auto_save_unwind_1
,
6002 make_number (minibuffer_auto_raise
));
6003 minibuffer_auto_raise
= 0;
6006 /* On first pass, save all files that don't have handlers.
6007 On second pass, save all files that do have handlers.
6009 If Emacs is crashing, the handlers may tweak what is causing
6010 Emacs to crash in the first place, and it would be a shame if
6011 Emacs failed to autosave perfectly ordinary files because it
6012 couldn't handle some ange-ftp'd file. */
6014 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
6015 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6017 buf
= XCDR (XCAR (tail
));
6020 /* Record all the buffers that have auto save mode
6021 in the special file that lists them. For each of these buffers,
6022 Record visited name (if any) and auto save name. */
6023 if (STRINGP (b
->auto_save_file_name
)
6024 && stream
!= NULL
&& do_handled_files
== 0)
6027 if (!NILP (b
->filename
))
6029 fwrite (SDATA (b
->filename
), 1,
6030 SBYTES (b
->filename
), stream
);
6032 putc ('\n', stream
);
6033 fwrite (SDATA (b
->auto_save_file_name
), 1,
6034 SBYTES (b
->auto_save_file_name
), stream
);
6035 putc ('\n', stream
);
6039 if (!NILP (current_only
)
6040 && b
!= current_buffer
)
6043 /* Don't auto-save indirect buffers.
6044 The base buffer takes care of it. */
6048 /* Check for auto save enabled
6049 and file changed since last auto save
6050 and file changed since last real save. */
6051 if (STRINGP (b
->auto_save_file_name
)
6052 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
6053 && b
->auto_save_modified
< BUF_MODIFF (b
)
6054 /* -1 means we've turned off autosaving for a while--see below. */
6055 && XINT (b
->save_length
) >= 0
6056 && (do_handled_files
6057 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
6060 EMACS_TIME before_time
, after_time
;
6062 EMACS_GET_TIME (before_time
);
6064 /* If we had a failure, don't try again for 20 minutes. */
6065 if (b
->auto_save_failure_time
>= 0
6066 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6069 if ((XFASTINT (b
->save_length
) * 10
6070 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6071 /* A short file is likely to change a large fraction;
6072 spare the user annoying messages. */
6073 && XFASTINT (b
->save_length
) > 5000
6074 /* These messages are frequent and annoying for `*mail*'. */
6075 && !EQ (b
->filename
, Qnil
)
6076 && NILP (no_message
))
6078 /* It has shrunk too much; turn off auto-saving here. */
6079 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6080 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6082 minibuffer_auto_raise
= 0;
6083 /* Turn off auto-saving until there's a real save,
6084 and prevent any more warnings. */
6085 XSETINT (b
->save_length
, -1);
6086 Fsleep_for (make_number (1), Qnil
);
6089 set_buffer_internal (b
);
6090 if (!auto_saved
&& NILP (no_message
))
6091 message1 ("Auto-saving...");
6092 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6094 b
->auto_save_modified
= BUF_MODIFF (b
);
6095 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6096 set_buffer_internal (old
);
6098 EMACS_GET_TIME (after_time
);
6100 /* If auto-save took more than 60 seconds,
6101 assume it was an NFS failure that got a timeout. */
6102 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6103 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6107 /* Prevent another auto save till enough input events come in. */
6108 record_auto_save ();
6110 if (auto_saved
&& NILP (no_message
))
6114 /* If we are going to restore an old message,
6115 give time to read ours. */
6116 sit_for (make_number (1), 0, 0);
6120 /* If we displayed a message and then restored a state
6121 with no message, leave a "done" message on the screen. */
6122 message1 ("Auto-saving...done");
6127 /* This restores the message-stack status. */
6128 unbind_to (count
, Qnil
);
6132 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6133 Sset_buffer_auto_saved
, 0, 0, 0,
6134 doc
: /* Mark current buffer as auto-saved with its current text.
6135 No auto-save file will be written until the buffer changes again. */)
6138 current_buffer
->auto_save_modified
= MODIFF
;
6139 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6140 current_buffer
->auto_save_failure_time
= -1;
6144 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6145 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6146 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6149 current_buffer
->auto_save_failure_time
= -1;
6153 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6155 doc
: /* Return t if current buffer has been auto-saved recently.
6156 More precisely, if it has been auto-saved since last read from or saved
6157 in the visited file. If the buffer has no visited file,
6158 then any auto-save counts as "recent". */)
6161 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6164 /* Reading and completing file names */
6165 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6167 /* In the string VAL, change each $ to $$ and return the result. */
6170 double_dollars (val
)
6173 register const unsigned char *old
;
6174 register unsigned char *new;
6178 osize
= SBYTES (val
);
6180 /* Count the number of $ characters. */
6181 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6182 if (*old
++ == '$') count
++;
6186 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6189 for (n
= osize
; n
> 0; n
--)
6203 read_file_name_cleanup (arg
)
6206 return (current_buffer
->directory
= arg
);
6209 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6211 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6212 (string
, dir
, action
)
6213 Lisp_Object string
, dir
, action
;
6214 /* action is nil for complete, t for return list of completions,
6215 lambda for verify final value */
6217 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6219 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6221 CHECK_STRING (string
);
6228 /* No need to protect ACTION--we only compare it with t and nil. */
6229 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6231 if (SCHARS (string
) == 0)
6233 if (EQ (action
, Qlambda
))
6241 orig_string
= string
;
6242 string
= Fsubstitute_in_file_name (string
);
6243 changed
= NILP (Fstring_equal (string
, orig_string
));
6244 name
= Ffile_name_nondirectory (string
);
6245 val
= Ffile_name_directory (string
);
6247 realdir
= Fexpand_file_name (val
, realdir
);
6252 specdir
= Ffile_name_directory (string
);
6253 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6258 return double_dollars (string
);
6262 if (!NILP (specdir
))
6263 val
= concat2 (specdir
, val
);
6265 return double_dollars (val
);
6268 #endif /* not VMS */
6272 if (EQ (action
, Qt
))
6274 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6278 if (NILP (Vread_file_name_predicate
)
6279 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6283 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6285 /* Brute-force speed up for directory checking:
6286 Discard strings which don't end in a slash. */
6287 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6289 Lisp_Object tem
= XCAR (all
);
6292 && (len
= SBYTES (tem
), len
> 0)
6293 && IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6294 comp
= Fcons (tem
, comp
);
6300 /* Must do it the hard (and slow) way. */
6302 GCPRO3 (all
, comp
, specdir
);
6303 count
= SPECPDL_INDEX ();
6304 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6305 current_buffer
->directory
= realdir
;
6306 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6308 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6310 comp
= Fcons (XCAR (all
), comp
);
6312 unbind_to (count
, Qnil
);
6315 return Fnreverse (comp
);
6318 /* Only other case actually used is ACTION = lambda */
6320 /* Supposedly this helps commands such as `cd' that read directory names,
6321 but can someone explain how it helps them? -- RMS */
6322 if (SCHARS (name
) == 0)
6325 string
= Fexpand_file_name (string
, dir
);
6326 if (!NILP (Vread_file_name_predicate
))
6327 return call1 (Vread_file_name_predicate
, string
);
6328 return Ffile_exists_p (string
);
6331 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6332 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6333 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6334 The return value is only relevant for a call to `read-file-name' that happens
6335 before any other event (mouse or keypress) is handeled. */)
6338 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6339 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6348 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6349 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6350 Value is not expanded---you must call `expand-file-name' yourself.
6351 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6352 the same non-empty string that was inserted by this function.
6353 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6354 except that if INITIAL is specified, that combined with DIR is used.)
6355 If the user exits with an empty minibuffer, this function returns
6356 an empty string. (This can only happen if the user erased the
6357 pre-inserted contents or if `insert-default-directory' is nil.)
6358 Fourth arg MUSTMATCH non-nil means require existing file's name.
6359 Non-nil and non-t means also require confirmation after completion.
6360 Fifth arg INITIAL specifies text to start with.
6361 If optional sixth arg PREDICATE is non-nil, possible completions and
6362 the resulting file name must satisfy (funcall PREDICATE NAME).
6363 DIR should be an absolute directory name. It defaults to the value of
6364 `default-directory'.
6366 If this command was invoked with the mouse, use a file dialog box if
6367 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6368 provides a file dialog box.
6370 See also `read-file-name-completion-ignore-case'
6371 and `read-file-name-function'. */)
6372 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6373 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6375 Lisp_Object val
, insdef
, tem
;
6376 struct gcpro gcpro1
, gcpro2
;
6377 register char *homedir
;
6378 Lisp_Object decoded_homedir
;
6379 int replace_in_history
= 0;
6380 int add_to_history
= 0;
6384 dir
= current_buffer
->directory
;
6385 if (NILP (Ffile_name_absolute_p (dir
)))
6386 dir
= Fexpand_file_name (dir
, Qnil
);
6387 if (NILP (default_filename
))
6390 ? Fexpand_file_name (initial
, dir
)
6391 : current_buffer
->filename
);
6393 /* If dir starts with user's homedir, change that to ~. */
6394 homedir
= (char *) egetenv ("HOME");
6396 /* homedir can be NULL in temacs, since Vglobal_environment is not
6397 yet set up. We shouldn't crash in that case. */
6400 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6401 CORRECT_DIR_SEPS (homedir
);
6406 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6409 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6410 SBYTES (decoded_homedir
))
6411 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6413 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6414 dir
= concat2 (build_string ("~"), dir
);
6416 /* Likewise for default_filename. */
6418 && STRINGP (default_filename
)
6419 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6420 SBYTES (decoded_homedir
))
6421 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6424 = Fsubstring (default_filename
,
6425 make_number (SCHARS (decoded_homedir
)), Qnil
);
6426 default_filename
= concat2 (build_string ("~"), default_filename
);
6428 if (!NILP (default_filename
))
6430 CHECK_STRING (default_filename
);
6431 default_filename
= double_dollars (default_filename
);
6434 if (insert_default_directory
&& STRINGP (dir
))
6437 if (!NILP (initial
))
6439 Lisp_Object args
[2], pos
;
6443 insdef
= Fconcat (2, args
);
6444 pos
= make_number (SCHARS (double_dollars (dir
)));
6445 insdef
= Fcons (double_dollars (insdef
), pos
);
6448 insdef
= double_dollars (insdef
);
6450 else if (STRINGP (initial
))
6451 insdef
= Fcons (double_dollars (initial
), make_number (0));
6455 if (!NILP (Vread_file_name_function
))
6457 Lisp_Object args
[7];
6459 GCPRO2 (insdef
, default_filename
);
6460 args
[0] = Vread_file_name_function
;
6463 args
[3] = default_filename
;
6464 args
[4] = mustmatch
;
6466 args
[6] = predicate
;
6467 RETURN_UNGCPRO (Ffuncall (7, args
));
6470 count
= SPECPDL_INDEX ();
6471 specbind (intern ("completion-ignore-case"),
6472 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6473 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6474 specbind (intern ("read-file-name-predicate"),
6475 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6477 GCPRO2 (insdef
, default_filename
);
6479 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6480 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6482 /* If DIR contains a file name, split it. */
6484 file
= Ffile_name_nondirectory (dir
);
6485 if (SCHARS (file
) && NILP (default_filename
))
6487 default_filename
= file
;
6488 dir
= Ffile_name_directory (dir
);
6490 if (!NILP(default_filename
))
6491 default_filename
= Fexpand_file_name (default_filename
, dir
);
6492 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6493 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6498 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6499 dir
, mustmatch
, insdef
,
6500 Qfile_name_history
, default_filename
, Qnil
);
6502 tem
= Fsymbol_value (Qfile_name_history
);
6503 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6504 replace_in_history
= 1;
6506 /* If Fcompleting_read returned the inserted default string itself
6507 (rather than a new string with the same contents),
6508 it has to mean that the user typed RET with the minibuffer empty.
6509 In that case, we really want to return ""
6510 so that commands such as set-visited-file-name can distinguish. */
6511 if (EQ (val
, default_filename
))
6513 /* In this case, Fcompleting_read has not added an element
6514 to the history. Maybe we should. */
6515 if (! replace_in_history
)
6518 val
= empty_unibyte_string
;
6521 unbind_to (count
, Qnil
);
6524 error ("No file name specified");
6526 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6528 if (!NILP (tem
) && !NILP (default_filename
))
6529 val
= default_filename
;
6530 val
= Fsubstitute_in_file_name (val
);
6532 if (replace_in_history
)
6533 /* Replace what Fcompleting_read added to the history
6534 with what we will actually return. */
6536 Lisp_Object val1
= double_dollars (val
);
6537 tem
= Fsymbol_value (Qfile_name_history
);
6538 if (history_delete_duplicates
)
6539 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6540 XSETCAR (tem
, val1
);
6542 else if (add_to_history
)
6544 /* Add the value to the history--but not if it matches
6545 the last value already there. */
6546 Lisp_Object val1
= double_dollars (val
);
6547 tem
= Fsymbol_value (Qfile_name_history
);
6548 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6550 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6551 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6562 /* Must be set before any path manipulation is performed. */
6563 XSETFASTINT (Vdirectory_sep_char
, '/');
6570 Qoperations
= intern ("operations");
6571 Qexpand_file_name
= intern ("expand-file-name");
6572 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6573 Qdirectory_file_name
= intern ("directory-file-name");
6574 Qfile_name_directory
= intern ("file-name-directory");
6575 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6576 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6577 Qfile_name_as_directory
= intern ("file-name-as-directory");
6578 Qcopy_file
= intern ("copy-file");
6579 Qmake_directory_internal
= intern ("make-directory-internal");
6580 Qmake_directory
= intern ("make-directory");
6581 Qdelete_directory
= intern ("delete-directory");
6582 Qdelete_file
= intern ("delete-file");
6583 Qrename_file
= intern ("rename-file");
6584 Qadd_name_to_file
= intern ("add-name-to-file");
6585 Qmake_symbolic_link
= intern ("make-symbolic-link");
6586 Qfile_exists_p
= intern ("file-exists-p");
6587 Qfile_executable_p
= intern ("file-executable-p");
6588 Qfile_readable_p
= intern ("file-readable-p");
6589 Qfile_writable_p
= intern ("file-writable-p");
6590 Qfile_symlink_p
= intern ("file-symlink-p");
6591 Qaccess_file
= intern ("access-file");
6592 Qfile_directory_p
= intern ("file-directory-p");
6593 Qfile_regular_p
= intern ("file-regular-p");
6594 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6595 Qfile_modes
= intern ("file-modes");
6596 Qset_file_modes
= intern ("set-file-modes");
6597 Qset_file_times
= intern ("set-file-times");
6598 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6599 Qinsert_file_contents
= intern ("insert-file-contents");
6600 Qwrite_region
= intern ("write-region");
6601 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6602 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6603 Qauto_save_coding
= intern ("auto-save-coding");
6605 staticpro (&Qoperations
);
6606 staticpro (&Qexpand_file_name
);
6607 staticpro (&Qsubstitute_in_file_name
);
6608 staticpro (&Qdirectory_file_name
);
6609 staticpro (&Qfile_name_directory
);
6610 staticpro (&Qfile_name_nondirectory
);
6611 staticpro (&Qunhandled_file_name_directory
);
6612 staticpro (&Qfile_name_as_directory
);
6613 staticpro (&Qcopy_file
);
6614 staticpro (&Qmake_directory_internal
);
6615 staticpro (&Qmake_directory
);
6616 staticpro (&Qdelete_directory
);
6617 staticpro (&Qdelete_file
);
6618 staticpro (&Qrename_file
);
6619 staticpro (&Qadd_name_to_file
);
6620 staticpro (&Qmake_symbolic_link
);
6621 staticpro (&Qfile_exists_p
);
6622 staticpro (&Qfile_executable_p
);
6623 staticpro (&Qfile_readable_p
);
6624 staticpro (&Qfile_writable_p
);
6625 staticpro (&Qaccess_file
);
6626 staticpro (&Qfile_symlink_p
);
6627 staticpro (&Qfile_directory_p
);
6628 staticpro (&Qfile_regular_p
);
6629 staticpro (&Qfile_accessible_directory_p
);
6630 staticpro (&Qfile_modes
);
6631 staticpro (&Qset_file_modes
);
6632 staticpro (&Qset_file_times
);
6633 staticpro (&Qfile_newer_than_file_p
);
6634 staticpro (&Qinsert_file_contents
);
6635 staticpro (&Qwrite_region
);
6636 staticpro (&Qverify_visited_file_modtime
);
6637 staticpro (&Qset_visited_file_modtime
);
6638 staticpro (&Qauto_save_coding
);
6640 Qfile_name_history
= intern ("file-name-history");
6641 Fset (Qfile_name_history
, Qnil
);
6642 staticpro (&Qfile_name_history
);
6644 Qfile_error
= intern ("file-error");
6645 staticpro (&Qfile_error
);
6646 Qfile_already_exists
= intern ("file-already-exists");
6647 staticpro (&Qfile_already_exists
);
6648 Qfile_date_error
= intern ("file-date-error");
6649 staticpro (&Qfile_date_error
);
6650 Qexcl
= intern ("excl");
6654 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6655 staticpro (&Qfind_buffer_file_type
);
6658 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6659 doc
: /* *Coding system for encoding file names.
6660 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6661 Vfile_name_coding_system
= Qnil
;
6663 DEFVAR_LISP ("default-file-name-coding-system",
6664 &Vdefault_file_name_coding_system
,
6665 doc
: /* Default coding system for encoding file names.
6666 This variable is used only when `file-name-coding-system' is nil.
6668 This variable is set/changed by the command `set-language-environment'.
6669 User should not set this variable manually,
6670 instead use `file-name-coding-system' to get a constant encoding
6671 of file names regardless of the current language environment. */);
6672 Vdefault_file_name_coding_system
= Qnil
;
6674 Qformat_decode
= intern ("format-decode");
6675 staticpro (&Qformat_decode
);
6676 Qformat_annotate_function
= intern ("format-annotate-function");
6677 staticpro (&Qformat_annotate_function
);
6678 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6679 staticpro (&Qafter_insert_file_set_coding
);
6681 Qcar_less_than_car
= intern ("car-less-than-car");
6682 staticpro (&Qcar_less_than_car
);
6684 Fput (Qfile_error
, Qerror_conditions
,
6685 list2 (Qfile_error
, Qerror
));
6686 Fput (Qfile_error
, Qerror_message
,
6687 build_string ("File error"));
6689 Fput (Qfile_already_exists
, Qerror_conditions
,
6690 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6691 Fput (Qfile_already_exists
, Qerror_message
,
6692 build_string ("File already exists"));
6694 Fput (Qfile_date_error
, Qerror_conditions
,
6695 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6696 Fput (Qfile_date_error
, Qerror_message
,
6697 build_string ("Cannot set file date"));
6699 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6700 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6701 Vread_file_name_function
= Qnil
;
6703 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6704 doc
: /* Current predicate used by `read-file-name-internal'. */);
6705 Vread_file_name_predicate
= Qnil
;
6707 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6708 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6709 #if defined VMS || defined DOS_NT || defined MAC_OS
6710 read_file_name_completion_ignore_case
= 1;
6712 read_file_name_completion_ignore_case
= 0;
6715 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6716 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6717 If the initial minibuffer contents are non-empty, you can usually
6718 request a default filename by typing RETURN without editing. For some
6719 commands, exiting with an empty minibuffer has a special meaning,
6720 such as making the current buffer visit no file in the case of
6721 `set-visited-file-name'.
6722 If this variable is non-nil, the minibuffer contents are always
6723 initially non-empty and typing RETURN without editing will fetch the
6724 default name, if one is provided. Note however that this default name
6725 is not necessarily the name originally inserted in the minibuffer, if
6726 that is just the default directory.
6727 If this variable is nil, the minibuffer often starts out empty. In
6728 that case you may have to explicitly fetch the next history element to
6729 request the default name. */);
6730 insert_default_directory
= 1;
6732 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6733 doc
: /* *Non-nil means write new files with record format `stmlf'.
6734 nil means use format `var'. This variable is meaningful only on VMS. */);
6735 vms_stmlf_recfm
= 0;
6737 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6738 doc
: /* Directory separator character for built-in functions that return file names.
6739 The value is always ?/. Don't use this variable, just use `/'. */);
6741 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6742 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6743 If a file name matches REGEXP, then all I/O on that file is done by calling
6746 The first argument given to HANDLER is the name of the I/O primitive
6747 to be handled; the remaining arguments are the arguments that were
6748 passed to that primitive. For example, if you do
6749 (file-exists-p FILENAME)
6750 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6751 (funcall HANDLER 'file-exists-p FILENAME)
6752 The function `find-file-name-handler' checks this list for a handler
6753 for its argument. */);
6754 Vfile_name_handler_alist
= Qnil
;
6756 DEFVAR_LISP ("set-auto-coding-function",
6757 &Vset_auto_coding_function
,
6758 doc
: /* If non-nil, a function to call to decide a coding system of file.
6759 Two arguments are passed to this function: the file name
6760 and the length of a file contents following the point.
6761 This function should return a coding system to decode the file contents.
6762 It should check the file name against `auto-coding-alist'.
6763 If no coding system is decided, it should check a coding system
6764 specified in the heading lines with the format:
6765 -*- ... coding: CODING-SYSTEM; ... -*-
6766 or local variable spec of the tailing lines with `coding:' tag. */);
6767 Vset_auto_coding_function
= Qnil
;
6769 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6770 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6771 Each is passed one argument, the number of characters inserted,
6772 with point at the start of the inserted text. Each function
6773 should leave point the same, and return the new character count.
6774 If `insert-file-contents' is intercepted by a handler from
6775 `file-name-handler-alist', that handler is responsible for calling the
6776 functions in `after-insert-file-functions' if appropriate. */);
6777 Vafter_insert_file_functions
= Qnil
;
6779 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6780 doc
: /* A list of functions to be called at the start of `write-region'.
6781 Each is passed two arguments, START and END as for `write-region'.
6782 These are usually two numbers but not always; see the documentation
6783 for `write-region'. The function should return a list of pairs
6784 of the form (POSITION . STRING), consisting of strings to be effectively
6785 inserted at the specified positions of the file being written (1 means to
6786 insert before the first byte written). The POSITIONs must be sorted into
6787 increasing order. If there are several functions in the list, the several
6788 lists are merged destructively. Alternatively, the function can return
6789 with a different buffer current; in that case it should pay attention
6790 to the annotations returned by previous functions and listed in
6791 `write-region-annotations-so-far'.*/);
6792 Vwrite_region_annotate_functions
= Qnil
;
6793 staticpro (&Qwrite_region_annotate_functions
);
6794 Qwrite_region_annotate_functions
6795 = intern ("write-region-annotate-functions");
6797 DEFVAR_LISP ("write-region-annotations-so-far",
6798 &Vwrite_region_annotations_so_far
,
6799 doc
: /* When an annotation function is called, this holds the previous annotations.
6800 These are the annotations made by other annotation functions
6801 that were already called. See also `write-region-annotate-functions'. */);
6802 Vwrite_region_annotations_so_far
= Qnil
;
6804 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6805 doc
: /* A list of file name handlers that temporarily should not be used.
6806 This applies only to the operation `inhibit-file-name-operation'. */);
6807 Vinhibit_file_name_handlers
= Qnil
;
6809 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6810 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6811 Vinhibit_file_name_operation
= Qnil
;
6813 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6814 doc
: /* File name in which we write a list of all auto save file names.
6815 This variable is initialized automatically from `auto-save-list-file-prefix'
6816 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6817 a non-nil value. */);
6818 Vauto_save_list_file_name
= Qnil
;
6821 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6822 doc
: /* *Non-nil means don't call fsync in `write-region'.
6823 This variable affects calls to `write-region' as well as save commands.
6824 A non-nil value may result in data loss! */);
6825 write_region_inhibit_fsync
= 0;
6828 defsubr (&Sfind_file_name_handler
);
6829 defsubr (&Sfile_name_directory
);
6830 defsubr (&Sfile_name_nondirectory
);
6831 defsubr (&Sunhandled_file_name_directory
);
6832 defsubr (&Sfile_name_as_directory
);
6833 defsubr (&Sdirectory_file_name
);
6834 defsubr (&Smake_temp_name
);
6835 defsubr (&Sexpand_file_name
);
6836 defsubr (&Ssubstitute_in_file_name
);
6837 defsubr (&Scopy_file
);
6838 defsubr (&Smake_directory_internal
);
6839 defsubr (&Sdelete_directory
);
6840 defsubr (&Sdelete_file
);
6841 defsubr (&Srename_file
);
6842 defsubr (&Sadd_name_to_file
);
6844 defsubr (&Smake_symbolic_link
);
6845 #endif /* S_IFLNK */
6847 defsubr (&Sdefine_logical_name
);
6850 defsubr (&Ssysnetunam
);
6851 #endif /* HPUX_NET */
6852 defsubr (&Sfile_name_absolute_p
);
6853 defsubr (&Sfile_exists_p
);
6854 defsubr (&Sfile_executable_p
);
6855 defsubr (&Sfile_readable_p
);
6856 defsubr (&Sfile_writable_p
);
6857 defsubr (&Saccess_file
);
6858 defsubr (&Sfile_symlink_p
);
6859 defsubr (&Sfile_directory_p
);
6860 defsubr (&Sfile_accessible_directory_p
);
6861 defsubr (&Sfile_regular_p
);
6862 defsubr (&Sfile_modes
);
6863 defsubr (&Sset_file_modes
);
6864 defsubr (&Sset_file_times
);
6865 defsubr (&Sset_default_file_modes
);
6866 defsubr (&Sdefault_file_modes
);
6867 defsubr (&Sfile_newer_than_file_p
);
6868 defsubr (&Sinsert_file_contents
);
6869 defsubr (&Swrite_region
);
6870 defsubr (&Scar_less_than_car
);
6871 defsubr (&Sverify_visited_file_modtime
);
6872 defsubr (&Sclear_visited_file_modtime
);
6873 defsubr (&Svisited_file_modtime
);
6874 defsubr (&Sset_visited_file_modtime
);
6875 defsubr (&Sdo_auto_save
);
6876 defsubr (&Sset_buffer_auto_saved
);
6877 defsubr (&Sclear_buffer_auto_save_failure
);
6878 defsubr (&Srecent_auto_save_p
);
6880 defsubr (&Sread_file_name_internal
);
6881 defsubr (&Sread_file_name
);
6882 defsubr (&Snext_read_file_uses_dialog_p
);
6885 defsubr (&Sunix_sync
);
6889 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6890 (do not change this comment) */