1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
78 #include "intervals.h"
108 #define min(a, b) ((a) < (b) ? (a) : (b))
109 #define max(a, b) ((a) > (b) ? (a) : (b))
111 /* Nonzero during writing of auto-save files */
114 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
115 a new file with the same mode as the original */
116 int auto_save_mode_bits
;
118 /* Alist of elements (REGEXP . HANDLER) for file names
119 whose I/O is done with a special handler. */
120 Lisp_Object Vfile_name_handler_alist
;
122 /* Functions to be called to process text properties in inserted file. */
123 Lisp_Object Vafter_insert_file_functions
;
125 /* Functions to be called to create text property annotations for file. */
126 Lisp_Object Vwrite_region_annotate_functions
;
128 /* During build_annotations, each time an annotation function is called,
129 this holds the annotations made by the previous functions. */
130 Lisp_Object Vwrite_region_annotations_so_far
;
132 /* File name in which we write a list of all our auto save files. */
133 Lisp_Object Vauto_save_list_file_name
;
135 /* Nonzero means, when reading a filename in the minibuffer,
136 start out by inserting the default directory into the minibuffer. */
137 int insert_default_directory
;
139 /* On VMS, nonzero means write new files with record format stmlf.
140 Zero means use var format. */
143 /* These variables describe handlers that have "already" had a chance
144 to handle the current operation.
146 Vinhibit_file_name_handlers is a list of file name handlers.
147 Vinhibit_file_name_operation is the operation being handled.
148 If we try to handle that operation, we ignore those handlers. */
150 static Lisp_Object Vinhibit_file_name_handlers
;
151 static Lisp_Object Vinhibit_file_name_operation
;
153 Lisp_Object Qfile_error
, Qfile_already_exists
;
155 Lisp_Object Qfile_name_history
;
157 Lisp_Object Qcar_less_than_car
;
159 report_file_error (string
, data
)
163 Lisp_Object errstring
;
165 errstring
= build_string (strerror (errno
));
167 /* System error messages are capitalized. Downcase the initial
168 unless it is followed by a slash. */
169 if (XSTRING (errstring
)->data
[1] != '/')
170 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
173 Fsignal (Qfile_error
,
174 Fcons (build_string (string
), Fcons (errstring
, data
)));
177 close_file_unwind (fd
)
180 close (XFASTINT (fd
));
183 /* Restore point, having saved it as a marker. */
185 restore_point_unwind (location
)
186 Lisp_Object location
;
188 SET_PT (marker_position (location
));
189 Fset_marker (location
, Qnil
, Qnil
);
192 Lisp_Object Qexpand_file_name
;
193 Lisp_Object Qdirectory_file_name
;
194 Lisp_Object Qfile_name_directory
;
195 Lisp_Object Qfile_name_nondirectory
;
196 Lisp_Object Qunhandled_file_name_directory
;
197 Lisp_Object Qfile_name_as_directory
;
198 Lisp_Object Qcopy_file
;
199 Lisp_Object Qmake_directory_internal
;
200 Lisp_Object Qdelete_directory
;
201 Lisp_Object Qdelete_file
;
202 Lisp_Object Qrename_file
;
203 Lisp_Object Qadd_name_to_file
;
204 Lisp_Object Qmake_symbolic_link
;
205 Lisp_Object Qfile_exists_p
;
206 Lisp_Object Qfile_executable_p
;
207 Lisp_Object Qfile_readable_p
;
208 Lisp_Object Qfile_symlink_p
;
209 Lisp_Object Qfile_writable_p
;
210 Lisp_Object Qfile_directory_p
;
211 Lisp_Object Qfile_accessible_directory_p
;
212 Lisp_Object Qfile_modes
;
213 Lisp_Object Qset_file_modes
;
214 Lisp_Object Qfile_newer_than_file_p
;
215 Lisp_Object Qinsert_file_contents
;
216 Lisp_Object Qwrite_region
;
217 Lisp_Object Qverify_visited_file_modtime
;
218 Lisp_Object Qset_visited_file_modtime
;
220 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
221 "Return FILENAME's handler function for OPERATION, if it has one.\n\
222 Otherwise, return nil.\n\
223 A file name is handled if one of the regular expressions in\n\
224 `file-name-handler-alist' matches it.\n\n\
225 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
226 any handlers that are members of `inhibit-file-name-handlers',\n\
227 but we still do run any other handlers. This lets handlers\n\
228 use the standard functions without calling themselves recursively.")
229 (filename
, operation
)
230 Lisp_Object filename
, operation
;
232 /* This function must not munge the match data. */
233 Lisp_Object chain
, inhibited_handlers
;
235 CHECK_STRING (filename
, 0);
237 if (EQ (operation
, Vinhibit_file_name_operation
))
238 inhibited_handlers
= Vinhibit_file_name_handlers
;
240 inhibited_handlers
= Qnil
;
242 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
243 chain
= XCONS (chain
)->cdr
)
246 elt
= XCONS (chain
)->car
;
247 if (XTYPE (elt
) == Lisp_Cons
)
250 string
= XCONS (elt
)->car
;
251 if (XTYPE (string
) == Lisp_String
252 && fast_string_match (string
, filename
) >= 0)
254 Lisp_Object handler
, tem
;
256 handler
= XCONS (elt
)->cdr
;
257 tem
= Fmemq (handler
, inhibited_handlers
);
268 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
270 "Return the directory component in file name NAME.\n\
271 Return nil if NAME does not include a directory.\n\
272 Otherwise return a directory spec.\n\
273 Given a Unix syntax file name, returns a string ending in slash;\n\
274 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
278 register unsigned char *beg
;
279 register unsigned char *p
;
282 CHECK_STRING (file
, 0);
284 /* If the file name has special constructs in it,
285 call the corresponding file handler. */
286 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
288 return call2 (handler
, Qfile_name_directory
, file
);
290 #ifdef FILE_SYSTEM_CASE
291 file
= FILE_SYSTEM_CASE (file
);
293 beg
= XSTRING (file
)->data
;
294 p
= beg
+ XSTRING (file
)->size
;
296 while (p
!= beg
&& p
[-1] != '/'
298 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
301 && p
[-1] != ':' && p
[-1] != '\\'
308 /* Expansion of "c:" to drive and default directory. */
309 if (p
== beg
+ 2 && beg
[1] == ':')
311 int drive
= (*beg
) - 'a';
312 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
313 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
314 if (getdefdir (drive
+ 1, res
+ 2))
316 res
[0] = drive
+ 'a';
318 if (res
[strlen (res
) - 1] != '/')
321 p
= beg
+ strlen (beg
);
325 return make_string (beg
, p
- beg
);
328 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
330 "Return file name NAME sans its directory.\n\
331 For example, in a Unix-syntax file name,\n\
332 this is everything after the last slash,\n\
333 or the entire name if it contains no slash.")
337 register unsigned char *beg
, *p
, *end
;
340 CHECK_STRING (file
, 0);
342 /* If the file name has special constructs in it,
343 call the corresponding file handler. */
344 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
346 return call2 (handler
, Qfile_name_nondirectory
, file
);
348 beg
= XSTRING (file
)->data
;
349 end
= p
= beg
+ XSTRING (file
)->size
;
351 while (p
!= beg
&& p
[-1] != '/'
353 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
356 && p
[-1] != ':' && p
[-1] != '\\'
360 return make_string (p
, end
- p
);
363 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
364 "Return a directly usable directory name somehow associated with FILENAME.\n\
365 A `directly usable' directory name is one that may be used without the\n\
366 intervention of any file handler.\n\
367 If FILENAME is a directly usable file itself, return\n\
368 (file-name-directory FILENAME).\n\
369 The `call-process' and `start-process' functions use this function to\n\
370 get a current directory to run processes in.")
372 Lisp_Object filename
;
376 /* If the file name has special constructs in it,
377 call the corresponding file handler. */
378 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
380 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
382 return Ffile_name_directory (filename
);
387 file_name_as_directory (out
, in
)
390 int size
= strlen (in
) - 1;
395 /* Is it already a directory string? */
396 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
398 /* Is it a VMS directory file name? If so, hack VMS syntax. */
399 else if (! index (in
, '/')
400 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
401 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
402 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
403 || ! strncmp (&in
[size
- 5], ".dir", 4))
404 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
405 && in
[size
] == '1')))
407 register char *p
, *dot
;
411 dir:x.dir --> dir:[x]
412 dir:[x]y.dir --> dir:[x.y] */
414 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
417 strncpy (out
, in
, p
- in
);
436 dot
= index (p
, '.');
439 /* blindly remove any extension */
440 size
= strlen (out
) + (dot
- p
);
441 strncat (out
, p
, dot
- p
);
452 /* For Unix syntax, Append a slash if necessary */
454 if (out
[size
] != ':' && out
[size
] != '/' && out
[size
] != '\\')
456 if (out
[size
] != '/')
463 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
464 Sfile_name_as_directory
, 1, 1, 0,
465 "Return a string representing file FILENAME interpreted as a directory.\n\
466 This operation exists because a directory is also a file, but its name as\n\
467 a directory is different from its name as a file.\n\
468 The result can be used as the value of `default-directory'\n\
469 or passed as second argument to `expand-file-name'.\n\
470 For a Unix-syntax file name, just appends a slash.\n\
471 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
478 CHECK_STRING (file
, 0);
482 /* If the file name has special constructs in it,
483 call the corresponding file handler. */
484 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
486 return call2 (handler
, Qfile_name_as_directory
, file
);
488 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
489 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
493 * Convert from directory name to filename.
495 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
496 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
497 * On UNIX, it's simple: just make sure there is a terminating /
499 * Value is nonzero if the string output is different from the input.
502 directory_file_name (src
, dst
)
510 struct FAB fab
= cc$rms_fab
;
511 struct NAM nam
= cc$rms_nam
;
512 char esa
[NAM$C_MAXRSS
];
517 if (! index (src
, '/')
518 && (src
[slen
- 1] == ']'
519 || src
[slen
- 1] == ':'
520 || src
[slen
- 1] == '>'))
522 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
524 fab
.fab$b_fns
= slen
;
525 fab
.fab$l_nam
= &nam
;
526 fab
.fab$l_fop
= FAB$M_NAM
;
529 nam
.nam$b_ess
= sizeof esa
;
530 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
532 /* We call SYS$PARSE to handle such things as [--] for us. */
533 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
535 slen
= nam
.nam$b_esl
;
536 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
541 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
543 /* what about when we have logical_name:???? */
544 if (src
[slen
- 1] == ':')
545 { /* Xlate logical name and see what we get */
546 ptr
= strcpy (dst
, src
); /* upper case for getenv */
549 if ('a' <= *ptr
&& *ptr
<= 'z')
553 dst
[slen
- 1] = 0; /* remove colon */
554 if (!(src
= egetenv (dst
)))
556 /* should we jump to the beginning of this procedure?
557 Good points: allows us to use logical names that xlate
559 Bad points: can be a problem if we just translated to a device
561 For now, I'll punt and always expect VMS names, and hope for
564 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
565 { /* no recursion here! */
571 { /* not a directory spec */
576 bracket
= src
[slen
- 1];
578 /* If bracket is ']' or '>', bracket - 2 is the corresponding
580 ptr
= index (src
, bracket
- 2);
582 { /* no opening bracket */
586 if (!(rptr
= rindex (src
, '.')))
589 strncpy (dst
, src
, slen
);
593 dst
[slen
++] = bracket
;
598 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
599 then translate the device and recurse. */
600 if (dst
[slen
- 1] == ':'
601 && dst
[slen
- 2] != ':' /* skip decnet nodes */
602 && strcmp(src
+ slen
, "[000000]") == 0)
604 dst
[slen
- 1] = '\0';
605 if ((ptr
= egetenv (dst
))
606 && (rlen
= strlen (ptr
) - 1) > 0
607 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
608 && ptr
[rlen
- 1] == '.')
610 char * buf
= (char *) alloca (strlen (ptr
) + 1);
614 return directory_file_name (buf
, dst
);
619 strcat (dst
, "[000000]");
623 rlen
= strlen (rptr
) - 1;
624 strncat (dst
, rptr
, rlen
);
625 dst
[slen
+ rlen
] = '\0';
626 strcat (dst
, ".DIR.1");
630 /* Process as Unix format: just remove any final slash.
631 But leave "/" unchanged; do not change it to "". */
635 && (dst
[slen
- 1] == '/' || dst
[slen
- 1] == '/')
636 && dst
[slen
- 2] != ':'
638 && dst
[slen
- 1] == '/'
645 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
647 "Returns the file name of the directory named DIR.\n\
648 This is the name of the file that holds the data for the directory DIR.\n\
649 This operation exists because a directory is also a file, but its name as\n\
650 a directory is different from its name as a file.\n\
651 In Unix-syntax, this function just removes the final slash.\n\
652 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
653 it returns a file name such as \"[X]Y.DIR.1\".")
655 Lisp_Object directory
;
660 CHECK_STRING (directory
, 0);
662 if (NILP (directory
))
665 /* If the file name has special constructs in it,
666 call the corresponding file handler. */
667 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
669 return call2 (handler
, Qdirectory_file_name
, directory
);
672 /* 20 extra chars is insufficient for VMS, since we might perform a
673 logical name translation. an equivalence string can be up to 255
674 chars long, so grab that much extra space... - sss */
675 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
677 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
679 directory_file_name (XSTRING (directory
)->data
, buf
);
680 return build_string (buf
);
683 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
684 "Generate temporary file name (string) starting with PREFIX (a string).\n\
685 The Emacs process number forms part of the result,\n\
686 so there is no danger of generating a name being used by another process.")
691 val
= concat2 (prefix
, build_string ("XXXXXX"));
692 mktemp (XSTRING (val
)->data
);
696 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
697 "Convert FILENAME to absolute, and canonicalize it.\n\
698 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
699 (does not start with slash); if DEFAULT is nil or missing,\n\
700 the current buffer's value of default-directory is used.\n\
701 Path components that are `.' are removed, and \n\
702 path components followed by `..' are removed, along with the `..' itself;\n\
703 note that these simplifications are done without checking the resulting\n\
704 paths in the file system.\n\
705 An initial `~/' expands to your home directory.\n\
706 An initial `~USER/' expands to USER's home directory.\n\
707 See also the function `substitute-in-file-name'.")
709 Lisp_Object name
, defalt
;
713 register unsigned char *newdir
, *p
, *o
;
715 unsigned char *target
;
718 unsigned char * colon
= 0;
719 unsigned char * close
= 0;
720 unsigned char * slash
= 0;
721 unsigned char * brack
= 0;
722 int lbrack
= 0, rbrack
= 0;
725 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
728 unsigned char *tmp
, *defdir
;
732 CHECK_STRING (name
, 0);
734 /* If the file name has special constructs in it,
735 call the corresponding file handler. */
736 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
738 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
740 /* Use the buffer's default-directory if DEFALT is omitted. */
742 defalt
= current_buffer
->directory
;
743 CHECK_STRING (defalt
, 1);
745 /* Make sure DEFALT is properly expanded.
746 It would be better to do this down below where we actually use
747 defalt. Unfortunately, calling Fexpand_file_name recursively
748 could invoke GC, and the strings might be relocated. This would
749 be annoying because we have pointers into strings lying around
750 that would need adjusting, and people would add new pointers to
751 the code and forget to adjust them, resulting in intermittent bugs.
752 Putting this call here avoids all that crud.
754 The EQ test avoids infinite recursion. */
755 if (! NILP (defalt
) && !EQ (defalt
, name
)
756 /* This saves time in a common case. */
757 && XSTRING (defalt
)->data
[0] != '/')
762 defalt
= Fexpand_file_name (defalt
, Qnil
);
767 /* Filenames on VMS are always upper case. */
768 name
= Fupcase (name
);
770 #ifdef FILE_SYSTEM_CASE
771 name
= FILE_SYSTEM_CASE (name
);
774 nm
= XSTRING (name
)->data
;
777 /* First map all backslashes to slashes. */
778 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
780 /* Now strip drive name. */
782 unsigned char *colon
= rindex (nm
, ':');
788 drive
= tolower (colon
[-1]) - 'a';
792 defdir
= alloca (MAXPATHLEN
+ 1);
793 relpath
= getdefdir (drive
+ 1, defdir
);
799 /* If nm is absolute, flush ...// and detect /./ and /../.
800 If no /./ or /../ we can return right away. */
808 /* If it turns out that the filename we want to return is just a
809 suffix of FILENAME, we don't need to go through and edit
810 things; we just need to construct a new string using data
811 starting at the middle of FILENAME. If we set lose to a
812 non-zero value, that means we've discovered that we can't do
819 /* Since we know the path is absolute, we can assume that each
820 element starts with a "/". */
822 /* "//" anywhere isn't necessarily hairy; we just start afresh
823 with the second slash. */
824 if (p
[0] == '/' && p
[1] == '/'
826 /* // at start of filename is meaningful on Apollo system */
832 /* "~" is hairy as the start of any path element. */
833 if (p
[0] == '/' && p
[1] == '~')
834 nm
= p
+ 1, lose
= 1;
836 /* "." and ".." are hairy. */
841 || (p
[2] == '.' && (p
[3] == '/'
848 /* if dev:[dir]/, move nm to / */
849 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
850 nm
= (brack
? brack
+ 1 : colon
+ 1);
859 /* VMS pre V4.4,convert '-'s in filenames. */
860 if (lbrack
== rbrack
)
862 if (dots
< 2) /* this is to allow negative version numbers */
867 if (lbrack
> rbrack
&&
868 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
869 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
875 /* count open brackets, reset close bracket pointer */
876 if (p
[0] == '[' || p
[0] == '<')
878 /* count close brackets, set close bracket pointer */
879 if (p
[0] == ']' || p
[0] == '>')
881 /* detect ][ or >< */
882 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
884 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
885 nm
= p
+ 1, lose
= 1;
886 if (p
[0] == ':' && (colon
|| slash
))
887 /* if dev1:[dir]dev2:, move nm to dev2: */
893 /* if /pathname/dev:, move nm to dev: */
896 /* if node::dev:, move colon following dev */
897 else if (colon
&& colon
[-1] == ':')
899 /* if dev1:dev2:, move nm to dev2: */
900 else if (colon
&& colon
[-1] != ':')
905 if (p
[0] == ':' && !colon
)
911 if (lbrack
== rbrack
)
914 else if (p
[0] == '.')
923 return build_string (sys_translate_unix (nm
));
926 if (nm
== XSTRING (name
)->data
)
928 return build_string (nm
);
933 /* Now determine directory to start with and put it in newdir */
937 if (nm
[0] == '~') /* prefix ~ */
943 || nm
[1] == 0) /* ~ by itself */
945 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
946 newdir
= (unsigned char *) "";
948 dostounix_filename (newdir
);
952 nm
++; /* Don't leave the slash in nm. */
955 else /* ~user/filename */
957 for (p
= nm
; *p
&& (*p
!= '/'
962 o
= (unsigned char *) alloca (p
- nm
+ 1);
963 bcopy ((char *) nm
, o
, p
- nm
);
966 pw
= (struct passwd
*) getpwnam (o
+ 1);
969 newdir
= (unsigned char *) pw
-> pw_dir
;
971 nm
= p
+ 1; /* skip the terminator */
977 /* If we don't find a user of that name, leave the name
978 unchanged; don't move nm forward to p. */
991 newdir
= XSTRING (defalt
)->data
;
995 if (newdir
== 0 && relpath
)
1000 /* Get rid of any slash at the end of newdir. */
1001 int length
= strlen (newdir
);
1002 /* Adding `length > 1 &&' makes ~ expand into / when homedir
1003 is the root dir. People disagree about whether that is right.
1004 Anyway, we can't take the risk of this change now. */
1006 if (newdir
[1] != ':' && length
> 1)
1008 if (newdir
[length
- 1] == '/')
1010 unsigned char *temp
= (unsigned char *) alloca (length
);
1011 bcopy (newdir
, temp
, length
- 1);
1012 temp
[length
- 1] = 0;
1020 /* Now concatenate the directory and name to new space in the stack frame */
1021 tlen
+= strlen (nm
) + 1;
1023 /* Add reserved space for drive name. */
1024 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1026 target
= (unsigned char *) alloca (tlen
);
1033 if (nm
[0] == 0 || nm
[0] == '/')
1034 strcpy (target
, newdir
);
1037 file_name_as_directory (target
, newdir
);
1040 strcat (target
, nm
);
1042 if (index (target
, '/'))
1043 strcpy (target
, sys_translate_unix (target
));
1046 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1054 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1060 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1061 /* brackets are offset from each other by 2 */
1064 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1065 /* convert [foo][bar] to [bar] */
1066 while (o
[-1] != '[' && o
[-1] != '<')
1068 else if (*p
== '-' && *o
!= '.')
1071 else if (p
[0] == '-' && o
[-1] == '.' &&
1072 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1073 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1077 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1078 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1080 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1082 /* else [foo.-] ==> [-] */
1088 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1089 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1099 else if (!strncmp (p
, "//", 2)
1101 /* // at start of filename is meaningful in Apollo system */
1109 else if (p
[0] == '/'
1114 /* If "/." is the entire filename, keep the "/". Otherwise,
1115 just delete the whole "/.". */
1116 if (o
== target
&& p
[2] == '\0')
1120 else if (!strncmp (p
, "/..", 3)
1121 /* `/../' is the "superroot" on certain file systems. */
1123 && (p
[3] == '/' || p
[3] == 0))
1125 while (o
!= target
&& *--o
!= '/')
1128 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1132 if (o
== target
&& *o
== '/')
1140 #endif /* not VMS */
1144 /* at last, set drive name. */
1145 if (target
[1] != ':')
1148 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1153 return make_string (target
, o
- target
);
1156 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1157 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1158 "Convert FILENAME to absolute, and canonicalize it.\n\
1159 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1160 (does not start with slash); if DEFAULT is nil or missing,\n\
1161 the current buffer's value of default-directory is used.\n\
1162 Filenames containing `.' or `..' as components are simplified;\n\
1163 initial `~/' expands to your home directory.\n\
1164 See also the function `substitute-in-file-name'.")
1166 Lisp_Object name, defalt;
1170 register unsigned char *newdir, *p, *o;
1172 unsigned char *target;
1176 unsigned char * colon = 0;
1177 unsigned char * close = 0;
1178 unsigned char * slash = 0;
1179 unsigned char * brack = 0;
1180 int lbrack = 0, rbrack = 0;
1184 CHECK_STRING (name
, 0);
1187 /* Filenames on VMS are always upper case. */
1188 name
= Fupcase (name
);
1191 nm
= XSTRING (name
)->data
;
1193 /* If nm is absolute, flush ...// and detect /./ and /../.
1194 If no /./ or /../ we can return right away. */
1206 if (p
[0] == '/' && p
[1] == '/'
1208 /* // at start of filename is meaningful on Apollo system */
1213 if (p
[0] == '/' && p
[1] == '~')
1214 nm
= p
+ 1, lose
= 1;
1215 if (p
[0] == '/' && p
[1] == '.'
1216 && (p
[2] == '/' || p
[2] == 0
1217 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1223 /* if dev:[dir]/, move nm to / */
1224 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1225 nm
= (brack
? brack
+ 1 : colon
+ 1);
1226 lbrack
= rbrack
= 0;
1234 /* VMS pre V4.4,convert '-'s in filenames. */
1235 if (lbrack
== rbrack
)
1237 if (dots
< 2) /* this is to allow negative version numbers */
1242 if (lbrack
> rbrack
&&
1243 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1244 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1250 /* count open brackets, reset close bracket pointer */
1251 if (p
[0] == '[' || p
[0] == '<')
1252 lbrack
++, brack
= 0;
1253 /* count close brackets, set close bracket pointer */
1254 if (p
[0] == ']' || p
[0] == '>')
1255 rbrack
++, brack
= p
;
1256 /* detect ][ or >< */
1257 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1259 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1260 nm
= p
+ 1, lose
= 1;
1261 if (p
[0] == ':' && (colon
|| slash
))
1262 /* if dev1:[dir]dev2:, move nm to dev2: */
1268 /* if /pathname/dev:, move nm to dev: */
1271 /* if node::dev:, move colon following dev */
1272 else if (colon
&& colon
[-1] == ':')
1274 /* if dev1:dev2:, move nm to dev2: */
1275 else if (colon
&& colon
[-1] != ':')
1280 if (p
[0] == ':' && !colon
)
1286 if (lbrack
== rbrack
)
1289 else if (p
[0] == '.')
1297 if (index (nm
, '/'))
1298 return build_string (sys_translate_unix (nm
));
1300 if (nm
== XSTRING (name
)->data
)
1302 return build_string (nm
);
1306 /* Now determine directory to start with and put it in NEWDIR */
1310 if (nm
[0] == '~') /* prefix ~ */
1315 || nm
[1] == 0)/* ~/filename */
1317 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1318 newdir
= (unsigned char *) "";
1321 nm
++; /* Don't leave the slash in nm. */
1324 else /* ~user/filename */
1326 /* Get past ~ to user */
1327 unsigned char *user
= nm
+ 1;
1328 /* Find end of name. */
1329 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1330 int len
= ptr
? ptr
- user
: strlen (user
);
1332 unsigned char *ptr1
= index (user
, ':');
1333 if (ptr1
!= 0 && ptr1
- user
< len
)
1336 /* Copy the user name into temp storage. */
1337 o
= (unsigned char *) alloca (len
+ 1);
1338 bcopy ((char *) user
, o
, len
);
1341 /* Look up the user name. */
1342 pw
= (struct passwd
*) getpwnam (o
+ 1);
1344 error ("\"%s\" isn't a registered user", o
+ 1);
1346 newdir
= (unsigned char *) pw
->pw_dir
;
1348 /* Discard the user name from NM. */
1355 #endif /* not VMS */
1359 defalt
= current_buffer
->directory
;
1360 CHECK_STRING (defalt
, 1);
1361 newdir
= XSTRING (defalt
)->data
;
1364 /* Now concatenate the directory and name to new space in the stack frame */
1366 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1367 target
= (unsigned char *) alloca (tlen
);
1373 if (nm
[0] == 0 || nm
[0] == '/')
1374 strcpy (target
, newdir
);
1377 file_name_as_directory (target
, newdir
);
1380 strcat (target
, nm
);
1382 if (index (target
, '/'))
1383 strcpy (target
, sys_translate_unix (target
));
1386 /* Now canonicalize by removing /. and /foo/.. if they appear */
1394 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1400 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1401 /* brackets are offset from each other by 2 */
1404 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1405 /* convert [foo][bar] to [bar] */
1406 while (o
[-1] != '[' && o
[-1] != '<')
1408 else if (*p
== '-' && *o
!= '.')
1411 else if (p
[0] == '-' && o
[-1] == '.' &&
1412 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1413 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1417 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1418 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1420 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1422 /* else [foo.-] ==> [-] */
1428 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1429 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1439 else if (!strncmp (p
, "//", 2)
1441 /* // at start of filename is meaningful in Apollo system */
1449 else if (p
[0] == '/' && p
[1] == '.' &&
1450 (p
[2] == '/' || p
[2] == 0))
1452 else if (!strncmp (p
, "/..", 3)
1453 /* `/../' is the "superroot" on certain file systems. */
1455 && (p
[3] == '/' || p
[3] == 0))
1457 while (o
!= target
&& *--o
!= '/')
1460 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1464 if (o
== target
&& *o
== '/')
1472 #endif /* not VMS */
1475 return make_string (target
, o
- target
);
1479 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1480 Ssubstitute_in_file_name
, 1, 1, 0,
1481 "Substitute environment variables referred to in FILENAME.\n\
1482 `$FOO' where FOO is an environment variable name means to substitute\n\
1483 the value of that variable. The variable name should be terminated\n\
1484 with a character not a letter, digit or underscore; otherwise, enclose\n\
1485 the entire variable name in braces.\n\
1486 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1487 On VMS, `$' substitution is not done; this function does little and only\n\
1488 duplicates what `expand-file-name' does.")
1494 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1495 unsigned char *target
;
1497 int substituted
= 0;
1500 CHECK_STRING (string
, 0);
1502 nm
= XSTRING (string
)->data
;
1504 dostounix_filename (nm
= strcpy (alloca (strlen (nm
) + 1), nm
));
1505 substituted
= !strcmp (nm
, XSTRING (string
)->data
);
1507 endp
= nm
+ XSTRING (string
)->size
;
1509 /* If /~ or // appears, discard everything through first slash. */
1511 for (p
= nm
; p
!= endp
; p
++)
1515 /* // at start of file name is meaningful in Apollo system */
1516 (p
[0] == '/' && p
- 1 != nm
)
1517 #else /* not APOLLO */
1519 #endif /* not APOLLO */
1523 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1534 if (p
[0] && p
[1] == ':')
1543 return build_string (nm
);
1546 /* See if any variables are substituted into the string
1547 and find the total length of their values in `total' */
1549 for (p
= nm
; p
!= endp
;)
1559 /* "$$" means a single "$" */
1568 while (p
!= endp
&& *p
!= '}') p
++;
1569 if (*p
!= '}') goto missingclose
;
1575 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1579 /* Copy out the variable name */
1580 target
= (unsigned char *) alloca (s
- o
+ 1);
1581 strncpy (target
, o
, s
- o
);
1584 strupr (target
); /* $home == $HOME etc. */
1587 /* Get variable value */
1588 o
= (unsigned char *) egetenv (target
);
1589 if (!o
) goto badvar
;
1590 total
+= strlen (o
);
1597 /* If substitution required, recopy the string and do it */
1598 /* Make space in stack frame for the new copy */
1599 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1602 /* Copy the rest of the name through, replacing $ constructs with values */
1619 while (p
!= endp
&& *p
!= '}') p
++;
1620 if (*p
!= '}') goto missingclose
;
1626 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1630 /* Copy out the variable name */
1631 target
= (unsigned char *) alloca (s
- o
+ 1);
1632 strncpy (target
, o
, s
- o
);
1635 strupr (target
); /* $home == $HOME etc. */
1638 /* Get variable value */
1639 o
= (unsigned char *) egetenv (target
);
1649 /* If /~ or // appears, discard everything through first slash. */
1651 for (p
= xnm
; p
!= x
; p
++)
1654 /* // at start of file name is meaningful in Apollo system */
1655 (p
[0] == '/' && p
- 1 != xnm
)
1656 #else /* not APOLLO */
1658 #endif /* not APOLLO */
1660 && p
!= nm
&& p
[-1] == '/')
1663 else if (p
[0] && p
[1] == ':')
1667 return make_string (xnm
, x
- xnm
);
1670 error ("Bad format environment-variable substitution");
1672 error ("Missing \"}\" in environment-variable substitution");
1674 error ("Substituting nonexistent environment variable \"%s\"", target
);
1677 #endif /* not VMS */
1680 /* A slightly faster and more convenient way to get
1681 (directory-file-name (expand-file-name FOO)). */
1684 expand_and_dir_to_file (filename
, defdir
)
1685 Lisp_Object filename
, defdir
;
1687 register Lisp_Object abspath
;
1689 abspath
= Fexpand_file_name (filename
, defdir
);
1692 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1693 if (c
== ':' || c
== ']' || c
== '>')
1694 abspath
= Fdirectory_file_name (abspath
);
1697 /* Remove final slash, if any (unless path is root).
1698 stat behaves differently depending! */
1699 if (XSTRING (abspath
)->size
> 1
1700 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1701 /* We cannot take shortcuts; they might be wrong for magic file names. */
1702 abspath
= Fdirectory_file_name (abspath
);
1707 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1708 Lisp_Object absname
;
1709 unsigned char *querystring
;
1712 register Lisp_Object tem
;
1713 struct stat statbuf
;
1714 struct gcpro gcpro1
;
1716 /* stat is a good way to tell whether the file exists,
1717 regardless of what access permissions it has. */
1718 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1721 Fsignal (Qfile_already_exists
,
1722 Fcons (build_string ("File already exists"),
1723 Fcons (absname
, Qnil
)));
1725 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1726 XSTRING (absname
)->data
, querystring
));
1729 Fsignal (Qfile_already_exists
,
1730 Fcons (build_string ("File already exists"),
1731 Fcons (absname
, Qnil
)));
1736 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1737 "fCopy file: \nFCopy %s to file: \np\nP",
1738 "Copy FILE to NEWNAME. Both args must be strings.\n\
1739 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1740 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1741 A number as third arg means request confirmation if NEWNAME already exists.\n\
1742 This is what happens in interactive use with M-x.\n\
1743 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1744 last-modified time as the old one. (This works on only some systems.)\n\
1745 A prefix arg makes KEEP-TIME non-nil.")
1746 (filename
, newname
, ok_if_already_exists
, keep_date
)
1747 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1750 char buf
[16 * 1024];
1752 Lisp_Object handler
;
1753 struct gcpro gcpro1
, gcpro2
;
1754 int count
= specpdl_ptr
- specpdl
;
1755 int input_file_statable_p
;
1757 GCPRO2 (filename
, newname
);
1758 CHECK_STRING (filename
, 0);
1759 CHECK_STRING (newname
, 1);
1760 filename
= Fexpand_file_name (filename
, Qnil
);
1761 newname
= Fexpand_file_name (newname
, Qnil
);
1763 /* If the input file name has special constructs in it,
1764 call the corresponding file handler. */
1765 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1766 /* Likewise for output file name. */
1768 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1769 if (!NILP (handler
))
1770 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1771 ok_if_already_exists
, keep_date
));
1773 if (NILP (ok_if_already_exists
)
1774 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1775 barf_or_query_if_file_exists (newname
, "copy to it",
1776 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1778 ifd
= open (XSTRING (filename
)->data
, O_RDONLY
);
1780 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1782 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1784 /* We can only copy regular files and symbolic links. Other files are not
1786 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1788 #if defined (S_ISREG) && defined (S_ISLNK)
1789 if (input_file_statable_p
)
1791 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1793 #if defined (EISDIR)
1794 /* Get a better looking error message. */
1797 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1800 #endif /* S_ISREG && S_ISLNK */
1803 /* Create the copy file with the same record format as the input file */
1804 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1807 /* System's default file type was set to binary by _fmode in emacs.c. */
1808 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1809 #else /* not MSDOS */
1810 ofd
= creat (XSTRING (newname
)->data
, 0666);
1811 #endif /* not MSDOS */
1814 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1816 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1820 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1821 if (write (ofd
, buf
, n
) != n
)
1822 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1825 /* Closing the output clobbers the file times on some systems. */
1826 if (close (ofd
) < 0)
1827 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1829 if (input_file_statable_p
)
1831 if (!NILP (keep_date
))
1833 EMACS_TIME atime
, mtime
;
1834 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1835 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1836 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1839 if (!egetenv ("USE_DOMAIN_ACLS"))
1841 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1846 /* Discard the unwind protects. */
1847 specpdl_ptr
= specpdl
+ count
;
1853 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1854 Smake_directory_internal
, 1, 1, 0,
1855 "Create a directory. One argument, a file name string.")
1857 Lisp_Object dirname
;
1860 Lisp_Object handler
;
1862 CHECK_STRING (dirname
, 0);
1863 dirname
= Fexpand_file_name (dirname
, Qnil
);
1865 handler
= Ffind_file_name_handler (dirname
, Qmake_directory_internal
);
1866 if (!NILP (handler
))
1867 return call2 (handler
, Qmake_directory_internal
, dirname
);
1869 dir
= XSTRING (dirname
)->data
;
1871 if (mkdir (dir
, 0777) != 0)
1872 report_file_error ("Creating directory", Flist (1, &dirname
));
1877 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1878 "Delete a directory. One argument, a file name or directory name string.")
1880 Lisp_Object dirname
;
1883 Lisp_Object handler
;
1885 CHECK_STRING (dirname
, 0);
1886 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1887 dir
= XSTRING (dirname
)->data
;
1889 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1890 if (!NILP (handler
))
1891 return call2 (handler
, Qdelete_directory
, dirname
);
1893 if (rmdir (dir
) != 0)
1894 report_file_error ("Removing directory", Flist (1, &dirname
));
1899 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1900 "Delete specified file. One argument, a file name string.\n\
1901 If file has multiple names, it continues to exist with the other names.")
1903 Lisp_Object filename
;
1905 Lisp_Object handler
;
1906 CHECK_STRING (filename
, 0);
1907 filename
= Fexpand_file_name (filename
, Qnil
);
1909 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1910 if (!NILP (handler
))
1911 return call2 (handler
, Qdelete_file
, filename
);
1913 if (0 > unlink (XSTRING (filename
)->data
))
1914 report_file_error ("Removing old name", Flist (1, &filename
));
1918 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1919 "fRename file: \nFRename %s to file: \np",
1920 "Rename FILE as NEWNAME. Both args strings.\n\
1921 If file has names other than FILE, it continues to have those names.\n\
1922 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1923 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1924 A number as third arg means request confirmation if NEWNAME already exists.\n\
1925 This is what happens in interactive use with M-x.")
1926 (filename
, newname
, ok_if_already_exists
)
1927 Lisp_Object filename
, newname
, ok_if_already_exists
;
1930 Lisp_Object args
[2];
1932 Lisp_Object handler
;
1933 struct gcpro gcpro1
, gcpro2
;
1935 GCPRO2 (filename
, newname
);
1936 CHECK_STRING (filename
, 0);
1937 CHECK_STRING (newname
, 1);
1938 filename
= Fexpand_file_name (filename
, Qnil
);
1939 newname
= Fexpand_file_name (newname
, Qnil
);
1941 /* If the file name has special constructs in it,
1942 call the corresponding file handler. */
1943 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1945 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1946 if (!NILP (handler
))
1947 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1948 filename
, newname
, ok_if_already_exists
));
1950 if (NILP (ok_if_already_exists
)
1951 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1952 barf_or_query_if_file_exists (newname
, "rename to it",
1953 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1955 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1957 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1958 || 0 > unlink (XSTRING (filename
)->data
))
1963 Fcopy_file (filename
, newname
,
1964 /* We have already prompted if it was an integer,
1965 so don't have copy-file prompt again. */
1966 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1967 Fdelete_file (filename
);
1974 report_file_error ("Renaming", Flist (2, args
));
1977 report_file_error ("Renaming", Flist (2, &filename
));
1984 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1985 "fAdd name to file: \nFName to add to %s: \np",
1986 "Give FILE additional name NEWNAME. Both args strings.\n\
1987 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1988 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1989 A number as third arg means request confirmation if NEWNAME already exists.\n\
1990 This is what happens in interactive use with M-x.")
1991 (filename
, newname
, ok_if_already_exists
)
1992 Lisp_Object filename
, newname
, ok_if_already_exists
;
1995 Lisp_Object args
[2];
1997 Lisp_Object handler
;
1998 struct gcpro gcpro1
, gcpro2
;
2000 GCPRO2 (filename
, newname
);
2001 CHECK_STRING (filename
, 0);
2002 CHECK_STRING (newname
, 1);
2003 filename
= Fexpand_file_name (filename
, Qnil
);
2004 newname
= Fexpand_file_name (newname
, Qnil
);
2006 /* If the file name has special constructs in it,
2007 call the corresponding file handler. */
2008 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
2009 if (!NILP (handler
))
2010 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
2011 newname
, ok_if_already_exists
));
2013 if (NILP (ok_if_already_exists
)
2014 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2015 barf_or_query_if_file_exists (newname
, "make it a new name",
2016 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2017 unlink (XSTRING (newname
)->data
);
2018 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2023 report_file_error ("Adding new name", Flist (2, args
));
2025 report_file_error ("Adding new name", Flist (2, &filename
));
2034 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2035 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2036 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2037 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2038 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2039 A number as third arg means request confirmation if NEWNAME already exists.\n\
2040 This happens for interactive use with M-x.")
2041 (filename
, linkname
, ok_if_already_exists
)
2042 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2045 Lisp_Object args
[2];
2047 Lisp_Object handler
;
2048 struct gcpro gcpro1
, gcpro2
;
2050 GCPRO2 (filename
, linkname
);
2051 CHECK_STRING (filename
, 0);
2052 CHECK_STRING (linkname
, 1);
2053 /* If the link target has a ~, we must expand it to get
2054 a truly valid file name. Otherwise, do not expand;
2055 we want to permit links to relative file names. */
2056 if (XSTRING (filename
)->data
[0] == '~')
2057 filename
= Fexpand_file_name (filename
, Qnil
);
2058 linkname
= Fexpand_file_name (linkname
, Qnil
);
2060 /* If the file name has special constructs in it,
2061 call the corresponding file handler. */
2062 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2063 if (!NILP (handler
))
2064 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2065 linkname
, ok_if_already_exists
));
2067 if (NILP (ok_if_already_exists
)
2068 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2069 barf_or_query_if_file_exists (linkname
, "make it a link",
2070 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2071 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2073 /* If we didn't complain already, silently delete existing file. */
2074 if (errno
== EEXIST
)
2076 unlink (XSTRING (linkname
)->data
);
2077 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2087 report_file_error ("Making symbolic link", Flist (2, args
));
2089 report_file_error ("Making symbolic link", Flist (2, &filename
));
2095 #endif /* S_IFLNK */
2099 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2100 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2101 "Define the job-wide logical name NAME to have the value STRING.\n\
2102 If STRING is nil or a null string, the logical name NAME is deleted.")
2104 Lisp_Object varname
;
2107 CHECK_STRING (varname
, 0);
2109 delete_logical_name (XSTRING (varname
)->data
);
2112 CHECK_STRING (string
, 1);
2114 if (XSTRING (string
)->size
== 0)
2115 delete_logical_name (XSTRING (varname
)->data
);
2117 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2126 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2127 "Open a network connection to PATH using LOGIN as the login string.")
2129 Lisp_Object path
, login
;
2133 CHECK_STRING (path
, 0);
2134 CHECK_STRING (login
, 0);
2136 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2138 if (netresult
== -1)
2143 #endif /* HPUX_NET */
2145 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2147 "Return t if file FILENAME specifies an absolute path name.\n\
2148 On Unix, this is a name starting with a `/' or a `~'.")
2150 Lisp_Object filename
;
2154 CHECK_STRING (filename
, 0);
2155 ptr
= XSTRING (filename
)->data
;
2156 if (*ptr
== '/' || *ptr
== '~'
2158 /* ??? This criterion is probably wrong for '<'. */
2159 || index (ptr
, ':') || index (ptr
, '<')
2160 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2164 || (*ptr
!= 0 && ptr
[1] == ':' && (ptr
[2] == '/' || ptr
[2] == '\\'))
2172 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2173 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2174 See also `file-readable-p' and `file-attributes'.")
2176 Lisp_Object filename
;
2178 Lisp_Object abspath
;
2179 Lisp_Object handler
;
2180 struct stat statbuf
;
2182 CHECK_STRING (filename
, 0);
2183 abspath
= Fexpand_file_name (filename
, Qnil
);
2185 /* If the file name has special constructs in it,
2186 call the corresponding file handler. */
2187 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2188 if (!NILP (handler
))
2189 return call2 (handler
, Qfile_exists_p
, abspath
);
2191 return (stat (XSTRING (abspath
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2194 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2195 "Return t if FILENAME can be executed by you.\n\
2196 For a directory, this means you can access files in that directory.")
2198 Lisp_Object filename
;
2201 Lisp_Object abspath
;
2202 Lisp_Object handler
;
2204 CHECK_STRING (filename
, 0);
2205 abspath
= Fexpand_file_name (filename
, Qnil
);
2207 /* If the file name has special constructs in it,
2208 call the corresponding file handler. */
2209 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2210 if (!NILP (handler
))
2211 return call2 (handler
, Qfile_executable_p
, abspath
);
2213 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2216 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2217 "Return t if file FILENAME exists and you can read it.\n\
2218 See also `file-exists-p' and `file-attributes'.")
2220 Lisp_Object filename
;
2222 Lisp_Object abspath
;
2223 Lisp_Object handler
;
2226 CHECK_STRING (filename
, 0);
2227 abspath
= Fexpand_file_name (filename
, Qnil
);
2229 /* If the file name has special constructs in it,
2230 call the corresponding file handler. */
2231 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2232 if (!NILP (handler
))
2233 return call2 (handler
, Qfile_readable_p
, abspath
);
2235 desc
= open (XSTRING (abspath
)->data
, O_RDONLY
);
2242 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2243 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2244 The value is the name of the file to which it is linked.\n\
2245 Otherwise returns nil.")
2247 Lisp_Object filename
;
2254 Lisp_Object handler
;
2256 CHECK_STRING (filename
, 0);
2257 filename
= Fexpand_file_name (filename
, Qnil
);
2259 /* If the file name has special constructs in it,
2260 call the corresponding file handler. */
2261 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2262 if (!NILP (handler
))
2263 return call2 (handler
, Qfile_symlink_p
, filename
);
2268 buf
= (char *) xmalloc (bufsize
);
2269 bzero (buf
, bufsize
);
2270 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2271 if (valsize
< bufsize
) break;
2272 /* Buffer was not long enough */
2281 val
= make_string (buf
, valsize
);
2284 #else /* not S_IFLNK */
2286 #endif /* not S_IFLNK */
2289 #ifdef SOLARIS_BROKEN_ACCESS
2290 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2291 considered by the access system call. This is Sun's bug, but we
2292 still have to make Emacs work. */
2294 #include <sys/statvfs.h>
2300 struct statvfs statvfsb
;
2302 if (statvfs(path
, &statvfsb
))
2303 return 1; /* error from statvfs, be conservative and say not wrtable */
2305 /* Otherwise, fsys is ro if bit is set. */
2306 return statvfsb
.f_flag
& ST_RDONLY
;
2309 /* But on every other os, access has already done the right thing. */
2310 #define ro_fsys(path) 0
2313 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2315 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2316 "Return t if file FILENAME can be written or created by you.")
2318 Lisp_Object filename
;
2320 Lisp_Object abspath
, dir
;
2321 Lisp_Object handler
;
2323 CHECK_STRING (filename
, 0);
2324 abspath
= Fexpand_file_name (filename
, Qnil
);
2326 /* If the file name has special constructs in it,
2327 call the corresponding file handler. */
2328 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2329 if (!NILP (handler
))
2330 return call2 (handler
, Qfile_writable_p
, abspath
);
2332 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2333 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2334 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2336 dir
= Ffile_name_directory (abspath
);
2339 dir
= Fdirectory_file_name (dir
);
2343 dir
= Fdirectory_file_name (dir
);
2345 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2346 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2350 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2351 "Return t if file FILENAME is the name of a directory as a file.\n\
2352 A directory name spec may be given instead; then the value is t\n\
2353 if the directory so specified exists and really is a directory.")
2355 Lisp_Object filename
;
2357 register Lisp_Object abspath
;
2359 Lisp_Object handler
;
2361 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2363 /* If the file name has special constructs in it,
2364 call the corresponding file handler. */
2365 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2366 if (!NILP (handler
))
2367 return call2 (handler
, Qfile_directory_p
, abspath
);
2369 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2371 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2374 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2375 "Return t if file FILENAME is the name of a directory as a file,\n\
2376 and files in that directory can be opened by you. In order to use a\n\
2377 directory as a buffer's current directory, this predicate must return true.\n\
2378 A directory name spec may be given instead; then the value is t\n\
2379 if the directory so specified exists and really is a readable and\n\
2380 searchable directory.")
2382 Lisp_Object filename
;
2384 Lisp_Object handler
;
2386 struct gcpro gcpro1
;
2388 /* If the file name has special constructs in it,
2389 call the corresponding file handler. */
2390 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2391 if (!NILP (handler
))
2392 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2394 /* Need to gcpro in case the first function call has a handler that
2395 causes filename to be relocated. */
2397 tem
= (NILP (Ffile_directory_p (filename
))
2398 || NILP (Ffile_executable_p (filename
)));
2400 return tem
? Qnil
: Qt
;
2403 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2404 "Return mode bits of FILE, as an integer.")
2406 Lisp_Object filename
;
2408 Lisp_Object abspath
;
2410 Lisp_Object handler
;
2412 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2414 /* If the file name has special constructs in it,
2415 call the corresponding file handler. */
2416 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2417 if (!NILP (handler
))
2418 return call2 (handler
, Qfile_modes
, abspath
);
2420 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2426 if (S_ISREG (st
.st_mode
)
2427 && (len
= XSTRING (abspath
)->size
) >= 5
2428 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2429 || stricmp (suffix
, ".exe") == 0
2430 || stricmp (suffix
, ".bat") == 0))
2431 st
.st_mode
|= S_IEXEC
;
2435 return make_number (st
.st_mode
& 07777);
2438 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2439 "Set mode bits of FILE to MODE (an integer).\n\
2440 Only the 12 low bits of MODE are used.")
2442 Lisp_Object filename
, mode
;
2444 Lisp_Object abspath
;
2445 Lisp_Object handler
;
2447 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2448 CHECK_NUMBER (mode
, 1);
2450 /* If the file name has special constructs in it,
2451 call the corresponding file handler. */
2452 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2453 if (!NILP (handler
))
2454 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2457 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2458 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2460 if (!egetenv ("USE_DOMAIN_ACLS"))
2463 struct timeval tvp
[2];
2465 /* chmod on apollo also change the file's modtime; need to save the
2466 modtime and then restore it. */
2467 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2469 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2473 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2474 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2476 /* reset the old accessed and modified times. */
2477 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2479 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2482 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2483 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2490 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2491 "Set the file permission bits for newly created files.\n\
2492 The argument MODE should be an integer; only the low 9 bits are used.\n\
2493 This setting is inherited by subprocesses.")
2497 CHECK_NUMBER (mode
, 0);
2499 umask ((~ XINT (mode
)) & 0777);
2504 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2505 "Return the default file protection for created files.\n\
2506 The value is an integer.")
2512 realmask
= umask (0);
2515 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2521 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2522 "Tell Unix to finish all pending disk updates.")
2531 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2532 "Return t if file FILE1 is newer than file FILE2.\n\
2533 If FILE1 does not exist, the answer is nil;\n\
2534 otherwise, if FILE2 does not exist, the answer is t.")
2536 Lisp_Object file1
, file2
;
2538 Lisp_Object abspath1
, abspath2
;
2541 Lisp_Object handler
;
2542 struct gcpro gcpro1
, gcpro2
;
2544 CHECK_STRING (file1
, 0);
2545 CHECK_STRING (file2
, 0);
2548 GCPRO2 (abspath1
, file2
);
2549 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2550 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2553 /* If the file name has special constructs in it,
2554 call the corresponding file handler. */
2555 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2557 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2558 if (!NILP (handler
))
2559 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2561 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2564 mtime1
= st
.st_mtime
;
2566 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2569 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2573 Lisp_Object Qfind_buffer_file_type
;
2576 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2578 "Insert contents of file FILENAME after point.\n\
2579 Returns list of absolute file name and length of data inserted.\n\
2580 If second argument VISIT is non-nil, the buffer's visited filename\n\
2581 and last save file modtime are set, and it is marked unmodified.\n\
2582 If visiting and the file does not exist, visiting is completed\n\
2583 before the error is signaled.\n\n\
2584 The optional third and fourth arguments BEG and END\n\
2585 specify what portion of the file to insert.\n\
2586 If VISIT is non-nil, BEG and END must be nil.\n\
2587 If optional fifth argument REPLACE is non-nil,\n\
2588 it means replace the current buffer contents (in the accessible portion)\n\
2589 with the file contents. This is better than simply deleting and inserting\n\
2590 the whole thing because (1) it preserves some marker positions\n\
2591 and (2) it puts less data in the undo list.")
2592 (filename
, visit
, beg
, end
, replace
)
2593 Lisp_Object filename
, visit
, beg
, end
, replace
;
2597 register int inserted
= 0;
2598 register int how_much
;
2599 int count
= specpdl_ptr
- specpdl
;
2600 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2601 Lisp_Object handler
, val
, insval
;
2608 GCPRO3 (filename
, val
, p
);
2609 if (!NILP (current_buffer
->read_only
))
2610 Fbarf_if_buffer_read_only();
2612 CHECK_STRING (filename
, 0);
2613 filename
= Fexpand_file_name (filename
, Qnil
);
2615 /* If the file name has special constructs in it,
2616 call the corresponding file handler. */
2617 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2618 if (!NILP (handler
))
2620 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2621 visit
, beg
, end
, replace
);
2628 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2630 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
2631 || fstat (fd
, &st
) < 0)
2632 #endif /* not APOLLO */
2634 if (fd
>= 0) close (fd
);
2637 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2644 /* This code will need to be changed in order to work on named
2645 pipes, and it's probably just not worth it. So we should at
2646 least signal an error. */
2647 if (!S_ISREG (st
.st_mode
))
2648 Fsignal (Qfile_error
,
2649 Fcons (build_string ("not a regular file"),
2650 Fcons (filename
, Qnil
)));
2654 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
2657 /* Replacement should preserve point as it preserves markers. */
2658 if (!NILP (replace
))
2659 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2661 record_unwind_protect (close_file_unwind
, make_number (fd
));
2663 /* Supposedly happens on VMS. */
2665 error ("File size is negative");
2667 if (!NILP (beg
) || !NILP (end
))
2669 error ("Attempt to visit less than an entire file");
2672 CHECK_NUMBER (beg
, 0);
2677 CHECK_NUMBER (end
, 0);
2680 XSETINT (end
, st
.st_size
);
2681 if (XINT (end
) != st
.st_size
)
2682 error ("maximum buffer size exceeded");
2685 /* If requested, replace the accessible part of the buffer
2686 with the file contents. Avoid replacing text at the
2687 beginning or end of the buffer that matches the file contents;
2688 that preserves markers pointing to the unchanged parts. */
2690 /* On MSDOS, replace mode doesn't really work, except for binary files,
2691 and it's not worth supporting just for them. */
2692 if (!NILP (replace
))
2696 XFASTINT (end
) = st
.st_size
;
2697 del_range_1 (BEGV
, ZV
, 0);
2700 if (!NILP (replace
))
2702 unsigned char buffer
[1 << 14];
2703 int same_at_start
= BEGV
;
2704 int same_at_end
= ZV
;
2709 /* Count how many chars at the start of the file
2710 match the text at the beginning of the buffer. */
2715 nread
= read (fd
, buffer
, sizeof buffer
);
2717 error ("IO error reading %s: %s",
2718 XSTRING (filename
)->data
, strerror (errno
));
2719 else if (nread
== 0)
2722 while (bufpos
< nread
&& same_at_start
< ZV
2723 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2724 same_at_start
++, bufpos
++;
2725 /* If we found a discrepancy, stop the scan.
2726 Otherwise loop around and scan the next bufferfull. */
2727 if (bufpos
!= nread
)
2731 /* If the file matches the buffer completely,
2732 there's no need to replace anything. */
2733 if (same_at_start
- BEGV
== st
.st_size
)
2737 /* Truncate the buffer to the size of the file. */
2738 del_range_1 (same_at_start
, same_at_end
, 0);
2743 /* Count how many chars at the end of the file
2744 match the text at the end of the buffer. */
2747 int total_read
, nread
, bufpos
, curpos
, trial
;
2749 /* At what file position are we now scanning? */
2750 curpos
= st
.st_size
- (ZV
- same_at_end
);
2751 /* If the entire file matches the buffer tail, stop the scan. */
2754 /* How much can we scan in the next step? */
2755 trial
= min (curpos
, sizeof buffer
);
2756 if (lseek (fd
, curpos
- trial
, 0) < 0)
2757 report_file_error ("Setting file position",
2758 Fcons (filename
, Qnil
));
2761 while (total_read
< trial
)
2763 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2765 error ("IO error reading %s: %s",
2766 XSTRING (filename
)->data
, strerror (errno
));
2767 total_read
+= nread
;
2769 /* Scan this bufferfull from the end, comparing with
2770 the Emacs buffer. */
2771 bufpos
= total_read
;
2772 /* Compare with same_at_start to avoid counting some buffer text
2773 as matching both at the file's beginning and at the end. */
2774 while (bufpos
> 0 && same_at_end
> same_at_start
2775 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2776 same_at_end
--, bufpos
--;
2777 /* If we found a discrepancy, stop the scan.
2778 Otherwise loop around and scan the preceding bufferfull. */
2784 /* Don't try to reuse the same piece of text twice. */
2785 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2787 same_at_end
+= overlap
;
2789 /* Arrange to read only the nonmatching middle part of the file. */
2790 XFASTINT (beg
) = same_at_start
- BEGV
;
2791 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2793 del_range_1 (same_at_start
, same_at_end
, 0);
2794 /* Insert from the file at the proper position. */
2795 SET_PT (same_at_start
);
2799 total
= XINT (end
) - XINT (beg
);
2802 register Lisp_Object temp
;
2804 /* Make sure point-max won't overflow after this insertion. */
2805 XSET (temp
, Lisp_Int
, total
);
2806 if (total
!= XINT (temp
))
2807 error ("maximum buffer size exceeded");
2810 if (NILP (visit
) && total
> 0)
2811 prepare_to_modify_buffer (point
, point
);
2814 if (GAP_SIZE
< total
)
2815 make_gap (total
- GAP_SIZE
);
2817 if (XINT (beg
) != 0 || !NILP (replace
))
2819 if (lseek (fd
, XINT (beg
), 0) < 0)
2820 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2824 while (inserted
< total
)
2826 int try = min (total
- inserted
, 64 << 10);
2829 /* Allow quitting out of the actual I/O. */
2832 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2849 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2850 /* Determine file type from name and remove LFs from CR-LFs if the file
2851 is deemed to be a text file. */
2853 struct gcpro gcpro1
;
2857 current_buffer
->buffer_file_type
2858 = call1 (Qfind_buffer_file_type
, filename
);
2860 if (NILP (current_buffer
->buffer_file_type
))
2863 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2866 GPT
-= reduced_size
;
2867 GAP_SIZE
+= reduced_size
;
2868 inserted
-= reduced_size
;
2875 record_insert (point
, inserted
);
2877 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2878 offset_intervals (current_buffer
, point
, inserted
);
2884 /* Discard the unwind protect for closing the file. */
2888 error ("IO error reading %s: %s",
2889 XSTRING (filename
)->data
, strerror (errno
));
2896 if (!EQ (current_buffer
->undo_list
, Qt
))
2897 current_buffer
->undo_list
= Qnil
;
2899 stat (XSTRING (filename
)->data
, &st
);
2904 current_buffer
->modtime
= st
.st_mtime
;
2905 current_buffer
->filename
= filename
;
2908 current_buffer
->save_modified
= MODIFF
;
2909 current_buffer
->auto_save_modified
= MODIFF
;
2910 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2911 #ifdef CLASH_DETECTION
2914 if (!NILP (current_buffer
->filename
))
2915 unlock_file (current_buffer
->filename
);
2916 unlock_file (filename
);
2918 #endif /* CLASH_DETECTION */
2919 /* If visiting nonexistent file, return nil. */
2920 if (current_buffer
->modtime
== -1)
2921 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2924 if (inserted
> 0 && NILP (visit
) && total
> 0)
2925 signal_after_change (point
, 0, inserted
);
2929 p
= Vafter_insert_file_functions
;
2932 insval
= call1 (Fcar (p
), make_number (inserted
));
2935 CHECK_NUMBER (insval
, 0);
2936 inserted
= XFASTINT (insval
);
2944 val
= Fcons (filename
,
2945 Fcons (make_number (inserted
),
2948 RETURN_UNGCPRO (unbind_to (count
, val
));
2951 static Lisp_Object
build_annotations ();
2953 /* If build_annotations switched buffers, switch back to BUF.
2954 Kill the temporary buffer that was selected in the meantime. */
2957 build_annotations_unwind (buf
)
2962 if (XBUFFER (buf
) == current_buffer
)
2964 tembuf
= Fcurrent_buffer ();
2966 Fkill_buffer (tembuf
);
2970 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2971 "r\nFWrite region to file: ",
2972 "Write current region into specified file.\n\
2973 When called from a program, takes three arguments:\n\
2974 START, END and FILENAME. START and END are buffer positions.\n\
2975 Optional fourth argument APPEND if non-nil means\n\
2976 append to existing file contents (if any).\n\
2977 Optional fifth argument VISIT if t means\n\
2978 set the last-save-file-modtime of buffer to this file's modtime\n\
2979 and mark buffer not modified.\n\
2980 If VISIT is a string, it is a second file name;\n\
2981 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2982 VISIT is also the file name to lock and unlock for clash detection.\n\
2983 If VISIT is neither t nor nil nor a string,\n\
2984 that means do not print the \"Wrote file\" message.\n\
2985 Kludgy feature: if START is a string, then that string is written\n\
2986 to the file, instead of any buffer contents, and END is ignored.")
2987 (start
, end
, filename
, append
, visit
)
2988 Lisp_Object start
, end
, filename
, append
, visit
;
2996 int count
= specpdl_ptr
- specpdl
;
2999 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3001 Lisp_Object handler
;
3002 Lisp_Object visit_file
;
3003 Lisp_Object annotations
;
3004 int visiting
, quietly
;
3005 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3006 struct buffer
*given_buffer
;
3008 int buffer_file_type
3009 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3012 if (!NILP (start
) && !STRINGP (start
))
3013 validate_region (&start
, &end
);
3015 GCPRO2 (filename
, visit
);
3016 filename
= Fexpand_file_name (filename
, Qnil
);
3017 if (STRINGP (visit
))
3018 visit_file
= Fexpand_file_name (visit
, Qnil
);
3020 visit_file
= filename
;
3023 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3024 quietly
= !NILP (visit
);
3028 GCPRO4 (start
, filename
, annotations
, visit_file
);
3030 /* If the file name has special constructs in it,
3031 call the corresponding file handler. */
3032 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3033 /* If FILENAME has no handler, see if VISIT has one. */
3034 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
3035 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3037 if (!NILP (handler
))
3040 val
= call6 (handler
, Qwrite_region
, start
, end
,
3041 filename
, append
, visit
);
3045 current_buffer
->save_modified
= MODIFF
;
3046 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3047 current_buffer
->filename
= visit_file
;
3053 /* Special kludge to simplify auto-saving. */
3056 XFASTINT (start
) = BEG
;
3060 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3061 count1
= specpdl_ptr
- specpdl
;
3063 given_buffer
= current_buffer
;
3064 annotations
= build_annotations (start
, end
);
3065 if (current_buffer
!= given_buffer
)
3071 #ifdef CLASH_DETECTION
3073 lock_file (visit_file
);
3074 #endif /* CLASH_DETECTION */
3076 fn
= XSTRING (filename
)->data
;
3080 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3082 desc
= open (fn
, O_WRONLY
);
3087 if (auto_saving
) /* Overwrite any previous version of autosave file */
3089 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3090 desc
= open (fn
, O_RDWR
);
3092 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3093 ? XSTRING (current_buffer
->filename
)->data
: 0,
3096 else /* Write to temporary name and rename if no errors */
3098 Lisp_Object temp_name
;
3099 temp_name
= Ffile_name_directory (filename
);
3101 if (!NILP (temp_name
))
3103 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3104 build_string ("$$SAVE$$")));
3105 fname
= XSTRING (filename
)->data
;
3106 fn
= XSTRING (temp_name
)->data
;
3107 desc
= creat_copy_attrs (fname
, fn
);
3110 /* If we can't open the temporary file, try creating a new
3111 version of the original file. VMS "creat" creates a
3112 new version rather than truncating an existing file. */
3115 desc
= creat (fn
, 0666);
3116 #if 0 /* This can clobber an existing file and fail to replace it,
3117 if the user runs out of space. */
3120 /* We can't make a new version;
3121 try to truncate and rewrite existing version if any. */
3123 desc
= open (fn
, O_RDWR
);
3129 desc
= creat (fn
, 0666);
3134 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3135 S_IREAD
| S_IWRITE
);
3136 #else /* not MSDOS */
3137 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3138 #endif /* not MSDOS */
3139 #endif /* not VMS */
3145 #ifdef CLASH_DETECTION
3147 if (!auto_saving
) unlock_file (visit_file
);
3149 #endif /* CLASH_DETECTION */
3150 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3153 record_unwind_protect (close_file_unwind
, make_number (desc
));
3156 if (lseek (desc
, 0, 2) < 0)
3158 #ifdef CLASH_DETECTION
3159 if (!auto_saving
) unlock_file (visit_file
);
3160 #endif /* CLASH_DETECTION */
3161 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3166 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3167 * if we do writes that don't end with a carriage return. Furthermore
3168 * it cannot handle writes of more then 16K. The modified
3169 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3170 * this EXCEPT for the last record (iff it doesn't end with a carriage
3171 * return). This implies that if your buffer doesn't end with a carriage
3172 * return, you get one free... tough. However it also means that if
3173 * we make two calls to sys_write (a la the following code) you can
3174 * get one at the gap as well. The easiest way to fix this (honest)
3175 * is to move the gap to the next newline (or the end of the buffer).
3180 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3181 move_gap (find_next_newline (GPT
, 1));
3187 if (STRINGP (start
))
3189 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3190 XSTRING (start
)->size
, 0, &annotations
);
3193 else if (XINT (start
) != XINT (end
))
3196 if (XINT (start
) < GPT
)
3198 register int end1
= XINT (end
);
3200 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3201 min (GPT
, end1
) - tem
, tem
, &annotations
);
3202 nwritten
+= min (GPT
, end1
) - tem
;
3206 if (XINT (end
) > GPT
&& !failure
)
3209 tem
= max (tem
, GPT
);
3210 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3212 nwritten
+= XINT (end
) - tem
;
3218 /* If file was empty, still need to write the annotations */
3219 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3227 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3228 Disk full in NFS may be reported here. */
3229 /* mib says that closing the file will try to write as fast as NFS can do
3230 it, and that means the fsync here is not crucial for autosave files. */
3231 if (!auto_saving
&& fsync (desc
) < 0)
3232 failure
= 1, save_errno
= errno
;
3235 /* Spurious "file has changed on disk" warnings have been
3236 observed on Suns as well.
3237 It seems that `close' can change the modtime, under nfs.
3239 (This has supposedly been fixed in Sunos 4,
3240 but who knows about all the other machines with NFS?) */
3243 /* On VMS and APOLLO, must do the stat after the close
3244 since closing changes the modtime. */
3247 /* Recall that #if defined does not work on VMS. */
3254 /* NFS can report a write failure now. */
3255 if (close (desc
) < 0)
3256 failure
= 1, save_errno
= errno
;
3259 /* If we wrote to a temporary name and had no errors, rename to real name. */
3263 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3271 /* Discard the unwind protect for close_file_unwind. */
3272 specpdl_ptr
= specpdl
+ count1
;
3273 /* Restore the original current buffer. */
3274 GCPRO1 (visit_file
);
3278 #ifdef CLASH_DETECTION
3280 unlock_file (visit_file
);
3281 #endif /* CLASH_DETECTION */
3283 /* Do this before reporting IO error
3284 to avoid a "file has changed on disk" warning on
3285 next attempt to save. */
3287 current_buffer
->modtime
= st
.st_mtime
;
3290 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3294 current_buffer
->save_modified
= MODIFF
;
3295 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3296 current_buffer
->filename
= visit_file
;
3297 update_mode_lines
++;
3303 message ("Wrote %s", XSTRING (visit_file
)->data
);
3308 Lisp_Object
merge ();
3310 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3311 "Return t if (car A) is numerically less than (car B).")
3315 return Flss (Fcar (a
), Fcar (b
));
3318 /* Build the complete list of annotations appropriate for writing out
3319 the text between START and END, by calling all the functions in
3320 write-region-annotate-functions and merging the lists they return.
3321 If one of these functions switches to a different buffer, we assume
3322 that buffer contains altered text. Therefore, the caller must
3323 make sure to restore the current buffer in all cases,
3324 as save-excursion would do. */
3327 build_annotations (start
, end
)
3328 Lisp_Object start
, end
;
3330 Lisp_Object annotations
;
3332 struct gcpro gcpro1
, gcpro2
;
3335 p
= Vwrite_region_annotate_functions
;
3336 GCPRO2 (annotations
, p
);
3339 struct buffer
*given_buffer
= current_buffer
;
3340 Vwrite_region_annotations_so_far
= annotations
;
3341 res
= call2 (Fcar (p
), start
, end
);
3342 /* If the function makes a different buffer current,
3343 assume that means this buffer contains altered text to be output.
3344 Reset START and END from the buffer bounds
3345 and discard all previous annotations because they should have
3346 been dealt with by this function. */
3347 if (current_buffer
!= given_buffer
)
3353 Flength (res
); /* Check basic validity of return value */
3354 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3361 /* Write to descriptor DESC the LEN characters starting at ADDR,
3362 assuming they start at position POS in the buffer.
3363 Intersperse with them the annotations from *ANNOT
3364 (those which fall within the range of positions POS to POS + LEN),
3365 each at its appropriate position.
3367 Modify *ANNOT by discarding elements as we output them.
3368 The return value is negative in case of system call failure. */
3371 a_write (desc
, addr
, len
, pos
, annot
)
3373 register char *addr
;
3380 int lastpos
= pos
+ len
;
3382 while (NILP (*annot
) || CONSP (*annot
))
3384 tem
= Fcar_safe (Fcar (*annot
));
3385 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3386 nextpos
= XFASTINT (tem
);
3388 return e_write (desc
, addr
, lastpos
- pos
);
3391 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3393 addr
+= nextpos
- pos
;
3396 tem
= Fcdr (Fcar (*annot
));
3399 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3402 *annot
= Fcdr (*annot
);
3407 e_write (desc
, addr
, len
)
3409 register char *addr
;
3412 char buf
[16 * 1024];
3413 register char *p
, *end
;
3415 if (!EQ (current_buffer
->selective_display
, Qt
))
3416 return write (desc
, addr
, len
) - len
;
3420 end
= p
+ sizeof buf
;
3425 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3434 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3440 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3441 Sverify_visited_file_modtime
, 1, 1, 0,
3442 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3443 This means that the file has not been changed since it was visited or saved.")
3449 Lisp_Object handler
;
3451 CHECK_BUFFER (buf
, 0);
3454 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3455 if (b
->modtime
== 0) return Qt
;
3457 /* If the file name has special constructs in it,
3458 call the corresponding file handler. */
3459 handler
= Ffind_file_name_handler (b
->filename
,
3460 Qverify_visited_file_modtime
);
3461 if (!NILP (handler
))
3462 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3464 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3466 /* If the file doesn't exist now and didn't exist before,
3467 we say that it isn't modified, provided the error is a tame one. */
3468 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3473 if (st
.st_mtime
== b
->modtime
3474 /* If both are positive, accept them if they are off by one second. */
3475 || (st
.st_mtime
> 0 && b
->modtime
> 0
3476 && (st
.st_mtime
== b
->modtime
+ 1
3477 || st
.st_mtime
== b
->modtime
- 1)))
3482 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3483 Sclear_visited_file_modtime
, 0, 0, 0,
3484 "Clear out records of last mod time of visited file.\n\
3485 Next attempt to save will certainly not complain of a discrepancy.")
3488 current_buffer
->modtime
= 0;
3492 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3493 Svisited_file_modtime
, 0, 0, 0,
3494 "Return the current buffer's recorded visited file modification time.\n\
3495 The value is a list of the form (HIGH . LOW), like the time values\n\
3496 that `file-attributes' returns.")
3499 return long_to_cons (current_buffer
->modtime
);
3502 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3503 Sset_visited_file_modtime
, 0, 1, 0,
3504 "Update buffer's recorded modification time from the visited file's time.\n\
3505 Useful if the buffer was not read from the file normally\n\
3506 or if the file itself has been changed for some known benign reason.\n\
3507 An argument specifies the modification time value to use\n\
3508 \(instead of that of the visited file), in the form of a list\n\
3509 \(HIGH . LOW) or (HIGH LOW).")
3511 Lisp_Object time_list
;
3513 if (!NILP (time_list
))
3514 current_buffer
->modtime
= cons_to_long (time_list
);
3517 register Lisp_Object filename
;
3519 Lisp_Object handler
;
3521 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3523 /* If the file name has special constructs in it,
3524 call the corresponding file handler. */
3525 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3526 if (!NILP (handler
))
3527 /* The handler can find the file name the same way we did. */
3528 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3529 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3530 current_buffer
->modtime
= st
.st_mtime
;
3540 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3541 Fsleep_for (make_number (1), Qnil
);
3542 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3543 Fsleep_for (make_number (1), Qnil
);
3544 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3545 Fsleep_for (make_number (1), Qnil
);
3555 /* Get visited file's mode to become the auto save file's mode. */
3556 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3557 /* But make sure we can overwrite it later! */
3558 auto_save_mode_bits
= st
.st_mode
| 0600;
3560 auto_save_mode_bits
= 0666;
3563 Fwrite_region (Qnil
, Qnil
,
3564 current_buffer
->auto_save_file_name
,
3569 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3572 close (XINT (desc
));
3576 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3577 "Auto-save all buffers that need it.\n\
3578 This is all buffers that have auto-saving enabled\n\
3579 and are changed since last auto-saved.\n\
3580 Auto-saving writes the buffer into a file\n\
3581 so that your editing is not lost if the system crashes.\n\
3582 This file is not the file you visited; that changes only when you save.\n\
3583 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3584 Non-nil first argument means do not print any message if successful.\n\
3585 Non-nil second argument means save only current buffer.")
3586 (no_message
, current_only
)
3587 Lisp_Object no_message
, current_only
;
3589 struct buffer
*old
= current_buffer
, *b
;
3590 Lisp_Object tail
, buf
;
3592 char *omessage
= echo_area_glyphs
;
3593 int omessage_length
= echo_area_glyphs_length
;
3594 extern int minibuf_level
;
3595 int do_handled_files
;
3598 int count
= specpdl_ptr
- specpdl
;
3601 /* Ordinarily don't quit within this function,
3602 but don't make it impossible to quit (in case we get hung in I/O). */
3606 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3607 point to non-strings reached from Vbuffer_alist. */
3613 if (!NILP (Vrun_hooks
))
3614 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3616 if (STRINGP (Vauto_save_list_file_name
))
3619 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3620 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3621 S_IREAD
| S_IWRITE
);
3622 #else /* not MSDOS */
3623 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3624 #endif /* not MSDOS */
3629 /* Arrange to close that file whether or not we get an error. */
3631 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3633 /* First, save all files which don't have handlers. If Emacs is
3634 crashing, the handlers may tweak what is causing Emacs to crash
3635 in the first place, and it would be a shame if Emacs failed to
3636 autosave perfectly ordinary files because it couldn't handle some
3638 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3639 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3640 tail
= XCONS (tail
)->cdr
)
3642 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3645 /* Record all the buffers that have auto save mode
3646 in the special file that lists them. */
3647 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3648 && listdesc
>= 0 && do_handled_files
== 0)
3650 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3651 XSTRING (b
->auto_save_file_name
)->size
);
3652 write (listdesc
, "\n", 1);
3655 if (!NILP (current_only
)
3656 && b
!= current_buffer
)
3659 /* Check for auto save enabled
3660 and file changed since last auto save
3661 and file changed since last real save. */
3662 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3663 && b
->save_modified
< BUF_MODIFF (b
)
3664 && b
->auto_save_modified
< BUF_MODIFF (b
)
3665 /* -1 means we've turned off autosaving for a while--see below. */
3666 && XINT (b
->save_length
) >= 0
3667 && (do_handled_files
3668 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3671 EMACS_TIME before_time
, after_time
;
3673 EMACS_GET_TIME (before_time
);
3675 /* If we had a failure, don't try again for 20 minutes. */
3676 if (b
->auto_save_failure_time
>= 0
3677 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3680 if ((XFASTINT (b
->save_length
) * 10
3681 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3682 /* A short file is likely to change a large fraction;
3683 spare the user annoying messages. */
3684 && XFASTINT (b
->save_length
) > 5000
3685 /* These messages are frequent and annoying for `*mail*'. */
3686 && !EQ (b
->filename
, Qnil
)
3687 && NILP (no_message
))
3689 /* It has shrunk too much; turn off auto-saving here. */
3690 message ("Buffer %s has shrunk a lot; auto save turned off there",
3691 XSTRING (b
->name
)->data
);
3692 /* Turn off auto-saving until there's a real save,
3693 and prevent any more warnings. */
3694 XSET (b
->save_length
, Lisp_Int
, -1);
3695 Fsleep_for (make_number (1), Qnil
);
3698 set_buffer_internal (b
);
3699 if (!auto_saved
&& NILP (no_message
))
3700 message1 ("Auto-saving...");
3701 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3703 b
->auto_save_modified
= BUF_MODIFF (b
);
3704 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3705 set_buffer_internal (old
);
3707 EMACS_GET_TIME (after_time
);
3709 /* If auto-save took more than 60 seconds,
3710 assume it was an NFS failure that got a timeout. */
3711 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3712 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3716 /* Prevent another auto save till enough input events come in. */
3717 record_auto_save ();
3719 if (auto_saved
&& NILP (no_message
))
3722 message2 (omessage
, omessage_length
);
3724 message1 ("Auto-saving...done");
3730 unbind_to (count
, Qnil
);
3734 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3735 Sset_buffer_auto_saved
, 0, 0, 0,
3736 "Mark current buffer as auto-saved with its current text.\n\
3737 No auto-save file will be written until the buffer changes again.")
3740 current_buffer
->auto_save_modified
= MODIFF
;
3741 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3742 current_buffer
->auto_save_failure_time
= -1;
3746 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3747 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3748 "Clear any record of a recent auto-save failure in the current buffer.")
3751 current_buffer
->auto_save_failure_time
= -1;
3755 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3757 "Return t if buffer has been auto-saved since last read in or saved.")
3760 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3763 /* Reading and completing file names */
3764 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3766 /* In the string VAL, change each $ to $$ and return the result. */
3769 double_dollars (val
)
3772 register unsigned char *old
, *new;
3776 osize
= XSTRING (val
)->size
;
3777 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3778 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3779 if (*old
++ == '$') count
++;
3782 old
= XSTRING (val
)->data
;
3783 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3784 new = XSTRING (val
)->data
;
3785 for (n
= osize
; n
> 0; n
--)
3798 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3800 "Internal subroutine for read-file-name. Do not call this.")
3801 (string
, dir
, action
)
3802 Lisp_Object string
, dir
, action
;
3803 /* action is nil for complete, t for return list of completions,
3804 lambda for verify final value */
3806 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3808 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3815 /* No need to protect ACTION--we only compare it with t and nil. */
3816 GCPRO4 (string
, realdir
, name
, specdir
);
3818 if (XSTRING (string
)->size
== 0)
3820 if (EQ (action
, Qlambda
))
3828 orig_string
= string
;
3829 string
= Fsubstitute_in_file_name (string
);
3830 changed
= NILP (Fstring_equal (string
, orig_string
));
3831 name
= Ffile_name_nondirectory (string
);
3832 val
= Ffile_name_directory (string
);
3834 realdir
= Fexpand_file_name (val
, realdir
);
3839 specdir
= Ffile_name_directory (string
);
3840 val
= Ffile_name_completion (name
, realdir
);
3842 if (XTYPE (val
) != Lisp_String
)
3845 return double_dollars (string
);
3849 if (!NILP (specdir
))
3850 val
= concat2 (specdir
, val
);
3852 return double_dollars (val
);
3855 #endif /* not VMS */
3859 if (EQ (action
, Qt
))
3860 return Ffile_name_all_completions (name
, realdir
);
3861 /* Only other case actually used is ACTION = lambda */
3863 /* Supposedly this helps commands such as `cd' that read directory names,
3864 but can someone explain how it helps them? -- RMS */
3865 if (XSTRING (name
)->size
== 0)
3868 return Ffile_exists_p (string
);
3871 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3872 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3873 Value is not expanded---you must call `expand-file-name' yourself.\n\
3874 Default name to DEFAULT if user enters a null string.\n\
3875 (If DEFAULT is omitted, the visited file name is used.)\n\
3876 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3877 Non-nil and non-t means also require confirmation after completion.\n\
3878 Fifth arg INITIAL specifies text to start with.\n\
3879 DIR defaults to current buffer's directory default.")
3880 (prompt
, dir
, defalt
, mustmatch
, initial
)
3881 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3883 Lisp_Object val
, insdef
, insdef1
, tem
;
3884 struct gcpro gcpro1
, gcpro2
;
3885 register char *homedir
;
3889 dir
= current_buffer
->directory
;
3891 defalt
= current_buffer
->filename
;
3893 /* If dir starts with user's homedir, change that to ~. */
3894 homedir
= (char *) egetenv ("HOME");
3896 && XTYPE (dir
) == Lisp_String
3897 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3898 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3900 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3901 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3902 XSTRING (dir
)->data
[0] = '~';
3905 if (insert_default_directory
)
3908 if (!NILP (initial
))
3910 Lisp_Object args
[2], pos
;
3914 insdef
= Fconcat (2, args
);
3915 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3916 insdef1
= Fcons (double_dollars (insdef
), pos
);
3919 insdef1
= double_dollars (insdef
);
3921 else if (!NILP (initial
))
3924 insdef1
= Fcons (double_dollars (insdef
), 0);
3927 insdef
= Qnil
, insdef1
= Qnil
;
3930 count
= specpdl_ptr
- specpdl
;
3931 specbind (intern ("completion-ignore-case"), Qt
);
3934 GCPRO2 (insdef
, defalt
);
3935 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3936 dir
, mustmatch
, insdef1
,
3937 Qfile_name_history
);
3940 unbind_to (count
, Qnil
);
3945 error ("No file name specified");
3946 tem
= Fstring_equal (val
, insdef
);
3947 if (!NILP (tem
) && !NILP (defalt
))
3949 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3954 error ("No default file name");
3956 return Fsubstitute_in_file_name (val
);
3959 #if 0 /* Old version */
3960 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3961 /* Don't confuse make-docfile by having two doc strings for this function.
3962 make-docfile does not pay attention to #if, for good reason! */
3964 (prompt
, dir
, defalt
, mustmatch
, initial
)
3965 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3967 Lisp_Object val
, insdef
, tem
;
3968 struct gcpro gcpro1
, gcpro2
;
3969 register char *homedir
;
3973 dir
= current_buffer
->directory
;
3975 defalt
= current_buffer
->filename
;
3977 /* If dir starts with user's homedir, change that to ~. */
3978 homedir
= (char *) egetenv ("HOME");
3980 && XTYPE (dir
) == Lisp_String
3981 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3982 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3984 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3985 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3986 XSTRING (dir
)->data
[0] = '~';
3989 if (!NILP (initial
))
3991 else if (insert_default_directory
)
3994 insdef
= build_string ("");
3997 count
= specpdl_ptr
- specpdl
;
3998 specbind (intern ("completion-ignore-case"), Qt
);
4001 GCPRO2 (insdef
, defalt
);
4002 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4004 insert_default_directory
? insdef
: Qnil
,
4005 Qfile_name_history
);
4008 unbind_to (count
, Qnil
);
4013 error ("No file name specified");
4014 tem
= Fstring_equal (val
, insdef
);
4015 if (!NILP (tem
) && !NILP (defalt
))
4017 return Fsubstitute_in_file_name (val
);
4019 #endif /* Old version */
4023 Qexpand_file_name
= intern ("expand-file-name");
4024 Qdirectory_file_name
= intern ("directory-file-name");
4025 Qfile_name_directory
= intern ("file-name-directory");
4026 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4027 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4028 Qfile_name_as_directory
= intern ("file-name-as-directory");
4029 Qcopy_file
= intern ("copy-file");
4030 Qmake_directory_internal
= intern ("make-directory-internal");
4031 Qdelete_directory
= intern ("delete-directory");
4032 Qdelete_file
= intern ("delete-file");
4033 Qrename_file
= intern ("rename-file");
4034 Qadd_name_to_file
= intern ("add-name-to-file");
4035 Qmake_symbolic_link
= intern ("make-symbolic-link");
4036 Qfile_exists_p
= intern ("file-exists-p");
4037 Qfile_executable_p
= intern ("file-executable-p");
4038 Qfile_readable_p
= intern ("file-readable-p");
4039 Qfile_symlink_p
= intern ("file-symlink-p");
4040 Qfile_writable_p
= intern ("file-writable-p");
4041 Qfile_directory_p
= intern ("file-directory-p");
4042 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4043 Qfile_modes
= intern ("file-modes");
4044 Qset_file_modes
= intern ("set-file-modes");
4045 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4046 Qinsert_file_contents
= intern ("insert-file-contents");
4047 Qwrite_region
= intern ("write-region");
4048 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4049 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4051 staticpro (&Qexpand_file_name
);
4052 staticpro (&Qdirectory_file_name
);
4053 staticpro (&Qfile_name_directory
);
4054 staticpro (&Qfile_name_nondirectory
);
4055 staticpro (&Qunhandled_file_name_directory
);
4056 staticpro (&Qfile_name_as_directory
);
4057 staticpro (&Qcopy_file
);
4058 staticpro (&Qmake_directory_internal
);
4059 staticpro (&Qdelete_directory
);
4060 staticpro (&Qdelete_file
);
4061 staticpro (&Qrename_file
);
4062 staticpro (&Qadd_name_to_file
);
4063 staticpro (&Qmake_symbolic_link
);
4064 staticpro (&Qfile_exists_p
);
4065 staticpro (&Qfile_executable_p
);
4066 staticpro (&Qfile_readable_p
);
4067 staticpro (&Qfile_symlink_p
);
4068 staticpro (&Qfile_writable_p
);
4069 staticpro (&Qfile_directory_p
);
4070 staticpro (&Qfile_accessible_directory_p
);
4071 staticpro (&Qfile_modes
);
4072 staticpro (&Qset_file_modes
);
4073 staticpro (&Qfile_newer_than_file_p
);
4074 staticpro (&Qinsert_file_contents
);
4075 staticpro (&Qwrite_region
);
4076 staticpro (&Qverify_visited_file_modtime
);
4078 Qfile_name_history
= intern ("file-name-history");
4079 Fset (Qfile_name_history
, Qnil
);
4080 staticpro (&Qfile_name_history
);
4082 Qfile_error
= intern ("file-error");
4083 staticpro (&Qfile_error
);
4084 Qfile_already_exists
= intern("file-already-exists");
4085 staticpro (&Qfile_already_exists
);
4088 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4089 staticpro (&Qfind_buffer_file_type
);
4092 Qcar_less_than_car
= intern ("car-less-than-car");
4093 staticpro (&Qcar_less_than_car
);
4095 Fput (Qfile_error
, Qerror_conditions
,
4096 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4097 Fput (Qfile_error
, Qerror_message
,
4098 build_string ("File error"));
4100 Fput (Qfile_already_exists
, Qerror_conditions
,
4101 Fcons (Qfile_already_exists
,
4102 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4103 Fput (Qfile_already_exists
, Qerror_message
,
4104 build_string ("File already exists"));
4106 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4107 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4108 insert_default_directory
= 1;
4110 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4111 "*Non-nil means write new files with record format `stmlf'.\n\
4112 nil means use format `var'. This variable is meaningful only on VMS.");
4113 vms_stmlf_recfm
= 0;
4115 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4116 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4117 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4120 The first argument given to HANDLER is the name of the I/O primitive\n\
4121 to be handled; the remaining arguments are the arguments that were\n\
4122 passed to that primitive. For example, if you do\n\
4123 (file-exists-p FILENAME)\n\
4124 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4125 (funcall HANDLER 'file-exists-p FILENAME)\n\
4126 The function `find-file-name-handler' checks this list for a handler\n\
4127 for its argument.");
4128 Vfile_name_handler_alist
= Qnil
;
4130 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4131 "A list of functions to be called at the end of `insert-file-contents'.\n\
4132 Each is passed one argument, the number of bytes inserted. It should return\n\
4133 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4134 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4135 responsible for calling the after-insert-file-functions if appropriate.");
4136 Vafter_insert_file_functions
= Qnil
;
4138 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4139 "A list of functions to be called at the start of `write-region'.\n\
4140 Each is passed two arguments, START and END as for `write-region'. It should\n\
4141 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4142 inserted at the specified positions of the file being written (1 means to\n\
4143 insert before the first byte written). The POSITIONs must be sorted into\n\
4144 increasing order. If there are several functions in the list, the several\n\
4145 lists are merged destructively.");
4146 Vwrite_region_annotate_functions
= Qnil
;
4148 DEFVAR_LISP ("write-region-annotations-so-far",
4149 &Vwrite_region_annotations_so_far
,
4150 "When an annotation function is called, this holds the previous annotations.\n\
4151 These are the annotations made by other annotation functions\n\
4152 that were already called. See also `write-region-annotate-functions'.");
4153 Vwrite_region_annotations_so_far
= Qnil
;
4155 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4156 "A list of file name handlers that temporarily should not be used.\n\
4157 This applies only to the operation `inhibit-file-name-operation'.");
4158 Vinhibit_file_name_handlers
= Qnil
;
4160 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4161 "The operation for which `inhibit-file-name-handlers' is applicable.");
4162 Vinhibit_file_name_operation
= Qnil
;
4164 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4165 "File name in which we write a list of all auto save file names.");
4166 Vauto_save_list_file_name
= Qnil
;
4168 defsubr (&Sfind_file_name_handler
);
4169 defsubr (&Sfile_name_directory
);
4170 defsubr (&Sfile_name_nondirectory
);
4171 defsubr (&Sunhandled_file_name_directory
);
4172 defsubr (&Sfile_name_as_directory
);
4173 defsubr (&Sdirectory_file_name
);
4174 defsubr (&Smake_temp_name
);
4175 defsubr (&Sexpand_file_name
);
4176 defsubr (&Ssubstitute_in_file_name
);
4177 defsubr (&Scopy_file
);
4178 defsubr (&Smake_directory_internal
);
4179 defsubr (&Sdelete_directory
);
4180 defsubr (&Sdelete_file
);
4181 defsubr (&Srename_file
);
4182 defsubr (&Sadd_name_to_file
);
4184 defsubr (&Smake_symbolic_link
);
4185 #endif /* S_IFLNK */
4187 defsubr (&Sdefine_logical_name
);
4190 defsubr (&Ssysnetunam
);
4191 #endif /* HPUX_NET */
4192 defsubr (&Sfile_name_absolute_p
);
4193 defsubr (&Sfile_exists_p
);
4194 defsubr (&Sfile_executable_p
);
4195 defsubr (&Sfile_readable_p
);
4196 defsubr (&Sfile_writable_p
);
4197 defsubr (&Sfile_symlink_p
);
4198 defsubr (&Sfile_directory_p
);
4199 defsubr (&Sfile_accessible_directory_p
);
4200 defsubr (&Sfile_modes
);
4201 defsubr (&Sset_file_modes
);
4202 defsubr (&Sset_default_file_modes
);
4203 defsubr (&Sdefault_file_modes
);
4204 defsubr (&Sfile_newer_than_file_p
);
4205 defsubr (&Sinsert_file_contents
);
4206 defsubr (&Swrite_region
);
4207 defsubr (&Scar_less_than_car
);
4208 defsubr (&Sverify_visited_file_modtime
);
4209 defsubr (&Sclear_visited_file_modtime
);
4210 defsubr (&Svisited_file_modtime
);
4211 defsubr (&Sset_visited_file_modtime
);
4212 defsubr (&Sdo_auto_save
);
4213 defsubr (&Sset_buffer_auto_saved
);
4214 defsubr (&Sclear_buffer_auto_save_failure
);
4215 defsubr (&Srecent_auto_save_p
);
4217 defsubr (&Sread_file_name_internal
);
4218 defsubr (&Sread_file_name
);
4221 defsubr (&Sunix_sync
);