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 /* If the entire file matches the buffer tail, stop the scan. */
2718 /* How much can we scan in the next step? */
2719 trial
= min (curpos
, sizeof buffer
);
2720 if (lseek (fd
, curpos
- trial
, 0) < 0)
2721 report_file_error ("Setting file position",
2722 Fcons (filename
, Qnil
));
2725 while (total_read
< trial
)
2727 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2729 error ("IO error reading %s: %s",
2730 XSTRING (filename
)->data
, strerror (errno
));
2731 total_read
+= nread
;
2733 /* Scan this bufferfull from the end, comparing with
2734 the Emacs buffer. */
2735 bufpos
= total_read
;
2736 /* Compare with same_at_start to avoid counting some buffer text
2737 as matching both at the file's beginning and at the end. */
2738 while (bufpos
> 0 && same_at_end
> same_at_start
2739 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2740 same_at_end
--, bufpos
--;
2741 /* If we found a discrepancy, stop the scan.
2742 Otherwise loop around and scan the preceding bufferfull. */
2748 /* Don't try to reuse the same piece of text twice. */
2749 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2751 same_at_end
+= overlap
;
2753 /* Arrange to read only the nonmatching middle part of the file. */
2754 XFASTINT (beg
) = same_at_start
- BEGV
;
2755 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2757 del_range_1 (same_at_start
, same_at_end
, 0);
2758 /* Insert from the file at the proper position. */
2759 SET_PT (same_at_start
);
2763 total
= XINT (end
) - XINT (beg
);
2766 register Lisp_Object temp
;
2768 /* Make sure point-max won't overflow after this insertion. */
2769 XSET (temp
, Lisp_Int
, total
);
2770 if (total
!= XINT (temp
))
2771 error ("maximum buffer size exceeded");
2774 if (NILP (visit
) && total
> 0)
2775 prepare_to_modify_buffer (point
, point
);
2778 if (GAP_SIZE
< total
)
2779 make_gap (total
- GAP_SIZE
);
2781 if (XINT (beg
) != 0 || !NILP (replace
))
2783 if (lseek (fd
, XINT (beg
), 0) < 0)
2784 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2788 while (inserted
< total
)
2790 int try = min (total
- inserted
, 64 << 10);
2793 /* Allow quitting out of the actual I/O. */
2796 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2813 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2814 /* Determine file type from name and remove LFs from CR-LFs if the file
2815 is deemed to be a text file. */
2817 struct gcpro gcpro1
;
2821 current_buffer
->buffer_file_type
2822 = call1 (Qfind_buffer_file_type
, filename
);
2824 if (NILP (current_buffer
->buffer_file_type
))
2827 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2830 GPT
-= reduced_size
;
2831 GAP_SIZE
+= reduced_size
;
2832 inserted
-= reduced_size
;
2839 record_insert (point
, inserted
);
2841 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2842 offset_intervals (current_buffer
, point
, inserted
);
2848 /* Discard the unwind protect for closing the file. */
2852 error ("IO error reading %s: %s",
2853 XSTRING (filename
)->data
, strerror (errno
));
2860 if (!EQ (current_buffer
->undo_list
, Qt
))
2861 current_buffer
->undo_list
= Qnil
;
2863 stat (XSTRING (filename
)->data
, &st
);
2868 current_buffer
->modtime
= st
.st_mtime
;
2869 current_buffer
->filename
= filename
;
2872 current_buffer
->save_modified
= MODIFF
;
2873 current_buffer
->auto_save_modified
= MODIFF
;
2874 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2875 #ifdef CLASH_DETECTION
2878 if (!NILP (current_buffer
->filename
))
2879 unlock_file (current_buffer
->filename
);
2880 unlock_file (filename
);
2882 #endif /* CLASH_DETECTION */
2883 /* If visiting nonexistent file, return nil. */
2884 if (current_buffer
->modtime
== -1)
2885 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2888 if (inserted
> 0 && NILP (visit
) && total
> 0)
2889 signal_after_change (point
, 0, inserted
);
2893 p
= Vafter_insert_file_functions
;
2896 insval
= call1 (Fcar (p
), make_number (inserted
));
2899 CHECK_NUMBER (insval
, 0);
2900 inserted
= XFASTINT (insval
);
2908 val
= Fcons (filename
,
2909 Fcons (make_number (inserted
),
2912 RETURN_UNGCPRO (unbind_to (count
, val
));
2915 static Lisp_Object
build_annotations ();
2917 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2918 "r\nFWrite region to file: ",
2919 "Write current region into specified file.\n\
2920 When called from a program, takes three arguments:\n\
2921 START, END and FILENAME. START and END are buffer positions.\n\
2922 Optional fourth argument APPEND if non-nil means\n\
2923 append to existing file contents (if any).\n\
2924 Optional fifth argument VISIT if t means\n\
2925 set the last-save-file-modtime of buffer to this file's modtime\n\
2926 and mark buffer not modified.\n\
2927 If VISIT is a string, it is a second file name;\n\
2928 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2929 VISIT is also the file name to lock and unlock for clash detection.\n\
2930 If VISIT is neither t nor nil nor a string,\n\
2931 that means do not print the \"Wrote file\" message.\n\
2932 Kludgy feature: if START is a string, then that string is written\n\
2933 to the file, instead of any buffer contents, and END is ignored.")
2934 (start
, end
, filename
, append
, visit
)
2935 Lisp_Object start
, end
, filename
, append
, visit
;
2943 int count
= specpdl_ptr
- specpdl
;
2945 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2947 Lisp_Object handler
;
2948 Lisp_Object visit_file
;
2949 Lisp_Object annotations
;
2950 int visiting
, quietly
;
2951 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2953 int buffer_file_type
2954 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2957 if (!NILP (start
) && !STRINGP (start
))
2958 validate_region (&start
, &end
);
2960 filename
= Fexpand_file_name (filename
, Qnil
);
2961 if (STRINGP (visit
))
2962 visit_file
= Fexpand_file_name (visit
, Qnil
);
2964 visit_file
= filename
;
2966 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2967 quietly
= !NILP (visit
);
2971 GCPRO4 (start
, filename
, annotations
, visit_file
);
2973 /* If the file name has special constructs in it,
2974 call the corresponding file handler. */
2975 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
2976 /* If FILENAME has no handler, see if VISIT has one. */
2977 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2978 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
2980 if (!NILP (handler
))
2983 val
= call6 (handler
, Qwrite_region
, start
, end
,
2984 filename
, append
, visit
);
2988 current_buffer
->save_modified
= MODIFF
;
2989 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2990 current_buffer
->filename
= visit_file
;
2996 /* Special kludge to simplify auto-saving. */
2999 XFASTINT (start
) = BEG
;
3003 annotations
= build_annotations (start
, end
);
3005 #ifdef CLASH_DETECTION
3007 lock_file (visit_file
);
3008 #endif /* CLASH_DETECTION */
3010 fn
= XSTRING (filename
)->data
;
3014 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3016 desc
= open (fn
, O_WRONLY
);
3021 if (auto_saving
) /* Overwrite any previous version of autosave file */
3023 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3024 desc
= open (fn
, O_RDWR
);
3026 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3027 ? XSTRING (current_buffer
->filename
)->data
: 0,
3030 else /* Write to temporary name and rename if no errors */
3032 Lisp_Object temp_name
;
3033 temp_name
= Ffile_name_directory (filename
);
3035 if (!NILP (temp_name
))
3037 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3038 build_string ("$$SAVE$$")));
3039 fname
= XSTRING (filename
)->data
;
3040 fn
= XSTRING (temp_name
)->data
;
3041 desc
= creat_copy_attrs (fname
, fn
);
3044 /* If we can't open the temporary file, try creating a new
3045 version of the original file. VMS "creat" creates a
3046 new version rather than truncating an existing file. */
3049 desc
= creat (fn
, 0666);
3050 #if 0 /* This can clobber an existing file and fail to replace it,
3051 if the user runs out of space. */
3054 /* We can't make a new version;
3055 try to truncate and rewrite existing version if any. */
3057 desc
= open (fn
, O_RDWR
);
3063 desc
= creat (fn
, 0666);
3068 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3069 S_IREAD
| S_IWRITE
);
3070 #else /* not MSDOS */
3071 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3072 #endif /* not MSDOS */
3073 #endif /* not VMS */
3079 #ifdef CLASH_DETECTION
3081 if (!auto_saving
) unlock_file (visit_file
);
3083 #endif /* CLASH_DETECTION */
3084 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3087 record_unwind_protect (close_file_unwind
, make_number (desc
));
3090 if (lseek (desc
, 0, 2) < 0)
3092 #ifdef CLASH_DETECTION
3093 if (!auto_saving
) unlock_file (visit_file
);
3094 #endif /* CLASH_DETECTION */
3095 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3100 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3101 * if we do writes that don't end with a carriage return. Furthermore
3102 * it cannot handle writes of more then 16K. The modified
3103 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3104 * this EXCEPT for the last record (iff it doesn't end with a carriage
3105 * return). This implies that if your buffer doesn't end with a carriage
3106 * return, you get one free... tough. However it also means that if
3107 * we make two calls to sys_write (a la the following code) you can
3108 * get one at the gap as well. The easiest way to fix this (honest)
3109 * is to move the gap to the next newline (or the end of the buffer).
3114 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3115 move_gap (find_next_newline (GPT
, 1));
3121 if (STRINGP (start
))
3123 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3124 XSTRING (start
)->size
, 0, &annotations
);
3127 else if (XINT (start
) != XINT (end
))
3130 if (XINT (start
) < GPT
)
3132 register int end1
= XINT (end
);
3134 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3135 min (GPT
, end1
) - tem
, tem
, &annotations
);
3136 nwritten
+= min (GPT
, end1
) - tem
;
3140 if (XINT (end
) > GPT
&& !failure
)
3143 tem
= max (tem
, GPT
);
3144 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3146 nwritten
+= XINT (end
) - tem
;
3152 /* If file was empty, still need to write the annotations */
3153 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3161 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3162 Disk full in NFS may be reported here. */
3163 /* mib says that closing the file will try to write as fast as NFS can do
3164 it, and that means the fsync here is not crucial for autosave files. */
3165 if (!auto_saving
&& fsync (desc
) < 0)
3166 failure
= 1, save_errno
= errno
;
3169 /* Spurious "file has changed on disk" warnings have been
3170 observed on Suns as well.
3171 It seems that `close' can change the modtime, under nfs.
3173 (This has supposedly been fixed in Sunos 4,
3174 but who knows about all the other machines with NFS?) */
3177 /* On VMS and APOLLO, must do the stat after the close
3178 since closing changes the modtime. */
3181 /* Recall that #if defined does not work on VMS. */
3188 /* NFS can report a write failure now. */
3189 if (close (desc
) < 0)
3190 failure
= 1, save_errno
= errno
;
3193 /* If we wrote to a temporary name and had no errors, rename to real name. */
3197 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3205 /* Discard the unwind protect */
3206 specpdl_ptr
= specpdl
+ count
;
3208 #ifdef CLASH_DETECTION
3210 unlock_file (visit_file
);
3211 #endif /* CLASH_DETECTION */
3213 /* Do this before reporting IO error
3214 to avoid a "file has changed on disk" warning on
3215 next attempt to save. */
3217 current_buffer
->modtime
= st
.st_mtime
;
3220 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3224 current_buffer
->save_modified
= MODIFF
;
3225 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3226 current_buffer
->filename
= visit_file
;
3227 update_mode_lines
++;
3233 message ("Wrote %s", XSTRING (visit_file
)->data
);
3238 Lisp_Object
merge ();
3240 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3241 "Return t if (car A) is numerically less than (car B).")
3245 return Flss (Fcar (a
), Fcar (b
));
3248 /* Build the complete list of annotations appropriate for writing out
3249 the text between START and END, by calling all the functions in
3250 write-region-annotate-functions and merging the lists they return. */
3253 build_annotations (start
, end
)
3254 Lisp_Object start
, end
;
3256 Lisp_Object annotations
;
3258 struct gcpro gcpro1
, gcpro2
;
3261 p
= Vwrite_region_annotate_functions
;
3262 GCPRO2 (annotations
, p
);
3265 res
= call2 (Fcar (p
), start
, end
);
3266 Flength (res
); /* Check basic validity of return value */
3267 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3274 /* Write to descriptor DESC the LEN characters starting at ADDR,
3275 assuming they start at position POS in the buffer.
3276 Intersperse with them the annotations from *ANNOT
3277 (those which fall within the range of positions POS to POS + LEN),
3278 each at its appropriate position.
3280 Modify *ANNOT by discarding elements as we output them.
3281 The return value is negative in case of system call failure. */
3284 a_write (desc
, addr
, len
, pos
, annot
)
3286 register char *addr
;
3293 int lastpos
= pos
+ len
;
3297 tem
= Fcar_safe (Fcar (*annot
));
3298 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3299 nextpos
= XFASTINT (tem
);
3301 return e_write (desc
, addr
, lastpos
- pos
);
3304 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3306 addr
+= nextpos
- pos
;
3309 tem
= Fcdr (Fcar (*annot
));
3312 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3315 *annot
= Fcdr (*annot
);
3320 e_write (desc
, addr
, len
)
3322 register char *addr
;
3325 char buf
[16 * 1024];
3326 register char *p
, *end
;
3328 if (!EQ (current_buffer
->selective_display
, Qt
))
3329 return write (desc
, addr
, len
) - len
;
3333 end
= p
+ sizeof buf
;
3338 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3347 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3353 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3354 Sverify_visited_file_modtime
, 1, 1, 0,
3355 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3356 This means that the file has not been changed since it was visited or saved.")
3362 Lisp_Object handler
;
3364 CHECK_BUFFER (buf
, 0);
3367 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3368 if (b
->modtime
== 0) return Qt
;
3370 /* If the file name has special constructs in it,
3371 call the corresponding file handler. */
3372 handler
= Ffind_file_name_handler (b
->filename
,
3373 Qverify_visited_file_modtime
);
3374 if (!NILP (handler
))
3375 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3377 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3379 /* If the file doesn't exist now and didn't exist before,
3380 we say that it isn't modified, provided the error is a tame one. */
3381 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3386 if (st
.st_mtime
== b
->modtime
3387 /* If both are positive, accept them if they are off by one second. */
3388 || (st
.st_mtime
> 0 && b
->modtime
> 0
3389 && (st
.st_mtime
== b
->modtime
+ 1
3390 || st
.st_mtime
== b
->modtime
- 1)))
3395 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3396 Sclear_visited_file_modtime
, 0, 0, 0,
3397 "Clear out records of last mod time of visited file.\n\
3398 Next attempt to save will certainly not complain of a discrepancy.")
3401 current_buffer
->modtime
= 0;
3405 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3406 Svisited_file_modtime
, 0, 0, 0,
3407 "Return the current buffer's recorded visited file modification time.\n\
3408 The value is a list of the form (HIGH . LOW), like the time values\n\
3409 that `file-attributes' returns.")
3412 return long_to_cons (current_buffer
->modtime
);
3415 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3416 Sset_visited_file_modtime
, 0, 1, 0,
3417 "Update buffer's recorded modification time from the visited file's time.\n\
3418 Useful if the buffer was not read from the file normally\n\
3419 or if the file itself has been changed for some known benign reason.\n\
3420 An argument specifies the modification time value to use\n\
3421 \(instead of that of the visited file), in the form of a list\n\
3422 \(HIGH . LOW) or (HIGH LOW).")
3424 Lisp_Object time_list
;
3426 if (!NILP (time_list
))
3427 current_buffer
->modtime
= cons_to_long (time_list
);
3430 register Lisp_Object filename
;
3432 Lisp_Object handler
;
3434 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3436 /* If the file name has special constructs in it,
3437 call the corresponding file handler. */
3438 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3439 if (!NILP (handler
))
3440 /* The handler can find the file name the same way we did. */
3441 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3442 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3443 current_buffer
->modtime
= st
.st_mtime
;
3452 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3455 message ("Autosaving...error for %s", name
);
3456 Fsleep_for (make_number (1), Qnil
);
3457 message ("Autosaving...error!for %s", name
);
3458 Fsleep_for (make_number (1), Qnil
);
3459 message ("Autosaving...error for %s", name
);
3460 Fsleep_for (make_number (1), Qnil
);
3470 /* Get visited file's mode to become the auto save file's mode. */
3471 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3472 /* But make sure we can overwrite it later! */
3473 auto_save_mode_bits
= st
.st_mode
| 0600;
3475 auto_save_mode_bits
= 0666;
3478 Fwrite_region (Qnil
, Qnil
,
3479 current_buffer
->auto_save_file_name
,
3484 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3487 close (XINT (desc
));
3491 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3492 "Auto-save all buffers that need it.\n\
3493 This is all buffers that have auto-saving enabled\n\
3494 and are changed since last auto-saved.\n\
3495 Auto-saving writes the buffer into a file\n\
3496 so that your editing is not lost if the system crashes.\n\
3497 This file is not the file you visited; that changes only when you save.\n\
3498 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3499 Non-nil first argument means do not print any message if successful.\n\
3500 Non-nil second argument means save only current buffer.")
3501 (no_message
, current_only
)
3502 Lisp_Object no_message
, current_only
;
3504 struct buffer
*old
= current_buffer
, *b
;
3505 Lisp_Object tail
, buf
;
3507 char *omessage
= echo_area_glyphs
;
3508 int omessage_length
= echo_area_glyphs_length
;
3509 extern int minibuf_level
;
3510 int do_handled_files
;
3513 Lisp_Object lispstream
;
3514 int count
= specpdl_ptr
- specpdl
;
3517 /* Ordinarily don't quit within this function,
3518 but don't make it impossible to quit (in case we get hung in I/O). */
3522 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3523 point to non-strings reached from Vbuffer_alist. */
3529 if (!NILP (Vrun_hooks
))
3530 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3532 if (STRINGP (Vauto_save_list_file_name
))
3535 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3536 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3537 S_IREAD
| S_IWRITE
);
3538 #else /* not MSDOS */
3539 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3540 #endif /* not MSDOS */
3545 /* Arrange to close that file whether or not we get an error. */
3547 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3549 /* First, save all files which don't have handlers. If Emacs is
3550 crashing, the handlers may tweak what is causing Emacs to crash
3551 in the first place, and it would be a shame if Emacs failed to
3552 autosave perfectly ordinary files because it couldn't handle some
3554 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3555 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3556 tail
= XCONS (tail
)->cdr
)
3558 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3561 /* Record all the buffers that have auto save mode
3562 in the special file that lists them. */
3563 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3564 && listdesc
>= 0 && do_handled_files
== 0)
3566 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3567 XSTRING (b
->auto_save_file_name
)->size
);
3568 write (listdesc
, "\n", 1);
3571 if (!NILP (current_only
)
3572 && b
!= current_buffer
)
3575 /* Check for auto save enabled
3576 and file changed since last auto save
3577 and file changed since last real save. */
3578 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3579 && b
->save_modified
< BUF_MODIFF (b
)
3580 && b
->auto_save_modified
< BUF_MODIFF (b
)
3581 /* -1 means we've turned off autosaving for a while--see below. */
3582 && XINT (b
->save_length
) >= 0
3583 && (do_handled_files
3584 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3587 EMACS_TIME before_time
, after_time
;
3589 EMACS_GET_TIME (before_time
);
3591 /* If we had a failure, don't try again for 20 minutes. */
3592 if (b
->auto_save_failure_time
>= 0
3593 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3596 if ((XFASTINT (b
->save_length
) * 10
3597 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3598 /* A short file is likely to change a large fraction;
3599 spare the user annoying messages. */
3600 && XFASTINT (b
->save_length
) > 5000
3601 /* These messages are frequent and annoying for `*mail*'. */
3602 && !EQ (b
->filename
, Qnil
)
3603 && NILP (no_message
))
3605 /* It has shrunk too much; turn off auto-saving here. */
3606 message ("Buffer %s has shrunk a lot; auto save turned off there",
3607 XSTRING (b
->name
)->data
);
3608 /* Turn off auto-saving until there's a real save,
3609 and prevent any more warnings. */
3610 XSET (b
->save_length
, Lisp_Int
, -1);
3611 Fsleep_for (make_number (1), Qnil
);
3614 set_buffer_internal (b
);
3615 if (!auto_saved
&& NILP (no_message
))
3616 message1 ("Auto-saving...");
3617 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3619 b
->auto_save_modified
= BUF_MODIFF (b
);
3620 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3621 set_buffer_internal (old
);
3623 EMACS_GET_TIME (after_time
);
3625 /* If auto-save took more than 60 seconds,
3626 assume it was an NFS failure that got a timeout. */
3627 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3628 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3632 /* Prevent another auto save till enough input events come in. */
3633 record_auto_save ();
3635 if (auto_saved
&& NILP (no_message
))
3638 message2 (omessage
, omessage_length
);
3640 message1 ("Auto-saving...done");
3646 unbind_to (count
, Qnil
);
3650 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3651 Sset_buffer_auto_saved
, 0, 0, 0,
3652 "Mark current buffer as auto-saved with its current text.\n\
3653 No auto-save file will be written until the buffer changes again.")
3656 current_buffer
->auto_save_modified
= MODIFF
;
3657 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3658 current_buffer
->auto_save_failure_time
= -1;
3662 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3663 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3664 "Clear any record of a recent auto-save failure in the current buffer.")
3667 current_buffer
->auto_save_failure_time
= -1;
3671 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3673 "Return t if buffer has been auto-saved since last read in or saved.")
3676 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3679 /* Reading and completing file names */
3680 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3682 /* In the string VAL, change each $ to $$ and return the result. */
3685 double_dollars (val
)
3688 register unsigned char *old
, *new;
3692 osize
= XSTRING (val
)->size
;
3693 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3694 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3695 if (*old
++ == '$') count
++;
3698 old
= XSTRING (val
)->data
;
3699 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3700 new = XSTRING (val
)->data
;
3701 for (n
= osize
; n
> 0; n
--)
3714 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3716 "Internal subroutine for read-file-name. Do not call this.")
3717 (string
, dir
, action
)
3718 Lisp_Object string
, dir
, action
;
3719 /* action is nil for complete, t for return list of completions,
3720 lambda for verify final value */
3722 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3724 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3731 /* No need to protect ACTION--we only compare it with t and nil. */
3732 GCPRO4 (string
, realdir
, name
, specdir
);
3734 if (XSTRING (string
)->size
== 0)
3736 if (EQ (action
, Qlambda
))
3744 orig_string
= string
;
3745 string
= Fsubstitute_in_file_name (string
);
3746 changed
= NILP (Fstring_equal (string
, orig_string
));
3747 name
= Ffile_name_nondirectory (string
);
3748 val
= Ffile_name_directory (string
);
3750 realdir
= Fexpand_file_name (val
, realdir
);
3755 specdir
= Ffile_name_directory (string
);
3756 val
= Ffile_name_completion (name
, realdir
);
3758 if (XTYPE (val
) != Lisp_String
)
3765 if (!NILP (specdir
))
3766 val
= concat2 (specdir
, val
);
3768 return double_dollars (val
);
3771 #endif /* not VMS */
3775 if (EQ (action
, Qt
))
3776 return Ffile_name_all_completions (name
, realdir
);
3777 /* Only other case actually used is ACTION = lambda */
3779 /* Supposedly this helps commands such as `cd' that read directory names,
3780 but can someone explain how it helps them? -- RMS */
3781 if (XSTRING (name
)->size
== 0)
3784 return Ffile_exists_p (string
);
3787 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3788 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3789 Value is not expanded---you must call `expand-file-name' yourself.\n\
3790 Default name to DEFAULT if user enters a null string.\n\
3791 (If DEFAULT is omitted, the visited file name is used.)\n\
3792 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3793 Non-nil and non-t means also require confirmation after completion.\n\
3794 Fifth arg INITIAL specifies text to start with.\n\
3795 DIR defaults to current buffer's directory default.")
3796 (prompt
, dir
, defalt
, mustmatch
, initial
)
3797 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3799 Lisp_Object val
, insdef
, insdef1
, tem
;
3800 struct gcpro gcpro1
, gcpro2
;
3801 register char *homedir
;
3805 dir
= current_buffer
->directory
;
3807 defalt
= current_buffer
->filename
;
3809 /* If dir starts with user's homedir, change that to ~. */
3810 homedir
= (char *) egetenv ("HOME");
3812 && XTYPE (dir
) == Lisp_String
3813 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3814 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3816 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3817 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3818 XSTRING (dir
)->data
[0] = '~';
3821 if (insert_default_directory
)
3824 if (!NILP (initial
))
3826 Lisp_Object args
[2], pos
;
3830 insdef
= Fconcat (2, args
);
3831 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3832 insdef1
= Fcons (double_dollars (insdef
), pos
);
3835 insdef1
= double_dollars (insdef
);
3837 else if (!NILP (initial
))
3840 insdef1
= Fcons (double_dollars (insdef
), 0);
3843 insdef
= Qnil
, insdef1
= Qnil
;
3846 count
= specpdl_ptr
- specpdl
;
3847 specbind (intern ("completion-ignore-case"), Qt
);
3850 GCPRO2 (insdef
, defalt
);
3851 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3852 dir
, mustmatch
, insdef1
,
3853 Qfile_name_history
);
3856 unbind_to (count
, Qnil
);
3861 error ("No file name specified");
3862 tem
= Fstring_equal (val
, insdef
);
3863 if (!NILP (tem
) && !NILP (defalt
))
3865 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3870 error ("No default file name");
3872 return Fsubstitute_in_file_name (val
);
3875 #if 0 /* Old version */
3876 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3877 /* Don't confuse make-docfile by having two doc strings for this function.
3878 make-docfile does not pay attention to #if, for good reason! */
3880 (prompt
, dir
, defalt
, mustmatch
, initial
)
3881 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3883 Lisp_Object val
, insdef
, tem
;
3884 struct gcpro gcpro1
, gcpro2
;
3885 register char *homedir
;
3889 dir
= current_buffer
->directory
;
3891 defalt
= current_buffer
->filename
;
3893 /* If dir starts with user's homedir, change that to ~. */
3894 homedir
= (char *) egetenv ("HOME");
3896 && XTYPE (dir
) == Lisp_String
3897 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3898 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3900 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3901 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3902 XSTRING (dir
)->data
[0] = '~';
3905 if (!NILP (initial
))
3907 else if (insert_default_directory
)
3910 insdef
= build_string ("");
3913 count
= specpdl_ptr
- specpdl
;
3914 specbind (intern ("completion-ignore-case"), Qt
);
3917 GCPRO2 (insdef
, defalt
);
3918 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3920 insert_default_directory
? insdef
: Qnil
,
3921 Qfile_name_history
);
3924 unbind_to (count
, Qnil
);
3929 error ("No file name specified");
3930 tem
= Fstring_equal (val
, insdef
);
3931 if (!NILP (tem
) && !NILP (defalt
))
3933 return Fsubstitute_in_file_name (val
);
3935 #endif /* Old version */
3939 Qexpand_file_name
= intern ("expand-file-name");
3940 Qdirectory_file_name
= intern ("directory-file-name");
3941 Qfile_name_directory
= intern ("file-name-directory");
3942 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3943 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3944 Qfile_name_as_directory
= intern ("file-name-as-directory");
3945 Qcopy_file
= intern ("copy-file");
3946 Qmake_directory
= intern ("make-directory");
3947 Qdelete_directory
= intern ("delete-directory");
3948 Qdelete_file
= intern ("delete-file");
3949 Qrename_file
= intern ("rename-file");
3950 Qadd_name_to_file
= intern ("add-name-to-file");
3951 Qmake_symbolic_link
= intern ("make-symbolic-link");
3952 Qfile_exists_p
= intern ("file-exists-p");
3953 Qfile_executable_p
= intern ("file-executable-p");
3954 Qfile_readable_p
= intern ("file-readable-p");
3955 Qfile_symlink_p
= intern ("file-symlink-p");
3956 Qfile_writable_p
= intern ("file-writable-p");
3957 Qfile_directory_p
= intern ("file-directory-p");
3958 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3959 Qfile_modes
= intern ("file-modes");
3960 Qset_file_modes
= intern ("set-file-modes");
3961 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3962 Qinsert_file_contents
= intern ("insert-file-contents");
3963 Qwrite_region
= intern ("write-region");
3964 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3965 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3967 staticpro (&Qexpand_file_name
);
3968 staticpro (&Qdirectory_file_name
);
3969 staticpro (&Qfile_name_directory
);
3970 staticpro (&Qfile_name_nondirectory
);
3971 staticpro (&Qunhandled_file_name_directory
);
3972 staticpro (&Qfile_name_as_directory
);
3973 staticpro (&Qcopy_file
);
3974 staticpro (&Qmake_directory
);
3975 staticpro (&Qdelete_directory
);
3976 staticpro (&Qdelete_file
);
3977 staticpro (&Qrename_file
);
3978 staticpro (&Qadd_name_to_file
);
3979 staticpro (&Qmake_symbolic_link
);
3980 staticpro (&Qfile_exists_p
);
3981 staticpro (&Qfile_executable_p
);
3982 staticpro (&Qfile_readable_p
);
3983 staticpro (&Qfile_symlink_p
);
3984 staticpro (&Qfile_writable_p
);
3985 staticpro (&Qfile_directory_p
);
3986 staticpro (&Qfile_accessible_directory_p
);
3987 staticpro (&Qfile_modes
);
3988 staticpro (&Qset_file_modes
);
3989 staticpro (&Qfile_newer_than_file_p
);
3990 staticpro (&Qinsert_file_contents
);
3991 staticpro (&Qwrite_region
);
3992 staticpro (&Qverify_visited_file_modtime
);
3994 Qfile_name_history
= intern ("file-name-history");
3995 Fset (Qfile_name_history
, Qnil
);
3996 staticpro (&Qfile_name_history
);
3998 Qfile_error
= intern ("file-error");
3999 staticpro (&Qfile_error
);
4000 Qfile_already_exists
= intern("file-already-exists");
4001 staticpro (&Qfile_already_exists
);
4004 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4005 staticpro (&Qfind_buffer_file_type
);
4008 Qcar_less_than_car
= intern ("car-less-than-car");
4009 staticpro (&Qcar_less_than_car
);
4011 Fput (Qfile_error
, Qerror_conditions
,
4012 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4013 Fput (Qfile_error
, Qerror_message
,
4014 build_string ("File error"));
4016 Fput (Qfile_already_exists
, Qerror_conditions
,
4017 Fcons (Qfile_already_exists
,
4018 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4019 Fput (Qfile_already_exists
, Qerror_message
,
4020 build_string ("File already exists"));
4022 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4023 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4024 insert_default_directory
= 1;
4026 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4027 "*Non-nil means write new files with record format `stmlf'.\n\
4028 nil means use format `var'. This variable is meaningful only on VMS.");
4029 vms_stmlf_recfm
= 0;
4031 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4032 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4033 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4036 The first argument given to HANDLER is the name of the I/O primitive\n\
4037 to be handled; the remaining arguments are the arguments that were\n\
4038 passed to that primitive. For example, if you do\n\
4039 (file-exists-p FILENAME)\n\
4040 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4041 (funcall HANDLER 'file-exists-p FILENAME)\n\
4042 The function `find-file-name-handler' checks this list for a handler\n\
4043 for its argument.");
4044 Vfile_name_handler_alist
= Qnil
;
4046 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4047 "A list of functions to be called at the end of `insert-file-contents'.\n\
4048 Each is passed one argument, the number of bytes inserted. It should return\n\
4049 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4050 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4051 responsible for calling the after-insert-file-functions if appropriate.");
4052 Vafter_insert_file_functions
= Qnil
;
4054 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4055 "A list of functions to be called at the start of `write-region'.\n\
4056 Each is passed two arguments, START and END as for `write-region'. It should\n\
4057 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4058 inserted at the specified positions of the file being written (1 means to\n\
4059 insert before the first byte written). The POSITIONs must be sorted into\n\
4060 increasing order. If there are several functions in the list, the several\n\
4061 lists are merged destructively.");
4062 Vwrite_region_annotate_functions
= Qnil
;
4064 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4065 "A list of file name handlers that temporarily should not be used.\n\
4066 This applies only to the operation `inhibit-file-name-operation'.");
4067 Vinhibit_file_name_handlers
= Qnil
;
4069 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4070 "The operation for which `inhibit-file-name-handlers' is applicable.");
4071 Vinhibit_file_name_operation
= Qnil
;
4073 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4074 "File name in which we write a list of all auto save file names.");
4075 Vauto_save_list_file_name
= Qnil
;
4077 defsubr (&Sfind_file_name_handler
);
4078 defsubr (&Sfile_name_directory
);
4079 defsubr (&Sfile_name_nondirectory
);
4080 defsubr (&Sunhandled_file_name_directory
);
4081 defsubr (&Sfile_name_as_directory
);
4082 defsubr (&Sdirectory_file_name
);
4083 defsubr (&Smake_temp_name
);
4084 defsubr (&Sexpand_file_name
);
4085 defsubr (&Ssubstitute_in_file_name
);
4086 defsubr (&Scopy_file
);
4087 defsubr (&Smake_directory_internal
);
4088 defsubr (&Sdelete_directory
);
4089 defsubr (&Sdelete_file
);
4090 defsubr (&Srename_file
);
4091 defsubr (&Sadd_name_to_file
);
4093 defsubr (&Smake_symbolic_link
);
4094 #endif /* S_IFLNK */
4096 defsubr (&Sdefine_logical_name
);
4099 defsubr (&Ssysnetunam
);
4100 #endif /* HPUX_NET */
4101 defsubr (&Sfile_name_absolute_p
);
4102 defsubr (&Sfile_exists_p
);
4103 defsubr (&Sfile_executable_p
);
4104 defsubr (&Sfile_readable_p
);
4105 defsubr (&Sfile_writable_p
);
4106 defsubr (&Sfile_symlink_p
);
4107 defsubr (&Sfile_directory_p
);
4108 defsubr (&Sfile_accessible_directory_p
);
4109 defsubr (&Sfile_modes
);
4110 defsubr (&Sset_file_modes
);
4111 defsubr (&Sset_default_file_modes
);
4112 defsubr (&Sdefault_file_modes
);
4113 defsubr (&Sfile_newer_than_file_p
);
4114 defsubr (&Sinsert_file_contents
);
4115 defsubr (&Swrite_region
);
4116 defsubr (&Scar_less_than_car
);
4117 defsubr (&Sverify_visited_file_modtime
);
4118 defsubr (&Sclear_visited_file_modtime
);
4119 defsubr (&Svisited_file_modtime
);
4120 defsubr (&Sset_visited_file_modtime
);
4121 defsubr (&Sdo_auto_save
);
4122 defsubr (&Sset_buffer_auto_saved
);
4123 defsubr (&Sclear_buffer_auto_save_failure
);
4124 defsubr (&Srecent_auto_save_p
);
4126 defsubr (&Sread_file_name_internal
);
4127 defsubr (&Sread_file_name
);
4130 defsubr (&Sunix_sync
);