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"
104 #define min(a, b) ((a) < (b) ? (a) : (b))
105 #define max(a, b) ((a) > (b) ? (a) : (b))
107 /* Nonzero during writing of auto-save files */
110 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
111 a new file with the same mode as the original */
112 int auto_save_mode_bits
;
114 /* Alist of elements (REGEXP . HANDLER) for file names
115 whose I/O is done with a special handler. */
116 Lisp_Object Vfile_name_handler_alist
;
118 /* Functions to be called to process text properties in inserted file. */
119 Lisp_Object Vafter_insert_file_functions
;
121 /* Functions to be called to create text property annotations for file. */
122 Lisp_Object Vwrite_region_annotate_functions
;
124 /* File name in which we write a list of all our auto save files. */
125 Lisp_Object Vauto_save_list_file_name
;
127 /* Nonzero means, when reading a filename in the minibuffer,
128 start out by inserting the default directory into the minibuffer. */
129 int insert_default_directory
;
131 /* On VMS, nonzero means write new files with record format stmlf.
132 Zero means use var format. */
135 /* These variables describe handlers that have "already" had a chance
136 to handle the current operation.
138 Vinhibit_file_name_handlers is a list of file name handlers.
139 Vinhibit_file_name_operation is the operation being handled.
140 If we try to handle that operation, we ignore those handlers. */
142 static Lisp_Object Vinhibit_file_name_handlers
;
143 static Lisp_Object Vinhibit_file_name_operation
;
145 Lisp_Object Qfile_error
, Qfile_already_exists
;
147 Lisp_Object Qfile_name_history
;
149 Lisp_Object Qcar_less_than_car
;
151 report_file_error (string
, data
)
155 Lisp_Object errstring
;
157 errstring
= build_string (strerror (errno
));
159 /* System error messages are capitalized. Downcase the initial
160 unless it is followed by a slash. */
161 if (XSTRING (errstring
)->data
[1] != '/')
162 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
165 Fsignal (Qfile_error
,
166 Fcons (build_string (string
), Fcons (errstring
, data
)));
169 close_file_unwind (fd
)
172 close (XFASTINT (fd
));
175 /* Restore point, having saved it as a marker. */
177 restore_point_unwind (location
)
178 Lisp_Object location
;
180 SET_PT (marker_position (location
));
181 Fset_marker (location
, Qnil
, Qnil
);
184 Lisp_Object Qexpand_file_name
;
185 Lisp_Object Qdirectory_file_name
;
186 Lisp_Object Qfile_name_directory
;
187 Lisp_Object Qfile_name_nondirectory
;
188 Lisp_Object Qunhandled_file_name_directory
;
189 Lisp_Object Qfile_name_as_directory
;
190 Lisp_Object Qcopy_file
;
191 Lisp_Object Qmake_directory
;
192 Lisp_Object Qdelete_directory
;
193 Lisp_Object Qdelete_file
;
194 Lisp_Object Qrename_file
;
195 Lisp_Object Qadd_name_to_file
;
196 Lisp_Object Qmake_symbolic_link
;
197 Lisp_Object Qfile_exists_p
;
198 Lisp_Object Qfile_executable_p
;
199 Lisp_Object Qfile_readable_p
;
200 Lisp_Object Qfile_symlink_p
;
201 Lisp_Object Qfile_writable_p
;
202 Lisp_Object Qfile_directory_p
;
203 Lisp_Object Qfile_accessible_directory_p
;
204 Lisp_Object Qfile_modes
;
205 Lisp_Object Qset_file_modes
;
206 Lisp_Object Qfile_newer_than_file_p
;
207 Lisp_Object Qinsert_file_contents
;
208 Lisp_Object Qwrite_region
;
209 Lisp_Object Qverify_visited_file_modtime
;
210 Lisp_Object Qset_visited_file_modtime
;
212 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
213 "Return FILENAME's handler function for OPERATION, if it has one.\n\
214 Otherwise, return nil.\n\
215 A file name is handled if one of the regular expressions in\n\
216 `file-name-handler-alist' matches it.\n\n\
217 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
218 any handlers that are members of `inhibit-file-name-handlers',\n\
219 but we still do run any other handlers. This lets handlers\n\
220 use the standard functions without calling themselves recursively.")
221 (filename
, operation
)
222 Lisp_Object filename
, operation
;
224 /* This function must not munge the match data. */
225 Lisp_Object chain
, inhibited_handlers
;
227 CHECK_STRING (filename
, 0);
229 if (EQ (operation
, Vinhibit_file_name_operation
))
230 inhibited_handlers
= Vinhibit_file_name_handlers
;
232 inhibited_handlers
= Qnil
;
234 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
235 chain
= XCONS (chain
)->cdr
)
238 elt
= XCONS (chain
)->car
;
239 if (XTYPE (elt
) == Lisp_Cons
)
242 string
= XCONS (elt
)->car
;
243 if (XTYPE (string
) == Lisp_String
244 && fast_string_match (string
, filename
) >= 0)
246 Lisp_Object handler
, tem
;
248 handler
= XCONS (elt
)->cdr
;
249 tem
= Fmemq (handler
, inhibited_handlers
);
260 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
262 "Return the directory component in file name NAME.\n\
263 Return nil if NAME does not include a directory.\n\
264 Otherwise return a directory spec.\n\
265 Given a Unix syntax file name, returns a string ending in slash;\n\
266 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
270 register unsigned char *beg
;
271 register unsigned char *p
;
274 CHECK_STRING (file
, 0);
276 /* If the file name has special constructs in it,
277 call the corresponding file handler. */
278 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
280 return call2 (handler
, Qfile_name_directory
, file
);
282 #ifdef FILE_SYSTEM_CASE
283 file
= FILE_SYSTEM_CASE (file
);
285 beg
= XSTRING (file
)->data
;
286 p
= beg
+ XSTRING (file
)->size
;
288 while (p
!= beg
&& p
[-1] != '/'
290 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
300 /* Expansion of "c:" to drive and default directory. */
301 if (p
== beg
+ 2 && beg
[1] == ':')
303 int drive
= (*beg
) - 'a';
304 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
305 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
306 if (getdefdir (drive
+ 1, res
+ 2))
308 res
[0] = drive
+ 'a';
310 if (res
[strlen (res
) - 1] != '/')
313 p
= beg
+ strlen (beg
);
317 return make_string (beg
, p
- beg
);
320 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
322 "Return file name NAME sans its directory.\n\
323 For example, in a Unix-syntax file name,\n\
324 this is everything after the last slash,\n\
325 or the entire name if it contains no slash.")
329 register unsigned char *beg
, *p
, *end
;
332 CHECK_STRING (file
, 0);
334 /* If the file name has special constructs in it,
335 call the corresponding file handler. */
336 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
338 return call2 (handler
, Qfile_name_nondirectory
, file
);
340 beg
= XSTRING (file
)->data
;
341 end
= p
= beg
+ XSTRING (file
)->size
;
343 while (p
!= beg
&& p
[-1] != '/'
345 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
352 return make_string (p
, end
- p
);
355 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
356 "Return a directly usable directory name somehow associated with FILENAME.\n\
357 A `directly usable' directory name is one that may be used without the\n\
358 intervention of any file handler.\n\
359 If FILENAME is a directly usable file itself, return\n\
360 (file-name-directory FILENAME).\n\
361 The `call-process' and `start-process' functions use this function to\n\
362 get a current directory to run processes in.")
364 Lisp_Object filename
;
368 /* If the file name has special constructs in it,
369 call the corresponding file handler. */
370 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
372 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
374 return Ffile_name_directory (filename
);
379 file_name_as_directory (out
, in
)
382 int size
= strlen (in
) - 1;
387 /* Is it already a directory string? */
388 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
390 /* Is it a VMS directory file name? If so, hack VMS syntax. */
391 else if (! index (in
, '/')
392 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
393 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
394 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
395 || ! strncmp (&in
[size
- 5], ".dir", 4))
396 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
397 && in
[size
] == '1')))
399 register char *p
, *dot
;
403 dir:x.dir --> dir:[x]
404 dir:[x]y.dir --> dir:[x.y] */
406 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
409 strncpy (out
, in
, p
- in
);
428 dot
= index (p
, '.');
431 /* blindly remove any extension */
432 size
= strlen (out
) + (dot
- p
);
433 strncat (out
, p
, dot
- p
);
444 /* For Unix syntax, Append a slash if necessary */
446 if (out
[size
] != ':' && out
[size
] != '/')
448 if (out
[size
] != '/')
455 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
456 Sfile_name_as_directory
, 1, 1, 0,
457 "Return a string representing file FILENAME interpreted as a directory.\n\
458 This operation exists because a directory is also a file, but its name as\n\
459 a directory is different from its name as a file.\n\
460 The result can be used as the value of `default-directory'\n\
461 or passed as second argument to `expand-file-name'.\n\
462 For a Unix-syntax file name, just appends a slash.\n\
463 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
470 CHECK_STRING (file
, 0);
474 /* If the file name has special constructs in it,
475 call the corresponding file handler. */
476 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
478 return call2 (handler
, Qfile_name_as_directory
, file
);
480 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
481 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
485 * Convert from directory name to filename.
487 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
488 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
489 * On UNIX, it's simple: just make sure there is a terminating /
491 * Value is nonzero if the string output is different from the input.
494 directory_file_name (src
, dst
)
502 struct FAB fab
= cc$rms_fab
;
503 struct NAM nam
= cc$rms_nam
;
504 char esa
[NAM$C_MAXRSS
];
509 if (! index (src
, '/')
510 && (src
[slen
- 1] == ']'
511 || src
[slen
- 1] == ':'
512 || src
[slen
- 1] == '>'))
514 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
516 fab
.fab$b_fns
= slen
;
517 fab
.fab$l_nam
= &nam
;
518 fab
.fab$l_fop
= FAB$M_NAM
;
521 nam
.nam$b_ess
= sizeof esa
;
522 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
524 /* We call SYS$PARSE to handle such things as [--] for us. */
525 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
527 slen
= nam
.nam$b_esl
;
528 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
533 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
535 /* what about when we have logical_name:???? */
536 if (src
[slen
- 1] == ':')
537 { /* Xlate logical name and see what we get */
538 ptr
= strcpy (dst
, src
); /* upper case for getenv */
541 if ('a' <= *ptr
&& *ptr
<= 'z')
545 dst
[slen
- 1] = 0; /* remove colon */
546 if (!(src
= egetenv (dst
)))
548 /* should we jump to the beginning of this procedure?
549 Good points: allows us to use logical names that xlate
551 Bad points: can be a problem if we just translated to a device
553 For now, I'll punt and always expect VMS names, and hope for
556 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
557 { /* no recursion here! */
563 { /* not a directory spec */
568 bracket
= src
[slen
- 1];
570 /* If bracket is ']' or '>', bracket - 2 is the corresponding
572 ptr
= index (src
, bracket
- 2);
574 { /* no opening bracket */
578 if (!(rptr
= rindex (src
, '.')))
581 strncpy (dst
, src
, slen
);
585 dst
[slen
++] = bracket
;
590 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
591 then translate the device and recurse. */
592 if (dst
[slen
- 1] == ':'
593 && dst
[slen
- 2] != ':' /* skip decnet nodes */
594 && strcmp(src
+ slen
, "[000000]") == 0)
596 dst
[slen
- 1] = '\0';
597 if ((ptr
= egetenv (dst
))
598 && (rlen
= strlen (ptr
) - 1) > 0
599 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
600 && ptr
[rlen
- 1] == '.')
602 char * buf
= (char *) alloca (strlen (ptr
) + 1);
606 return directory_file_name (buf
, dst
);
611 strcat (dst
, "[000000]");
615 rlen
= strlen (rptr
) - 1;
616 strncat (dst
, rptr
, rlen
);
617 dst
[slen
+ rlen
] = '\0';
618 strcat (dst
, ".DIR.1");
622 /* Process as Unix format: just remove any final slash.
623 But leave "/" unchanged; do not change it to "". */
626 && dst
[slen
- 1] == '/'
628 && dst
[slen
- 2] != ':'
635 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
637 "Returns the file name of the directory named DIR.\n\
638 This is the name of the file that holds the data for the directory DIR.\n\
639 This operation exists because a directory is also a file, but its name as\n\
640 a directory is different from its name as a file.\n\
641 In Unix-syntax, this function just removes the final slash.\n\
642 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
643 it returns a file name such as \"[X]Y.DIR.1\".")
645 Lisp_Object directory
;
650 CHECK_STRING (directory
, 0);
652 if (NILP (directory
))
655 /* If the file name has special constructs in it,
656 call the corresponding file handler. */
657 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
659 return call2 (handler
, Qdirectory_file_name
, directory
);
662 /* 20 extra chars is insufficient for VMS, since we might perform a
663 logical name translation. an equivalence string can be up to 255
664 chars long, so grab that much extra space... - sss */
665 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
667 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
669 directory_file_name (XSTRING (directory
)->data
, buf
);
670 return build_string (buf
);
673 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
674 "Generate temporary file name (string) starting with PREFIX (a string).\n\
675 The Emacs process number forms part of the result,\n\
676 so there is no danger of generating a name being used by another process.")
681 val
= concat2 (prefix
, build_string ("XXXXXX"));
682 mktemp (XSTRING (val
)->data
);
686 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
687 "Convert FILENAME to absolute, and canonicalize it.\n\
688 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
689 (does not start with slash); if DEFAULT is nil or missing,\n\
690 the current buffer's value of default-directory is used.\n\
691 Path components that are `.' are removed, and \n\
692 path components followed by `..' are removed, along with the `..' itself;\n\
693 note that these simplifications are done without checking the resulting\n\
694 paths in the file system.\n\
695 An initial `~/' expands to your home directory.\n\
696 An initial `~USER/' expands to USER's home directory.\n\
697 See also the function `substitute-in-file-name'.")
699 Lisp_Object name
, defalt
;
703 register unsigned char *newdir
, *p
, *o
;
705 unsigned char *target
;
708 unsigned char * colon
= 0;
709 unsigned char * close
= 0;
710 unsigned char * slash
= 0;
711 unsigned char * brack
= 0;
712 int lbrack
= 0, rbrack
= 0;
715 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
718 unsigned char *tmp
, *defdir
;
722 CHECK_STRING (name
, 0);
724 /* If the file name has special constructs in it,
725 call the corresponding file handler. */
726 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
728 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
730 /* Use the buffer's default-directory if DEFALT is omitted. */
732 defalt
= current_buffer
->directory
;
733 CHECK_STRING (defalt
, 1);
735 /* Make sure DEFALT is properly expanded.
736 It would be better to do this down below where we actually use
737 defalt. Unfortunately, calling Fexpand_file_name recursively
738 could invoke GC, and the strings might be relocated. This would
739 be annoying because we have pointers into strings lying around
740 that would need adjusting, and people would add new pointers to
741 the code and forget to adjust them, resulting in intermittent bugs.
742 Putting this call here avoids all that crud.
744 The EQ test avoids infinite recursion. */
745 if (! NILP (defalt
) && !EQ (defalt
, name
)
746 /* This saves time in a common case. */
747 && XSTRING (defalt
)->data
[0] != '/')
752 defalt
= Fexpand_file_name (defalt
, Qnil
);
757 /* Filenames on VMS are always upper case. */
758 name
= Fupcase (name
);
760 #ifdef FILE_SYSTEM_CASE
761 name
= FILE_SYSTEM_CASE (name
);
764 nm
= XSTRING (name
)->data
;
767 /* firstly, strip drive name. */
769 unsigned char *colon
= rindex (nm
, ':');
775 drive
= tolower (colon
[-1]) - 'a';
779 defdir
= alloca (MAXPATHLEN
+ 1);
780 relpath
= getdefdir (drive
+ 1, defdir
);
786 /* If nm is absolute, flush ...// and detect /./ and /../.
787 If no /./ or /../ we can return right away. */
795 /* If it turns out that the filename we want to return is just a
796 suffix of FILENAME, we don't need to go through and edit
797 things; we just need to construct a new string using data
798 starting at the middle of FILENAME. If we set lose to a
799 non-zero value, that means we've discovered that we can't do
806 /* Since we know the path is absolute, we can assume that each
807 element starts with a "/". */
809 /* "//" anywhere isn't necessarily hairy; we just start afresh
810 with the second slash. */
811 if (p
[0] == '/' && p
[1] == '/'
813 /* // at start of filename is meaningful on Apollo system */
819 /* "~" is hairy as the start of any path element. */
820 if (p
[0] == '/' && p
[1] == '~')
821 nm
= p
+ 1, lose
= 1;
823 /* "." and ".." are hairy. */
828 || (p
[2] == '.' && (p
[3] == '/'
835 /* if dev:[dir]/, move nm to / */
836 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
837 nm
= (brack
? brack
+ 1 : colon
+ 1);
846 /* VMS pre V4.4,convert '-'s in filenames. */
847 if (lbrack
== rbrack
)
849 if (dots
< 2) /* this is to allow negative version numbers */
854 if (lbrack
> rbrack
&&
855 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
856 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
862 /* count open brackets, reset close bracket pointer */
863 if (p
[0] == '[' || p
[0] == '<')
865 /* count close brackets, set close bracket pointer */
866 if (p
[0] == ']' || p
[0] == '>')
868 /* detect ][ or >< */
869 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
871 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
872 nm
= p
+ 1, lose
= 1;
873 if (p
[0] == ':' && (colon
|| slash
))
874 /* if dev1:[dir]dev2:, move nm to dev2: */
880 /* if /pathname/dev:, move nm to dev: */
883 /* if node::dev:, move colon following dev */
884 else if (colon
&& colon
[-1] == ':')
886 /* if dev1:dev2:, move nm to dev2: */
887 else if (colon
&& colon
[-1] != ':')
892 if (p
[0] == ':' && !colon
)
898 if (lbrack
== rbrack
)
901 else if (p
[0] == '.')
910 return build_string (sys_translate_unix (nm
));
913 if (nm
== XSTRING (name
)->data
)
915 return build_string (nm
);
920 /* Now determine directory to start with and put it in newdir */
924 if (nm
[0] == '~') /* prefix ~ */
930 || nm
[1] == 0) /* ~ by itself */
932 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
933 newdir
= (unsigned char *) "";
935 dostounix_filename (newdir
);
939 nm
++; /* Don't leave the slash in nm. */
942 else /* ~user/filename */
944 for (p
= nm
; *p
&& (*p
!= '/'
949 o
= (unsigned char *) alloca (p
- nm
+ 1);
950 bcopy ((char *) nm
, o
, p
- nm
);
953 pw
= (struct passwd
*) getpwnam (o
+ 1);
956 newdir
= (unsigned char *) pw
-> pw_dir
;
958 nm
= p
+ 1; /* skip the terminator */
964 /* If we don't find a user of that name, leave the name
965 unchanged; don't move nm forward to p. */
978 newdir
= XSTRING (defalt
)->data
;
982 if (newdir
== 0 && relpath
)
987 /* Get rid of any slash at the end of newdir. */
988 int length
= strlen (newdir
);
989 /* Adding `length > 1 &&' makes ~ expand into / when homedir
990 is the root dir. People disagree about whether that is right.
991 Anyway, we can't take the risk of this change now. */
993 if (newdir
[1] != ':' && length
> 1)
995 if (newdir
[length
- 1] == '/')
997 unsigned char *temp
= (unsigned char *) alloca (length
);
998 bcopy (newdir
, temp
, length
- 1);
999 temp
[length
- 1] = 0;
1007 /* Now concatenate the directory and name to new space in the stack frame */
1008 tlen
+= strlen (nm
) + 1;
1010 /* Add reserved space for drive name. */
1011 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1013 target
= (unsigned char *) alloca (tlen
);
1020 if (nm
[0] == 0 || nm
[0] == '/')
1021 strcpy (target
, newdir
);
1024 file_name_as_directory (target
, newdir
);
1027 strcat (target
, nm
);
1029 if (index (target
, '/'))
1030 strcpy (target
, sys_translate_unix (target
));
1033 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1041 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1047 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1048 /* brackets are offset from each other by 2 */
1051 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1052 /* convert [foo][bar] to [bar] */
1053 while (o
[-1] != '[' && o
[-1] != '<')
1055 else if (*p
== '-' && *o
!= '.')
1058 else if (p
[0] == '-' && o
[-1] == '.' &&
1059 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1060 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1064 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1065 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1067 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1069 /* else [foo.-] ==> [-] */
1075 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1076 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1086 else if (!strncmp (p
, "//", 2)
1088 /* // at start of filename is meaningful in Apollo system */
1096 else if (p
[0] == '/'
1101 /* If "/." is the entire filename, keep the "/". Otherwise,
1102 just delete the whole "/.". */
1103 if (o
== target
&& p
[2] == '\0')
1107 else if (!strncmp (p
, "/..", 3)
1108 /* `/../' is the "superroot" on certain file systems. */
1110 && (p
[3] == '/' || p
[3] == 0))
1112 while (o
!= target
&& *--o
!= '/')
1115 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1119 if (o
== target
&& *o
== '/')
1127 #endif /* not VMS */
1131 /* at last, set drive name. */
1132 if (target
[1] != ':')
1135 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1140 return make_string (target
, o
- target
);
1143 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1144 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1145 "Convert FILENAME to absolute, and canonicalize it.\n\
1146 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1147 (does not start with slash); if DEFAULT is nil or missing,\n\
1148 the current buffer's value of default-directory is used.\n\
1149 Filenames containing `.' or `..' as components are simplified;\n\
1150 initial `~/' expands to your home directory.\n\
1151 See also the function `substitute-in-file-name'.")
1153 Lisp_Object name, defalt;
1157 register unsigned char *newdir, *p, *o;
1159 unsigned char *target;
1163 unsigned char * colon = 0;
1164 unsigned char * close = 0;
1165 unsigned char * slash = 0;
1166 unsigned char * brack = 0;
1167 int lbrack = 0, rbrack = 0;
1171 CHECK_STRING (name
, 0);
1174 /* Filenames on VMS are always upper case. */
1175 name
= Fupcase (name
);
1178 nm
= XSTRING (name
)->data
;
1180 /* If nm is absolute, flush ...// and detect /./ and /../.
1181 If no /./ or /../ we can return right away. */
1193 if (p
[0] == '/' && p
[1] == '/'
1195 /* // at start of filename is meaningful on Apollo system */
1200 if (p
[0] == '/' && p
[1] == '~')
1201 nm
= p
+ 1, lose
= 1;
1202 if (p
[0] == '/' && p
[1] == '.'
1203 && (p
[2] == '/' || p
[2] == 0
1204 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1210 /* if dev:[dir]/, move nm to / */
1211 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1212 nm
= (brack
? brack
+ 1 : colon
+ 1);
1213 lbrack
= rbrack
= 0;
1221 /* VMS pre V4.4,convert '-'s in filenames. */
1222 if (lbrack
== rbrack
)
1224 if (dots
< 2) /* this is to allow negative version numbers */
1229 if (lbrack
> rbrack
&&
1230 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1231 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1237 /* count open brackets, reset close bracket pointer */
1238 if (p
[0] == '[' || p
[0] == '<')
1239 lbrack
++, brack
= 0;
1240 /* count close brackets, set close bracket pointer */
1241 if (p
[0] == ']' || p
[0] == '>')
1242 rbrack
++, brack
= p
;
1243 /* detect ][ or >< */
1244 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1246 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1247 nm
= p
+ 1, lose
= 1;
1248 if (p
[0] == ':' && (colon
|| slash
))
1249 /* if dev1:[dir]dev2:, move nm to dev2: */
1255 /* if /pathname/dev:, move nm to dev: */
1258 /* if node::dev:, move colon following dev */
1259 else if (colon
&& colon
[-1] == ':')
1261 /* if dev1:dev2:, move nm to dev2: */
1262 else if (colon
&& colon
[-1] != ':')
1267 if (p
[0] == ':' && !colon
)
1273 if (lbrack
== rbrack
)
1276 else if (p
[0] == '.')
1284 if (index (nm
, '/'))
1285 return build_string (sys_translate_unix (nm
));
1287 if (nm
== XSTRING (name
)->data
)
1289 return build_string (nm
);
1293 /* Now determine directory to start with and put it in NEWDIR */
1297 if (nm
[0] == '~') /* prefix ~ */
1302 || nm
[1] == 0)/* ~/filename */
1304 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1305 newdir
= (unsigned char *) "";
1308 nm
++; /* Don't leave the slash in nm. */
1311 else /* ~user/filename */
1313 /* Get past ~ to user */
1314 unsigned char *user
= nm
+ 1;
1315 /* Find end of name. */
1316 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1317 int len
= ptr
? ptr
- user
: strlen (user
);
1319 unsigned char *ptr1
= index (user
, ':');
1320 if (ptr1
!= 0 && ptr1
- user
< len
)
1323 /* Copy the user name into temp storage. */
1324 o
= (unsigned char *) alloca (len
+ 1);
1325 bcopy ((char *) user
, o
, len
);
1328 /* Look up the user name. */
1329 pw
= (struct passwd
*) getpwnam (o
+ 1);
1331 error ("\"%s\" isn't a registered user", o
+ 1);
1333 newdir
= (unsigned char *) pw
->pw_dir
;
1335 /* Discard the user name from NM. */
1342 #endif /* not VMS */
1346 defalt
= current_buffer
->directory
;
1347 CHECK_STRING (defalt
, 1);
1348 newdir
= XSTRING (defalt
)->data
;
1351 /* Now concatenate the directory and name to new space in the stack frame */
1353 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1354 target
= (unsigned char *) alloca (tlen
);
1360 if (nm
[0] == 0 || nm
[0] == '/')
1361 strcpy (target
, newdir
);
1364 file_name_as_directory (target
, newdir
);
1367 strcat (target
, nm
);
1369 if (index (target
, '/'))
1370 strcpy (target
, sys_translate_unix (target
));
1373 /* Now canonicalize by removing /. and /foo/.. if they appear */
1381 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1387 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1388 /* brackets are offset from each other by 2 */
1391 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1392 /* convert [foo][bar] to [bar] */
1393 while (o
[-1] != '[' && o
[-1] != '<')
1395 else if (*p
== '-' && *o
!= '.')
1398 else if (p
[0] == '-' && o
[-1] == '.' &&
1399 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1400 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1404 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1405 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1407 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1409 /* else [foo.-] ==> [-] */
1415 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1416 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1426 else if (!strncmp (p
, "//", 2)
1428 /* // at start of filename is meaningful in Apollo system */
1436 else if (p
[0] == '/' && p
[1] == '.' &&
1437 (p
[2] == '/' || p
[2] == 0))
1439 else if (!strncmp (p
, "/..", 3)
1440 /* `/../' is the "superroot" on certain file systems. */
1442 && (p
[3] == '/' || p
[3] == 0))
1444 while (o
!= target
&& *--o
!= '/')
1447 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1451 if (o
== target
&& *o
== '/')
1459 #endif /* not VMS */
1462 return make_string (target
, o
- target
);
1466 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1467 Ssubstitute_in_file_name
, 1, 1, 0,
1468 "Substitute environment variables referred to in FILENAME.\n\
1469 `$FOO' where FOO is an environment variable name means to substitute\n\
1470 the value of that variable. The variable name should be terminated\n\
1471 with a character not a letter, digit or underscore; otherwise, enclose\n\
1472 the entire variable name in braces.\n\
1473 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1474 On VMS, `$' substitution is not done; this function does little and only\n\
1475 duplicates what `expand-file-name' does.")
1481 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1482 unsigned char *target
;
1484 int substituted
= 0;
1487 CHECK_STRING (string
, 0);
1489 nm
= XSTRING (string
)->data
;
1490 endp
= nm
+ XSTRING (string
)->size
;
1492 /* If /~ or // appears, discard everything through first slash. */
1494 for (p
= nm
; p
!= endp
; p
++)
1498 /* // at start of file name is meaningful in Apollo system */
1499 (p
[0] == '/' && p
- 1 != nm
)
1500 #else /* not APOLLO */
1502 #endif /* not APOLLO */
1506 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1517 if (p
[0] && p
[1] == ':')
1526 return build_string (nm
);
1529 /* See if any variables are substituted into the string
1530 and find the total length of their values in `total' */
1532 for (p
= nm
; p
!= endp
;)
1542 /* "$$" means a single "$" */
1551 while (p
!= endp
&& *p
!= '}') p
++;
1552 if (*p
!= '}') goto missingclose
;
1558 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1562 /* Copy out the variable name */
1563 target
= (unsigned char *) alloca (s
- o
+ 1);
1564 strncpy (target
, o
, s
- o
);
1567 strupr (target
); /* $home == $HOME etc. */
1570 /* Get variable value */
1571 o
= (unsigned char *) egetenv (target
);
1572 if (!o
) goto badvar
;
1573 total
+= strlen (o
);
1580 /* If substitution required, recopy the string and do it */
1581 /* Make space in stack frame for the new copy */
1582 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1585 /* Copy the rest of the name through, replacing $ constructs with values */
1602 while (p
!= endp
&& *p
!= '}') p
++;
1603 if (*p
!= '}') goto missingclose
;
1609 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1613 /* Copy out the variable name */
1614 target
= (unsigned char *) alloca (s
- o
+ 1);
1615 strncpy (target
, o
, s
- o
);
1618 strupr (target
); /* $home == $HOME etc. */
1621 /* Get variable value */
1622 o
= (unsigned char *) egetenv (target
);
1632 /* If /~ or // appears, discard everything through first slash. */
1634 for (p
= xnm
; p
!= x
; p
++)
1637 /* // at start of file name is meaningful in Apollo system */
1638 (p
[0] == '/' && p
- 1 != xnm
)
1639 #else /* not APOLLO */
1641 #endif /* not APOLLO */
1643 && p
!= nm
&& p
[-1] == '/')
1646 else if (p
[0] && p
[1] == ':')
1650 return make_string (xnm
, x
- xnm
);
1653 error ("Bad format environment-variable substitution");
1655 error ("Missing \"}\" in environment-variable substitution");
1657 error ("Substituting nonexistent environment variable \"%s\"", target
);
1660 #endif /* not VMS */
1663 /* A slightly faster and more convenient way to get
1664 (directory-file-name (expand-file-name FOO)). */
1667 expand_and_dir_to_file (filename
, defdir
)
1668 Lisp_Object filename
, defdir
;
1670 register Lisp_Object abspath
;
1672 abspath
= Fexpand_file_name (filename
, defdir
);
1675 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1676 if (c
== ':' || c
== ']' || c
== '>')
1677 abspath
= Fdirectory_file_name (abspath
);
1680 /* Remove final slash, if any (unless path is root).
1681 stat behaves differently depending! */
1682 if (XSTRING (abspath
)->size
> 1
1683 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1684 /* We cannot take shortcuts; they might be wrong for magic file names. */
1685 abspath
= Fdirectory_file_name (abspath
);
1690 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1691 Lisp_Object absname
;
1692 unsigned char *querystring
;
1695 register Lisp_Object tem
;
1696 struct gcpro gcpro1
;
1698 if (access (XSTRING (absname
)->data
, 4) >= 0)
1701 Fsignal (Qfile_already_exists
,
1702 Fcons (build_string ("File already exists"),
1703 Fcons (absname
, Qnil
)));
1705 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1706 XSTRING (absname
)->data
, querystring
));
1709 Fsignal (Qfile_already_exists
,
1710 Fcons (build_string ("File already exists"),
1711 Fcons (absname
, Qnil
)));
1716 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1717 "fCopy file: \nFCopy %s to file: \np\nP",
1718 "Copy FILE to NEWNAME. Both args must be strings.\n\
1719 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1720 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1721 A number as third arg means request confirmation if NEWNAME already exists.\n\
1722 This is what happens in interactive use with M-x.\n\
1723 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1724 last-modified time as the old one. (This works on only some systems.)\n\
1725 A prefix arg makes KEEP-TIME non-nil.")
1726 (filename
, newname
, ok_if_already_exists
, keep_date
)
1727 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1730 char buf
[16 * 1024];
1732 Lisp_Object handler
;
1733 struct gcpro gcpro1
, gcpro2
;
1734 int count
= specpdl_ptr
- specpdl
;
1735 Lisp_Object args
[6];
1736 int input_file_statable_p
;
1738 GCPRO2 (filename
, newname
);
1739 CHECK_STRING (filename
, 0);
1740 CHECK_STRING (newname
, 1);
1741 filename
= Fexpand_file_name (filename
, Qnil
);
1742 newname
= Fexpand_file_name (newname
, Qnil
);
1744 /* If the input file name has special constructs in it,
1745 call the corresponding file handler. */
1746 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1747 /* Likewise for output file name. */
1749 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1750 if (!NILP (handler
))
1751 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1752 ok_if_already_exists
, keep_date
));
1754 if (NILP (ok_if_already_exists
)
1755 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1756 barf_or_query_if_file_exists (newname
, "copy to it",
1757 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1759 ifd
= open (XSTRING (filename
)->data
, 0);
1761 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1763 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1765 /* We can only copy regular files and symbolic links. Other files are not
1767 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1769 #if defined (S_ISREG) && defined (S_ISLNK)
1770 if (input_file_statable_p
)
1772 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1774 #if defined (EISDIR)
1775 /* Get a better looking error message. */
1778 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1781 #endif /* S_ISREG && S_ISLNK */
1784 /* Create the copy file with the same record format as the input file */
1785 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1788 /* System's default file type was set to binary by _fmode in emacs.c. */
1789 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1790 #else /* not MSDOS */
1791 ofd
= creat (XSTRING (newname
)->data
, 0666);
1792 #endif /* not MSDOS */
1795 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1797 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1801 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1802 if (write (ofd
, buf
, n
) != n
)
1803 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1806 /* Closing the output clobbers the file times on some systems. */
1807 if (close (ofd
) < 0)
1808 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1810 if (input_file_statable_p
)
1812 if (!NILP (keep_date
))
1814 EMACS_TIME atime
, mtime
;
1815 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1816 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1817 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1820 if (!egetenv ("USE_DOMAIN_ACLS"))
1822 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1827 /* Discard the unwind protects. */
1828 specpdl_ptr
= specpdl
+ count
;
1834 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1835 Smake_directory_internal
, 1, 1, 0,
1836 "Create a directory. One argument, a file name string.")
1838 Lisp_Object dirname
;
1841 Lisp_Object handler
;
1843 CHECK_STRING (dirname
, 0);
1844 dirname
= Fexpand_file_name (dirname
, Qnil
);
1846 handler
= Ffind_file_name_handler (dirname
, Qmake_directory
);
1847 if (!NILP (handler
))
1848 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1850 dir
= XSTRING (dirname
)->data
;
1852 if (mkdir (dir
, 0777) != 0)
1853 report_file_error ("Creating directory", Flist (1, &dirname
));
1858 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1859 "Delete a directory. One argument, a file name or directory name string.")
1861 Lisp_Object dirname
;
1864 Lisp_Object handler
;
1866 CHECK_STRING (dirname
, 0);
1867 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1868 dir
= XSTRING (dirname
)->data
;
1870 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1871 if (!NILP (handler
))
1872 return call2 (handler
, Qdelete_directory
, dirname
);
1874 if (rmdir (dir
) != 0)
1875 report_file_error ("Removing directory", Flist (1, &dirname
));
1880 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1881 "Delete specified file. One argument, a file name string.\n\
1882 If file has multiple names, it continues to exist with the other names.")
1884 Lisp_Object filename
;
1886 Lisp_Object handler
;
1887 CHECK_STRING (filename
, 0);
1888 filename
= Fexpand_file_name (filename
, Qnil
);
1890 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1891 if (!NILP (handler
))
1892 return call2 (handler
, Qdelete_file
, filename
);
1894 if (0 > unlink (XSTRING (filename
)->data
))
1895 report_file_error ("Removing old name", Flist (1, &filename
));
1899 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1900 "fRename file: \nFRename %s to file: \np",
1901 "Rename FILE as NEWNAME. Both args strings.\n\
1902 If file has names other than FILE, it continues to have those names.\n\
1903 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1904 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1905 A number as third arg means request confirmation if NEWNAME already exists.\n\
1906 This is what happens in interactive use with M-x.")
1907 (filename
, newname
, ok_if_already_exists
)
1908 Lisp_Object filename
, newname
, ok_if_already_exists
;
1911 Lisp_Object args
[2];
1913 Lisp_Object handler
;
1914 struct gcpro gcpro1
, gcpro2
;
1916 GCPRO2 (filename
, newname
);
1917 CHECK_STRING (filename
, 0);
1918 CHECK_STRING (newname
, 1);
1919 filename
= Fexpand_file_name (filename
, Qnil
);
1920 newname
= Fexpand_file_name (newname
, Qnil
);
1922 /* If the file name has special constructs in it,
1923 call the corresponding file handler. */
1924 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1926 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1927 if (!NILP (handler
))
1928 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1929 filename
, newname
, ok_if_already_exists
));
1931 if (NILP (ok_if_already_exists
)
1932 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1933 barf_or_query_if_file_exists (newname
, "rename to it",
1934 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1936 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1938 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1939 || 0 > unlink (XSTRING (filename
)->data
))
1944 Fcopy_file (filename
, newname
,
1945 /* We have already prompted if it was an integer,
1946 so don't have copy-file prompt again. */
1947 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1948 Fdelete_file (filename
);
1955 report_file_error ("Renaming", Flist (2, args
));
1958 report_file_error ("Renaming", Flist (2, &filename
));
1965 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1966 "fAdd name to file: \nFName to add to %s: \np",
1967 "Give FILE additional name NEWNAME. Both args strings.\n\
1968 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1969 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1970 A number as third arg means request confirmation if NEWNAME already exists.\n\
1971 This is what happens in interactive use with M-x.")
1972 (filename
, newname
, ok_if_already_exists
)
1973 Lisp_Object filename
, newname
, ok_if_already_exists
;
1976 Lisp_Object args
[2];
1978 Lisp_Object handler
;
1979 struct gcpro gcpro1
, gcpro2
;
1981 GCPRO2 (filename
, newname
);
1982 CHECK_STRING (filename
, 0);
1983 CHECK_STRING (newname
, 1);
1984 filename
= Fexpand_file_name (filename
, Qnil
);
1985 newname
= Fexpand_file_name (newname
, Qnil
);
1987 /* If the file name has special constructs in it,
1988 call the corresponding file handler. */
1989 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
1990 if (!NILP (handler
))
1991 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
1992 newname
, ok_if_already_exists
));
1994 if (NILP (ok_if_already_exists
)
1995 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1996 barf_or_query_if_file_exists (newname
, "make it a new name",
1997 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1998 unlink (XSTRING (newname
)->data
);
1999 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2004 report_file_error ("Adding new name", Flist (2, args
));
2006 report_file_error ("Adding new name", Flist (2, &filename
));
2015 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2016 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2017 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2018 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2019 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2020 A number as third arg means request confirmation if NEWNAME already exists.\n\
2021 This happens for interactive use with M-x.")
2022 (filename
, linkname
, ok_if_already_exists
)
2023 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2026 Lisp_Object args
[2];
2028 Lisp_Object handler
;
2029 struct gcpro gcpro1
, gcpro2
;
2031 GCPRO2 (filename
, linkname
);
2032 CHECK_STRING (filename
, 0);
2033 CHECK_STRING (linkname
, 1);
2034 /* If the link target has a ~, we must expand it to get
2035 a truly valid file name. Otherwise, do not expand;
2036 we want to permit links to relative file names. */
2037 if (XSTRING (filename
)->data
[0] == '~')
2038 filename
= Fexpand_file_name (filename
, Qnil
);
2039 linkname
= Fexpand_file_name (linkname
, Qnil
);
2041 /* If the file name has special constructs in it,
2042 call the corresponding file handler. */
2043 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2044 if (!NILP (handler
))
2045 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2046 linkname
, ok_if_already_exists
));
2048 if (NILP (ok_if_already_exists
)
2049 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2050 barf_or_query_if_file_exists (linkname
, "make it a link",
2051 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2052 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2054 /* If we didn't complain already, silently delete existing file. */
2055 if (errno
== EEXIST
)
2057 unlink (XSTRING (linkname
)->data
);
2058 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2065 report_file_error ("Making symbolic link", Flist (2, args
));
2067 report_file_error ("Making symbolic link", Flist (2, &filename
));
2073 #endif /* S_IFLNK */
2077 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2078 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2079 "Define the job-wide logical name NAME to have the value STRING.\n\
2080 If STRING is nil or a null string, the logical name NAME is deleted.")
2082 Lisp_Object varname
;
2085 CHECK_STRING (varname
, 0);
2087 delete_logical_name (XSTRING (varname
)->data
);
2090 CHECK_STRING (string
, 1);
2092 if (XSTRING (string
)->size
== 0)
2093 delete_logical_name (XSTRING (varname
)->data
);
2095 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2104 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2105 "Open a network connection to PATH using LOGIN as the login string.")
2107 Lisp_Object path
, login
;
2111 CHECK_STRING (path
, 0);
2112 CHECK_STRING (login
, 0);
2114 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2116 if (netresult
== -1)
2121 #endif /* HPUX_NET */
2123 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2125 "Return t if file FILENAME specifies an absolute path name.\n\
2126 On Unix, this is a name starting with a `/' or a `~'.")
2128 Lisp_Object filename
;
2132 CHECK_STRING (filename
, 0);
2133 ptr
= XSTRING (filename
)->data
;
2134 if (*ptr
== '/' || *ptr
== '~'
2136 /* ??? This criterion is probably wrong for '<'. */
2137 || index (ptr
, ':') || index (ptr
, '<')
2138 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2142 || (*ptr
!= 0 && ptr
[1] == ':' && ptr
[2] == '/')
2150 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2151 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2152 See also `file-readable-p' and `file-attributes'.")
2154 Lisp_Object filename
;
2156 Lisp_Object abspath
;
2157 Lisp_Object handler
;
2159 CHECK_STRING (filename
, 0);
2160 abspath
= Fexpand_file_name (filename
, Qnil
);
2162 /* If the file name has special constructs in it,
2163 call the corresponding file handler. */
2164 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2165 if (!NILP (handler
))
2166 return call2 (handler
, Qfile_exists_p
, abspath
);
2168 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2171 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2172 "Return t if FILENAME can be executed by you.\n\
2173 For a directory, this means you can access files in that directory.")
2175 Lisp_Object filename
;
2178 Lisp_Object abspath
;
2179 Lisp_Object handler
;
2181 CHECK_STRING (filename
, 0);
2182 abspath
= Fexpand_file_name (filename
, Qnil
);
2184 /* If the file name has special constructs in it,
2185 call the corresponding file handler. */
2186 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2187 if (!NILP (handler
))
2188 return call2 (handler
, Qfile_executable_p
, abspath
);
2190 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2193 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2194 "Return t if file FILENAME exists and you can read it.\n\
2195 See also `file-exists-p' and `file-attributes'.")
2197 Lisp_Object filename
;
2199 Lisp_Object abspath
;
2200 Lisp_Object handler
;
2202 CHECK_STRING (filename
, 0);
2203 abspath
= Fexpand_file_name (filename
, Qnil
);
2205 /* If the file name has special constructs in it,
2206 call the corresponding file handler. */
2207 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2208 if (!NILP (handler
))
2209 return call2 (handler
, Qfile_readable_p
, abspath
);
2211 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2214 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2215 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2216 The value is the name of the file to which it is linked.\n\
2217 Otherwise returns nil.")
2219 Lisp_Object filename
;
2226 Lisp_Object handler
;
2228 CHECK_STRING (filename
, 0);
2229 filename
= Fexpand_file_name (filename
, Qnil
);
2231 /* If the file name has special constructs in it,
2232 call the corresponding file handler. */
2233 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2234 if (!NILP (handler
))
2235 return call2 (handler
, Qfile_symlink_p
, filename
);
2240 buf
= (char *) xmalloc (bufsize
);
2241 bzero (buf
, bufsize
);
2242 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2243 if (valsize
< bufsize
) break;
2244 /* Buffer was not long enough */
2253 val
= make_string (buf
, valsize
);
2256 #else /* not S_IFLNK */
2258 #endif /* not S_IFLNK */
2261 #ifdef SOLARIS_BROKEN_ACCESS
2262 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2263 considered by the access system call. This is Sun's bug, but we
2264 still have to make Emacs work. */
2266 #include <sys/statvfs.h>
2272 struct statvfs statvfsb
;
2274 if (statvfs(path
, &statvfsb
))
2275 return 1; /* error from statvfs, be conservative and say not wrtable */
2277 /* Otherwise, fsys is ro if bit is set. */
2278 return statvfsb
.f_flag
& ST_RDONLY
;
2281 /* But on every other os, access has already done the right thing. */
2282 #define ro_fsys(path) 0
2285 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2287 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2288 "Return t if file FILENAME can be written or created by you.")
2290 Lisp_Object filename
;
2292 Lisp_Object abspath
, dir
;
2293 Lisp_Object handler
;
2295 CHECK_STRING (filename
, 0);
2296 abspath
= Fexpand_file_name (filename
, Qnil
);
2298 /* If the file name has special constructs in it,
2299 call the corresponding file handler. */
2300 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2301 if (!NILP (handler
))
2302 return call2 (handler
, Qfile_writable_p
, abspath
);
2304 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2305 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2306 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2308 dir
= Ffile_name_directory (abspath
);
2311 dir
= Fdirectory_file_name (dir
);
2315 dir
= Fdirectory_file_name (dir
);
2317 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2318 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2322 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2323 "Return t if file FILENAME is the name of a directory as a file.\n\
2324 A directory name spec may be given instead; then the value is t\n\
2325 if the directory so specified exists and really is a directory.")
2327 Lisp_Object filename
;
2329 register Lisp_Object abspath
;
2331 Lisp_Object handler
;
2333 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2335 /* If the file name has special constructs in it,
2336 call the corresponding file handler. */
2337 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2338 if (!NILP (handler
))
2339 return call2 (handler
, Qfile_directory_p
, abspath
);
2341 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2343 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2346 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2347 "Return t if file FILENAME is the name of a directory as a file,\n\
2348 and files in that directory can be opened by you. In order to use a\n\
2349 directory as a buffer's current directory, this predicate must return true.\n\
2350 A directory name spec may be given instead; then the value is t\n\
2351 if the directory so specified exists and really is a readable and\n\
2352 searchable directory.")
2354 Lisp_Object filename
;
2356 Lisp_Object handler
;
2358 /* If the file name has special constructs in it,
2359 call the corresponding file handler. */
2360 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2361 if (!NILP (handler
))
2362 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2364 if (NILP (Ffile_directory_p (filename
))
2365 || NILP (Ffile_executable_p (filename
)))
2371 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2372 "Return mode bits of FILE, as an integer.")
2374 Lisp_Object filename
;
2376 Lisp_Object abspath
;
2378 Lisp_Object handler
;
2380 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2382 /* If the file name has special constructs in it,
2383 call the corresponding file handler. */
2384 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2385 if (!NILP (handler
))
2386 return call2 (handler
, Qfile_modes
, abspath
);
2388 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2394 if (S_ISREG (st
.st_mode
)
2395 && (len
= XSTRING (abspath
)->size
) >= 5
2396 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2397 || stricmp (suffix
, ".exe") == 0
2398 || stricmp (suffix
, ".bat") == 0))
2399 st
.st_mode
|= S_IEXEC
;
2403 return make_number (st
.st_mode
& 07777);
2406 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2407 "Set mode bits of FILE to MODE (an integer).\n\
2408 Only the 12 low bits of MODE are used.")
2410 Lisp_Object filename
, mode
;
2412 Lisp_Object abspath
;
2413 Lisp_Object handler
;
2415 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2416 CHECK_NUMBER (mode
, 1);
2418 /* If the file name has special constructs in it,
2419 call the corresponding file handler. */
2420 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2421 if (!NILP (handler
))
2422 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2425 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2426 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2428 if (!egetenv ("USE_DOMAIN_ACLS"))
2431 struct timeval tvp
[2];
2433 /* chmod on apollo also change the file's modtime; need to save the
2434 modtime and then restore it. */
2435 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2437 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2441 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2442 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2444 /* reset the old accessed and modified times. */
2445 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2447 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2450 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2451 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2458 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2459 "Set the file permission bits for newly created files.\n\
2460 The argument MODE should be an integer; only the low 9 bits are used.\n\
2461 This setting is inherited by subprocesses.")
2465 CHECK_NUMBER (mode
, 0);
2467 umask ((~ XINT (mode
)) & 0777);
2472 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2473 "Return the default file protection for created files.\n\
2474 The value is an integer.")
2480 realmask
= umask (0);
2483 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2489 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2490 "Tell Unix to finish all pending disk updates.")
2499 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2500 "Return t if file FILE1 is newer than file FILE2.\n\
2501 If FILE1 does not exist, the answer is nil;\n\
2502 otherwise, if FILE2 does not exist, the answer is t.")
2504 Lisp_Object file1
, file2
;
2506 Lisp_Object abspath1
, abspath2
;
2509 Lisp_Object handler
;
2510 struct gcpro gcpro1
, gcpro2
;
2512 CHECK_STRING (file1
, 0);
2513 CHECK_STRING (file2
, 0);
2516 GCPRO2 (abspath1
, file2
);
2517 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2518 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2521 /* If the file name has special constructs in it,
2522 call the corresponding file handler. */
2523 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2525 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2526 if (!NILP (handler
))
2527 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2529 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2532 mtime1
= st
.st_mtime
;
2534 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2537 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2541 Lisp_Object Qfind_buffer_file_type
;
2544 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2546 "Insert contents of file FILENAME after point.\n\
2547 Returns list of absolute file name and length of data inserted.\n\
2548 If second argument VISIT is non-nil, the buffer's visited filename\n\
2549 and last save file modtime are set, and it is marked unmodified.\n\
2550 If visiting and the file does not exist, visiting is completed\n\
2551 before the error is signaled.\n\n\
2552 The optional third and fourth arguments BEG and END\n\
2553 specify what portion of the file to insert.\n\
2554 If VISIT is non-nil, BEG and END must be nil.\n\
2555 If optional fifth argument REPLACE is non-nil,\n\
2556 it means replace the current buffer contents (in the accessible portion)\n\
2557 with the file contents. This is better than simply deleting and inserting\n\
2558 the whole thing because (1) it preserves some marker positions\n\
2559 and (2) it puts less data in the undo list.")
2560 (filename
, visit
, beg
, end
, replace
)
2561 Lisp_Object filename
, visit
, beg
, end
, replace
;
2565 register int inserted
= 0;
2566 register int how_much
;
2567 int count
= specpdl_ptr
- specpdl
;
2568 struct gcpro gcpro1
, gcpro2
;
2569 Lisp_Object handler
, val
, insval
;
2576 GCPRO2 (filename
, p
);
2577 if (!NILP (current_buffer
->read_only
))
2578 Fbarf_if_buffer_read_only();
2580 CHECK_STRING (filename
, 0);
2581 filename
= Fexpand_file_name (filename
, Qnil
);
2583 /* If the file name has special constructs in it,
2584 call the corresponding file handler. */
2585 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2586 if (!NILP (handler
))
2588 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2589 visit
, beg
, end
, replace
);
2596 if (stat (XSTRING (filename
)->data
, &st
) < 0
2597 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2599 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2600 || fstat (fd
, &st
) < 0)
2601 #endif /* not APOLLO */
2603 if (fd
>= 0) close (fd
);
2605 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2611 /* Replacement should preserve point as it preserves markers. */
2612 if (!NILP (replace
))
2613 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2615 record_unwind_protect (close_file_unwind
, make_number (fd
));
2618 /* This code will need to be changed in order to work on named
2619 pipes, and it's probably just not worth it. So we should at
2620 least signal an error. */
2621 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2622 Fsignal (Qfile_error
,
2623 Fcons (build_string ("reading from named pipe"),
2624 Fcons (filename
, Qnil
)));
2627 /* Supposedly happens on VMS. */
2629 error ("File size is negative");
2631 if (!NILP (beg
) || !NILP (end
))
2633 error ("Attempt to visit less than an entire file");
2636 CHECK_NUMBER (beg
, 0);
2641 CHECK_NUMBER (end
, 0);
2644 XSETINT (end
, st
.st_size
);
2645 if (XINT (end
) != st
.st_size
)
2646 error ("maximum buffer size exceeded");
2649 /* If requested, replace the accessible part of the buffer
2650 with the file contents. Avoid replacing text at the
2651 beginning or end of the buffer that matches the file contents;
2652 that preserves markers pointing to the unchanged parts. */
2654 /* On MSDOS, replace mode doesn't really work, except for binary files,
2655 and it's not worth supporting just for them. */
2656 if (!NILP (replace
))
2660 XFASTINT (end
) = st
.st_size
;
2661 del_range_1 (BEGV
, ZV
, 0);
2664 if (!NILP (replace
))
2666 unsigned char buffer
[1 << 14];
2667 int same_at_start
= BEGV
;
2668 int same_at_end
= ZV
;
2673 /* Count how many chars at the start of the file
2674 match the text at the beginning of the buffer. */
2679 nread
= read (fd
, buffer
, sizeof buffer
);
2681 error ("IO error reading %s: %s",
2682 XSTRING (filename
)->data
, strerror (errno
));
2683 else if (nread
== 0)
2686 while (bufpos
< nread
&& same_at_start
< ZV
2687 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2688 same_at_start
++, bufpos
++;
2689 /* If we found a discrepancy, stop the scan.
2690 Otherwise loop around and scan the next bufferfull. */
2691 if (bufpos
!= nread
)
2695 /* If the file matches the buffer completely,
2696 there's no need to replace anything. */
2697 if (same_at_start
- BEGV
== st
.st_size
)
2701 /* Truncate the buffer to the size of the file. */
2702 del_range_1 (same_at_start
, same_at_end
, 0);
2707 /* Count how many chars at the end of the file
2708 match the text at the end of the buffer. */
2711 int total_read
, nread
, bufpos
, curpos
, trial
;
2713 /* At what file position are we now scanning? */
2714 curpos
= st
.st_size
- (ZV
- same_at_end
);
2715 /* How much can we scan in the next step? */
2716 trial
= min (curpos
, sizeof buffer
);
2717 if (lseek (fd
, curpos
- trial
, 0) < 0)
2718 report_file_error ("Setting file position",
2719 Fcons (filename
, Qnil
));
2722 while (total_read
< trial
)
2724 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2726 error ("IO error reading %s: %s",
2727 XSTRING (filename
)->data
, strerror (errno
));
2728 total_read
+= nread
;
2730 /* Scan this bufferfull from the end, comparing with
2731 the Emacs buffer. */
2732 bufpos
= total_read
;
2733 /* Compare with same_at_start to avoid counting some buffer text
2734 as matching both at the file's beginning and at the end. */
2735 while (bufpos
> 0 && same_at_end
> same_at_start
2736 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2737 same_at_end
--, bufpos
--;
2738 /* If we found a discrepancy, stop the scan.
2739 Otherwise loop around and scan the preceding bufferfull. */
2745 /* Don't try to reuse the same piece of text twice. */
2746 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2748 same_at_end
+= overlap
;
2750 /* Arrange to read only the nonmatching middle part of the file. */
2751 XFASTINT (beg
) = same_at_start
- BEGV
;
2752 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2754 del_range_1 (same_at_start
, same_at_end
, 0);
2755 /* Insert from the file at the proper position. */
2756 SET_PT (same_at_start
);
2760 total
= XINT (end
) - XINT (beg
);
2763 register Lisp_Object temp
;
2765 /* Make sure point-max won't overflow after this insertion. */
2766 XSET (temp
, Lisp_Int
, total
);
2767 if (total
!= XINT (temp
))
2768 error ("maximum buffer size exceeded");
2771 if (NILP (visit
) && total
> 0)
2772 prepare_to_modify_buffer (point
, point
);
2775 if (GAP_SIZE
< total
)
2776 make_gap (total
- GAP_SIZE
);
2778 if (XINT (beg
) != 0 || !NILP (replace
))
2780 if (lseek (fd
, XINT (beg
), 0) < 0)
2781 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2785 while (inserted
< total
)
2787 int try = min (total
- inserted
, 64 << 10);
2790 /* Allow quitting out of the actual I/O. */
2793 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2810 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2811 /* Determine file type from name and remove LFs from CR-LFs if the file
2812 is deemed to be a text file. */
2814 struct gcpro gcpro1
;
2818 current_buffer
->buffer_file_type
2819 = call1 (Qfind_buffer_file_type
, filename
);
2821 if (NILP (current_buffer
->buffer_file_type
))
2824 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2827 GPT
-= reduced_size
;
2828 GAP_SIZE
+= reduced_size
;
2829 inserted
-= reduced_size
;
2836 record_insert (point
, inserted
);
2838 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2839 offset_intervals (current_buffer
, point
, inserted
);
2845 /* Discard the unwind protect for closing the file. */
2849 error ("IO error reading %s: %s",
2850 XSTRING (filename
)->data
, strerror (errno
));
2857 if (!EQ (current_buffer
->undo_list
, Qt
))
2858 current_buffer
->undo_list
= Qnil
;
2860 stat (XSTRING (filename
)->data
, &st
);
2865 current_buffer
->modtime
= st
.st_mtime
;
2866 current_buffer
->filename
= filename
;
2869 current_buffer
->save_modified
= MODIFF
;
2870 current_buffer
->auto_save_modified
= MODIFF
;
2871 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2872 #ifdef CLASH_DETECTION
2875 if (!NILP (current_buffer
->filename
))
2876 unlock_file (current_buffer
->filename
);
2877 unlock_file (filename
);
2879 #endif /* CLASH_DETECTION */
2880 /* If visiting nonexistent file, return nil. */
2881 if (current_buffer
->modtime
== -1)
2882 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2885 if (inserted
> 0 && NILP (visit
) && total
> 0)
2886 signal_after_change (point
, 0, inserted
);
2890 p
= Vafter_insert_file_functions
;
2893 insval
= call1 (Fcar (p
), make_number (inserted
));
2896 CHECK_NUMBER (insval
, 0);
2897 inserted
= XFASTINT (insval
);
2905 val
= Fcons (filename
,
2906 Fcons (make_number (inserted
),
2909 RETURN_UNGCPRO (unbind_to (count
, val
));
2912 static Lisp_Object
build_annotations ();
2914 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2915 "r\nFWrite region to file: ",
2916 "Write current region into specified file.\n\
2917 When called from a program, takes three arguments:\n\
2918 START, END and FILENAME. START and END are buffer positions.\n\
2919 Optional fourth argument APPEND if non-nil means\n\
2920 append to existing file contents (if any).\n\
2921 Optional fifth argument VISIT if t means\n\
2922 set the last-save-file-modtime of buffer to this file's modtime\n\
2923 and mark buffer not modified.\n\
2924 If VISIT is a string, it is a second file name;\n\
2925 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2926 VISIT is also the file name to lock and unlock for clash detection.\n\
2927 If VISIT is neither t nor nil nor a string,\n\
2928 that means do not print the \"Wrote file\" message.\n\
2929 Kludgy feature: if START is a string, then that string is written\n\
2930 to the file, instead of any buffer contents, and END is ignored.")
2931 (start
, end
, filename
, append
, visit
)
2932 Lisp_Object start
, end
, filename
, append
, visit
;
2940 int count
= specpdl_ptr
- specpdl
;
2942 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2944 Lisp_Object handler
;
2945 Lisp_Object visit_file
;
2946 Lisp_Object annotations
;
2947 int visiting
, quietly
;
2948 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2950 int buffer_file_type
2951 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2954 if (!NILP (start
) && !STRINGP (start
))
2955 validate_region (&start
, &end
);
2957 filename
= Fexpand_file_name (filename
, Qnil
);
2958 if (STRINGP (visit
))
2959 visit_file
= Fexpand_file_name (visit
, Qnil
);
2961 visit_file
= filename
;
2963 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2964 quietly
= !NILP (visit
);
2968 GCPRO4 (start
, filename
, annotations
, visit_file
);
2970 /* If the file name has special constructs in it,
2971 call the corresponding file handler. */
2972 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
2973 /* If FILENAME has no handler, see if VISIT has one. */
2974 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2975 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
2977 if (!NILP (handler
))
2980 val
= call6 (handler
, Qwrite_region
, start
, end
,
2981 filename
, append
, visit
);
2985 current_buffer
->save_modified
= MODIFF
;
2986 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2987 current_buffer
->filename
= visit_file
;
2993 /* Special kludge to simplify auto-saving. */
2996 XFASTINT (start
) = BEG
;
3000 annotations
= build_annotations (start
, end
);
3002 #ifdef CLASH_DETECTION
3004 lock_file (visit_file
);
3005 #endif /* CLASH_DETECTION */
3007 fn
= XSTRING (filename
)->data
;
3011 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3013 desc
= open (fn
, O_WRONLY
);
3018 if (auto_saving
) /* Overwrite any previous version of autosave file */
3020 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3021 desc
= open (fn
, O_RDWR
);
3023 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3024 ? XSTRING (current_buffer
->filename
)->data
: 0,
3027 else /* Write to temporary name and rename if no errors */
3029 Lisp_Object temp_name
;
3030 temp_name
= Ffile_name_directory (filename
);
3032 if (!NILP (temp_name
))
3034 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3035 build_string ("$$SAVE$$")));
3036 fname
= XSTRING (filename
)->data
;
3037 fn
= XSTRING (temp_name
)->data
;
3038 desc
= creat_copy_attrs (fname
, fn
);
3041 /* If we can't open the temporary file, try creating a new
3042 version of the original file. VMS "creat" creates a
3043 new version rather than truncating an existing file. */
3046 desc
= creat (fn
, 0666);
3047 #if 0 /* This can clobber an existing file and fail to replace it,
3048 if the user runs out of space. */
3051 /* We can't make a new version;
3052 try to truncate and rewrite existing version if any. */
3054 desc
= open (fn
, O_RDWR
);
3060 desc
= creat (fn
, 0666);
3065 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3066 S_IREAD
| S_IWRITE
);
3067 #else /* not MSDOS */
3068 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3069 #endif /* not MSDOS */
3070 #endif /* not VMS */
3076 #ifdef CLASH_DETECTION
3078 if (!auto_saving
) unlock_file (visit_file
);
3080 #endif /* CLASH_DETECTION */
3081 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3084 record_unwind_protect (close_file_unwind
, make_number (desc
));
3087 if (lseek (desc
, 0, 2) < 0)
3089 #ifdef CLASH_DETECTION
3090 if (!auto_saving
) unlock_file (visit_file
);
3091 #endif /* CLASH_DETECTION */
3092 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3097 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3098 * if we do writes that don't end with a carriage return. Furthermore
3099 * it cannot handle writes of more then 16K. The modified
3100 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3101 * this EXCEPT for the last record (iff it doesn't end with a carriage
3102 * return). This implies that if your buffer doesn't end with a carriage
3103 * return, you get one free... tough. However it also means that if
3104 * we make two calls to sys_write (a la the following code) you can
3105 * get one at the gap as well. The easiest way to fix this (honest)
3106 * is to move the gap to the next newline (or the end of the buffer).
3111 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3112 move_gap (find_next_newline (GPT
, 1));
3118 if (STRINGP (start
))
3120 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3121 XSTRING (start
)->size
, 0, &annotations
);
3124 else if (XINT (start
) != XINT (end
))
3127 if (XINT (start
) < GPT
)
3129 register int end1
= XINT (end
);
3131 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3132 min (GPT
, end1
) - tem
, tem
, &annotations
);
3133 nwritten
+= min (GPT
, end1
) - tem
;
3137 if (XINT (end
) > GPT
&& !failure
)
3140 tem
= max (tem
, GPT
);
3141 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3143 nwritten
+= XINT (end
) - tem
;
3149 /* If file was empty, still need to write the annotations */
3150 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3158 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3159 Disk full in NFS may be reported here. */
3160 /* mib says that closing the file will try to write as fast as NFS can do
3161 it, and that means the fsync here is not crucial for autosave files. */
3162 if (!auto_saving
&& fsync (desc
) < 0)
3163 failure
= 1, save_errno
= errno
;
3166 /* Spurious "file has changed on disk" warnings have been
3167 observed on Suns as well.
3168 It seems that `close' can change the modtime, under nfs.
3170 (This has supposedly been fixed in Sunos 4,
3171 but who knows about all the other machines with NFS?) */
3174 /* On VMS and APOLLO, must do the stat after the close
3175 since closing changes the modtime. */
3178 /* Recall that #if defined does not work on VMS. */
3185 /* NFS can report a write failure now. */
3186 if (close (desc
) < 0)
3187 failure
= 1, save_errno
= errno
;
3190 /* If we wrote to a temporary name and had no errors, rename to real name. */
3194 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3202 /* Discard the unwind protect */
3203 specpdl_ptr
= specpdl
+ count
;
3205 #ifdef CLASH_DETECTION
3207 unlock_file (visit_file
);
3208 #endif /* CLASH_DETECTION */
3210 /* Do this before reporting IO error
3211 to avoid a "file has changed on disk" warning on
3212 next attempt to save. */
3214 current_buffer
->modtime
= st
.st_mtime
;
3217 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3221 current_buffer
->save_modified
= MODIFF
;
3222 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3223 current_buffer
->filename
= visit_file
;
3224 update_mode_lines
++;
3230 message ("Wrote %s", XSTRING (visit_file
)->data
);
3235 Lisp_Object
merge ();
3237 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3238 "Return t if (car A) is numerically less than (car B).")
3242 return Flss (Fcar (a
), Fcar (b
));
3245 /* Build the complete list of annotations appropriate for writing out
3246 the text between START and END, by calling all the functions in
3247 write-region-annotate-functions and merging the lists they return. */
3250 build_annotations (start
, end
)
3251 Lisp_Object start
, end
;
3253 Lisp_Object annotations
;
3255 struct gcpro gcpro1
, gcpro2
;
3258 p
= Vwrite_region_annotate_functions
;
3259 GCPRO2 (annotations
, p
);
3262 res
= call2 (Fcar (p
), start
, end
);
3263 Flength (res
); /* Check basic validity of return value */
3264 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3271 /* Write to descriptor DESC the LEN characters starting at ADDR,
3272 assuming they start at position POS in the buffer.
3273 Intersperse with them the annotations from *ANNOT
3274 (those which fall within the range of positions POS to POS + LEN),
3275 each at its appropriate position.
3277 Modify *ANNOT by discarding elements as we output them.
3278 The return value is negative in case of system call failure. */
3281 a_write (desc
, addr
, len
, pos
, annot
)
3283 register char *addr
;
3290 int lastpos
= pos
+ len
;
3294 tem
= Fcar_safe (Fcar (*annot
));
3295 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3296 nextpos
= XFASTINT (tem
);
3298 return e_write (desc
, addr
, lastpos
- pos
);
3301 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3303 addr
+= nextpos
- pos
;
3306 tem
= Fcdr (Fcar (*annot
));
3309 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3312 *annot
= Fcdr (*annot
);
3317 e_write (desc
, addr
, len
)
3319 register char *addr
;
3322 char buf
[16 * 1024];
3323 register char *p
, *end
;
3325 if (!EQ (current_buffer
->selective_display
, Qt
))
3326 return write (desc
, addr
, len
) - len
;
3330 end
= p
+ sizeof buf
;
3335 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3344 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3350 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3351 Sverify_visited_file_modtime
, 1, 1, 0,
3352 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3353 This means that the file has not been changed since it was visited or saved.")
3359 Lisp_Object handler
;
3361 CHECK_BUFFER (buf
, 0);
3364 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3365 if (b
->modtime
== 0) return Qt
;
3367 /* If the file name has special constructs in it,
3368 call the corresponding file handler. */
3369 handler
= Ffind_file_name_handler (b
->filename
,
3370 Qverify_visited_file_modtime
);
3371 if (!NILP (handler
))
3372 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3374 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3376 /* If the file doesn't exist now and didn't exist before,
3377 we say that it isn't modified, provided the error is a tame one. */
3378 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3383 if (st
.st_mtime
== b
->modtime
3384 /* If both are positive, accept them if they are off by one second. */
3385 || (st
.st_mtime
> 0 && b
->modtime
> 0
3386 && (st
.st_mtime
== b
->modtime
+ 1
3387 || st
.st_mtime
== b
->modtime
- 1)))
3392 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3393 Sclear_visited_file_modtime
, 0, 0, 0,
3394 "Clear out records of last mod time of visited file.\n\
3395 Next attempt to save will certainly not complain of a discrepancy.")
3398 current_buffer
->modtime
= 0;
3402 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3403 Svisited_file_modtime
, 0, 0, 0,
3404 "Return the current buffer's recorded visited file modification time.\n\
3405 The value is a list of the form (HIGH . LOW), like the time values\n\
3406 that `file-attributes' returns.")
3409 return long_to_cons (current_buffer
->modtime
);
3412 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3413 Sset_visited_file_modtime
, 0, 1, 0,
3414 "Update buffer's recorded modification time from the visited file's time.\n\
3415 Useful if the buffer was not read from the file normally\n\
3416 or if the file itself has been changed for some known benign reason.\n\
3417 An argument specifies the modification time value to use\n\
3418 \(instead of that of the visited file), in the form of a list\n\
3419 \(HIGH . LOW) or (HIGH LOW).")
3421 Lisp_Object time_list
;
3423 if (!NILP (time_list
))
3424 current_buffer
->modtime
= cons_to_long (time_list
);
3427 register Lisp_Object filename
;
3429 Lisp_Object handler
;
3431 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3433 /* If the file name has special constructs in it,
3434 call the corresponding file handler. */
3435 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3436 if (!NILP (handler
))
3437 /* The handler can find the file name the same way we did. */
3438 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3439 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3440 current_buffer
->modtime
= st
.st_mtime
;
3449 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3452 message ("Autosaving...error for %s", name
);
3453 Fsleep_for (make_number (1), Qnil
);
3454 message ("Autosaving...error!for %s", name
);
3455 Fsleep_for (make_number (1), Qnil
);
3456 message ("Autosaving...error for %s", name
);
3457 Fsleep_for (make_number (1), Qnil
);
3467 /* Get visited file's mode to become the auto save file's mode. */
3468 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3469 /* But make sure we can overwrite it later! */
3470 auto_save_mode_bits
= st
.st_mode
| 0600;
3472 auto_save_mode_bits
= 0666;
3475 Fwrite_region (Qnil
, Qnil
,
3476 current_buffer
->auto_save_file_name
,
3481 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3484 close (XINT (desc
));
3488 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3489 "Auto-save all buffers that need it.\n\
3490 This is all buffers that have auto-saving enabled\n\
3491 and are changed since last auto-saved.\n\
3492 Auto-saving writes the buffer into a file\n\
3493 so that your editing is not lost if the system crashes.\n\
3494 This file is not the file you visited; that changes only when you save.\n\
3495 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3496 Non-nil first argument means do not print any message if successful.\n\
3497 Non-nil second argument means save only current buffer.")
3498 (no_message
, current_only
)
3499 Lisp_Object no_message
, current_only
;
3501 struct buffer
*old
= current_buffer
, *b
;
3502 Lisp_Object tail
, buf
;
3504 char *omessage
= echo_area_glyphs
;
3505 int omessage_length
= echo_area_glyphs_length
;
3506 extern int minibuf_level
;
3507 int do_handled_files
;
3510 Lisp_Object lispstream
;
3511 int count
= specpdl_ptr
- specpdl
;
3514 /* Ordinarily don't quit within this function,
3515 but don't make it impossible to quit (in case we get hung in I/O). */
3519 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3520 point to non-strings reached from Vbuffer_alist. */
3526 if (!NILP (Vrun_hooks
))
3527 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3529 if (STRINGP (Vauto_save_list_file_name
))
3532 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3533 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3534 S_IREAD
| S_IWRITE
);
3535 #else /* not MSDOS */
3536 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3537 #endif /* not MSDOS */
3542 /* Arrange to close that file whether or not we get an error. */
3544 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3546 /* First, save all files which don't have handlers. If Emacs is
3547 crashing, the handlers may tweak what is causing Emacs to crash
3548 in the first place, and it would be a shame if Emacs failed to
3549 autosave perfectly ordinary files because it couldn't handle some
3551 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3552 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3553 tail
= XCONS (tail
)->cdr
)
3555 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3558 /* Record all the buffers that have auto save mode
3559 in the special file that lists them. */
3560 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3561 && listdesc
>= 0 && do_handled_files
== 0)
3563 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3564 XSTRING (b
->auto_save_file_name
)->size
);
3565 write (listdesc
, "\n", 1);
3568 if (!NILP (current_only
)
3569 && b
!= current_buffer
)
3572 /* Check for auto save enabled
3573 and file changed since last auto save
3574 and file changed since last real save. */
3575 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3576 && b
->save_modified
< BUF_MODIFF (b
)
3577 && b
->auto_save_modified
< BUF_MODIFF (b
)
3578 /* -1 means we've turned off autosaving for a while--see below. */
3579 && XINT (b
->save_length
) >= 0
3580 && (do_handled_files
3581 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3584 EMACS_TIME before_time
, after_time
;
3586 EMACS_GET_TIME (before_time
);
3588 /* If we had a failure, don't try again for 20 minutes. */
3589 if (b
->auto_save_failure_time
>= 0
3590 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3593 if ((XFASTINT (b
->save_length
) * 10
3594 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3595 /* A short file is likely to change a large fraction;
3596 spare the user annoying messages. */
3597 && XFASTINT (b
->save_length
) > 5000
3598 /* These messages are frequent and annoying for `*mail*'. */
3599 && !EQ (b
->filename
, Qnil
)
3600 && NILP (no_message
))
3602 /* It has shrunk too much; turn off auto-saving here. */
3603 message ("Buffer %s has shrunk a lot; auto save turned off there",
3604 XSTRING (b
->name
)->data
);
3605 /* Turn off auto-saving until there's a real save,
3606 and prevent any more warnings. */
3607 XSET (b
->save_length
, Lisp_Int
, -1);
3608 Fsleep_for (make_number (1), Qnil
);
3611 set_buffer_internal (b
);
3612 if (!auto_saved
&& NILP (no_message
))
3613 message1 ("Auto-saving...");
3614 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3616 b
->auto_save_modified
= BUF_MODIFF (b
);
3617 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3618 set_buffer_internal (old
);
3620 EMACS_GET_TIME (after_time
);
3622 /* If auto-save took more than 60 seconds,
3623 assume it was an NFS failure that got a timeout. */
3624 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3625 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3629 /* Prevent another auto save till enough input events come in. */
3630 record_auto_save ();
3632 if (auto_saved
&& NILP (no_message
))
3635 message2 (omessage
, omessage_length
);
3637 message1 ("Auto-saving...done");
3643 unbind_to (count
, Qnil
);
3647 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3648 Sset_buffer_auto_saved
, 0, 0, 0,
3649 "Mark current buffer as auto-saved with its current text.\n\
3650 No auto-save file will be written until the buffer changes again.")
3653 current_buffer
->auto_save_modified
= MODIFF
;
3654 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3655 current_buffer
->auto_save_failure_time
= -1;
3659 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3660 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3661 "Clear any record of a recent auto-save failure in the current buffer.")
3664 current_buffer
->auto_save_failure_time
= -1;
3668 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3670 "Return t if buffer has been auto-saved since last read in or saved.")
3673 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3676 /* Reading and completing file names */
3677 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3679 /* In the string VAL, change each $ to $$ and return the result. */
3682 double_dollars (val
)
3685 register unsigned char *old
, *new;
3689 osize
= XSTRING (val
)->size
;
3690 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3691 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3692 if (*old
++ == '$') count
++;
3695 old
= XSTRING (val
)->data
;
3696 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3697 new = XSTRING (val
)->data
;
3698 for (n
= osize
; n
> 0; n
--)
3711 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3713 "Internal subroutine for read-file-name. Do not call this.")
3714 (string
, dir
, action
)
3715 Lisp_Object string
, dir
, action
;
3716 /* action is nil for complete, t for return list of completions,
3717 lambda for verify final value */
3719 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3721 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3728 /* No need to protect ACTION--we only compare it with t and nil. */
3729 GCPRO4 (string
, realdir
, name
, specdir
);
3731 if (XSTRING (string
)->size
== 0)
3733 if (EQ (action
, Qlambda
))
3741 orig_string
= string
;
3742 string
= Fsubstitute_in_file_name (string
);
3743 changed
= NILP (Fstring_equal (string
, orig_string
));
3744 name
= Ffile_name_nondirectory (string
);
3745 val
= Ffile_name_directory (string
);
3747 realdir
= Fexpand_file_name (val
, realdir
);
3752 specdir
= Ffile_name_directory (string
);
3753 val
= Ffile_name_completion (name
, realdir
);
3755 if (XTYPE (val
) != Lisp_String
)
3762 if (!NILP (specdir
))
3763 val
= concat2 (specdir
, val
);
3765 return double_dollars (val
);
3768 #endif /* not VMS */
3772 if (EQ (action
, Qt
))
3773 return Ffile_name_all_completions (name
, realdir
);
3774 /* Only other case actually used is ACTION = lambda */
3776 /* Supposedly this helps commands such as `cd' that read directory names,
3777 but can someone explain how it helps them? -- RMS */
3778 if (XSTRING (name
)->size
== 0)
3781 return Ffile_exists_p (string
);
3784 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3785 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3786 Value is not expanded---you must call `expand-file-name' yourself.\n\
3787 Default name to DEFAULT if user enters a null string.\n\
3788 (If DEFAULT is omitted, the visited file name is used.)\n\
3789 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3790 Non-nil and non-t means also require confirmation after completion.\n\
3791 Fifth arg INITIAL specifies text to start with.\n\
3792 DIR defaults to current buffer's directory default.")
3793 (prompt
, dir
, defalt
, mustmatch
, initial
)
3794 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3796 Lisp_Object val
, insdef
, insdef1
, tem
;
3797 struct gcpro gcpro1
, gcpro2
;
3798 register char *homedir
;
3802 dir
= current_buffer
->directory
;
3804 defalt
= current_buffer
->filename
;
3806 /* If dir starts with user's homedir, change that to ~. */
3807 homedir
= (char *) egetenv ("HOME");
3809 && XTYPE (dir
) == Lisp_String
3810 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3811 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3813 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3814 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3815 XSTRING (dir
)->data
[0] = '~';
3818 if (insert_default_directory
)
3821 if (!NILP (initial
))
3823 Lisp_Object args
[2], pos
;
3827 insdef
= Fconcat (2, args
);
3828 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3829 insdef1
= Fcons (double_dollars (insdef
), pos
);
3832 insdef1
= double_dollars (insdef
);
3834 else if (!NILP (initial
))
3837 insdef1
= Fcons (double_dollars (insdef
), 0);
3840 insdef
= Qnil
, insdef1
= Qnil
;
3843 count
= specpdl_ptr
- specpdl
;
3844 specbind (intern ("completion-ignore-case"), Qt
);
3847 GCPRO2 (insdef
, defalt
);
3848 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3849 dir
, mustmatch
, insdef1
,
3850 Qfile_name_history
);
3853 unbind_to (count
, Qnil
);
3858 error ("No file name specified");
3859 tem
= Fstring_equal (val
, insdef
);
3860 if (!NILP (tem
) && !NILP (defalt
))
3862 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3867 error ("No default file name");
3869 return Fsubstitute_in_file_name (val
);
3872 #if 0 /* Old version */
3873 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3874 /* Don't confuse make-docfile by having two doc strings for this function.
3875 make-docfile does not pay attention to #if, for good reason! */
3877 (prompt
, dir
, defalt
, mustmatch
, initial
)
3878 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3880 Lisp_Object val
, insdef
, tem
;
3881 struct gcpro gcpro1
, gcpro2
;
3882 register char *homedir
;
3886 dir
= current_buffer
->directory
;
3888 defalt
= current_buffer
->filename
;
3890 /* If dir starts with user's homedir, change that to ~. */
3891 homedir
= (char *) egetenv ("HOME");
3893 && XTYPE (dir
) == Lisp_String
3894 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3895 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3897 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3898 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3899 XSTRING (dir
)->data
[0] = '~';
3902 if (!NILP (initial
))
3904 else if (insert_default_directory
)
3907 insdef
= build_string ("");
3910 count
= specpdl_ptr
- specpdl
;
3911 specbind (intern ("completion-ignore-case"), Qt
);
3914 GCPRO2 (insdef
, defalt
);
3915 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3917 insert_default_directory
? insdef
: Qnil
,
3918 Qfile_name_history
);
3921 unbind_to (count
, Qnil
);
3926 error ("No file name specified");
3927 tem
= Fstring_equal (val
, insdef
);
3928 if (!NILP (tem
) && !NILP (defalt
))
3930 return Fsubstitute_in_file_name (val
);
3932 #endif /* Old version */
3936 Qexpand_file_name
= intern ("expand-file-name");
3937 Qdirectory_file_name
= intern ("directory-file-name");
3938 Qfile_name_directory
= intern ("file-name-directory");
3939 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3940 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3941 Qfile_name_as_directory
= intern ("file-name-as-directory");
3942 Qcopy_file
= intern ("copy-file");
3943 Qmake_directory
= intern ("make-directory");
3944 Qdelete_directory
= intern ("delete-directory");
3945 Qdelete_file
= intern ("delete-file");
3946 Qrename_file
= intern ("rename-file");
3947 Qadd_name_to_file
= intern ("add-name-to-file");
3948 Qmake_symbolic_link
= intern ("make-symbolic-link");
3949 Qfile_exists_p
= intern ("file-exists-p");
3950 Qfile_executable_p
= intern ("file-executable-p");
3951 Qfile_readable_p
= intern ("file-readable-p");
3952 Qfile_symlink_p
= intern ("file-symlink-p");
3953 Qfile_writable_p
= intern ("file-writable-p");
3954 Qfile_directory_p
= intern ("file-directory-p");
3955 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3956 Qfile_modes
= intern ("file-modes");
3957 Qset_file_modes
= intern ("set-file-modes");
3958 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3959 Qinsert_file_contents
= intern ("insert-file-contents");
3960 Qwrite_region
= intern ("write-region");
3961 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3962 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3964 staticpro (&Qexpand_file_name
);
3965 staticpro (&Qdirectory_file_name
);
3966 staticpro (&Qfile_name_directory
);
3967 staticpro (&Qfile_name_nondirectory
);
3968 staticpro (&Qunhandled_file_name_directory
);
3969 staticpro (&Qfile_name_as_directory
);
3970 staticpro (&Qcopy_file
);
3971 staticpro (&Qmake_directory
);
3972 staticpro (&Qdelete_directory
);
3973 staticpro (&Qdelete_file
);
3974 staticpro (&Qrename_file
);
3975 staticpro (&Qadd_name_to_file
);
3976 staticpro (&Qmake_symbolic_link
);
3977 staticpro (&Qfile_exists_p
);
3978 staticpro (&Qfile_executable_p
);
3979 staticpro (&Qfile_readable_p
);
3980 staticpro (&Qfile_symlink_p
);
3981 staticpro (&Qfile_writable_p
);
3982 staticpro (&Qfile_directory_p
);
3983 staticpro (&Qfile_accessible_directory_p
);
3984 staticpro (&Qfile_modes
);
3985 staticpro (&Qset_file_modes
);
3986 staticpro (&Qfile_newer_than_file_p
);
3987 staticpro (&Qinsert_file_contents
);
3988 staticpro (&Qwrite_region
);
3989 staticpro (&Qverify_visited_file_modtime
);
3991 Qfile_name_history
= intern ("file-name-history");
3992 Fset (Qfile_name_history
, Qnil
);
3993 staticpro (&Qfile_name_history
);
3995 Qfile_error
= intern ("file-error");
3996 staticpro (&Qfile_error
);
3997 Qfile_already_exists
= intern("file-already-exists");
3998 staticpro (&Qfile_already_exists
);
4001 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4002 staticpro (&Qfind_buffer_file_type
);
4005 Qcar_less_than_car
= intern ("car-less-than-car");
4006 staticpro (&Qcar_less_than_car
);
4008 Fput (Qfile_error
, Qerror_conditions
,
4009 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4010 Fput (Qfile_error
, Qerror_message
,
4011 build_string ("File error"));
4013 Fput (Qfile_already_exists
, Qerror_conditions
,
4014 Fcons (Qfile_already_exists
,
4015 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4016 Fput (Qfile_already_exists
, Qerror_message
,
4017 build_string ("File already exists"));
4019 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4020 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4021 insert_default_directory
= 1;
4023 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4024 "*Non-nil means write new files with record format `stmlf'.\n\
4025 nil means use format `var'. This variable is meaningful only on VMS.");
4026 vms_stmlf_recfm
= 0;
4028 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4029 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4030 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4033 The first argument given to HANDLER is the name of the I/O primitive\n\
4034 to be handled; the remaining arguments are the arguments that were\n\
4035 passed to that primitive. For example, if you do\n\
4036 (file-exists-p FILENAME)\n\
4037 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4038 (funcall HANDLER 'file-exists-p FILENAME)\n\
4039 The function `find-file-name-handler' checks this list for a handler\n\
4040 for its argument.");
4041 Vfile_name_handler_alist
= Qnil
;
4043 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4044 "A list of functions to be called at the end of `insert-file-contents'.\n\
4045 Each is passed one argument, the number of bytes inserted. It should return\n\
4046 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4047 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4048 responsible for calling the after-insert-file-functions if appropriate.");
4049 Vafter_insert_file_functions
= Qnil
;
4051 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4052 "A list of functions to be called at the start of `write-region'.\n\
4053 Each is passed two arguments, START and END as for `write-region'. It should\n\
4054 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4055 inserted at the specified positions of the file being written (1 means to\n\
4056 insert before the first byte written). The POSITIONs must be sorted into\n\
4057 increasing order. If there are several functions in the list, the several\n\
4058 lists are merged destructively.");
4059 Vwrite_region_annotate_functions
= Qnil
;
4061 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4062 "A list of file name handlers that temporarily should not be used.\n\
4063 This applies only to the operation `inhibit-file-name-operation'.");
4064 Vinhibit_file_name_handlers
= Qnil
;
4066 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4067 "The operation for which `inhibit-file-name-handlers' is applicable.");
4068 Vinhibit_file_name_operation
= Qnil
;
4070 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4071 "File name in which we write a list of all auto save file names.");
4072 Vauto_save_list_file_name
= Qnil
;
4074 defsubr (&Sfind_file_name_handler
);
4075 defsubr (&Sfile_name_directory
);
4076 defsubr (&Sfile_name_nondirectory
);
4077 defsubr (&Sunhandled_file_name_directory
);
4078 defsubr (&Sfile_name_as_directory
);
4079 defsubr (&Sdirectory_file_name
);
4080 defsubr (&Smake_temp_name
);
4081 defsubr (&Sexpand_file_name
);
4082 defsubr (&Ssubstitute_in_file_name
);
4083 defsubr (&Scopy_file
);
4084 defsubr (&Smake_directory_internal
);
4085 defsubr (&Sdelete_directory
);
4086 defsubr (&Sdelete_file
);
4087 defsubr (&Srename_file
);
4088 defsubr (&Sadd_name_to_file
);
4090 defsubr (&Smake_symbolic_link
);
4091 #endif /* S_IFLNK */
4093 defsubr (&Sdefine_logical_name
);
4096 defsubr (&Ssysnetunam
);
4097 #endif /* HPUX_NET */
4098 defsubr (&Sfile_name_absolute_p
);
4099 defsubr (&Sfile_exists_p
);
4100 defsubr (&Sfile_executable_p
);
4101 defsubr (&Sfile_readable_p
);
4102 defsubr (&Sfile_writable_p
);
4103 defsubr (&Sfile_symlink_p
);
4104 defsubr (&Sfile_directory_p
);
4105 defsubr (&Sfile_accessible_directory_p
);
4106 defsubr (&Sfile_modes
);
4107 defsubr (&Sset_file_modes
);
4108 defsubr (&Sset_default_file_modes
);
4109 defsubr (&Sdefault_file_modes
);
4110 defsubr (&Sfile_newer_than_file_p
);
4111 defsubr (&Sinsert_file_contents
);
4112 defsubr (&Swrite_region
);
4113 defsubr (&Scar_less_than_car
);
4114 defsubr (&Sverify_visited_file_modtime
);
4115 defsubr (&Sclear_visited_file_modtime
);
4116 defsubr (&Svisited_file_modtime
);
4117 defsubr (&Sset_visited_file_modtime
);
4118 defsubr (&Sdo_auto_save
);
4119 defsubr (&Sset_buffer_auto_saved
);
4120 defsubr (&Sclear_buffer_auto_save_failure
);
4121 defsubr (&Srecent_auto_save_p
);
4123 defsubr (&Sread_file_name_internal
);
4124 defsubr (&Sread_file_name
);
4127 defsubr (&Sunix_sync
);