1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include <sys/types.h>
30 #if !defined (S_ISLNK) && defined (S_IFLNK)
31 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
34 #if !defined (S_ISREG) && defined (S_IFREG)
35 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
46 #include <sys/param.h>
64 extern char *strerror ();
81 #include "intervals.h"
90 #endif /* not WINDOWSNT */
118 #define min(a, b) ((a) < (b) ? (a) : (b))
119 #define max(a, b) ((a) > (b) ? (a) : (b))
121 /* Nonzero during writing of auto-save files */
124 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
125 a new file with the same mode as the original */
126 int auto_save_mode_bits
;
128 /* Alist of elements (REGEXP . HANDLER) for file names
129 whose I/O is done with a special handler. */
130 Lisp_Object Vfile_name_handler_alist
;
132 /* Format for auto-save files */
133 Lisp_Object Vauto_save_file_format
;
135 /* Lisp functions for translating file formats */
136 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
138 /* Functions to be called to process text properties in inserted file. */
139 Lisp_Object Vafter_insert_file_functions
;
141 /* Functions to be called to create text property annotations for file. */
142 Lisp_Object Vwrite_region_annotate_functions
;
144 /* During build_annotations, each time an annotation function is called,
145 this holds the annotations made by the previous functions. */
146 Lisp_Object Vwrite_region_annotations_so_far
;
148 /* File name in which we write a list of all our auto save files. */
149 Lisp_Object Vauto_save_list_file_name
;
151 /* Nonzero means, when reading a filename in the minibuffer,
152 start out by inserting the default directory into the minibuffer. */
153 int insert_default_directory
;
155 /* On VMS, nonzero means write new files with record format stmlf.
156 Zero means use var format. */
159 /* These variables describe handlers that have "already" had a chance
160 to handle the current operation.
162 Vinhibit_file_name_handlers is a list of file name handlers.
163 Vinhibit_file_name_operation is the operation being handled.
164 If we try to handle that operation, we ignore those handlers. */
166 static Lisp_Object Vinhibit_file_name_handlers
;
167 static Lisp_Object Vinhibit_file_name_operation
;
169 Lisp_Object Qfile_error
, Qfile_already_exists
;
171 Lisp_Object Qfile_name_history
;
173 Lisp_Object Qcar_less_than_car
;
175 report_file_error (string
, data
)
179 Lisp_Object errstring
;
181 errstring
= build_string (strerror (errno
));
183 /* System error messages are capitalized. Downcase the initial
184 unless it is followed by a slash. */
185 if (XSTRING (errstring
)->data
[1] != '/')
186 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
189 Fsignal (Qfile_error
,
190 Fcons (build_string (string
), Fcons (errstring
, data
)));
193 close_file_unwind (fd
)
196 close (XFASTINT (fd
));
199 /* Restore point, having saved it as a marker. */
201 restore_point_unwind (location
)
202 Lisp_Object location
;
204 SET_PT (marker_position (location
));
205 Fset_marker (location
, Qnil
, Qnil
);
208 Lisp_Object Qexpand_file_name
;
209 Lisp_Object Qsubstitute_in_file_name
;
210 Lisp_Object Qdirectory_file_name
;
211 Lisp_Object Qfile_name_directory
;
212 Lisp_Object Qfile_name_nondirectory
;
213 Lisp_Object Qunhandled_file_name_directory
;
214 Lisp_Object Qfile_name_as_directory
;
215 Lisp_Object Qcopy_file
;
216 Lisp_Object Qmake_directory_internal
;
217 Lisp_Object Qdelete_directory
;
218 Lisp_Object Qdelete_file
;
219 Lisp_Object Qrename_file
;
220 Lisp_Object Qadd_name_to_file
;
221 Lisp_Object Qmake_symbolic_link
;
222 Lisp_Object Qfile_exists_p
;
223 Lisp_Object Qfile_executable_p
;
224 Lisp_Object Qfile_readable_p
;
225 Lisp_Object Qfile_symlink_p
;
226 Lisp_Object Qfile_writable_p
;
227 Lisp_Object Qfile_directory_p
;
228 Lisp_Object Qfile_regular_p
;
229 Lisp_Object Qfile_accessible_directory_p
;
230 Lisp_Object Qfile_modes
;
231 Lisp_Object Qset_file_modes
;
232 Lisp_Object Qfile_newer_than_file_p
;
233 Lisp_Object Qinsert_file_contents
;
234 Lisp_Object Qwrite_region
;
235 Lisp_Object Qverify_visited_file_modtime
;
236 Lisp_Object Qset_visited_file_modtime
;
238 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
239 "Return FILENAME's handler function for OPERATION, if it has one.\n\
240 Otherwise, return nil.\n\
241 A file name is handled if one of the regular expressions in\n\
242 `file-name-handler-alist' matches it.\n\n\
243 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
244 any handlers that are members of `inhibit-file-name-handlers',\n\
245 but we still do run any other handlers. This lets handlers\n\
246 use the standard functions without calling themselves recursively.")
247 (filename
, operation
)
248 Lisp_Object filename
, operation
;
250 /* This function must not munge the match data. */
251 Lisp_Object chain
, inhibited_handlers
;
253 CHECK_STRING (filename
, 0);
255 if (EQ (operation
, Vinhibit_file_name_operation
))
256 inhibited_handlers
= Vinhibit_file_name_handlers
;
258 inhibited_handlers
= Qnil
;
260 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
261 chain
= XCONS (chain
)->cdr
)
264 elt
= XCONS (chain
)->car
;
268 string
= XCONS (elt
)->car
;
269 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
271 Lisp_Object handler
, tem
;
273 handler
= XCONS (elt
)->cdr
;
274 tem
= Fmemq (handler
, inhibited_handlers
);
285 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
287 "Return the directory component in file name FILENAME.\n\
288 Return nil if FILENAME does not include a directory.\n\
289 Otherwise return a directory spec.\n\
290 Given a Unix syntax file name, returns a string ending in slash;\n\
291 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
293 Lisp_Object filename
;
295 register unsigned char *beg
;
296 register unsigned char *p
;
299 CHECK_STRING (filename
, 0);
301 /* If the file name has special constructs in it,
302 call the corresponding file handler. */
303 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
305 return call2 (handler
, Qfile_name_directory
, filename
);
307 #ifdef FILE_SYSTEM_CASE
308 filename
= FILE_SYSTEM_CASE (filename
);
310 beg
= XSTRING (filename
)->data
;
311 p
= beg
+ XSTRING (filename
)->size
;
313 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
315 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
322 /* Expansion of "c:" to drive and default directory. */
323 /* (NT does the right thing.) */
324 if (p
== beg
+ 2 && beg
[1] == ':')
326 int drive
= (*beg
) - 'a';
327 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
328 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
332 /* The NT version places the drive letter at the beginning already. */
333 #else /* not WINDOWSNT */
334 /* On MSDOG we must put the drive letter in by hand. */
336 #endif /* not WINDOWSNT */
337 if (getdefdir (drive
+ 1, res
))
340 res
[0] = drive
+ 'a';
343 if (IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
346 p
= beg
+ strlen (beg
);
350 return make_string (beg
, p
- beg
);
353 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
355 "Return file name FILENAME sans its directory.\n\
356 For example, in a Unix-syntax file name,\n\
357 this is everything after the last slash,\n\
358 or the entire name if it contains no slash.")
360 Lisp_Object filename
;
362 register unsigned char *beg
, *p
, *end
;
365 CHECK_STRING (filename
, 0);
367 /* If the file name has special constructs in it,
368 call the corresponding file handler. */
369 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
371 return call2 (handler
, Qfile_name_nondirectory
, filename
);
373 beg
= XSTRING (filename
)->data
;
374 end
= p
= beg
+ XSTRING (filename
)->size
;
376 while (p
!= beg
&& !IS_ANY_SEP (p
[-1])
378 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
382 return make_string (p
, end
- p
);
385 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
386 "Return a directly usable directory name somehow associated with FILENAME.\n\
387 A `directly usable' directory name is one that may be used without the\n\
388 intervention of any file handler.\n\
389 If FILENAME is a directly usable file itself, return\n\
390 (file-name-directory FILENAME).\n\
391 The `call-process' and `start-process' functions use this function to\n\
392 get a current directory to run processes in.")
394 Lisp_Object filename
;
398 /* If the file name has special constructs in it,
399 call the corresponding file handler. */
400 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
402 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
404 return Ffile_name_directory (filename
);
409 file_name_as_directory (out
, in
)
412 int size
= strlen (in
) - 1;
417 /* Is it already a directory string? */
418 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
420 /* Is it a VMS directory file name? If so, hack VMS syntax. */
421 else if (! index (in
, '/')
422 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
423 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
424 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
425 || ! strncmp (&in
[size
- 5], ".dir", 4))
426 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
427 && in
[size
] == '1')))
429 register char *p
, *dot
;
433 dir:x.dir --> dir:[x]
434 dir:[x]y.dir --> dir:[x.y] */
436 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
439 strncpy (out
, in
, p
- in
);
458 dot
= index (p
, '.');
461 /* blindly remove any extension */
462 size
= strlen (out
) + (dot
- p
);
463 strncat (out
, p
, dot
- p
);
474 /* For Unix syntax, Append a slash if necessary */
475 if (!IS_ANY_SEP (out
[size
]))
477 out
[size
+ 1] = DIRECTORY_SEP
;
478 out
[size
+ 2] = '\0';
484 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
485 Sfile_name_as_directory
, 1, 1, 0,
486 "Return a string representing file FILENAME interpreted as a directory.\n\
487 This operation exists because a directory is also a file, but its name as\n\
488 a directory is different from its name as a file.\n\
489 The result can be used as the value of `default-directory'\n\
490 or passed as second argument to `expand-file-name'.\n\
491 For a Unix-syntax file name, just appends a slash.\n\
492 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
499 CHECK_STRING (file
, 0);
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
507 return call2 (handler
, Qfile_name_as_directory
, file
);
509 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
510 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
514 * Convert from directory name to filename.
516 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
517 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
518 * On UNIX, it's simple: just make sure there is a terminating /
520 * Value is nonzero if the string output is different from the input.
523 directory_file_name (src
, dst
)
531 struct FAB fab
= cc$rms_fab
;
532 struct NAM nam
= cc$rms_nam
;
533 char esa
[NAM$C_MAXRSS
];
538 if (! index (src
, '/')
539 && (src
[slen
- 1] == ']'
540 || src
[slen
- 1] == ':'
541 || src
[slen
- 1] == '>'))
543 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
545 fab
.fab$b_fns
= slen
;
546 fab
.fab$l_nam
= &nam
;
547 fab
.fab$l_fop
= FAB$M_NAM
;
550 nam
.nam$b_ess
= sizeof esa
;
551 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
553 /* We call SYS$PARSE to handle such things as [--] for us. */
554 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
556 slen
= nam
.nam$b_esl
;
557 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
562 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
564 /* what about when we have logical_name:???? */
565 if (src
[slen
- 1] == ':')
566 { /* Xlate logical name and see what we get */
567 ptr
= strcpy (dst
, src
); /* upper case for getenv */
570 if ('a' <= *ptr
&& *ptr
<= 'z')
574 dst
[slen
- 1] = 0; /* remove colon */
575 if (!(src
= egetenv (dst
)))
577 /* should we jump to the beginning of this procedure?
578 Good points: allows us to use logical names that xlate
580 Bad points: can be a problem if we just translated to a device
582 For now, I'll punt and always expect VMS names, and hope for
585 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
586 { /* no recursion here! */
592 { /* not a directory spec */
597 bracket
= src
[slen
- 1];
599 /* If bracket is ']' or '>', bracket - 2 is the corresponding
601 ptr
= index (src
, bracket
- 2);
603 { /* no opening bracket */
607 if (!(rptr
= rindex (src
, '.')))
610 strncpy (dst
, src
, slen
);
614 dst
[slen
++] = bracket
;
619 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
620 then translate the device and recurse. */
621 if (dst
[slen
- 1] == ':'
622 && dst
[slen
- 2] != ':' /* skip decnet nodes */
623 && strcmp(src
+ slen
, "[000000]") == 0)
625 dst
[slen
- 1] = '\0';
626 if ((ptr
= egetenv (dst
))
627 && (rlen
= strlen (ptr
) - 1) > 0
628 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
629 && ptr
[rlen
- 1] == '.')
631 char * buf
= (char *) alloca (strlen (ptr
) + 1);
635 return directory_file_name (buf
, dst
);
640 strcat (dst
, "[000000]");
644 rlen
= strlen (rptr
) - 1;
645 strncat (dst
, rptr
, rlen
);
646 dst
[slen
+ rlen
] = '\0';
647 strcat (dst
, ".DIR.1");
651 /* Process as Unix format: just remove any final slash.
652 But leave "/" unchanged; do not change it to "". */
655 /* Handle // as root for apollo's. */
656 if ((slen
> 2 && dst
[slen
- 1] == '/')
657 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
661 && IS_DIRECTORY_SEP (dst
[slen
- 1])
663 && !IS_ANY_SEP (dst
[slen
- 2])
671 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
673 "Returns the file name of the directory named DIRECTORY.\n\
674 This is the name of the file that holds the data for the directory DIRECTORY.\n\
675 This operation exists because a directory is also a file, but its name as\n\
676 a directory is different from its name as a file.\n\
677 In Unix-syntax, this function just removes the final slash.\n\
678 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
679 it returns a file name such as \"[X]Y.DIR.1\".")
681 Lisp_Object directory
;
686 CHECK_STRING (directory
, 0);
688 if (NILP (directory
))
691 /* If the file name has special constructs in it,
692 call the corresponding file handler. */
693 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
695 return call2 (handler
, Qdirectory_file_name
, directory
);
698 /* 20 extra chars is insufficient for VMS, since we might perform a
699 logical name translation. an equivalence string can be up to 255
700 chars long, so grab that much extra space... - sss */
701 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
703 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
705 directory_file_name (XSTRING (directory
)->data
, buf
);
706 return build_string (buf
);
709 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
710 "Generate temporary file name (string) starting with PREFIX (a string).\n\
711 The Emacs process number forms part of the result,\n\
712 so there is no danger of generating a name being used by another process.")
718 /* Don't use too many characters of the restricted 8+3 DOS
720 val
= concat2 (prefix
, build_string ("a.XXX"));
722 val
= concat2 (prefix
, build_string ("XXXXXX"));
724 mktemp (XSTRING (val
)->data
);
728 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
729 "Convert filename NAME to absolute, and canonicalize it.\n\
730 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
731 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
732 the current buffer's value of default-directory is used.\n\
733 Path components that are `.' are removed, and \n\
734 path components followed by `..' are removed, along with the `..' itself;\n\
735 note that these simplifications are done without checking the resulting\n\
736 paths in the file system.\n\
737 An initial `~/' expands to your home directory.\n\
738 An initial `~USER/' expands to USER's home directory.\n\
739 See also the function `substitute-in-file-name'.")
740 (name
, default_directory
)
741 Lisp_Object name
, default_directory
;
745 register unsigned char *newdir
, *p
, *o
;
747 unsigned char *target
;
750 unsigned char * colon
= 0;
751 unsigned char * close
= 0;
752 unsigned char * slash
= 0;
753 unsigned char * brack
= 0;
754 int lbrack
= 0, rbrack
= 0;
758 /* Demacs 1.1.2 91/10/20 Manabu Higashida */
761 unsigned char *tmp
, *defdir
;
765 CHECK_STRING (name
, 0);
767 /* If the file name has special constructs in it,
768 call the corresponding file handler. */
769 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
771 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
773 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
774 if (NILP (default_directory
))
775 default_directory
= current_buffer
->directory
;
776 CHECK_STRING (default_directory
, 1);
778 if (!NILP (default_directory
))
780 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
782 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
785 o
= XSTRING (default_directory
)->data
;
787 /* Make sure DEFAULT_DIRECTORY is properly expanded.
788 It would be better to do this down below where we actually use
789 default_directory. Unfortunately, calling Fexpand_file_name recursively
790 could invoke GC, and the strings might be relocated. This would
791 be annoying because we have pointers into strings lying around
792 that would need adjusting, and people would add new pointers to
793 the code and forget to adjust them, resulting in intermittent bugs.
794 Putting this call here avoids all that crud.
796 The EQ test avoids infinite recursion. */
797 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
798 /* This saves time in a common case. */
799 && ! (XSTRING (default_directory
)->size
>= 3
800 && IS_DIRECTORY_SEP (XSTRING (default_directory
)->data
[0])
801 && IS_DEVICE_SEP (XSTRING (default_directory
)->data
[1])))
806 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
811 /* Filenames on VMS are always upper case. */
812 name
= Fupcase (name
);
814 #ifdef FILE_SYSTEM_CASE
815 name
= FILE_SYSTEM_CASE (name
);
818 nm
= XSTRING (name
)->data
;
821 /* First map all backslashes to slashes. */
822 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
826 /* Now strip drive name. */
828 unsigned char *colon
= rindex (nm
, ':');
836 if (!IS_DIRECTORY_SEP (*nm
))
838 defdir
= alloca (MAXPATHLEN
+ 1);
839 relpath
= getdefdir (tolower (drive
) - 'a' + 1, defdir
);
845 /* Handle // and /~ in middle of file name
846 by discarding everything through the first / of that sequence. */
850 /* Since we know the path is absolute, we can assume that each
851 element starts with a "/". */
853 /* "//" anywhere isn't necessarily hairy; we just start afresh
854 with the second slash. */
855 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
856 #if defined (APOLLO) || defined (WINDOWSNT)
857 /* // at start of filename is meaningful on Apollo
858 and WindowsNT systems */
860 #endif /* APOLLO || WINDOWSNT */
864 /* "~" is hairy as the start of any path element. */
865 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
871 /* If nm is absolute, flush ...// and detect /./ and /../.
872 If no /./ or /../ we can return right away. */
874 IS_DIRECTORY_SEP (nm
[0])
880 /* If it turns out that the filename we want to return is just a
881 suffix of FILENAME, we don't need to go through and edit
882 things; we just need to construct a new string using data
883 starting at the middle of FILENAME. If we set lose to a
884 non-zero value, that means we've discovered that we can't do
891 /* Since we know the path is absolute, we can assume that each
892 element starts with a "/". */
894 /* "." and ".." are hairy. */
895 if (IS_DIRECTORY_SEP (p
[0])
897 && (IS_DIRECTORY_SEP (p
[2])
899 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
906 /* if dev:[dir]/, move nm to / */
907 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
908 nm
= (brack
? brack
+ 1 : colon
+ 1);
917 /* VMS pre V4.4,convert '-'s in filenames. */
918 if (lbrack
== rbrack
)
920 if (dots
< 2) /* this is to allow negative version numbers */
925 if (lbrack
> rbrack
&&
926 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
927 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
933 /* count open brackets, reset close bracket pointer */
934 if (p
[0] == '[' || p
[0] == '<')
936 /* count close brackets, set close bracket pointer */
937 if (p
[0] == ']' || p
[0] == '>')
939 /* detect ][ or >< */
940 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
942 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
943 nm
= p
+ 1, lose
= 1;
944 if (p
[0] == ':' && (colon
|| slash
))
945 /* if dev1:[dir]dev2:, move nm to dev2: */
951 /* if /pathname/dev:, move nm to dev: */
954 /* if node::dev:, move colon following dev */
955 else if (colon
&& colon
[-1] == ':')
957 /* if dev1:dev2:, move nm to dev2: */
958 else if (colon
&& colon
[-1] != ':')
963 if (p
[0] == ':' && !colon
)
969 if (lbrack
== rbrack
)
972 else if (p
[0] == '.')
981 return build_string (sys_translate_unix (nm
));
984 if (nm
== XSTRING (name
)->data
)
986 return build_string (nm
);
987 #endif /* not DOS_NT */
991 /* Now determine directory to start with and put it in newdir */
995 if (nm
[0] == '~') /* prefix ~ */
997 if (IS_DIRECTORY_SEP (nm
[1])
1001 || nm
[1] == 0) /* ~ by itself */
1003 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1004 newdir
= (unsigned char *) "";
1006 /* Problem when expanding "~\" if HOME is not on current drive.
1007 Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
1008 if (newdir
[1] == ':')
1010 dostounix_filename (newdir
);
1014 nm
++; /* Don't leave the slash in nm. */
1017 else /* ~user/filename */
1019 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1024 o
= (unsigned char *) alloca (p
- nm
+ 1);
1025 bcopy ((char *) nm
, o
, p
- nm
);
1029 newdir
= (unsigned char *) egetenv ("HOME");
1030 dostounix_filename (newdir
);
1031 #else /* not WINDOWSNT */
1032 pw
= (struct passwd
*) getpwnam (o
+ 1);
1035 newdir
= (unsigned char *) pw
-> pw_dir
;
1037 nm
= p
+ 1; /* skip the terminator */
1042 #endif /* not WINDOWSNT */
1044 /* If we don't find a user of that name, leave the name
1045 unchanged; don't move nm forward to p. */
1049 if (!IS_ANY_SEP (nm
[0])
1052 #endif /* not VMS */
1058 newdir
= XSTRING (default_directory
)->data
;
1062 if (newdir
== 0 && relpath
)
1067 /* Get rid of any slash at the end of newdir. */
1068 int length
= strlen (newdir
);
1069 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1070 is the root dir. People disagree about whether that is right.
1071 Anyway, we can't take the risk of this change now. */
1073 if (newdir
[1] != ':' && length
> 1)
1075 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1077 unsigned char *temp
= (unsigned char *) alloca (length
);
1078 bcopy (newdir
, temp
, length
- 1);
1079 temp
[length
- 1] = 0;
1087 /* Now concatenate the directory and name to new space in the stack frame */
1088 tlen
+= strlen (nm
) + 1;
1090 /* Add reserved space for drive name. (The Microsoft x86 compiler
1091 produces incorrect code if the following two lines are combined.) */
1092 target
= (unsigned char *) alloca (tlen
+ 2);
1094 #else /* not DOS_NT */
1095 target
= (unsigned char *) alloca (tlen
);
1096 #endif /* not DOS_NT */
1102 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1103 strcpy (target
, newdir
);
1106 file_name_as_directory (target
, newdir
);
1109 strcat (target
, nm
);
1111 if (index (target
, '/'))
1112 strcpy (target
, sys_translate_unix (target
));
1115 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1123 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1129 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1130 /* brackets are offset from each other by 2 */
1133 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1134 /* convert [foo][bar] to [bar] */
1135 while (o
[-1] != '[' && o
[-1] != '<')
1137 else if (*p
== '-' && *o
!= '.')
1140 else if (p
[0] == '-' && o
[-1] == '.' &&
1141 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1142 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1146 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1147 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1149 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1151 /* else [foo.-] ==> [-] */
1157 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1158 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1164 if (!IS_DIRECTORY_SEP (*p
))
1168 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1169 #if defined (APOLLO) || defined (WINDOWSNT)
1170 /* // at start of filename is meaningful in Apollo
1171 and WindowsNT systems */
1179 else if (IS_DIRECTORY_SEP (p
[0])
1181 && (IS_DIRECTORY_SEP (p
[2])
1184 /* If "/." is the entire filename, keep the "/". Otherwise,
1185 just delete the whole "/.". */
1186 if (o
== target
&& p
[2] == '\0')
1190 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1191 /* `/../' is the "superroot" on certain file systems. */
1193 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1195 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1197 #if defined (APOLLO) || defined (WINDOWSNT)
1199 && IS_DIRECTORY_SEP (o
[-1]) && IS_DIRECTORY_SEP (o
[0]))
1202 #endif /* APOLLO || WINDOWSNT */
1203 if (o
== target
&& IS_ANY_SEP (*o
))
1211 #endif /* not VMS */
1215 /* at last, set drive name. */
1216 if (target
[1] != ':'
1218 /* Allow network paths that look like "\\foo" */
1219 && !(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1]))
1220 #endif /* WINDOWSNT */
1224 target
[0] = (drive
< 0 ? getdisk () + 'A' : drive
);
1229 return make_string (target
, o
- target
);
1233 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1234 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1235 "Convert FILENAME to absolute, and canonicalize it.\n\
1236 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1237 (does not start with slash); if DEFAULT is nil or missing,\n\
1238 the current buffer's value of default-directory is used.\n\
1239 Filenames containing `.' or `..' as components are simplified;\n\
1240 initial `~/' expands to your home directory.\n\
1241 See also the function `substitute-in-file-name'.")
1243 Lisp_Object name
, defalt
;
1247 register unsigned char *newdir
, *p
, *o
;
1249 unsigned char *target
;
1253 unsigned char * colon
= 0;
1254 unsigned char * close
= 0;
1255 unsigned char * slash
= 0;
1256 unsigned char * brack
= 0;
1257 int lbrack
= 0, rbrack
= 0;
1261 CHECK_STRING (name
, 0);
1264 /* Filenames on VMS are always upper case. */
1265 name
= Fupcase (name
);
1268 nm
= XSTRING (name
)->data
;
1270 /* If nm is absolute, flush ...// and detect /./ and /../.
1271 If no /./ or /../ we can return right away. */
1283 if (p
[0] == '/' && p
[1] == '/'
1285 /* // at start of filename is meaningful on Apollo system */
1290 if (p
[0] == '/' && p
[1] == '~')
1291 nm
= p
+ 1, lose
= 1;
1292 if (p
[0] == '/' && p
[1] == '.'
1293 && (p
[2] == '/' || p
[2] == 0
1294 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1300 /* if dev:[dir]/, move nm to / */
1301 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1302 nm
= (brack
? brack
+ 1 : colon
+ 1);
1303 lbrack
= rbrack
= 0;
1311 /* VMS pre V4.4,convert '-'s in filenames. */
1312 if (lbrack
== rbrack
)
1314 if (dots
< 2) /* this is to allow negative version numbers */
1319 if (lbrack
> rbrack
&&
1320 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1321 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1327 /* count open brackets, reset close bracket pointer */
1328 if (p
[0] == '[' || p
[0] == '<')
1329 lbrack
++, brack
= 0;
1330 /* count close brackets, set close bracket pointer */
1331 if (p
[0] == ']' || p
[0] == '>')
1332 rbrack
++, brack
= p
;
1333 /* detect ][ or >< */
1334 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1336 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1337 nm
= p
+ 1, lose
= 1;
1338 if (p
[0] == ':' && (colon
|| slash
))
1339 /* if dev1:[dir]dev2:, move nm to dev2: */
1345 /* if /pathname/dev:, move nm to dev: */
1348 /* if node::dev:, move colon following dev */
1349 else if (colon
&& colon
[-1] == ':')
1351 /* if dev1:dev2:, move nm to dev2: */
1352 else if (colon
&& colon
[-1] != ':')
1357 if (p
[0] == ':' && !colon
)
1363 if (lbrack
== rbrack
)
1366 else if (p
[0] == '.')
1374 if (index (nm
, '/'))
1375 return build_string (sys_translate_unix (nm
));
1377 if (nm
== XSTRING (name
)->data
)
1379 return build_string (nm
);
1383 /* Now determine directory to start with and put it in NEWDIR */
1387 if (nm
[0] == '~') /* prefix ~ */
1392 || nm
[1] == 0)/* ~/filename */
1394 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1395 newdir
= (unsigned char *) "";
1398 nm
++; /* Don't leave the slash in nm. */
1401 else /* ~user/filename */
1403 /* Get past ~ to user */
1404 unsigned char *user
= nm
+ 1;
1405 /* Find end of name. */
1406 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1407 int len
= ptr
? ptr
- user
: strlen (user
);
1409 unsigned char *ptr1
= index (user
, ':');
1410 if (ptr1
!= 0 && ptr1
- user
< len
)
1413 /* Copy the user name into temp storage. */
1414 o
= (unsigned char *) alloca (len
+ 1);
1415 bcopy ((char *) user
, o
, len
);
1418 /* Look up the user name. */
1419 pw
= (struct passwd
*) getpwnam (o
+ 1);
1421 error ("\"%s\" isn't a registered user", o
+ 1);
1423 newdir
= (unsigned char *) pw
->pw_dir
;
1425 /* Discard the user name from NM. */
1432 #endif /* not VMS */
1436 defalt
= current_buffer
->directory
;
1437 CHECK_STRING (defalt
, 1);
1438 newdir
= XSTRING (defalt
)->data
;
1441 /* Now concatenate the directory and name to new space in the stack frame */
1443 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1444 target
= (unsigned char *) alloca (tlen
);
1450 if (nm
[0] == 0 || nm
[0] == '/')
1451 strcpy (target
, newdir
);
1454 file_name_as_directory (target
, newdir
);
1457 strcat (target
, nm
);
1459 if (index (target
, '/'))
1460 strcpy (target
, sys_translate_unix (target
));
1463 /* Now canonicalize by removing /. and /foo/.. if they appear */
1471 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1477 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1478 /* brackets are offset from each other by 2 */
1481 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1482 /* convert [foo][bar] to [bar] */
1483 while (o
[-1] != '[' && o
[-1] != '<')
1485 else if (*p
== '-' && *o
!= '.')
1488 else if (p
[0] == '-' && o
[-1] == '.' &&
1489 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1490 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1494 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1495 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1497 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1499 /* else [foo.-] ==> [-] */
1505 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1506 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1516 else if (!strncmp (p
, "//", 2)
1518 /* // at start of filename is meaningful in Apollo system */
1526 else if (p
[0] == '/' && p
[1] == '.' &&
1527 (p
[2] == '/' || p
[2] == 0))
1529 else if (!strncmp (p
, "/..", 3)
1530 /* `/../' is the "superroot" on certain file systems. */
1532 && (p
[3] == '/' || p
[3] == 0))
1534 while (o
!= target
&& *--o
!= '/')
1537 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1541 if (o
== target
&& *o
== '/')
1549 #endif /* not VMS */
1552 return make_string (target
, o
- target
);
1556 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1557 Ssubstitute_in_file_name
, 1, 1, 0,
1558 "Substitute environment variables referred to in FILENAME.\n\
1559 `$FOO' where FOO is an environment variable name means to substitute\n\
1560 the value of that variable. The variable name should be terminated\n\
1561 with a character not a letter, digit or underscore; otherwise, enclose\n\
1562 the entire variable name in braces.\n\
1563 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1564 On VMS, `$' substitution is not done; this function does little and only\n\
1565 duplicates what `expand-file-name' does.")
1567 Lisp_Object filename
;
1571 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1572 unsigned char *target
;
1574 int substituted
= 0;
1576 Lisp_Object handler
;
1578 CHECK_STRING (filename
, 0);
1580 /* If the file name has special constructs in it,
1581 call the corresponding file handler. */
1582 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1583 if (!NILP (handler
))
1584 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1586 nm
= XSTRING (filename
)->data
;
1588 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1589 substituted
= !strcmp (nm
, XSTRING (filename
)->data
);
1591 endp
= nm
+ XSTRING (filename
)->size
;
1593 /* If /~ or // appears, discard everything through first slash. */
1595 for (p
= nm
; p
!= endp
; p
++)
1599 /* // at start of file name is meaningful in Apollo system */
1600 (p
[0] == '/' && p
- 1 != nm
)
1601 #else /* not APOLLO */
1603 (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1604 #else /* not WINDOWSNT */
1606 #endif /* not WINDOWSNT */
1607 #endif /* not APOLLO */
1612 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1614 || IS_DIRECTORY_SEP (p
[-1])))
1620 if (p
[0] && p
[1] == ':')
1629 return build_string (nm
);
1632 /* See if any variables are substituted into the string
1633 and find the total length of their values in `total' */
1635 for (p
= nm
; p
!= endp
;)
1645 /* "$$" means a single "$" */
1654 while (p
!= endp
&& *p
!= '}') p
++;
1655 if (*p
!= '}') goto missingclose
;
1661 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1665 /* Copy out the variable name */
1666 target
= (unsigned char *) alloca (s
- o
+ 1);
1667 strncpy (target
, o
, s
- o
);
1670 strupr (target
); /* $home == $HOME etc. */
1673 /* Get variable value */
1674 o
= (unsigned char *) egetenv (target
);
1675 if (!o
) goto badvar
;
1676 total
+= strlen (o
);
1683 /* If substitution required, recopy the string and do it */
1684 /* Make space in stack frame for the new copy */
1685 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1688 /* Copy the rest of the name through, replacing $ constructs with values */
1705 while (p
!= endp
&& *p
!= '}') p
++;
1706 if (*p
!= '}') goto missingclose
;
1712 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1716 /* Copy out the variable name */
1717 target
= (unsigned char *) alloca (s
- o
+ 1);
1718 strncpy (target
, o
, s
- o
);
1721 strupr (target
); /* $home == $HOME etc. */
1724 /* Get variable value */
1725 o
= (unsigned char *) egetenv (target
);
1735 /* If /~ or // appears, discard everything through first slash. */
1737 for (p
= xnm
; p
!= x
; p
++)
1740 /* // at start of file name is meaningful in Apollo system */
1741 || (p
[0] == '/' && p
- 1 != xnm
)
1742 #else /* not APOLLO */
1744 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1745 #else /* not WINDOWSNT */
1747 #endif /* not WINDOWSNT */
1748 #endif /* not APOLLO */
1750 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1753 else if (p
[0] && p
[1] == ':')
1757 return make_string (xnm
, x
- xnm
);
1760 error ("Bad format environment-variable substitution");
1762 error ("Missing \"}\" in environment-variable substitution");
1764 error ("Substituting nonexistent environment variable \"%s\"", target
);
1767 #endif /* not VMS */
1770 /* A slightly faster and more convenient way to get
1771 (directory-file-name (expand-file-name FOO)). */
1774 expand_and_dir_to_file (filename
, defdir
)
1775 Lisp_Object filename
, defdir
;
1777 register Lisp_Object abspath
;
1779 abspath
= Fexpand_file_name (filename
, defdir
);
1782 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1783 if (c
== ':' || c
== ']' || c
== '>')
1784 abspath
= Fdirectory_file_name (abspath
);
1787 /* Remove final slash, if any (unless path is root).
1788 stat behaves differently depending! */
1789 if (XSTRING (abspath
)->size
> 1
1790 && IS_DIRECTORY_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1])
1791 && !IS_DEVICE_SEP (XSTRING (abspath
)->data
[XSTRING (abspath
)->size
-2]))
1792 /* We cannot take shortcuts; they might be wrong for magic file names. */
1793 abspath
= Fdirectory_file_name (abspath
);
1798 /* Signal an error if the file ABSNAME already exists.
1799 If INTERACTIVE is nonzero, ask the user whether to proceed,
1800 and bypass the error if the user says to go ahead.
1801 QUERYSTRING is a name for the action that is being considered
1803 *STATPTR is used to store the stat information if the file exists.
1804 If the file does not exist, STATPTR->st_mode is set to 0. */
1807 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1808 Lisp_Object absname
;
1809 unsigned char *querystring
;
1811 struct stat
*statptr
;
1813 register Lisp_Object tem
;
1814 struct stat statbuf
;
1815 struct gcpro gcpro1
;
1817 /* stat is a good way to tell whether the file exists,
1818 regardless of what access permissions it has. */
1819 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1822 Fsignal (Qfile_already_exists
,
1823 Fcons (build_string ("File already exists"),
1824 Fcons (absname
, Qnil
)));
1826 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1827 XSTRING (absname
)->data
, querystring
));
1830 Fsignal (Qfile_already_exists
,
1831 Fcons (build_string ("File already exists"),
1832 Fcons (absname
, Qnil
)));
1839 statptr
->st_mode
= 0;
1844 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1845 "fCopy file: \nFCopy %s to file: \np\nP",
1846 "Copy FILE to NEWNAME. Both args must be strings.\n\
1847 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1848 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1849 A number as third arg means request confirmation if NEWNAME already exists.\n\
1850 This is what happens in interactive use with M-x.\n\
1851 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1852 last-modified time as the old one. (This works on only some systems.)\n\
1853 A prefix arg makes KEEP-TIME non-nil.")
1854 (file
, newname
, ok_if_already_exists
, keep_date
)
1855 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
1858 char buf
[16 * 1024];
1859 struct stat st
, out_st
;
1860 Lisp_Object handler
;
1861 struct gcpro gcpro1
, gcpro2
;
1862 int count
= specpdl_ptr
- specpdl
;
1863 int input_file_statable_p
;
1865 GCPRO2 (file
, newname
);
1866 CHECK_STRING (file
, 0);
1867 CHECK_STRING (newname
, 1);
1868 file
= Fexpand_file_name (file
, Qnil
);
1869 newname
= Fexpand_file_name (newname
, Qnil
);
1871 /* If the input file name has special constructs in it,
1872 call the corresponding file handler. */
1873 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
1874 /* Likewise for output file name. */
1876 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1877 if (!NILP (handler
))
1878 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
1879 ok_if_already_exists
, keep_date
));
1881 if (NILP (ok_if_already_exists
)
1882 || INTEGERP (ok_if_already_exists
))
1883 barf_or_query_if_file_exists (newname
, "copy to it",
1884 INTEGERP (ok_if_already_exists
), &out_st
);
1885 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
1888 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
1890 report_file_error ("Opening input file", Fcons (file
, Qnil
));
1892 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1894 /* We can only copy regular files and symbolic links. Other files are not
1896 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1899 if (out_st
.st_mode
!= 0
1900 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
1903 report_file_error ("Input and output files are the same",
1904 Fcons (file
, Fcons (newname
, Qnil
)));
1908 #if defined (S_ISREG) && defined (S_ISLNK)
1909 if (input_file_statable_p
)
1911 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1913 #if defined (EISDIR)
1914 /* Get a better looking error message. */
1917 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
1920 #endif /* S_ISREG && S_ISLNK */
1923 /* Create the copy file with the same record format as the input file */
1924 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1927 /* System's default file type was set to binary by _fmode in emacs.c. */
1928 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1929 #else /* not MSDOS */
1930 ofd
= creat (XSTRING (newname
)->data
, 0666);
1931 #endif /* not MSDOS */
1934 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1936 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1940 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1941 if (write (ofd
, buf
, n
) != n
)
1942 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1945 /* Closing the output clobbers the file times on some systems. */
1946 if (close (ofd
) < 0)
1947 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1949 if (input_file_statable_p
)
1951 if (!NILP (keep_date
))
1953 EMACS_TIME atime
, mtime
;
1954 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1955 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1956 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
1957 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1960 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1962 #if defined (__DJGPP__) && __DJGPP__ > 1
1963 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
1964 and if it can't, it tells so. Otherwise, under MSDOS we usually
1965 get only the READ bit, which will make the copied file read-only,
1966 so it's better not to chmod at all. */
1967 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
1968 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1969 #endif /* DJGPP version 2 or newer */
1975 /* Discard the unwind protects. */
1976 specpdl_ptr
= specpdl
+ count
;
1982 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1983 Smake_directory_internal
, 1, 1, 0,
1984 "Create a new directory named DIRECTORY.")
1986 Lisp_Object directory
;
1989 Lisp_Object handler
;
1991 CHECK_STRING (directory
, 0);
1992 directory
= Fexpand_file_name (directory
, Qnil
);
1994 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
1995 if (!NILP (handler
))
1996 return call2 (handler
, Qmake_directory_internal
, directory
);
1998 dir
= XSTRING (directory
)->data
;
2001 if (mkdir (dir
) != 0)
2003 if (mkdir (dir
, 0777) != 0)
2005 report_file_error ("Creating directory", Flist (1, &directory
));
2010 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2011 "Delete the directory named DIRECTORY.")
2013 Lisp_Object directory
;
2016 Lisp_Object handler
;
2018 CHECK_STRING (directory
, 0);
2019 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2020 dir
= XSTRING (directory
)->data
;
2022 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2023 if (!NILP (handler
))
2024 return call2 (handler
, Qdelete_directory
, directory
);
2026 if (rmdir (dir
) != 0)
2027 report_file_error ("Removing directory", Flist (1, &directory
));
2032 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2033 "Delete file named FILENAME.\n\
2034 If file has multiple names, it continues to exist with the other names.")
2036 Lisp_Object filename
;
2038 Lisp_Object handler
;
2039 CHECK_STRING (filename
, 0);
2040 filename
= Fexpand_file_name (filename
, Qnil
);
2042 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2043 if (!NILP (handler
))
2044 return call2 (handler
, Qdelete_file
, filename
);
2046 if (0 > unlink (XSTRING (filename
)->data
))
2047 report_file_error ("Removing old name", Flist (1, &filename
));
2052 internal_delete_file_1 (ignore
)
2058 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2061 internal_delete_file (filename
)
2062 Lisp_Object filename
;
2064 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2065 Qt
, internal_delete_file_1
));
2068 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2069 "fRename file: \nFRename %s to file: \np",
2070 "Rename FILE as NEWNAME. Both args strings.\n\
2071 If file has names other than FILE, it continues to have those names.\n\
2072 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2073 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2074 A number as third arg means request confirmation if NEWNAME already exists.\n\
2075 This is what happens in interactive use with M-x.")
2076 (file
, newname
, ok_if_already_exists
)
2077 Lisp_Object file
, newname
, ok_if_already_exists
;
2080 Lisp_Object args
[2];
2082 Lisp_Object handler
;
2083 struct gcpro gcpro1
, gcpro2
;
2085 GCPRO2 (file
, newname
);
2086 CHECK_STRING (file
, 0);
2087 CHECK_STRING (newname
, 1);
2088 file
= Fexpand_file_name (file
, Qnil
);
2089 newname
= Fexpand_file_name (newname
, Qnil
);
2091 /* If the file name has special constructs in it,
2092 call the corresponding file handler. */
2093 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2095 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2096 if (!NILP (handler
))
2097 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2098 file
, newname
, ok_if_already_exists
));
2100 if (NILP (ok_if_already_exists
)
2101 || INTEGERP (ok_if_already_exists
))
2102 barf_or_query_if_file_exists (newname
, "rename to it",
2103 INTEGERP (ok_if_already_exists
), 0);
2105 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2108 if (!MoveFile (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2109 #else /* not WINDOWSNT */
2110 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2111 || 0 > unlink (XSTRING (file
)->data
))
2112 #endif /* not WINDOWSNT */
2116 /* Why two? And why doesn't MS document what MoveFile will return? */
2117 if (GetLastError () == ERROR_FILE_EXISTS
2118 || GetLastError () == ERROR_ALREADY_EXISTS
)
2119 #else /* not WINDOWSNT */
2121 #endif /* not WINDOWSNT */
2123 Fcopy_file (file
, newname
,
2124 /* We have already prompted if it was an integer,
2125 so don't have copy-file prompt again. */
2126 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2127 Fdelete_file (file
);
2134 report_file_error ("Renaming", Flist (2, args
));
2137 report_file_error ("Renaming", Flist (2, &file
));
2144 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2145 "fAdd name to file: \nFName to add to %s: \np",
2146 "Give FILE additional name NEWNAME. Both args strings.\n\
2147 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2148 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2149 A number as third arg means request confirmation if NEWNAME already exists.\n\
2150 This is what happens in interactive use with M-x.")
2151 (file
, newname
, ok_if_already_exists
)
2152 Lisp_Object file
, newname
, ok_if_already_exists
;
2155 Lisp_Object args
[2];
2157 Lisp_Object handler
;
2158 struct gcpro gcpro1
, gcpro2
;
2160 GCPRO2 (file
, newname
);
2161 CHECK_STRING (file
, 0);
2162 CHECK_STRING (newname
, 1);
2163 file
= Fexpand_file_name (file
, Qnil
);
2164 newname
= Fexpand_file_name (newname
, Qnil
);
2166 /* If the file name has special constructs in it,
2167 call the corresponding file handler. */
2168 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2169 if (!NILP (handler
))
2170 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2171 newname
, ok_if_already_exists
));
2173 /* If the new name has special constructs in it,
2174 call the corresponding file handler. */
2175 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2176 if (!NILP (handler
))
2177 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2178 newname
, ok_if_already_exists
));
2180 if (NILP (ok_if_already_exists
)
2181 || INTEGERP (ok_if_already_exists
))
2182 barf_or_query_if_file_exists (newname
, "make it a new name",
2183 INTEGERP (ok_if_already_exists
), 0);
2185 /* Windows does not support this operation. */
2186 report_file_error ("Adding new name", Flist (2, &file
));
2187 #else /* not WINDOWSNT */
2189 unlink (XSTRING (newname
)->data
);
2190 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2195 report_file_error ("Adding new name", Flist (2, args
));
2197 report_file_error ("Adding new name", Flist (2, &file
));
2200 #endif /* not WINDOWSNT */
2207 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2208 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2209 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2210 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2211 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2212 A number as third arg means request confirmation if LINKNAME already exists.\n\
2213 This happens for interactive use with M-x.")
2214 (filename
, linkname
, ok_if_already_exists
)
2215 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2218 Lisp_Object args
[2];
2220 Lisp_Object handler
;
2221 struct gcpro gcpro1
, gcpro2
;
2223 GCPRO2 (filename
, linkname
);
2224 CHECK_STRING (filename
, 0);
2225 CHECK_STRING (linkname
, 1);
2226 /* If the link target has a ~, we must expand it to get
2227 a truly valid file name. Otherwise, do not expand;
2228 we want to permit links to relative file names. */
2229 if (XSTRING (filename
)->data
[0] == '~')
2230 filename
= Fexpand_file_name (filename
, Qnil
);
2231 linkname
= Fexpand_file_name (linkname
, Qnil
);
2233 /* If the file name has special constructs in it,
2234 call the corresponding file handler. */
2235 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2236 if (!NILP (handler
))
2237 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2238 linkname
, ok_if_already_exists
));
2240 /* If the new link name has special constructs in it,
2241 call the corresponding file handler. */
2242 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2243 if (!NILP (handler
))
2244 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2245 linkname
, ok_if_already_exists
));
2247 if (NILP (ok_if_already_exists
)
2248 || INTEGERP (ok_if_already_exists
))
2249 barf_or_query_if_file_exists (linkname
, "make it a link",
2250 INTEGERP (ok_if_already_exists
), 0);
2251 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2253 /* If we didn't complain already, silently delete existing file. */
2254 if (errno
== EEXIST
)
2256 unlink (XSTRING (linkname
)->data
);
2257 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2267 report_file_error ("Making symbolic link", Flist (2, args
));
2269 report_file_error ("Making symbolic link", Flist (2, &filename
));
2275 #endif /* S_IFLNK */
2279 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2280 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2281 "Define the job-wide logical name NAME to have the value STRING.\n\
2282 If STRING is nil or a null string, the logical name NAME is deleted.")
2287 CHECK_STRING (name
, 0);
2289 delete_logical_name (XSTRING (name
)->data
);
2292 CHECK_STRING (string
, 1);
2294 if (XSTRING (string
)->size
== 0)
2295 delete_logical_name (XSTRING (name
)->data
);
2297 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2306 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2307 "Open a network connection to PATH using LOGIN as the login string.")
2309 Lisp_Object path
, login
;
2313 CHECK_STRING (path
, 0);
2314 CHECK_STRING (login
, 0);
2316 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2318 if (netresult
== -1)
2323 #endif /* HPUX_NET */
2325 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2327 "Return t if file FILENAME specifies an absolute path name.\n\
2328 On Unix, this is a name starting with a `/' or a `~'.")
2330 Lisp_Object filename
;
2334 CHECK_STRING (filename
, 0);
2335 ptr
= XSTRING (filename
)->data
;
2336 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2338 /* ??? This criterion is probably wrong for '<'. */
2339 || index (ptr
, ':') || index (ptr
, '<')
2340 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2344 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2352 /* Return nonzero if file FILENAME exists and can be executed. */
2355 check_executable (filename
)
2359 int len
= strlen (filename
);
2362 if (stat (filename
, &st
) < 0)
2364 return (S_ISREG (st
.st_mode
)
2366 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2367 || stricmp (suffix
, ".exe") == 0
2368 || stricmp (suffix
, ".bat") == 0)
2369 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2370 #else /* not DOS_NT */
2372 return (eaccess (filename
, 1) >= 0);
2374 /* Access isn't quite right because it uses the real uid
2375 and we really want to test with the effective uid.
2376 But Unix doesn't give us a right way to do it. */
2377 return (access (filename
, 1) >= 0);
2379 #endif /* not DOS_NT */
2382 /* Return nonzero if file FILENAME exists and can be written. */
2385 check_writable (filename
)
2390 if (stat (filename
, &st
) < 0)
2392 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2393 #else /* not MSDOS */
2395 return (eaccess (filename
, 2) >= 0);
2397 /* Access isn't quite right because it uses the real uid
2398 and we really want to test with the effective uid.
2399 But Unix doesn't give us a right way to do it.
2400 Opening with O_WRONLY could work for an ordinary file,
2401 but would lose for directories. */
2402 return (access (filename
, 2) >= 0);
2404 #endif /* not MSDOS */
2407 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2408 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2409 See also `file-readable-p' and `file-attributes'.")
2411 Lisp_Object filename
;
2413 Lisp_Object abspath
;
2414 Lisp_Object handler
;
2415 struct stat statbuf
;
2417 CHECK_STRING (filename
, 0);
2418 abspath
= Fexpand_file_name (filename
, Qnil
);
2420 /* If the file name has special constructs in it,
2421 call the corresponding file handler. */
2422 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2423 if (!NILP (handler
))
2424 return call2 (handler
, Qfile_exists_p
, abspath
);
2426 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2429 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2430 "Return t if FILENAME can be executed by you.\n\
2431 For a directory, this means you can access files in that directory.")
2433 Lisp_Object filename
;
2436 Lisp_Object abspath
;
2437 Lisp_Object handler
;
2439 CHECK_STRING (filename
, 0);
2440 abspath
= Fexpand_file_name (filename
, Qnil
);
2442 /* If the file name has special constructs in it,
2443 call the corresponding file handler. */
2444 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2445 if (!NILP (handler
))
2446 return call2 (handler
, Qfile_executable_p
, abspath
);
2448 return (check_executable (XSTRING (abspath
)->data
) ? Qt
: Qnil
);
2451 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2452 "Return t if file FILENAME exists and you can read it.\n\
2453 See also `file-exists-p' and `file-attributes'.")
2455 Lisp_Object filename
;
2457 Lisp_Object abspath
;
2458 Lisp_Object handler
;
2461 CHECK_STRING (filename
, 0);
2462 abspath
= Fexpand_file_name (filename
, Qnil
);
2464 /* If the file name has special constructs in it,
2465 call the corresponding file handler. */
2466 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2467 if (!NILP (handler
))
2468 return call2 (handler
, Qfile_readable_p
, abspath
);
2471 /* Under MS-DOS, open does not work't right, because it doesn't work for
2472 directories (MS-DOS won't let you open a directory). */
2473 if (access (XSTRING (abspath
)->data
, 0) == 0)
2476 #else /* not MSDOS */
2477 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2482 #endif /* not MSDOS */
2485 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2487 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2488 "Return t if file FILENAME can be written or created by you.")
2490 Lisp_Object filename
;
2492 Lisp_Object abspath
, dir
;
2493 Lisp_Object handler
;
2494 struct stat statbuf
;
2496 CHECK_STRING (filename
, 0);
2497 abspath
= Fexpand_file_name (filename
, Qnil
);
2499 /* If the file name has special constructs in it,
2500 call the corresponding file handler. */
2501 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2502 if (!NILP (handler
))
2503 return call2 (handler
, Qfile_writable_p
, abspath
);
2505 if (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0)
2506 return (check_writable (XSTRING (abspath
)->data
)
2508 dir
= Ffile_name_directory (abspath
);
2511 dir
= Fdirectory_file_name (dir
);
2515 dir
= Fdirectory_file_name (dir
);
2517 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2521 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2522 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2523 The value is the name of the file to which it is linked.\n\
2524 Otherwise returns nil.")
2526 Lisp_Object filename
;
2533 Lisp_Object handler
;
2535 CHECK_STRING (filename
, 0);
2536 filename
= Fexpand_file_name (filename
, Qnil
);
2538 /* If the file name has special constructs in it,
2539 call the corresponding file handler. */
2540 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2541 if (!NILP (handler
))
2542 return call2 (handler
, Qfile_symlink_p
, filename
);
2547 buf
= (char *) xmalloc (bufsize
);
2548 bzero (buf
, bufsize
);
2549 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2550 if (valsize
< bufsize
) break;
2551 /* Buffer was not long enough */
2560 val
= make_string (buf
, valsize
);
2563 #else /* not S_IFLNK */
2565 #endif /* not S_IFLNK */
2568 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2569 "Return t if file FILENAME is the name of a directory as a file.\n\
2570 A directory name spec may be given instead; then the value is t\n\
2571 if the directory so specified exists and really is a directory.")
2573 Lisp_Object filename
;
2575 register Lisp_Object abspath
;
2577 Lisp_Object handler
;
2579 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2581 /* If the file name has special constructs in it,
2582 call the corresponding file handler. */
2583 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2584 if (!NILP (handler
))
2585 return call2 (handler
, Qfile_directory_p
, abspath
);
2587 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2589 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2592 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2593 "Return t if file FILENAME is the name of a directory as a file,\n\
2594 and files in that directory can be opened by you. In order to use a\n\
2595 directory as a buffer's current directory, this predicate must return true.\n\
2596 A directory name spec may be given instead; then the value is t\n\
2597 if the directory so specified exists and really is a readable and\n\
2598 searchable directory.")
2600 Lisp_Object filename
;
2602 Lisp_Object handler
;
2604 struct gcpro gcpro1
;
2606 /* If the file name has special constructs in it,
2607 call the corresponding file handler. */
2608 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2609 if (!NILP (handler
))
2610 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2612 /* It's an unlikely combination, but yes we really do need to gcpro:
2613 Suppose that file-accessible-directory-p has no handler, but
2614 file-directory-p does have a handler; this handler causes a GC which
2615 relocates the string in `filename'; and finally file-directory-p
2616 returns non-nil. Then we would end up passing a garbaged string
2617 to file-executable-p. */
2619 tem
= (NILP (Ffile_directory_p (filename
))
2620 || NILP (Ffile_executable_p (filename
)));
2622 return tem
? Qnil
: Qt
;
2625 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2626 "Return t if file FILENAME is the name of a regular file.\n\
2627 This is the sort of file that holds an ordinary stream of data bytes.")
2629 Lisp_Object filename
;
2631 register Lisp_Object abspath
;
2633 Lisp_Object handler
;
2635 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2637 /* If the file name has special constructs in it,
2638 call the corresponding file handler. */
2639 handler
= Ffind_file_name_handler (abspath
, Qfile_regular_p
);
2640 if (!NILP (handler
))
2641 return call2 (handler
, Qfile_regular_p
, abspath
);
2643 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2645 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2648 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2649 "Return mode bits of file named FILENAME, as an integer.")
2651 Lisp_Object filename
;
2653 Lisp_Object abspath
;
2655 Lisp_Object handler
;
2657 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2659 /* If the file name has special constructs in it,
2660 call the corresponding file handler. */
2661 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2662 if (!NILP (handler
))
2663 return call2 (handler
, Qfile_modes
, abspath
);
2665 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2668 if (check_executable (XSTRING (abspath
)->data
))
2669 st
.st_mode
|= S_IEXEC
;
2672 return make_number (st
.st_mode
& 07777);
2675 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2676 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2677 Only the 12 low bits of MODE are used.")
2679 Lisp_Object filename
, mode
;
2681 Lisp_Object abspath
;
2682 Lisp_Object handler
;
2684 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2685 CHECK_NUMBER (mode
, 1);
2687 /* If the file name has special constructs in it,
2688 call the corresponding file handler. */
2689 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2690 if (!NILP (handler
))
2691 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2693 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2694 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2699 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2700 "Set the file permission bits for newly created files.\n\
2701 The argument MODE should be an integer; only the low 9 bits are used.\n\
2702 This setting is inherited by subprocesses.")
2706 CHECK_NUMBER (mode
, 0);
2708 umask ((~ XINT (mode
)) & 0777);
2713 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2714 "Return the default file protection for created files.\n\
2715 The value is an integer.")
2721 realmask
= umask (0);
2724 XSETINT (value
, (~ realmask
) & 0777);
2730 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2731 "Tell Unix to finish all pending disk updates.")
2740 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2741 "Return t if file FILE1 is newer than file FILE2.\n\
2742 If FILE1 does not exist, the answer is nil;\n\
2743 otherwise, if FILE2 does not exist, the answer is t.")
2745 Lisp_Object file1
, file2
;
2747 Lisp_Object abspath1
, abspath2
;
2750 Lisp_Object handler
;
2751 struct gcpro gcpro1
, gcpro2
;
2753 CHECK_STRING (file1
, 0);
2754 CHECK_STRING (file2
, 0);
2757 GCPRO2 (abspath1
, file2
);
2758 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2759 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2762 /* If the file name has special constructs in it,
2763 call the corresponding file handler. */
2764 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2766 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2767 if (!NILP (handler
))
2768 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2770 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2773 mtime1
= st
.st_mtime
;
2775 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2778 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2782 Lisp_Object Qfind_buffer_file_type
;
2785 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2787 "Insert contents of file FILENAME after point.\n\
2788 Returns list of absolute file name and length of data inserted.\n\
2789 If second argument VISIT is non-nil, the buffer's visited filename\n\
2790 and last save file modtime are set, and it is marked unmodified.\n\
2791 If visiting and the file does not exist, visiting is completed\n\
2792 before the error is signaled.\n\n\
2793 The optional third and fourth arguments BEG and END\n\
2794 specify what portion of the file to insert.\n\
2795 If VISIT is non-nil, BEG and END must be nil.\n\
2796 If optional fifth argument REPLACE is non-nil,\n\
2797 it means replace the current buffer contents (in the accessible portion)\n\
2798 with the file contents. This is better than simply deleting and inserting\n\
2799 the whole thing because (1) it preserves some marker positions\n\
2800 and (2) it puts less data in the undo list.")
2801 (filename
, visit
, beg
, end
, replace
)
2802 Lisp_Object filename
, visit
, beg
, end
, replace
;
2806 register int inserted
= 0;
2807 register int how_much
;
2808 int count
= specpdl_ptr
- specpdl
;
2809 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2810 Lisp_Object handler
, val
, insval
;
2813 int not_regular
= 0;
2815 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2816 error ("Cannot do file visiting in an indirect buffer");
2818 if (!NILP (current_buffer
->read_only
))
2819 Fbarf_if_buffer_read_only ();
2824 GCPRO3 (filename
, val
, p
);
2826 CHECK_STRING (filename
, 0);
2827 filename
= Fexpand_file_name (filename
, Qnil
);
2829 /* If the file name has special constructs in it,
2830 call the corresponding file handler. */
2831 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2832 if (!NILP (handler
))
2834 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2835 visit
, beg
, end
, replace
);
2842 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2844 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2845 || fstat (fd
, &st
) < 0)
2846 #endif /* not APOLLO */
2848 if (fd
>= 0) close (fd
);
2851 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2858 /* This code will need to be changed in order to work on named
2859 pipes, and it's probably just not worth it. So we should at
2860 least signal an error. */
2861 if (!S_ISREG (st
.st_mode
))
2864 Fsignal (Qfile_error
,
2865 Fcons (build_string ("not a regular file"),
2866 Fcons (filename
, Qnil
)));
2874 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2877 /* Replacement should preserve point as it preserves markers. */
2878 if (!NILP (replace
))
2879 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2881 record_unwind_protect (close_file_unwind
, make_number (fd
));
2883 /* Supposedly happens on VMS. */
2885 error ("File size is negative");
2887 if (!NILP (beg
) || !NILP (end
))
2889 error ("Attempt to visit less than an entire file");
2892 CHECK_NUMBER (beg
, 0);
2894 XSETFASTINT (beg
, 0);
2897 CHECK_NUMBER (end
, 0);
2900 XSETINT (end
, st
.st_size
);
2901 if (XINT (end
) != st
.st_size
)
2902 error ("maximum buffer size exceeded");
2905 /* If requested, replace the accessible part of the buffer
2906 with the file contents. Avoid replacing text at the
2907 beginning or end of the buffer that matches the file contents;
2908 that preserves markers pointing to the unchanged parts. */
2910 /* On MSDOS, replace mode doesn't really work, except for binary files,
2911 and it's not worth supporting just for them. */
2912 if (!NILP (replace
))
2915 XSETFASTINT (beg
, 0);
2916 XSETFASTINT (end
, st
.st_size
);
2917 del_range_1 (BEGV
, ZV
, 0);
2919 #else /* not DOS_NT */
2920 if (!NILP (replace
))
2922 unsigned char buffer
[1 << 14];
2923 int same_at_start
= BEGV
;
2924 int same_at_end
= ZV
;
2929 /* Count how many chars at the start of the file
2930 match the text at the beginning of the buffer. */
2935 nread
= read (fd
, buffer
, sizeof buffer
);
2937 error ("IO error reading %s: %s",
2938 XSTRING (filename
)->data
, strerror (errno
));
2939 else if (nread
== 0)
2942 while (bufpos
< nread
&& same_at_start
< ZV
2943 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2944 same_at_start
++, bufpos
++;
2945 /* If we found a discrepancy, stop the scan.
2946 Otherwise loop around and scan the next bufferful. */
2947 if (bufpos
!= nread
)
2951 /* If the file matches the buffer completely,
2952 there's no need to replace anything. */
2953 if (same_at_start
- BEGV
== st
.st_size
)
2957 /* Truncate the buffer to the size of the file. */
2958 del_range_1 (same_at_start
, same_at_end
, 0);
2963 /* Count how many chars at the end of the file
2964 match the text at the end of the buffer. */
2967 int total_read
, nread
, bufpos
, curpos
, trial
;
2969 /* At what file position are we now scanning? */
2970 curpos
= st
.st_size
- (ZV
- same_at_end
);
2971 /* If the entire file matches the buffer tail, stop the scan. */
2974 /* How much can we scan in the next step? */
2975 trial
= min (curpos
, sizeof buffer
);
2976 if (lseek (fd
, curpos
- trial
, 0) < 0)
2977 report_file_error ("Setting file position",
2978 Fcons (filename
, Qnil
));
2981 while (total_read
< trial
)
2983 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2985 error ("IO error reading %s: %s",
2986 XSTRING (filename
)->data
, strerror (errno
));
2987 total_read
+= nread
;
2989 /* Scan this bufferful from the end, comparing with
2990 the Emacs buffer. */
2991 bufpos
= total_read
;
2992 /* Compare with same_at_start to avoid counting some buffer text
2993 as matching both at the file's beginning and at the end. */
2994 while (bufpos
> 0 && same_at_end
> same_at_start
2995 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2996 same_at_end
--, bufpos
--;
2997 /* If we found a discrepancy, stop the scan.
2998 Otherwise loop around and scan the preceding bufferful. */
3001 /* If display current starts at beginning of line,
3002 keep it that way. */
3003 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3004 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3008 /* Don't try to reuse the same piece of text twice. */
3009 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3011 same_at_end
+= overlap
;
3013 /* Arrange to read only the nonmatching middle part of the file. */
3014 XSETFASTINT (beg
, same_at_start
- BEGV
);
3015 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3017 del_range_1 (same_at_start
, same_at_end
, 0);
3018 /* Insert from the file at the proper position. */
3019 SET_PT (same_at_start
);
3021 #endif /* not DOS_NT */
3023 total
= XINT (end
) - XINT (beg
);
3026 register Lisp_Object temp
;
3028 /* Make sure point-max won't overflow after this insertion. */
3029 XSETINT (temp
, total
);
3030 if (total
!= XINT (temp
))
3031 error ("maximum buffer size exceeded");
3034 if (NILP (visit
) && total
> 0)
3035 prepare_to_modify_buffer (point
, point
);
3038 if (GAP_SIZE
< total
)
3039 make_gap (total
- GAP_SIZE
);
3041 if (XINT (beg
) != 0 || !NILP (replace
))
3043 if (lseek (fd
, XINT (beg
), 0) < 0)
3044 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3048 while (inserted
< total
)
3050 /* try is reserved in some compilers (Microsoft C) */
3051 int trytry
= min (total
- inserted
, 64 << 10);
3054 /* Allow quitting out of the actual I/O. */
3057 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3074 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3075 /* Determine file type from name and remove LFs from CR-LFs if the file
3076 is deemed to be a text file. */
3078 current_buffer
->buffer_file_type
3079 = call1 (Qfind_buffer_file_type
, filename
);
3080 if (NILP (current_buffer
->buffer_file_type
))
3083 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3086 GPT
-= reduced_size
;
3087 GAP_SIZE
+= reduced_size
;
3088 inserted
-= reduced_size
;
3095 record_insert (point
, inserted
);
3097 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3098 offset_intervals (current_buffer
, point
, inserted
);
3104 /* Discard the unwind protect for closing the file. */
3108 error ("IO error reading %s: %s",
3109 XSTRING (filename
)->data
, strerror (errno
));
3116 if (!EQ (current_buffer
->undo_list
, Qt
))
3117 current_buffer
->undo_list
= Qnil
;
3119 stat (XSTRING (filename
)->data
, &st
);
3124 current_buffer
->modtime
= st
.st_mtime
;
3125 current_buffer
->filename
= filename
;
3128 SAVE_MODIFF
= MODIFF
;
3129 current_buffer
->auto_save_modified
= MODIFF
;
3130 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3131 #ifdef CLASH_DETECTION
3134 if (!NILP (current_buffer
->file_truename
))
3135 unlock_file (current_buffer
->file_truename
);
3136 unlock_file (filename
);
3138 #endif /* CLASH_DETECTION */
3140 Fsignal (Qfile_error
,
3141 Fcons (build_string ("not a regular file"),
3142 Fcons (filename
, Qnil
)));
3144 /* If visiting nonexistent file, return nil. */
3145 if (current_buffer
->modtime
== -1)
3146 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3149 /* Decode file format */
3152 insval
= call3 (Qformat_decode
,
3153 Qnil
, make_number (inserted
), visit
);
3154 CHECK_NUMBER (insval
, 0);
3155 inserted
= XFASTINT (insval
);
3158 if (inserted
> 0 && NILP (visit
) && total
> 0)
3159 signal_after_change (point
, 0, inserted
);
3163 p
= Vafter_insert_file_functions
;
3166 insval
= call1 (Fcar (p
), make_number (inserted
));
3169 CHECK_NUMBER (insval
, 0);
3170 inserted
= XFASTINT (insval
);
3178 val
= Fcons (filename
,
3179 Fcons (make_number (inserted
),
3182 RETURN_UNGCPRO (unbind_to (count
, val
));
3185 static Lisp_Object
build_annotations ();
3187 /* If build_annotations switched buffers, switch back to BUF.
3188 Kill the temporary buffer that was selected in the meantime. */
3191 build_annotations_unwind (buf
)
3196 if (XBUFFER (buf
) == current_buffer
)
3198 tembuf
= Fcurrent_buffer ();
3200 Fkill_buffer (tembuf
);
3204 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3205 "r\nFWrite region to file: ",
3206 "Write current region into specified file.\n\
3207 When called from a program, takes three arguments:\n\
3208 START, END and FILENAME. START and END are buffer positions.\n\
3209 Optional fourth argument APPEND if non-nil means\n\
3210 append to existing file contents (if any).\n\
3211 Optional fifth argument VISIT if t means\n\
3212 set the last-save-file-modtime of buffer to this file's modtime\n\
3213 and mark buffer not modified.\n\
3214 If VISIT is a string, it is a second file name;\n\
3215 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3216 VISIT is also the file name to lock and unlock for clash detection.\n\
3217 If VISIT is neither t nor nil nor a string,\n\
3218 that means do not print the \"Wrote file\" message.\n\
3219 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3220 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3221 Kludgy feature: if START is a string, then that string is written\n\
3222 to the file, instead of any buffer contents, and END is ignored.")
3223 (start
, end
, filename
, append
, visit
, lockname
)
3224 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3232 int count
= specpdl_ptr
- specpdl
;
3235 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3237 Lisp_Object handler
;
3238 Lisp_Object visit_file
;
3239 Lisp_Object annotations
;
3240 int visiting
, quietly
;
3241 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3242 struct buffer
*given_buffer
;
3244 int buffer_file_type
3245 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3248 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3249 error ("Cannot do file visiting in an indirect buffer");
3251 if (!NILP (start
) && !STRINGP (start
))
3252 validate_region (&start
, &end
);
3254 GCPRO3 (filename
, visit
, lockname
);
3255 filename
= Fexpand_file_name (filename
, Qnil
);
3256 if (STRINGP (visit
))
3257 visit_file
= Fexpand_file_name (visit
, Qnil
);
3259 visit_file
= filename
;
3262 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3263 quietly
= !NILP (visit
);
3267 if (NILP (lockname
))
3268 lockname
= visit_file
;
3270 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3272 /* If the file name has special constructs in it,
3273 call the corresponding file handler. */
3274 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3275 /* If FILENAME has no handler, see if VISIT has one. */
3276 if (NILP (handler
) && STRINGP (visit
))
3277 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3279 if (!NILP (handler
))
3282 val
= call6 (handler
, Qwrite_region
, start
, end
,
3283 filename
, append
, visit
);
3287 SAVE_MODIFF
= MODIFF
;
3288 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3289 current_buffer
->filename
= visit_file
;
3295 /* Special kludge to simplify auto-saving. */
3298 XSETFASTINT (start
, BEG
);
3299 XSETFASTINT (end
, Z
);
3302 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3303 count1
= specpdl_ptr
- specpdl
;
3305 given_buffer
= current_buffer
;
3306 annotations
= build_annotations (start
, end
);
3307 if (current_buffer
!= given_buffer
)
3313 #ifdef CLASH_DETECTION
3315 lock_file (lockname
);
3316 #endif /* CLASH_DETECTION */
3318 fn
= XSTRING (filename
)->data
;
3322 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3323 #else /* not DOS_NT */
3324 desc
= open (fn
, O_WRONLY
);
3325 #endif /* not DOS_NT */
3329 if (auto_saving
) /* Overwrite any previous version of autosave file */
3331 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3332 desc
= open (fn
, O_RDWR
);
3334 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3335 ? XSTRING (current_buffer
->filename
)->data
: 0,
3338 else /* Write to temporary name and rename if no errors */
3340 Lisp_Object temp_name
;
3341 temp_name
= Ffile_name_directory (filename
);
3343 if (!NILP (temp_name
))
3345 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3346 build_string ("$$SAVE$$")));
3347 fname
= XSTRING (filename
)->data
;
3348 fn
= XSTRING (temp_name
)->data
;
3349 desc
= creat_copy_attrs (fname
, fn
);
3352 /* If we can't open the temporary file, try creating a new
3353 version of the original file. VMS "creat" creates a
3354 new version rather than truncating an existing file. */
3357 desc
= creat (fn
, 0666);
3358 #if 0 /* This can clobber an existing file and fail to replace it,
3359 if the user runs out of space. */
3362 /* We can't make a new version;
3363 try to truncate and rewrite existing version if any. */
3365 desc
= open (fn
, O_RDWR
);
3371 desc
= creat (fn
, 0666);
3376 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3377 S_IREAD
| S_IWRITE
);
3378 #else /* not DOS_NT */
3379 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3380 #endif /* not DOS_NT */
3381 #endif /* not VMS */
3387 #ifdef CLASH_DETECTION
3389 if (!auto_saving
) unlock_file (lockname
);
3391 #endif /* CLASH_DETECTION */
3392 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3395 record_unwind_protect (close_file_unwind
, make_number (desc
));
3398 if (lseek (desc
, 0, 2) < 0)
3400 #ifdef CLASH_DETECTION
3401 if (!auto_saving
) unlock_file (lockname
);
3402 #endif /* CLASH_DETECTION */
3403 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3408 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3409 * if we do writes that don't end with a carriage return. Furthermore
3410 * it cannot handle writes of more then 16K. The modified
3411 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3412 * this EXCEPT for the last record (iff it doesn't end with a carriage
3413 * return). This implies that if your buffer doesn't end with a carriage
3414 * return, you get one free... tough. However it also means that if
3415 * we make two calls to sys_write (a la the following code) you can
3416 * get one at the gap as well. The easiest way to fix this (honest)
3417 * is to move the gap to the next newline (or the end of the buffer).
3422 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3423 move_gap (find_next_newline (GPT
, 1));
3429 if (STRINGP (start
))
3431 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3432 XSTRING (start
)->size
, 0, &annotations
);
3435 else if (XINT (start
) != XINT (end
))
3438 if (XINT (start
) < GPT
)
3440 register int end1
= XINT (end
);
3442 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3443 min (GPT
, end1
) - tem
, tem
, &annotations
);
3444 nwritten
+= min (GPT
, end1
) - tem
;
3448 if (XINT (end
) > GPT
&& !failure
)
3451 tem
= max (tem
, GPT
);
3452 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3454 nwritten
+= XINT (end
) - tem
;
3460 /* If file was empty, still need to write the annotations */
3461 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3468 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3469 Disk full in NFS may be reported here. */
3470 /* mib says that closing the file will try to write as fast as NFS can do
3471 it, and that means the fsync here is not crucial for autosave files. */
3472 if (!auto_saving
&& fsync (desc
) < 0)
3474 /* If fsync fails with EINTR, don't treat that as serious. */
3476 failure
= 1, save_errno
= errno
;
3480 /* Spurious "file has changed on disk" warnings have been
3481 observed on Suns as well.
3482 It seems that `close' can change the modtime, under nfs.
3484 (This has supposedly been fixed in Sunos 4,
3485 but who knows about all the other machines with NFS?) */
3488 /* On VMS and APOLLO, must do the stat after the close
3489 since closing changes the modtime. */
3492 /* Recall that #if defined does not work on VMS. */
3499 /* NFS can report a write failure now. */
3500 if (close (desc
) < 0)
3501 failure
= 1, save_errno
= errno
;
3504 /* If we wrote to a temporary name and had no errors, rename to real name. */
3508 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3516 /* Discard the unwind protect for close_file_unwind. */
3517 specpdl_ptr
= specpdl
+ count1
;
3518 /* Restore the original current buffer. */
3519 visit_file
= unbind_to (count
, visit_file
);
3521 #ifdef CLASH_DETECTION
3523 unlock_file (lockname
);
3524 #endif /* CLASH_DETECTION */
3526 /* Do this before reporting IO error
3527 to avoid a "file has changed on disk" warning on
3528 next attempt to save. */
3530 current_buffer
->modtime
= st
.st_mtime
;
3533 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3537 SAVE_MODIFF
= MODIFF
;
3538 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3539 current_buffer
->filename
= visit_file
;
3540 update_mode_lines
++;
3546 message ("Wrote %s", XSTRING (visit_file
)->data
);
3551 Lisp_Object
merge ();
3553 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3554 "Return t if (car A) is numerically less than (car B).")
3558 return Flss (Fcar (a
), Fcar (b
));
3561 /* Build the complete list of annotations appropriate for writing out
3562 the text between START and END, by calling all the functions in
3563 write-region-annotate-functions and merging the lists they return.
3564 If one of these functions switches to a different buffer, we assume
3565 that buffer contains altered text. Therefore, the caller must
3566 make sure to restore the current buffer in all cases,
3567 as save-excursion would do. */
3570 build_annotations (start
, end
)
3571 Lisp_Object start
, end
;
3573 Lisp_Object annotations
;
3575 struct gcpro gcpro1
, gcpro2
;
3578 p
= Vwrite_region_annotate_functions
;
3579 GCPRO2 (annotations
, p
);
3582 struct buffer
*given_buffer
= current_buffer
;
3583 Vwrite_region_annotations_so_far
= annotations
;
3584 res
= call2 (Fcar (p
), start
, end
);
3585 /* If the function makes a different buffer current,
3586 assume that means this buffer contains altered text to be output.
3587 Reset START and END from the buffer bounds
3588 and discard all previous annotations because they should have
3589 been dealt with by this function. */
3590 if (current_buffer
!= given_buffer
)
3596 Flength (res
); /* Check basic validity of return value */
3597 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3601 /* Now do the same for annotation functions implied by the file-format */
3602 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3603 p
= Vauto_save_file_format
;
3605 p
= current_buffer
->file_format
;
3608 struct buffer
*given_buffer
= current_buffer
;
3609 Vwrite_region_annotations_so_far
= annotations
;
3610 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3611 if (current_buffer
!= given_buffer
)
3618 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3625 /* Write to descriptor DESC the LEN characters starting at ADDR,
3626 assuming they start at position POS in the buffer.
3627 Intersperse with them the annotations from *ANNOT
3628 (those which fall within the range of positions POS to POS + LEN),
3629 each at its appropriate position.
3631 Modify *ANNOT by discarding elements as we output them.
3632 The return value is negative in case of system call failure. */
3635 a_write (desc
, addr
, len
, pos
, annot
)
3637 register char *addr
;
3644 int lastpos
= pos
+ len
;
3646 while (NILP (*annot
) || CONSP (*annot
))
3648 tem
= Fcar_safe (Fcar (*annot
));
3649 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3650 nextpos
= XFASTINT (tem
);
3652 return e_write (desc
, addr
, lastpos
- pos
);
3655 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3657 addr
+= nextpos
- pos
;
3660 tem
= Fcdr (Fcar (*annot
));
3663 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3666 *annot
= Fcdr (*annot
);
3671 e_write (desc
, addr
, len
)
3673 register char *addr
;
3676 char buf
[16 * 1024];
3677 register char *p
, *end
;
3679 if (!EQ (current_buffer
->selective_display
, Qt
))
3680 return write (desc
, addr
, len
) - len
;
3684 end
= p
+ sizeof buf
;
3689 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3698 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3704 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3705 Sverify_visited_file_modtime
, 1, 1, 0,
3706 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3707 This means that the file has not been changed since it was visited or saved.")
3713 Lisp_Object handler
;
3715 CHECK_BUFFER (buf
, 0);
3718 if (!STRINGP (b
->filename
)) return Qt
;
3719 if (b
->modtime
== 0) return Qt
;
3721 /* If the file name has special constructs in it,
3722 call the corresponding file handler. */
3723 handler
= Ffind_file_name_handler (b
->filename
,
3724 Qverify_visited_file_modtime
);
3725 if (!NILP (handler
))
3726 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3728 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3730 /* If the file doesn't exist now and didn't exist before,
3731 we say that it isn't modified, provided the error is a tame one. */
3732 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3737 if (st
.st_mtime
== b
->modtime
3738 /* If both are positive, accept them if they are off by one second. */
3739 || (st
.st_mtime
> 0 && b
->modtime
> 0
3740 && (st
.st_mtime
== b
->modtime
+ 1
3741 || st
.st_mtime
== b
->modtime
- 1)))
3746 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3747 Sclear_visited_file_modtime
, 0, 0, 0,
3748 "Clear out records of last mod time of visited file.\n\
3749 Next attempt to save will certainly not complain of a discrepancy.")
3752 current_buffer
->modtime
= 0;
3756 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3757 Svisited_file_modtime
, 0, 0, 0,
3758 "Return the current buffer's recorded visited file modification time.\n\
3759 The value is a list of the form (HIGH . LOW), like the time values\n\
3760 that `file-attributes' returns.")
3763 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3766 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3767 Sset_visited_file_modtime
, 0, 1, 0,
3768 "Update buffer's recorded modification time from the visited file's time.\n\
3769 Useful if the buffer was not read from the file normally\n\
3770 or if the file itself has been changed for some known benign reason.\n\
3771 An argument specifies the modification time value to use\n\
3772 \(instead of that of the visited file), in the form of a list\n\
3773 \(HIGH . LOW) or (HIGH LOW).")
3775 Lisp_Object time_list
;
3777 if (!NILP (time_list
))
3778 current_buffer
->modtime
= cons_to_long (time_list
);
3781 register Lisp_Object filename
;
3783 Lisp_Object handler
;
3785 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3787 /* If the file name has special constructs in it,
3788 call the corresponding file handler. */
3789 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3790 if (!NILP (handler
))
3791 /* The handler can find the file name the same way we did. */
3792 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3793 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3794 current_buffer
->modtime
= st
.st_mtime
;
3804 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3805 Fsleep_for (make_number (1), Qnil
);
3806 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3807 Fsleep_for (make_number (1), Qnil
);
3808 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3809 Fsleep_for (make_number (1), Qnil
);
3819 /* Get visited file's mode to become the auto save file's mode. */
3820 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3821 /* But make sure we can overwrite it later! */
3822 auto_save_mode_bits
= st
.st_mode
| 0600;
3824 auto_save_mode_bits
= 0666;
3827 Fwrite_region (Qnil
, Qnil
,
3828 current_buffer
->auto_save_file_name
,
3829 Qnil
, Qlambda
, Qnil
);
3833 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3837 if (XINT (desc
) >= 0)
3838 close (XINT (desc
));
3842 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3843 "Auto-save all buffers that need it.\n\
3844 This is all buffers that have auto-saving enabled\n\
3845 and are changed since last auto-saved.\n\
3846 Auto-saving writes the buffer into a file\n\
3847 so that your editing is not lost if the system crashes.\n\
3848 This file is not the file you visited; that changes only when you save.\n\
3849 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3850 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
3851 A non-nil CURRENT-ONLY argument means save only current buffer.")
3852 (no_message
, current_only
)
3853 Lisp_Object no_message
, current_only
;
3855 struct buffer
*old
= current_buffer
, *b
;
3856 Lisp_Object tail
, buf
;
3858 char *omessage
= echo_area_glyphs
;
3859 int omessage_length
= echo_area_glyphs_length
;
3860 extern int minibuf_level
;
3861 int do_handled_files
;
3864 int count
= specpdl_ptr
- specpdl
;
3867 /* Ordinarily don't quit within this function,
3868 but don't make it impossible to quit (in case we get hung in I/O). */
3872 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3873 point to non-strings reached from Vbuffer_alist. */
3878 if (!NILP (Vrun_hooks
))
3879 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3881 if (STRINGP (Vauto_save_list_file_name
))
3883 Lisp_Object listfile
;
3884 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
3886 listdesc
= open (XSTRING (listfile
)->data
,
3887 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3888 S_IREAD
| S_IWRITE
);
3889 #else /* not DOS_NT */
3890 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
3891 #endif /* not DOS_NT */
3896 /* Arrange to close that file whether or not we get an error.
3897 Also reset auto_saving to 0. */
3898 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3902 /* First, save all files which don't have handlers. If Emacs is
3903 crashing, the handlers may tweak what is causing Emacs to crash
3904 in the first place, and it would be a shame if Emacs failed to
3905 autosave perfectly ordinary files because it couldn't handle some
3907 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3908 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3910 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3913 /* Record all the buffers that have auto save mode
3914 in the special file that lists them. For each of these buffers,
3915 Record visited name (if any) and auto save name. */
3916 if (STRINGP (b
->auto_save_file_name
)
3917 && listdesc
>= 0 && do_handled_files
== 0)
3919 if (!NILP (b
->filename
))
3921 write (listdesc
, XSTRING (b
->filename
)->data
,
3922 XSTRING (b
->filename
)->size
);
3924 write (listdesc
, "\n", 1);
3925 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3926 XSTRING (b
->auto_save_file_name
)->size
);
3927 write (listdesc
, "\n", 1);
3930 if (!NILP (current_only
)
3931 && b
!= current_buffer
)
3934 /* Don't auto-save indirect buffers.
3935 The base buffer takes care of it. */
3939 /* Check for auto save enabled
3940 and file changed since last auto save
3941 and file changed since last real save. */
3942 if (STRINGP (b
->auto_save_file_name
)
3943 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
3944 && b
->auto_save_modified
< BUF_MODIFF (b
)
3945 /* -1 means we've turned off autosaving for a while--see below. */
3946 && XINT (b
->save_length
) >= 0
3947 && (do_handled_files
3948 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3951 EMACS_TIME before_time
, after_time
;
3953 EMACS_GET_TIME (before_time
);
3955 /* If we had a failure, don't try again for 20 minutes. */
3956 if (b
->auto_save_failure_time
>= 0
3957 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3960 if ((XFASTINT (b
->save_length
) * 10
3961 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3962 /* A short file is likely to change a large fraction;
3963 spare the user annoying messages. */
3964 && XFASTINT (b
->save_length
) > 5000
3965 /* These messages are frequent and annoying for `*mail*'. */
3966 && !EQ (b
->filename
, Qnil
)
3967 && NILP (no_message
))
3969 /* It has shrunk too much; turn off auto-saving here. */
3970 message ("Buffer %s has shrunk a lot; auto save turned off there",
3971 XSTRING (b
->name
)->data
);
3972 /* Turn off auto-saving until there's a real save,
3973 and prevent any more warnings. */
3974 XSETINT (b
->save_length
, -1);
3975 Fsleep_for (make_number (1), Qnil
);
3978 set_buffer_internal (b
);
3979 if (!auto_saved
&& NILP (no_message
))
3980 message1 ("Auto-saving...");
3981 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3983 b
->auto_save_modified
= BUF_MODIFF (b
);
3984 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3985 set_buffer_internal (old
);
3987 EMACS_GET_TIME (after_time
);
3989 /* If auto-save took more than 60 seconds,
3990 assume it was an NFS failure that got a timeout. */
3991 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3992 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3996 /* Prevent another auto save till enough input events come in. */
3997 record_auto_save ();
3999 if (auto_saved
&& NILP (no_message
))
4003 sit_for (1, 0, 0, 0);
4004 message2 (omessage
, omessage_length
);
4007 message1 ("Auto-saving...done");
4012 unbind_to (count
, Qnil
);
4016 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4017 Sset_buffer_auto_saved
, 0, 0, 0,
4018 "Mark current buffer as auto-saved with its current text.\n\
4019 No auto-save file will be written until the buffer changes again.")
4022 current_buffer
->auto_save_modified
= MODIFF
;
4023 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4024 current_buffer
->auto_save_failure_time
= -1;
4028 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4029 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4030 "Clear any record of a recent auto-save failure in the current buffer.")
4033 current_buffer
->auto_save_failure_time
= -1;
4037 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4039 "Return t if buffer has been auto-saved since last read in or saved.")
4042 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4045 /* Reading and completing file names */
4046 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4048 /* In the string VAL, change each $ to $$ and return the result. */
4051 double_dollars (val
)
4054 register unsigned char *old
, *new;
4058 osize
= XSTRING (val
)->size
;
4059 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4060 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4061 if (*old
++ == '$') count
++;
4064 old
= XSTRING (val
)->data
;
4065 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4066 new = XSTRING (val
)->data
;
4067 for (n
= osize
; n
> 0; n
--)
4080 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4082 "Internal subroutine for read-file-name. Do not call this.")
4083 (string
, dir
, action
)
4084 Lisp_Object string
, dir
, action
;
4085 /* action is nil for complete, t for return list of completions,
4086 lambda for verify final value */
4088 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4090 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4097 /* No need to protect ACTION--we only compare it with t and nil. */
4098 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4100 if (XSTRING (string
)->size
== 0)
4102 if (EQ (action
, Qlambda
))
4110 orig_string
= string
;
4111 string
= Fsubstitute_in_file_name (string
);
4112 changed
= NILP (Fstring_equal (string
, orig_string
));
4113 name
= Ffile_name_nondirectory (string
);
4114 val
= Ffile_name_directory (string
);
4116 realdir
= Fexpand_file_name (val
, realdir
);
4121 specdir
= Ffile_name_directory (string
);
4122 val
= Ffile_name_completion (name
, realdir
);
4127 return double_dollars (string
);
4131 if (!NILP (specdir
))
4132 val
= concat2 (specdir
, val
);
4134 return double_dollars (val
);
4137 #endif /* not VMS */
4141 if (EQ (action
, Qt
))
4142 return Ffile_name_all_completions (name
, realdir
);
4143 /* Only other case actually used is ACTION = lambda */
4145 /* Supposedly this helps commands such as `cd' that read directory names,
4146 but can someone explain how it helps them? -- RMS */
4147 if (XSTRING (name
)->size
== 0)
4150 return Ffile_exists_p (string
);
4153 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4154 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4155 Value is not expanded---you must call `expand-file-name' yourself.\n\
4156 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4157 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4158 except that if INITIAL is specified, that combined with DIR is used.)\n\
4159 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4160 Non-nil and non-t means also require confirmation after completion.\n\
4161 Fifth arg INITIAL specifies text to start with.\n\
4162 DIR defaults to current buffer's directory default.")
4163 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4164 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4166 Lisp_Object val
, insdef
, insdef1
, tem
;
4167 struct gcpro gcpro1
, gcpro2
;
4168 register char *homedir
;
4172 dir
= current_buffer
->directory
;
4173 if (NILP (default_filename
))
4175 if (! NILP (initial
))
4176 default_filename
= Fexpand_file_name (initial
, dir
);
4178 default_filename
= current_buffer
->filename
;
4181 /* If dir starts with user's homedir, change that to ~. */
4182 homedir
= (char *) egetenv ("HOME");
4185 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4186 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4188 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4189 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4190 XSTRING (dir
)->data
[0] = '~';
4193 if (insert_default_directory
)
4196 if (!NILP (initial
))
4198 Lisp_Object args
[2], pos
;
4202 insdef
= Fconcat (2, args
);
4203 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4204 insdef1
= Fcons (double_dollars (insdef
), pos
);
4207 insdef1
= double_dollars (insdef
);
4209 else if (!NILP (initial
))
4212 insdef1
= Fcons (double_dollars (insdef
), 0);
4215 insdef
= Qnil
, insdef1
= Qnil
;
4218 count
= specpdl_ptr
- specpdl
;
4219 specbind (intern ("completion-ignore-case"), Qt
);
4222 GCPRO2 (insdef
, default_filename
);
4223 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4224 dir
, mustmatch
, insdef1
,
4225 Qfile_name_history
);
4228 unbind_to (count
, Qnil
);
4233 error ("No file name specified");
4234 tem
= Fstring_equal (val
, insdef
);
4235 if (!NILP (tem
) && !NILP (default_filename
))
4236 return default_filename
;
4237 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4239 if (!NILP (default_filename
))
4240 return default_filename
;
4242 error ("No default file name");
4244 return Fsubstitute_in_file_name (val
);
4247 #if 0 /* Old version */
4248 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4249 /* Don't confuse make-docfile by having two doc strings for this function.
4250 make-docfile does not pay attention to #if, for good reason! */
4252 (prompt
, dir
, defalt
, mustmatch
, initial
)
4253 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4255 Lisp_Object val
, insdef
, tem
;
4256 struct gcpro gcpro1
, gcpro2
;
4257 register char *homedir
;
4261 dir
= current_buffer
->directory
;
4263 defalt
= current_buffer
->filename
;
4265 /* If dir starts with user's homedir, change that to ~. */
4266 homedir
= (char *) egetenv ("HOME");
4269 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4270 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4272 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4273 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4274 XSTRING (dir
)->data
[0] = '~';
4277 if (!NILP (initial
))
4279 else if (insert_default_directory
)
4282 insdef
= build_string ("");
4285 count
= specpdl_ptr
- specpdl
;
4286 specbind (intern ("completion-ignore-case"), Qt
);
4289 GCPRO2 (insdef
, defalt
);
4290 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4292 insert_default_directory
? insdef
: Qnil
,
4293 Qfile_name_history
);
4296 unbind_to (count
, Qnil
);
4301 error ("No file name specified");
4302 tem
= Fstring_equal (val
, insdef
);
4303 if (!NILP (tem
) && !NILP (defalt
))
4305 return Fsubstitute_in_file_name (val
);
4307 #endif /* Old version */
4311 Qexpand_file_name
= intern ("expand-file-name");
4312 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4313 Qdirectory_file_name
= intern ("directory-file-name");
4314 Qfile_name_directory
= intern ("file-name-directory");
4315 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4316 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4317 Qfile_name_as_directory
= intern ("file-name-as-directory");
4318 Qcopy_file
= intern ("copy-file");
4319 Qmake_directory_internal
= intern ("make-directory-internal");
4320 Qdelete_directory
= intern ("delete-directory");
4321 Qdelete_file
= intern ("delete-file");
4322 Qrename_file
= intern ("rename-file");
4323 Qadd_name_to_file
= intern ("add-name-to-file");
4324 Qmake_symbolic_link
= intern ("make-symbolic-link");
4325 Qfile_exists_p
= intern ("file-exists-p");
4326 Qfile_executable_p
= intern ("file-executable-p");
4327 Qfile_readable_p
= intern ("file-readable-p");
4328 Qfile_symlink_p
= intern ("file-symlink-p");
4329 Qfile_writable_p
= intern ("file-writable-p");
4330 Qfile_directory_p
= intern ("file-directory-p");
4331 Qfile_regular_p
= intern ("file-regular-p");
4332 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4333 Qfile_modes
= intern ("file-modes");
4334 Qset_file_modes
= intern ("set-file-modes");
4335 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4336 Qinsert_file_contents
= intern ("insert-file-contents");
4337 Qwrite_region
= intern ("write-region");
4338 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4339 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4341 staticpro (&Qexpand_file_name
);
4342 staticpro (&Qsubstitute_in_file_name
);
4343 staticpro (&Qdirectory_file_name
);
4344 staticpro (&Qfile_name_directory
);
4345 staticpro (&Qfile_name_nondirectory
);
4346 staticpro (&Qunhandled_file_name_directory
);
4347 staticpro (&Qfile_name_as_directory
);
4348 staticpro (&Qcopy_file
);
4349 staticpro (&Qmake_directory_internal
);
4350 staticpro (&Qdelete_directory
);
4351 staticpro (&Qdelete_file
);
4352 staticpro (&Qrename_file
);
4353 staticpro (&Qadd_name_to_file
);
4354 staticpro (&Qmake_symbolic_link
);
4355 staticpro (&Qfile_exists_p
);
4356 staticpro (&Qfile_executable_p
);
4357 staticpro (&Qfile_readable_p
);
4358 staticpro (&Qfile_symlink_p
);
4359 staticpro (&Qfile_writable_p
);
4360 staticpro (&Qfile_directory_p
);
4361 staticpro (&Qfile_regular_p
);
4362 staticpro (&Qfile_accessible_directory_p
);
4363 staticpro (&Qfile_modes
);
4364 staticpro (&Qset_file_modes
);
4365 staticpro (&Qfile_newer_than_file_p
);
4366 staticpro (&Qinsert_file_contents
);
4367 staticpro (&Qwrite_region
);
4368 staticpro (&Qverify_visited_file_modtime
);
4370 Qfile_name_history
= intern ("file-name-history");
4371 Fset (Qfile_name_history
, Qnil
);
4372 staticpro (&Qfile_name_history
);
4374 Qfile_error
= intern ("file-error");
4375 staticpro (&Qfile_error
);
4376 Qfile_already_exists
= intern("file-already-exists");
4377 staticpro (&Qfile_already_exists
);
4380 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4381 staticpro (&Qfind_buffer_file_type
);
4384 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4385 "*Format in which to write auto-save files.\n\
4386 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4387 If it is t, which is the default, auto-save files are written in the\n\
4388 same format as a regular save would use.");
4389 Vauto_save_file_format
= Qt
;
4391 Qformat_decode
= intern ("format-decode");
4392 staticpro (&Qformat_decode
);
4393 Qformat_annotate_function
= intern ("format-annotate-function");
4394 staticpro (&Qformat_annotate_function
);
4396 Qcar_less_than_car
= intern ("car-less-than-car");
4397 staticpro (&Qcar_less_than_car
);
4399 Fput (Qfile_error
, Qerror_conditions
,
4400 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4401 Fput (Qfile_error
, Qerror_message
,
4402 build_string ("File error"));
4404 Fput (Qfile_already_exists
, Qerror_conditions
,
4405 Fcons (Qfile_already_exists
,
4406 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4407 Fput (Qfile_already_exists
, Qerror_message
,
4408 build_string ("File already exists"));
4410 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4411 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4412 insert_default_directory
= 1;
4414 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4415 "*Non-nil means write new files with record format `stmlf'.\n\
4416 nil means use format `var'. This variable is meaningful only on VMS.");
4417 vms_stmlf_recfm
= 0;
4419 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4420 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4421 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4424 The first argument given to HANDLER is the name of the I/O primitive\n\
4425 to be handled; the remaining arguments are the arguments that were\n\
4426 passed to that primitive. For example, if you do\n\
4427 (file-exists-p FILENAME)\n\
4428 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4429 (funcall HANDLER 'file-exists-p FILENAME)\n\
4430 The function `find-file-name-handler' checks this list for a handler\n\
4431 for its argument.");
4432 Vfile_name_handler_alist
= Qnil
;
4434 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4435 "A list of functions to be called at the end of `insert-file-contents'.\n\
4436 Each is passed one argument, the number of bytes inserted. It should return\n\
4437 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4438 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4439 responsible for calling the after-insert-file-functions if appropriate.");
4440 Vafter_insert_file_functions
= Qnil
;
4442 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4443 "A list of functions to be called at the start of `write-region'.\n\
4444 Each is passed two arguments, START and END as for `write-region'. It should\n\
4445 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4446 inserted at the specified positions of the file being written (1 means to\n\
4447 insert before the first byte written). The POSITIONs must be sorted into\n\
4448 increasing order. If there are several functions in the list, the several\n\
4449 lists are merged destructively.");
4450 Vwrite_region_annotate_functions
= Qnil
;
4452 DEFVAR_LISP ("write-region-annotations-so-far",
4453 &Vwrite_region_annotations_so_far
,
4454 "When an annotation function is called, this holds the previous annotations.\n\
4455 These are the annotations made by other annotation functions\n\
4456 that were already called. See also `write-region-annotate-functions'.");
4457 Vwrite_region_annotations_so_far
= Qnil
;
4459 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4460 "A list of file name handlers that temporarily should not be used.\n\
4461 This applies only to the operation `inhibit-file-name-operation'.");
4462 Vinhibit_file_name_handlers
= Qnil
;
4464 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4465 "The operation for which `inhibit-file-name-handlers' is applicable.");
4466 Vinhibit_file_name_operation
= Qnil
;
4468 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4469 "File name in which we write a list of all auto save file names.\n\
4470 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4471 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4473 Vauto_save_list_file_name
= Qnil
;
4475 defsubr (&Sfind_file_name_handler
);
4476 defsubr (&Sfile_name_directory
);
4477 defsubr (&Sfile_name_nondirectory
);
4478 defsubr (&Sunhandled_file_name_directory
);
4479 defsubr (&Sfile_name_as_directory
);
4480 defsubr (&Sdirectory_file_name
);
4481 defsubr (&Smake_temp_name
);
4482 defsubr (&Sexpand_file_name
);
4483 defsubr (&Ssubstitute_in_file_name
);
4484 defsubr (&Scopy_file
);
4485 defsubr (&Smake_directory_internal
);
4486 defsubr (&Sdelete_directory
);
4487 defsubr (&Sdelete_file
);
4488 defsubr (&Srename_file
);
4489 defsubr (&Sadd_name_to_file
);
4491 defsubr (&Smake_symbolic_link
);
4492 #endif /* S_IFLNK */
4494 defsubr (&Sdefine_logical_name
);
4497 defsubr (&Ssysnetunam
);
4498 #endif /* HPUX_NET */
4499 defsubr (&Sfile_name_absolute_p
);
4500 defsubr (&Sfile_exists_p
);
4501 defsubr (&Sfile_executable_p
);
4502 defsubr (&Sfile_readable_p
);
4503 defsubr (&Sfile_writable_p
);
4504 defsubr (&Sfile_symlink_p
);
4505 defsubr (&Sfile_directory_p
);
4506 defsubr (&Sfile_accessible_directory_p
);
4507 defsubr (&Sfile_regular_p
);
4508 defsubr (&Sfile_modes
);
4509 defsubr (&Sset_file_modes
);
4510 defsubr (&Sset_default_file_modes
);
4511 defsubr (&Sdefault_file_modes
);
4512 defsubr (&Sfile_newer_than_file_p
);
4513 defsubr (&Sinsert_file_contents
);
4514 defsubr (&Swrite_region
);
4515 defsubr (&Scar_less_than_car
);
4516 defsubr (&Sverify_visited_file_modtime
);
4517 defsubr (&Sclear_visited_file_modtime
);
4518 defsubr (&Svisited_file_modtime
);
4519 defsubr (&Sset_visited_file_modtime
);
4520 defsubr (&Sdo_auto_save
);
4521 defsubr (&Sset_buffer_auto_saved
);
4522 defsubr (&Sclear_buffer_auto_save_failure
);
4523 defsubr (&Srecent_auto_save_p
);
4525 defsubr (&Sread_file_name_internal
);
4526 defsubr (&Sread_file_name
);
4529 defsubr (&Sunix_sync
);