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 /* Nonzero means, when reading a filename in the minibuffer,
125 start out by inserting the default directory into the minibuffer. */
126 int insert_default_directory
;
128 /* On VMS, nonzero means write new files with record format stmlf.
129 Zero means use var format. */
132 /* These variables describe handlers that have "already" had a chance
133 to handle the current operation.
135 Vinhibit_file_name_handlers is a list of file name handlers.
136 Vinhibit_file_name_operation is the operation being handled.
137 If we try to handle that operation, we ignore those handlers. */
139 static Lisp_Object Vinhibit_file_name_handlers
;
140 static Lisp_Object Vinhibit_file_name_operation
;
142 Lisp_Object Qfile_error
, Qfile_already_exists
;
144 Lisp_Object Qfile_name_history
;
146 Lisp_Object Qcar_less_than_car
;
148 report_file_error (string
, data
)
152 Lisp_Object errstring
;
154 errstring
= build_string (strerror (errno
));
156 /* System error messages are capitalized. Downcase the initial
157 unless it is followed by a slash. */
158 if (XSTRING (errstring
)->data
[1] != '/')
159 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
162 Fsignal (Qfile_error
,
163 Fcons (build_string (string
), Fcons (errstring
, data
)));
166 close_file_unwind (fd
)
169 close (XFASTINT (fd
));
172 /* Restore point, having saved it as a marker. */
174 restore_point_unwind (location
)
175 Lisp_Object location
;
177 SET_PT (marker_position (location
));
178 Fset_marker (location
, Qnil
, Qnil
);
181 Lisp_Object Qexpand_file_name
;
182 Lisp_Object Qdirectory_file_name
;
183 Lisp_Object Qfile_name_directory
;
184 Lisp_Object Qfile_name_nondirectory
;
185 Lisp_Object Qunhandled_file_name_directory
;
186 Lisp_Object Qfile_name_as_directory
;
187 Lisp_Object Qcopy_file
;
188 Lisp_Object Qmake_directory
;
189 Lisp_Object Qdelete_directory
;
190 Lisp_Object Qdelete_file
;
191 Lisp_Object Qrename_file
;
192 Lisp_Object Qadd_name_to_file
;
193 Lisp_Object Qmake_symbolic_link
;
194 Lisp_Object Qfile_exists_p
;
195 Lisp_Object Qfile_executable_p
;
196 Lisp_Object Qfile_readable_p
;
197 Lisp_Object Qfile_symlink_p
;
198 Lisp_Object Qfile_writable_p
;
199 Lisp_Object Qfile_directory_p
;
200 Lisp_Object Qfile_accessible_directory_p
;
201 Lisp_Object Qfile_modes
;
202 Lisp_Object Qset_file_modes
;
203 Lisp_Object Qfile_newer_than_file_p
;
204 Lisp_Object Qinsert_file_contents
;
205 Lisp_Object Qwrite_region
;
206 Lisp_Object Qverify_visited_file_modtime
;
207 Lisp_Object Qset_visited_file_modtime
;
209 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
210 "Return FILENAME's handler function for OPERATION, if it has one.\n\
211 Otherwise, return nil.\n\
212 A file name is handled if one of the regular expressions in\n\
213 `file-name-handler-alist' matches it.\n\n\
214 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
215 any handlers that are members of `inhibit-file-name-handlers',\n\
216 but we still do run any other handlers. This lets handlers\n\
217 use the standard functions without calling themselves recursively.")
218 (filename
, operation
)
219 Lisp_Object filename
, operation
;
221 /* This function must not munge the match data. */
222 Lisp_Object chain
, inhibited_handlers
;
224 CHECK_STRING (filename
, 0);
226 if (EQ (operation
, Vinhibit_file_name_operation
))
227 inhibited_handlers
= Vinhibit_file_name_handlers
;
229 inhibited_handlers
= Qnil
;
231 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
232 chain
= XCONS (chain
)->cdr
)
235 elt
= XCONS (chain
)->car
;
236 if (XTYPE (elt
) == Lisp_Cons
)
239 string
= XCONS (elt
)->car
;
240 if (XTYPE (string
) == Lisp_String
241 && fast_string_match (string
, filename
) >= 0)
243 Lisp_Object handler
, tem
;
245 handler
= XCONS (elt
)->cdr
;
246 tem
= Fmemq (handler
, inhibited_handlers
);
257 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
259 "Return the directory component in file name NAME.\n\
260 Return nil if NAME does not include a directory.\n\
261 Otherwise return a directory spec.\n\
262 Given a Unix syntax file name, returns a string ending in slash;\n\
263 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
267 register unsigned char *beg
;
268 register unsigned char *p
;
271 CHECK_STRING (file
, 0);
273 /* If the file name has special constructs in it,
274 call the corresponding file handler. */
275 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
277 return call2 (handler
, Qfile_name_directory
, file
);
279 #ifdef FILE_SYSTEM_CASE
280 file
= FILE_SYSTEM_CASE (file
);
282 beg
= XSTRING (file
)->data
;
283 p
= beg
+ XSTRING (file
)->size
;
285 while (p
!= beg
&& p
[-1] != '/'
287 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
297 /* Expansion of "c:" to drive and default directory. */
298 if (p
== beg
+ 2 && beg
[1] == ':')
300 int drive
= (*beg
) - 'a';
301 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
302 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
303 if (getdefdir (drive
+ 1, res
+ 2))
305 res
[0] = drive
+ 'a';
307 if (res
[strlen (res
) - 1] != '/')
310 p
= beg
+ strlen (beg
);
314 return make_string (beg
, p
- beg
);
317 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
319 "Return file name NAME sans its directory.\n\
320 For example, in a Unix-syntax file name,\n\
321 this is everything after the last slash,\n\
322 or the entire name if it contains no slash.")
326 register unsigned char *beg
, *p
, *end
;
329 CHECK_STRING (file
, 0);
331 /* If the file name has special constructs in it,
332 call the corresponding file handler. */
333 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
335 return call2 (handler
, Qfile_name_nondirectory
, file
);
337 beg
= XSTRING (file
)->data
;
338 end
= p
= beg
+ XSTRING (file
)->size
;
340 while (p
!= beg
&& p
[-1] != '/'
342 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
349 return make_string (p
, end
- p
);
352 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
353 "Return a directly usable directory name somehow associated with FILENAME.\n\
354 A `directly usable' directory name is one that may be used without the\n\
355 intervention of any file handler.\n\
356 If FILENAME is a directly usable file itself, return\n\
357 (file-name-directory FILENAME).\n\
358 The `call-process' and `start-process' functions use this function to\n\
359 get a current directory to run processes in.")
361 Lisp_Object filename
;
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
369 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
371 return Ffile_name_directory (filename
);
376 file_name_as_directory (out
, in
)
379 int size
= strlen (in
) - 1;
384 /* Is it already a directory string? */
385 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
387 /* Is it a VMS directory file name? If so, hack VMS syntax. */
388 else if (! index (in
, '/')
389 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
390 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
391 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
392 || ! strncmp (&in
[size
- 5], ".dir", 4))
393 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
394 && in
[size
] == '1')))
396 register char *p
, *dot
;
400 dir:x.dir --> dir:[x]
401 dir:[x]y.dir --> dir:[x.y] */
403 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
406 strncpy (out
, in
, p
- in
);
425 dot
= index (p
, '.');
428 /* blindly remove any extension */
429 size
= strlen (out
) + (dot
- p
);
430 strncat (out
, p
, dot
- p
);
441 /* For Unix syntax, Append a slash if necessary */
443 if (out
[size
] != ':' && out
[size
] != '/')
445 if (out
[size
] != '/')
452 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
453 Sfile_name_as_directory
, 1, 1, 0,
454 "Return a string representing file FILENAME interpreted as a directory.\n\
455 This operation exists because a directory is also a file, but its name as\n\
456 a directory is different from its name as a file.\n\
457 The result can be used as the value of `default-directory'\n\
458 or passed as second argument to `expand-file-name'.\n\
459 For a Unix-syntax file name, just appends a slash.\n\
460 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
467 CHECK_STRING (file
, 0);
471 /* If the file name has special constructs in it,
472 call the corresponding file handler. */
473 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
475 return call2 (handler
, Qfile_name_as_directory
, file
);
477 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
478 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
482 * Convert from directory name to filename.
484 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
485 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
486 * On UNIX, it's simple: just make sure there is a terminating /
488 * Value is nonzero if the string output is different from the input.
491 directory_file_name (src
, dst
)
499 struct FAB fab
= cc$rms_fab
;
500 struct NAM nam
= cc$rms_nam
;
501 char esa
[NAM$C_MAXRSS
];
506 if (! index (src
, '/')
507 && (src
[slen
- 1] == ']'
508 || src
[slen
- 1] == ':'
509 || src
[slen
- 1] == '>'))
511 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
513 fab
.fab$b_fns
= slen
;
514 fab
.fab$l_nam
= &nam
;
515 fab
.fab$l_fop
= FAB$M_NAM
;
518 nam
.nam$b_ess
= sizeof esa
;
519 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
521 /* We call SYS$PARSE to handle such things as [--] for us. */
522 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
524 slen
= nam
.nam$b_esl
;
525 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
530 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
532 /* what about when we have logical_name:???? */
533 if (src
[slen
- 1] == ':')
534 { /* Xlate logical name and see what we get */
535 ptr
= strcpy (dst
, src
); /* upper case for getenv */
538 if ('a' <= *ptr
&& *ptr
<= 'z')
542 dst
[slen
- 1] = 0; /* remove colon */
543 if (!(src
= egetenv (dst
)))
545 /* should we jump to the beginning of this procedure?
546 Good points: allows us to use logical names that xlate
548 Bad points: can be a problem if we just translated to a device
550 For now, I'll punt and always expect VMS names, and hope for
553 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
554 { /* no recursion here! */
560 { /* not a directory spec */
565 bracket
= src
[slen
- 1];
567 /* If bracket is ']' or '>', bracket - 2 is the corresponding
569 ptr
= index (src
, bracket
- 2);
571 { /* no opening bracket */
575 if (!(rptr
= rindex (src
, '.')))
578 strncpy (dst
, src
, slen
);
582 dst
[slen
++] = bracket
;
587 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
588 then translate the device and recurse. */
589 if (dst
[slen
- 1] == ':'
590 && dst
[slen
- 2] != ':' /* skip decnet nodes */
591 && strcmp(src
+ slen
, "[000000]") == 0)
593 dst
[slen
- 1] = '\0';
594 if ((ptr
= egetenv (dst
))
595 && (rlen
= strlen (ptr
) - 1) > 0
596 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
597 && ptr
[rlen
- 1] == '.')
599 char * buf
= (char *) alloca (strlen (ptr
) + 1);
603 return directory_file_name (buf
, dst
);
608 strcat (dst
, "[000000]");
612 rlen
= strlen (rptr
) - 1;
613 strncat (dst
, rptr
, rlen
);
614 dst
[slen
+ rlen
] = '\0';
615 strcat (dst
, ".DIR.1");
619 /* Process as Unix format: just remove any final slash.
620 But leave "/" unchanged; do not change it to "". */
623 && dst
[slen
- 1] == '/'
625 && dst
[slen
- 2] != ':'
632 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
634 "Returns the file name of the directory named DIR.\n\
635 This is the name of the file that holds the data for the directory DIR.\n\
636 This operation exists because a directory is also a file, but its name as\n\
637 a directory is different from its name as a file.\n\
638 In Unix-syntax, this function just removes the final slash.\n\
639 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
640 it returns a file name such as \"[X]Y.DIR.1\".")
642 Lisp_Object directory
;
647 CHECK_STRING (directory
, 0);
649 if (NILP (directory
))
652 /* If the file name has special constructs in it,
653 call the corresponding file handler. */
654 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
656 return call2 (handler
, Qdirectory_file_name
, directory
);
659 /* 20 extra chars is insufficient for VMS, since we might perform a
660 logical name translation. an equivalence string can be up to 255
661 chars long, so grab that much extra space... - sss */
662 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
664 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
666 directory_file_name (XSTRING (directory
)->data
, buf
);
667 return build_string (buf
);
670 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
671 "Generate temporary file name (string) starting with PREFIX (a string).\n\
672 The Emacs process number forms part of the result,\n\
673 so there is no danger of generating a name being used by another process.")
678 val
= concat2 (prefix
, build_string ("XXXXXX"));
679 mktemp (XSTRING (val
)->data
);
683 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
684 "Convert FILENAME to absolute, and canonicalize it.\n\
685 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
686 (does not start with slash); if DEFAULT is nil or missing,\n\
687 the current buffer's value of default-directory is used.\n\
688 Path components that are `.' are removed, and \n\
689 path components followed by `..' are removed, along with the `..' itself;\n\
690 note that these simplifications are done without checking the resulting\n\
691 paths in the file system.\n\
692 An initial `~/' expands to your home directory.\n\
693 An initial `~USER/' expands to USER's home directory.\n\
694 See also the function `substitute-in-file-name'.")
696 Lisp_Object name
, defalt
;
700 register unsigned char *newdir
, *p
, *o
;
702 unsigned char *target
;
705 unsigned char * colon
= 0;
706 unsigned char * close
= 0;
707 unsigned char * slash
= 0;
708 unsigned char * brack
= 0;
709 int lbrack
= 0, rbrack
= 0;
712 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
715 unsigned char *tmp
, *defdir
;
719 CHECK_STRING (name
, 0);
721 /* If the file name has special constructs in it,
722 call the corresponding file handler. */
723 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
725 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
727 /* Use the buffer's default-directory if DEFALT is omitted. */
729 defalt
= current_buffer
->directory
;
730 CHECK_STRING (defalt
, 1);
732 /* Make sure DEFALT is properly expanded.
733 It would be better to do this down below where we actually use
734 defalt. Unfortunately, calling Fexpand_file_name recursively
735 could invoke GC, and the strings might be relocated. This would
736 be annoying because we have pointers into strings lying around
737 that would need adjusting, and people would add new pointers to
738 the code and forget to adjust them, resulting in intermittent bugs.
739 Putting this call here avoids all that crud.
741 The EQ test avoids infinite recursion. */
742 if (! NILP (defalt
) && !EQ (defalt
, name
)
743 /* This saves time in a common case. */
744 && XSTRING (defalt
)->data
[0] != '/')
749 defalt
= Fexpand_file_name (defalt
, Qnil
);
754 /* Filenames on VMS are always upper case. */
755 name
= Fupcase (name
);
757 #ifdef FILE_SYSTEM_CASE
758 name
= FILE_SYSTEM_CASE (name
);
761 nm
= XSTRING (name
)->data
;
764 /* firstly, strip drive name. */
766 unsigned char *colon
= rindex (nm
, ':');
772 drive
= tolower (colon
[-1]) - 'a';
776 defdir
= alloca (MAXPATHLEN
+ 1);
777 relpath
= getdefdir (drive
+ 1, defdir
);
783 /* If nm is absolute, flush ...// and detect /./ and /../.
784 If no /./ or /../ we can return right away. */
792 /* If it turns out that the filename we want to return is just a
793 suffix of FILENAME, we don't need to go through and edit
794 things; we just need to construct a new string using data
795 starting at the middle of FILENAME. If we set lose to a
796 non-zero value, that means we've discovered that we can't do
803 /* Since we know the path is absolute, we can assume that each
804 element starts with a "/". */
806 /* "//" anywhere isn't necessarily hairy; we just start afresh
807 with the second slash. */
808 if (p
[0] == '/' && p
[1] == '/'
810 /* // at start of filename is meaningful on Apollo system */
816 /* "~" is hairy as the start of any path element. */
817 if (p
[0] == '/' && p
[1] == '~')
818 nm
= p
+ 1, lose
= 1;
820 /* "." and ".." are hairy. */
825 || (p
[2] == '.' && (p
[3] == '/'
832 /* if dev:[dir]/, move nm to / */
833 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
834 nm
= (brack
? brack
+ 1 : colon
+ 1);
843 /* VMS pre V4.4,convert '-'s in filenames. */
844 if (lbrack
== rbrack
)
846 if (dots
< 2) /* this is to allow negative version numbers */
851 if (lbrack
> rbrack
&&
852 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
853 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
859 /* count open brackets, reset close bracket pointer */
860 if (p
[0] == '[' || p
[0] == '<')
862 /* count close brackets, set close bracket pointer */
863 if (p
[0] == ']' || p
[0] == '>')
865 /* detect ][ or >< */
866 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
868 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
869 nm
= p
+ 1, lose
= 1;
870 if (p
[0] == ':' && (colon
|| slash
))
871 /* if dev1:[dir]dev2:, move nm to dev2: */
877 /* if /pathname/dev:, move nm to dev: */
880 /* if node::dev:, move colon following dev */
881 else if (colon
&& colon
[-1] == ':')
883 /* if dev1:dev2:, move nm to dev2: */
884 else if (colon
&& colon
[-1] != ':')
889 if (p
[0] == ':' && !colon
)
895 if (lbrack
== rbrack
)
898 else if (p
[0] == '.')
907 return build_string (sys_translate_unix (nm
));
910 if (nm
== XSTRING (name
)->data
)
912 return build_string (nm
);
917 /* Now determine directory to start with and put it in newdir */
921 if (nm
[0] == '~') /* prefix ~ */
927 || nm
[1] == 0) /* ~ by itself */
929 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
930 newdir
= (unsigned char *) "";
932 dostounix_filename (newdir
);
936 nm
++; /* Don't leave the slash in nm. */
939 else /* ~user/filename */
941 for (p
= nm
; *p
&& (*p
!= '/'
946 o
= (unsigned char *) alloca (p
- nm
+ 1);
947 bcopy ((char *) nm
, o
, p
- nm
);
950 pw
= (struct passwd
*) getpwnam (o
+ 1);
953 newdir
= (unsigned char *) pw
-> pw_dir
;
955 nm
= p
+ 1; /* skip the terminator */
961 /* If we don't find a user of that name, leave the name
962 unchanged; don't move nm forward to p. */
975 newdir
= XSTRING (defalt
)->data
;
979 if (newdir
== 0 && relpath
)
984 /* Get rid of any slash at the end of newdir. */
985 int length
= strlen (newdir
);
986 /* Adding `length > 1 &&' makes ~ expand into / when homedir
987 is the root dir. People disagree about whether that is right.
988 Anyway, we can't take the risk of this change now. */
990 if (newdir
[1] != ':' && length
> 1)
992 if (newdir
[length
- 1] == '/')
994 unsigned char *temp
= (unsigned char *) alloca (length
);
995 bcopy (newdir
, temp
, length
- 1);
996 temp
[length
- 1] = 0;
1004 /* Now concatenate the directory and name to new space in the stack frame */
1005 tlen
+= strlen (nm
) + 1;
1007 /* Add reserved space for drive name. */
1008 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1010 target
= (unsigned char *) alloca (tlen
);
1017 if (nm
[0] == 0 || nm
[0] == '/')
1018 strcpy (target
, newdir
);
1021 file_name_as_directory (target
, newdir
);
1024 strcat (target
, nm
);
1026 if (index (target
, '/'))
1027 strcpy (target
, sys_translate_unix (target
));
1030 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1038 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1044 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1045 /* brackets are offset from each other by 2 */
1048 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1049 /* convert [foo][bar] to [bar] */
1050 while (o
[-1] != '[' && o
[-1] != '<')
1052 else if (*p
== '-' && *o
!= '.')
1055 else if (p
[0] == '-' && o
[-1] == '.' &&
1056 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1057 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1061 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1062 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1064 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1066 /* else [foo.-] ==> [-] */
1072 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1073 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1083 else if (!strncmp (p
, "//", 2)
1085 /* // at start of filename is meaningful in Apollo system */
1093 else if (p
[0] == '/'
1098 /* If "/." is the entire filename, keep the "/". Otherwise,
1099 just delete the whole "/.". */
1100 if (o
== target
&& p
[2] == '\0')
1104 else if (!strncmp (p
, "/..", 3)
1105 /* `/../' is the "superroot" on certain file systems. */
1107 && (p
[3] == '/' || p
[3] == 0))
1109 while (o
!= target
&& *--o
!= '/')
1112 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1116 if (o
== target
&& *o
== '/')
1124 #endif /* not VMS */
1128 /* at last, set drive name. */
1129 if (target
[1] != ':')
1132 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1137 return make_string (target
, o
- target
);
1140 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1141 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1142 "Convert FILENAME to absolute, and canonicalize it.\n\
1143 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1144 (does not start with slash); if DEFAULT is nil or missing,\n\
1145 the current buffer's value of default-directory is used.\n\
1146 Filenames containing `.' or `..' as components are simplified;\n\
1147 initial `~/' expands to your home directory.\n\
1148 See also the function `substitute-in-file-name'.")
1150 Lisp_Object name, defalt;
1154 register unsigned char *newdir, *p, *o;
1156 unsigned char *target;
1160 unsigned char * colon = 0;
1161 unsigned char * close = 0;
1162 unsigned char * slash = 0;
1163 unsigned char * brack = 0;
1164 int lbrack = 0, rbrack = 0;
1168 CHECK_STRING (name
, 0);
1171 /* Filenames on VMS are always upper case. */
1172 name
= Fupcase (name
);
1175 nm
= XSTRING (name
)->data
;
1177 /* If nm is absolute, flush ...// and detect /./ and /../.
1178 If no /./ or /../ we can return right away. */
1190 if (p
[0] == '/' && p
[1] == '/'
1192 /* // at start of filename is meaningful on Apollo system */
1197 if (p
[0] == '/' && p
[1] == '~')
1198 nm
= p
+ 1, lose
= 1;
1199 if (p
[0] == '/' && p
[1] == '.'
1200 && (p
[2] == '/' || p
[2] == 0
1201 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1207 /* if dev:[dir]/, move nm to / */
1208 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1209 nm
= (brack
? brack
+ 1 : colon
+ 1);
1210 lbrack
= rbrack
= 0;
1218 /* VMS pre V4.4,convert '-'s in filenames. */
1219 if (lbrack
== rbrack
)
1221 if (dots
< 2) /* this is to allow negative version numbers */
1226 if (lbrack
> rbrack
&&
1227 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1228 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1234 /* count open brackets, reset close bracket pointer */
1235 if (p
[0] == '[' || p
[0] == '<')
1236 lbrack
++, brack
= 0;
1237 /* count close brackets, set close bracket pointer */
1238 if (p
[0] == ']' || p
[0] == '>')
1239 rbrack
++, brack
= p
;
1240 /* detect ][ or >< */
1241 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1243 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1244 nm
= p
+ 1, lose
= 1;
1245 if (p
[0] == ':' && (colon
|| slash
))
1246 /* if dev1:[dir]dev2:, move nm to dev2: */
1252 /* if /pathname/dev:, move nm to dev: */
1255 /* if node::dev:, move colon following dev */
1256 else if (colon
&& colon
[-1] == ':')
1258 /* if dev1:dev2:, move nm to dev2: */
1259 else if (colon
&& colon
[-1] != ':')
1264 if (p
[0] == ':' && !colon
)
1270 if (lbrack
== rbrack
)
1273 else if (p
[0] == '.')
1281 if (index (nm
, '/'))
1282 return build_string (sys_translate_unix (nm
));
1284 if (nm
== XSTRING (name
)->data
)
1286 return build_string (nm
);
1290 /* Now determine directory to start with and put it in NEWDIR */
1294 if (nm
[0] == '~') /* prefix ~ */
1299 || nm
[1] == 0)/* ~/filename */
1301 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1302 newdir
= (unsigned char *) "";
1305 nm
++; /* Don't leave the slash in nm. */
1308 else /* ~user/filename */
1310 /* Get past ~ to user */
1311 unsigned char *user
= nm
+ 1;
1312 /* Find end of name. */
1313 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1314 int len
= ptr
? ptr
- user
: strlen (user
);
1316 unsigned char *ptr1
= index (user
, ':');
1317 if (ptr1
!= 0 && ptr1
- user
< len
)
1320 /* Copy the user name into temp storage. */
1321 o
= (unsigned char *) alloca (len
+ 1);
1322 bcopy ((char *) user
, o
, len
);
1325 /* Look up the user name. */
1326 pw
= (struct passwd
*) getpwnam (o
+ 1);
1328 error ("\"%s\" isn't a registered user", o
+ 1);
1330 newdir
= (unsigned char *) pw
->pw_dir
;
1332 /* Discard the user name from NM. */
1339 #endif /* not VMS */
1343 defalt
= current_buffer
->directory
;
1344 CHECK_STRING (defalt
, 1);
1345 newdir
= XSTRING (defalt
)->data
;
1348 /* Now concatenate the directory and name to new space in the stack frame */
1350 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1351 target
= (unsigned char *) alloca (tlen
);
1357 if (nm
[0] == 0 || nm
[0] == '/')
1358 strcpy (target
, newdir
);
1361 file_name_as_directory (target
, newdir
);
1364 strcat (target
, nm
);
1366 if (index (target
, '/'))
1367 strcpy (target
, sys_translate_unix (target
));
1370 /* Now canonicalize by removing /. and /foo/.. if they appear */
1378 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1384 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1385 /* brackets are offset from each other by 2 */
1388 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1389 /* convert [foo][bar] to [bar] */
1390 while (o
[-1] != '[' && o
[-1] != '<')
1392 else if (*p
== '-' && *o
!= '.')
1395 else if (p
[0] == '-' && o
[-1] == '.' &&
1396 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1397 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1401 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1402 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1404 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1406 /* else [foo.-] ==> [-] */
1412 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1413 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1423 else if (!strncmp (p
, "//", 2)
1425 /* // at start of filename is meaningful in Apollo system */
1433 else if (p
[0] == '/' && p
[1] == '.' &&
1434 (p
[2] == '/' || p
[2] == 0))
1436 else if (!strncmp (p
, "/..", 3)
1437 /* `/../' is the "superroot" on certain file systems. */
1439 && (p
[3] == '/' || p
[3] == 0))
1441 while (o
!= target
&& *--o
!= '/')
1444 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1448 if (o
== target
&& *o
== '/')
1456 #endif /* not VMS */
1459 return make_string (target
, o
- target
);
1463 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1464 Ssubstitute_in_file_name
, 1, 1, 0,
1465 "Substitute environment variables referred to in FILENAME.\n\
1466 `$FOO' where FOO is an environment variable name means to substitute\n\
1467 the value of that variable. The variable name should be terminated\n\
1468 with a character not a letter, digit or underscore; otherwise, enclose\n\
1469 the entire variable name in braces.\n\
1470 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1471 On VMS, `$' substitution is not done; this function does little and only\n\
1472 duplicates what `expand-file-name' does.")
1478 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1479 unsigned char *target
;
1481 int substituted
= 0;
1484 CHECK_STRING (string
, 0);
1486 nm
= XSTRING (string
)->data
;
1487 endp
= nm
+ XSTRING (string
)->size
;
1489 /* If /~ or // appears, discard everything through first slash. */
1491 for (p
= nm
; p
!= endp
; p
++)
1495 /* // at start of file name is meaningful in Apollo system */
1496 (p
[0] == '/' && p
- 1 != nm
)
1497 #else /* not APOLLO */
1499 #endif /* not APOLLO */
1503 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1514 if (p
[0] && p
[1] == ':')
1523 return build_string (nm
);
1526 /* See if any variables are substituted into the string
1527 and find the total length of their values in `total' */
1529 for (p
= nm
; p
!= endp
;)
1539 /* "$$" means a single "$" */
1548 while (p
!= endp
&& *p
!= '}') p
++;
1549 if (*p
!= '}') goto missingclose
;
1555 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1559 /* Copy out the variable name */
1560 target
= (unsigned char *) alloca (s
- o
+ 1);
1561 strncpy (target
, o
, s
- o
);
1564 strupr (target
); /* $home == $HOME etc. */
1567 /* Get variable value */
1568 o
= (unsigned char *) egetenv (target
);
1569 if (!o
) goto badvar
;
1570 total
+= strlen (o
);
1577 /* If substitution required, recopy the string and do it */
1578 /* Make space in stack frame for the new copy */
1579 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1582 /* Copy the rest of the name through, replacing $ constructs with values */
1599 while (p
!= endp
&& *p
!= '}') p
++;
1600 if (*p
!= '}') goto missingclose
;
1606 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1610 /* Copy out the variable name */
1611 target
= (unsigned char *) alloca (s
- o
+ 1);
1612 strncpy (target
, o
, s
- o
);
1615 strupr (target
); /* $home == $HOME etc. */
1618 /* Get variable value */
1619 o
= (unsigned char *) egetenv (target
);
1629 /* If /~ or // appears, discard everything through first slash. */
1631 for (p
= xnm
; p
!= x
; p
++)
1634 /* // at start of file name is meaningful in Apollo system */
1635 (p
[0] == '/' && p
- 1 != xnm
)
1636 #else /* not APOLLO */
1638 #endif /* not APOLLO */
1640 && p
!= nm
&& p
[-1] == '/')
1643 else if (p
[0] && p
[1] == ':')
1647 return make_string (xnm
, x
- xnm
);
1650 error ("Bad format environment-variable substitution");
1652 error ("Missing \"}\" in environment-variable substitution");
1654 error ("Substituting nonexistent environment variable \"%s\"", target
);
1657 #endif /* not VMS */
1660 /* A slightly faster and more convenient way to get
1661 (directory-file-name (expand-file-name FOO)). */
1664 expand_and_dir_to_file (filename
, defdir
)
1665 Lisp_Object filename
, defdir
;
1667 register Lisp_Object abspath
;
1669 abspath
= Fexpand_file_name (filename
, defdir
);
1672 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1673 if (c
== ':' || c
== ']' || c
== '>')
1674 abspath
= Fdirectory_file_name (abspath
);
1677 /* Remove final slash, if any (unless path is root).
1678 stat behaves differently depending! */
1679 if (XSTRING (abspath
)->size
> 1
1680 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1681 /* We cannot take shortcuts; they might be wrong for magic file names. */
1682 abspath
= Fdirectory_file_name (abspath
);
1687 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1688 Lisp_Object absname
;
1689 unsigned char *querystring
;
1692 register Lisp_Object tem
;
1693 struct gcpro gcpro1
;
1695 if (access (XSTRING (absname
)->data
, 4) >= 0)
1698 Fsignal (Qfile_already_exists
,
1699 Fcons (build_string ("File already exists"),
1700 Fcons (absname
, Qnil
)));
1702 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1703 XSTRING (absname
)->data
, querystring
));
1706 Fsignal (Qfile_already_exists
,
1707 Fcons (build_string ("File already exists"),
1708 Fcons (absname
, Qnil
)));
1713 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1714 "fCopy file: \nFCopy %s to file: \np\nP",
1715 "Copy FILE to NEWNAME. Both args must be strings.\n\
1716 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1717 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1718 A number as third arg means request confirmation if NEWNAME already exists.\n\
1719 This is what happens in interactive use with M-x.\n\
1720 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1721 last-modified time as the old one. (This works on only some systems.)\n\
1722 A prefix arg makes KEEP-TIME non-nil.")
1723 (filename
, newname
, ok_if_already_exists
, keep_date
)
1724 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1727 char buf
[16 * 1024];
1729 Lisp_Object handler
;
1730 struct gcpro gcpro1
, gcpro2
;
1731 int count
= specpdl_ptr
- specpdl
;
1732 Lisp_Object args
[6];
1733 int input_file_statable_p
;
1735 GCPRO2 (filename
, newname
);
1736 CHECK_STRING (filename
, 0);
1737 CHECK_STRING (newname
, 1);
1738 filename
= Fexpand_file_name (filename
, Qnil
);
1739 newname
= Fexpand_file_name (newname
, Qnil
);
1741 /* If the input file name has special constructs in it,
1742 call the corresponding file handler. */
1743 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1744 /* Likewise for output file name. */
1746 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1747 if (!NILP (handler
))
1748 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1749 ok_if_already_exists
, keep_date
));
1751 if (NILP (ok_if_already_exists
)
1752 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1753 barf_or_query_if_file_exists (newname
, "copy to it",
1754 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1756 ifd
= open (XSTRING (filename
)->data
, 0);
1758 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1760 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1762 /* We can only copy regular files and symbolic links. Other files are not
1764 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1766 #if defined (S_ISREG) && defined (S_ISLNK)
1767 if (input_file_statable_p
)
1769 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1771 #if defined (EISDIR)
1772 /* Get a better looking error message. */
1775 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1778 #endif /* S_ISREG && S_ISLNK */
1781 /* Create the copy file with the same record format as the input file */
1782 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1785 /* System's default file type was set to binary by _fmode in emacs.c. */
1786 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1787 #else /* not MSDOS */
1788 ofd
= creat (XSTRING (newname
)->data
, 0666);
1789 #endif /* not MSDOS */
1792 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1794 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1798 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1799 if (write (ofd
, buf
, n
) != n
)
1800 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1803 if (input_file_statable_p
)
1805 if (!NILP (keep_date
))
1807 EMACS_TIME atime
, mtime
;
1808 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1809 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1810 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1813 if (!egetenv ("USE_DOMAIN_ACLS"))
1815 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1818 /* Discard the unwind protects. */
1819 specpdl_ptr
= specpdl
+ count
;
1822 if (close (ofd
) < 0)
1823 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1829 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1830 Smake_directory_internal
, 1, 1, 0,
1831 "Create a directory. One argument, a file name string.")
1833 Lisp_Object dirname
;
1836 Lisp_Object handler
;
1838 CHECK_STRING (dirname
, 0);
1839 dirname
= Fexpand_file_name (dirname
, Qnil
);
1841 handler
= Ffind_file_name_handler (dirname
, Qmake_directory
);
1842 if (!NILP (handler
))
1843 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1845 dir
= XSTRING (dirname
)->data
;
1847 if (mkdir (dir
, 0777) != 0)
1848 report_file_error ("Creating directory", Flist (1, &dirname
));
1853 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1854 "Delete a directory. One argument, a file name string.")
1856 Lisp_Object dirname
;
1859 Lisp_Object handler
;
1861 CHECK_STRING (dirname
, 0);
1862 dirname
= Fexpand_file_name (dirname
, Qnil
);
1863 dir
= XSTRING (dirname
)->data
;
1865 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1866 if (!NILP (handler
))
1867 return call2 (handler
, Qdelete_directory
, dirname
);
1869 if (rmdir (dir
) != 0)
1870 report_file_error ("Removing directory", Flist (1, &dirname
));
1875 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1876 "Delete specified file. One argument, a file name string.\n\
1877 If file has multiple names, it continues to exist with the other names.")
1879 Lisp_Object filename
;
1881 Lisp_Object handler
;
1882 CHECK_STRING (filename
, 0);
1883 filename
= Fexpand_file_name (filename
, Qnil
);
1885 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1886 if (!NILP (handler
))
1887 return call2 (handler
, Qdelete_file
, filename
);
1889 if (0 > unlink (XSTRING (filename
)->data
))
1890 report_file_error ("Removing old name", Flist (1, &filename
));
1894 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1895 "fRename file: \nFRename %s to file: \np",
1896 "Rename FILE as NEWNAME. Both args strings.\n\
1897 If file has names other than FILE, it continues to have those names.\n\
1898 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1899 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1900 A number as third arg means request confirmation if NEWNAME already exists.\n\
1901 This is what happens in interactive use with M-x.")
1902 (filename
, newname
, ok_if_already_exists
)
1903 Lisp_Object filename
, newname
, ok_if_already_exists
;
1906 Lisp_Object args
[2];
1908 Lisp_Object handler
;
1909 struct gcpro gcpro1
, gcpro2
;
1911 GCPRO2 (filename
, newname
);
1912 CHECK_STRING (filename
, 0);
1913 CHECK_STRING (newname
, 1);
1914 filename
= Fexpand_file_name (filename
, Qnil
);
1915 newname
= Fexpand_file_name (newname
, Qnil
);
1917 /* If the file name has special constructs in it,
1918 call the corresponding file handler. */
1919 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1921 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1922 if (!NILP (handler
))
1923 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1924 filename
, newname
, ok_if_already_exists
));
1926 if (NILP (ok_if_already_exists
)
1927 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1928 barf_or_query_if_file_exists (newname
, "rename to it",
1929 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1931 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1933 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1934 || 0 > unlink (XSTRING (filename
)->data
))
1939 Fcopy_file (filename
, newname
,
1940 /* We have already prompted if it was an integer,
1941 so don't have copy-file prompt again. */
1942 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1943 Fdelete_file (filename
);
1950 report_file_error ("Renaming", Flist (2, args
));
1953 report_file_error ("Renaming", Flist (2, &filename
));
1960 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1961 "fAdd name to file: \nFName to add to %s: \np",
1962 "Give FILE additional name NEWNAME. Both args strings.\n\
1963 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1964 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1965 A number as third arg means request confirmation if NEWNAME already exists.\n\
1966 This is what happens in interactive use with M-x.")
1967 (filename
, newname
, ok_if_already_exists
)
1968 Lisp_Object filename
, newname
, ok_if_already_exists
;
1971 Lisp_Object args
[2];
1973 Lisp_Object handler
;
1974 struct gcpro gcpro1
, gcpro2
;
1976 GCPRO2 (filename
, newname
);
1977 CHECK_STRING (filename
, 0);
1978 CHECK_STRING (newname
, 1);
1979 filename
= Fexpand_file_name (filename
, Qnil
);
1980 newname
= Fexpand_file_name (newname
, Qnil
);
1982 /* If the file name has special constructs in it,
1983 call the corresponding file handler. */
1984 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
1985 if (!NILP (handler
))
1986 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
1987 newname
, ok_if_already_exists
));
1989 if (NILP (ok_if_already_exists
)
1990 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1991 barf_or_query_if_file_exists (newname
, "make it a new name",
1992 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1993 unlink (XSTRING (newname
)->data
);
1994 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1999 report_file_error ("Adding new name", Flist (2, args
));
2001 report_file_error ("Adding new name", Flist (2, &filename
));
2010 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2011 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2012 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2013 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2014 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2015 A number as third arg means request confirmation if NEWNAME already exists.\n\
2016 This happens for interactive use with M-x.")
2017 (filename
, linkname
, ok_if_already_exists
)
2018 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2021 Lisp_Object args
[2];
2023 Lisp_Object handler
;
2024 struct gcpro gcpro1
, gcpro2
;
2026 GCPRO2 (filename
, linkname
);
2027 CHECK_STRING (filename
, 0);
2028 CHECK_STRING (linkname
, 1);
2029 /* If the link target has a ~, we must expand it to get
2030 a truly valid file name. Otherwise, do not expand;
2031 we want to permit links to relative file names. */
2032 if (XSTRING (filename
)->data
[0] == '~')
2033 filename
= Fexpand_file_name (filename
, Qnil
);
2034 linkname
= Fexpand_file_name (linkname
, Qnil
);
2036 /* If the file name has special constructs in it,
2037 call the corresponding file handler. */
2038 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2039 if (!NILP (handler
))
2040 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2041 linkname
, ok_if_already_exists
));
2043 if (NILP (ok_if_already_exists
)
2044 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2045 barf_or_query_if_file_exists (linkname
, "make it a link",
2046 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2047 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2049 /* If we didn't complain already, silently delete existing file. */
2050 if (errno
== EEXIST
)
2052 unlink (XSTRING (linkname
)->data
);
2053 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2060 report_file_error ("Making symbolic link", Flist (2, args
));
2062 report_file_error ("Making symbolic link", Flist (2, &filename
));
2068 #endif /* S_IFLNK */
2072 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2073 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2074 "Define the job-wide logical name NAME to have the value STRING.\n\
2075 If STRING is nil or a null string, the logical name NAME is deleted.")
2077 Lisp_Object varname
;
2080 CHECK_STRING (varname
, 0);
2082 delete_logical_name (XSTRING (varname
)->data
);
2085 CHECK_STRING (string
, 1);
2087 if (XSTRING (string
)->size
== 0)
2088 delete_logical_name (XSTRING (varname
)->data
);
2090 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2099 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2100 "Open a network connection to PATH using LOGIN as the login string.")
2102 Lisp_Object path
, login
;
2106 CHECK_STRING (path
, 0);
2107 CHECK_STRING (login
, 0);
2109 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2111 if (netresult
== -1)
2116 #endif /* HPUX_NET */
2118 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2120 "Return t if file FILENAME specifies an absolute path name.\n\
2121 On Unix, this is a name starting with a `/' or a `~'.")
2123 Lisp_Object filename
;
2127 CHECK_STRING (filename
, 0);
2128 ptr
= XSTRING (filename
)->data
;
2129 if (*ptr
== '/' || *ptr
== '~'
2131 /* ??? This criterion is probably wrong for '<'. */
2132 || index (ptr
, ':') || index (ptr
, '<')
2133 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2137 || (*ptr
!= 0 && ptr
[1] == ':' && ptr
[2] == '/')
2145 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2146 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2147 See also `file-readable-p' and `file-attributes'.")
2149 Lisp_Object filename
;
2151 Lisp_Object abspath
;
2152 Lisp_Object handler
;
2154 CHECK_STRING (filename
, 0);
2155 abspath
= Fexpand_file_name (filename
, Qnil
);
2157 /* If the file name has special constructs in it,
2158 call the corresponding file handler. */
2159 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2160 if (!NILP (handler
))
2161 return call2 (handler
, Qfile_exists_p
, abspath
);
2163 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2166 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2167 "Return t if FILENAME can be executed by you.\n\
2168 For a directory, this means you can access files in that directory.")
2170 Lisp_Object filename
;
2173 Lisp_Object abspath
;
2174 Lisp_Object handler
;
2176 CHECK_STRING (filename
, 0);
2177 abspath
= Fexpand_file_name (filename
, Qnil
);
2179 /* If the file name has special constructs in it,
2180 call the corresponding file handler. */
2181 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2182 if (!NILP (handler
))
2183 return call2 (handler
, Qfile_executable_p
, abspath
);
2185 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2188 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2189 "Return t if file FILENAME exists and you can read it.\n\
2190 See also `file-exists-p' and `file-attributes'.")
2192 Lisp_Object filename
;
2194 Lisp_Object abspath
;
2195 Lisp_Object handler
;
2197 CHECK_STRING (filename
, 0);
2198 abspath
= Fexpand_file_name (filename
, Qnil
);
2200 /* If the file name has special constructs in it,
2201 call the corresponding file handler. */
2202 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2203 if (!NILP (handler
))
2204 return call2 (handler
, Qfile_readable_p
, abspath
);
2206 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2209 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2210 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2211 The value is the name of the file to which it is linked.\n\
2212 Otherwise returns nil.")
2214 Lisp_Object filename
;
2221 Lisp_Object handler
;
2223 CHECK_STRING (filename
, 0);
2224 filename
= Fexpand_file_name (filename
, Qnil
);
2226 /* If the file name has special constructs in it,
2227 call the corresponding file handler. */
2228 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2229 if (!NILP (handler
))
2230 return call2 (handler
, Qfile_symlink_p
, filename
);
2235 buf
= (char *) xmalloc (bufsize
);
2236 bzero (buf
, bufsize
);
2237 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2238 if (valsize
< bufsize
) break;
2239 /* Buffer was not long enough */
2248 val
= make_string (buf
, valsize
);
2251 #else /* not S_IFLNK */
2253 #endif /* not S_IFLNK */
2256 #ifdef SOLARIS_BROKEN_ACCESS
2257 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2258 considered by the access system call. This is Sun's bug, but we
2259 still have to make Emacs work. */
2261 #include <sys/statvfs.h>
2267 struct statvfs statvfsb
;
2269 if (statvfs(path
, &statvfsb
))
2270 return 1; /* error from statvfs, be conservative and say not wrtable */
2272 /* Otherwise, fsys is ro if bit is set. */
2273 return statvfsb
.f_flag
& ST_RDONLY
;
2276 /* But on every other os, access has already done the right thing. */
2277 #define ro_fsys(path) 0
2280 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2282 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2283 "Return t if file FILENAME can be written or created by you.")
2285 Lisp_Object filename
;
2287 Lisp_Object abspath
, dir
;
2288 Lisp_Object handler
;
2290 CHECK_STRING (filename
, 0);
2291 abspath
= Fexpand_file_name (filename
, Qnil
);
2293 /* If the file name has special constructs in it,
2294 call the corresponding file handler. */
2295 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2296 if (!NILP (handler
))
2297 return call2 (handler
, Qfile_writable_p
, abspath
);
2299 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2300 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2301 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2303 dir
= Ffile_name_directory (abspath
);
2306 dir
= Fdirectory_file_name (dir
);
2310 dir
= Fdirectory_file_name (dir
);
2312 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2313 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2317 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2318 "Return t if file FILENAME is the name of a directory as a file.\n\
2319 A directory name spec may be given instead; then the value is t\n\
2320 if the directory so specified exists and really is a directory.")
2322 Lisp_Object filename
;
2324 register Lisp_Object abspath
;
2326 Lisp_Object handler
;
2328 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2330 /* If the file name has special constructs in it,
2331 call the corresponding file handler. */
2332 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2333 if (!NILP (handler
))
2334 return call2 (handler
, Qfile_directory_p
, abspath
);
2336 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2338 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2341 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2342 "Return t if file FILENAME is the name of a directory as a file,\n\
2343 and files in that directory can be opened by you. In order to use a\n\
2344 directory as a buffer's current directory, this predicate must return true.\n\
2345 A directory name spec may be given instead; then the value is t\n\
2346 if the directory so specified exists and really is a readable and\n\
2347 searchable directory.")
2349 Lisp_Object filename
;
2351 Lisp_Object handler
;
2353 /* If the file name has special constructs in it,
2354 call the corresponding file handler. */
2355 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2356 if (!NILP (handler
))
2357 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2359 if (NILP (Ffile_directory_p (filename
))
2360 || NILP (Ffile_executable_p (filename
)))
2366 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2367 "Return mode bits of FILE, as an integer.")
2369 Lisp_Object filename
;
2371 Lisp_Object abspath
;
2373 Lisp_Object handler
;
2375 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2377 /* If the file name has special constructs in it,
2378 call the corresponding file handler. */
2379 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2380 if (!NILP (handler
))
2381 return call2 (handler
, Qfile_modes
, abspath
);
2383 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2389 if (S_ISREG (st
.st_mode
)
2390 && (len
= XSTRING (abspath
)->size
) >= 5
2391 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2392 || stricmp (suffix
, ".exe") == 0
2393 || stricmp (suffix
, ".bat") == 0))
2394 st
.st_mode
|= S_IEXEC
;
2398 return make_number (st
.st_mode
& 07777);
2401 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2402 "Set mode bits of FILE to MODE (an integer).\n\
2403 Only the 12 low bits of MODE are used.")
2405 Lisp_Object filename
, mode
;
2407 Lisp_Object abspath
;
2408 Lisp_Object handler
;
2410 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2411 CHECK_NUMBER (mode
, 1);
2413 /* If the file name has special constructs in it,
2414 call the corresponding file handler. */
2415 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2416 if (!NILP (handler
))
2417 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2420 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2421 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2423 if (!egetenv ("USE_DOMAIN_ACLS"))
2426 struct timeval tvp
[2];
2428 /* chmod on apollo also change the file's modtime; need to save the
2429 modtime and then restore it. */
2430 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2432 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2436 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2437 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2439 /* reset the old accessed and modified times. */
2440 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2442 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2445 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2446 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2453 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2454 "Set the file permission bits for newly created files.\n\
2455 The argument MODE should be an integer; only the low 9 bits are used.\n\
2456 This setting is inherited by subprocesses.")
2460 CHECK_NUMBER (mode
, 0);
2462 umask ((~ XINT (mode
)) & 0777);
2467 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2468 "Return the default file protection for created files.\n\
2469 The value is an integer.")
2475 realmask
= umask (0);
2478 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2484 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2485 "Tell Unix to finish all pending disk updates.")
2494 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2495 "Return t if file FILE1 is newer than file FILE2.\n\
2496 If FILE1 does not exist, the answer is nil;\n\
2497 otherwise, if FILE2 does not exist, the answer is t.")
2499 Lisp_Object file1
, file2
;
2501 Lisp_Object abspath1
, abspath2
;
2504 Lisp_Object handler
;
2505 struct gcpro gcpro1
, gcpro2
;
2507 CHECK_STRING (file1
, 0);
2508 CHECK_STRING (file2
, 0);
2511 GCPRO2 (abspath1
, file2
);
2512 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2513 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2516 /* If the file name has special constructs in it,
2517 call the corresponding file handler. */
2518 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2520 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2521 if (!NILP (handler
))
2522 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2524 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2527 mtime1
= st
.st_mtime
;
2529 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2532 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2536 Lisp_Object Qfind_buffer_file_type
;
2539 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2541 "Insert contents of file FILENAME after point.\n\
2542 Returns list of absolute file name and length of data inserted.\n\
2543 If second argument VISIT is non-nil, the buffer's visited filename\n\
2544 and last save file modtime are set, and it is marked unmodified.\n\
2545 If visiting and the file does not exist, visiting is completed\n\
2546 before the error is signaled.\n\n\
2547 The optional third and fourth arguments BEG and END\n\
2548 specify what portion of the file to insert.\n\
2549 If VISIT is non-nil, BEG and END must be nil.\n\
2550 If optional fifth argument REPLACE is non-nil,\n\
2551 it means replace the current buffer contents (in the accessible portion)\n\
2552 with the file contents. This is better than simply deleting and inserting\n\
2553 the whole thing because (1) it preserves some marker positions\n\
2554 and (2) it puts less data in the undo list.")
2555 (filename
, visit
, beg
, end
, replace
)
2556 Lisp_Object filename
, visit
, beg
, end
, replace
;
2560 register int inserted
= 0;
2561 register int how_much
;
2562 int count
= specpdl_ptr
- specpdl
;
2563 struct gcpro gcpro1
, gcpro2
;
2564 Lisp_Object handler
, val
, insval
;
2571 GCPRO2 (filename
, p
);
2572 if (!NILP (current_buffer
->read_only
))
2573 Fbarf_if_buffer_read_only();
2575 CHECK_STRING (filename
, 0);
2576 filename
= Fexpand_file_name (filename
, Qnil
);
2578 /* If the file name has special constructs in it,
2579 call the corresponding file handler. */
2580 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2581 if (!NILP (handler
))
2583 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2584 visit
, beg
, end
, replace
);
2591 if (stat (XSTRING (filename
)->data
, &st
) < 0
2592 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2594 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2595 || fstat (fd
, &st
) < 0)
2596 #endif /* not APOLLO */
2598 if (fd
>= 0) close (fd
);
2600 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2606 /* Replacement should preserve point as it preserves markers. */
2607 if (!NILP (replace
))
2608 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2610 record_unwind_protect (close_file_unwind
, make_number (fd
));
2613 /* This code will need to be changed in order to work on named
2614 pipes, and it's probably just not worth it. So we should at
2615 least signal an error. */
2616 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2617 Fsignal (Qfile_error
,
2618 Fcons (build_string ("reading from named pipe"),
2619 Fcons (filename
, Qnil
)));
2622 /* Supposedly happens on VMS. */
2624 error ("File size is negative");
2626 if (!NILP (beg
) || !NILP (end
))
2628 error ("Attempt to visit less than an entire file");
2631 CHECK_NUMBER (beg
, 0);
2636 CHECK_NUMBER (end
, 0);
2639 XSETINT (end
, st
.st_size
);
2640 if (XINT (end
) != st
.st_size
)
2641 error ("maximum buffer size exceeded");
2644 /* If requested, replace the accessible part of the buffer
2645 with the file contents. Avoid replacing text at the
2646 beginning or end of the buffer that matches the file contents;
2647 that preserves markers pointing to the unchanged parts. */
2648 if (!NILP (replace
))
2650 char buffer
[1 << 14];
2651 int same_at_start
= BEGV
;
2652 int same_at_end
= ZV
;
2657 /* Count how many chars at the start of the file
2658 match the text at the beginning of the buffer. */
2663 nread
= read (fd
, buffer
, sizeof buffer
);
2665 error ("IO error reading %s: %s",
2666 XSTRING (filename
)->data
, strerror (errno
));
2667 else if (nread
== 0)
2670 while (bufpos
< nread
&& same_at_start
< ZV
2671 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2672 same_at_start
++, bufpos
++;
2673 /* If we found a discrepancy, stop the scan.
2674 Otherwise loop around and scan the next bufferfull. */
2675 if (bufpos
!= nread
)
2679 /* If the file matches the buffer completely,
2680 there's no need to replace anything. */
2681 if (same_at_start
== st
.st_size
)
2689 /* Count how many chars at the end of the file
2690 match the text at the end of the buffer. */
2693 int total_read
, nread
, bufpos
, curpos
, trial
;
2695 /* At what file position are we now scanning? */
2696 curpos
= st
.st_size
- (ZV
- same_at_end
);
2697 /* How much can we scan in the next step? */
2698 trial
= min (curpos
, sizeof buffer
);
2699 if (lseek (fd
, curpos
- trial
, 0) < 0)
2700 report_file_error ("Setting file position",
2701 Fcons (filename
, Qnil
));
2704 while (total_read
< trial
)
2706 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2708 error ("IO error reading %s: %s",
2709 XSTRING (filename
)->data
, strerror (errno
));
2710 total_read
+= nread
;
2712 /* Scan this bufferfull from the end, comparing with
2713 the Emacs buffer. */
2714 bufpos
= total_read
;
2715 /* Compare with same_at_start to avoid counting some buffer text
2716 as matching both at the file's beginning and at the end. */
2717 while (bufpos
> 0 && same_at_end
> same_at_start
2718 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2719 same_at_end
--, bufpos
--;
2720 /* If we found a discrepancy, stop the scan.
2721 Otherwise loop around and scan the preceding bufferfull. */
2727 /* Don't try to reuse the same piece of text twice. */
2728 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2730 same_at_end
+= overlap
;
2732 /* Arrange to read only the nonmatching middle part of the file. */
2733 XFASTINT (beg
) = same_at_start
- BEGV
;
2734 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2736 del_range_1 (same_at_start
, same_at_end
, 0);
2737 /* Insert from the file at the proper position. */
2738 SET_PT (same_at_start
);
2741 total
= XINT (end
) - XINT (beg
);
2744 register Lisp_Object temp
;
2746 /* Make sure point-max won't overflow after this insertion. */
2747 XSET (temp
, Lisp_Int
, total
);
2748 if (total
!= XINT (temp
))
2749 error ("maximum buffer size exceeded");
2752 if (NILP (visit
) && total
> 0)
2753 prepare_to_modify_buffer (point
, point
);
2756 if (GAP_SIZE
< total
)
2757 make_gap (total
- GAP_SIZE
);
2759 if (XINT (beg
) != 0 || !NILP (replace
))
2761 if (lseek (fd
, XINT (beg
), 0) < 0)
2762 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2766 while (inserted
< total
)
2768 int try = min (total
- inserted
, 64 << 10);
2771 /* Allow quitting out of the actual I/O. */
2774 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2791 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2792 /* Determine file type from name and remove LFs from CR-LFs if the file
2793 is deemed to be a text file. */
2795 struct gcpro gcpro1
;
2799 current_buffer
->buffer_file_type
2800 = call1 (Qfind_buffer_file_type
, filename
);
2802 if (NILP (current_buffer
->buffer_file_type
))
2805 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2808 GPT
-= reduced_size
;
2809 GAP_SIZE
+= reduced_size
;
2810 inserted
-= reduced_size
;
2817 record_insert (point
, inserted
);
2819 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2820 offset_intervals (current_buffer
, point
, inserted
);
2826 /* Discard the unwind protect for closing the file. */
2830 error ("IO error reading %s: %s",
2831 XSTRING (filename
)->data
, strerror (errno
));
2838 if (!EQ (current_buffer
->undo_list
, Qt
))
2839 current_buffer
->undo_list
= Qnil
;
2841 stat (XSTRING (filename
)->data
, &st
);
2846 current_buffer
->modtime
= st
.st_mtime
;
2847 current_buffer
->filename
= filename
;
2850 current_buffer
->save_modified
= MODIFF
;
2851 current_buffer
->auto_save_modified
= MODIFF
;
2852 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2853 #ifdef CLASH_DETECTION
2856 if (!NILP (current_buffer
->filename
))
2857 unlock_file (current_buffer
->filename
);
2858 unlock_file (filename
);
2860 #endif /* CLASH_DETECTION */
2861 /* If visiting nonexistent file, return nil. */
2862 if (current_buffer
->modtime
== -1)
2863 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2866 if (inserted
> 0 && NILP (visit
) && total
> 0)
2867 signal_after_change (point
, 0, inserted
);
2871 p
= Vafter_insert_file_functions
;
2874 insval
= call1 (Fcar (p
), make_number (inserted
));
2877 CHECK_NUMBER (insval
, 0);
2878 inserted
= XFASTINT (insval
);
2886 val
= Fcons (filename
,
2887 Fcons (make_number (inserted
),
2890 RETURN_UNGCPRO (unbind_to (count
, val
));
2893 static Lisp_Object
build_annotations ();
2895 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2896 "r\nFWrite region to file: ",
2897 "Write current region into specified file.\n\
2898 When called from a program, takes three arguments:\n\
2899 START, END and FILENAME. START and END are buffer positions.\n\
2900 Optional fourth argument APPEND if non-nil means\n\
2901 append to existing file contents (if any).\n\
2902 Optional fifth argument VISIT if t means\n\
2903 set the last-save-file-modtime of buffer to this file's modtime\n\
2904 and mark buffer not modified.\n\
2905 If VISIT is a string, it is a second file name;\n\
2906 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2907 VISIT is also the file name to lock and unlock for clash detection.\n\
2908 If VISIT is neither t nor nil nor a string,\n\
2909 that means do not print the \"Wrote file\" message.\n\
2910 Kludgy feature: if START is a string, then that string is written\n\
2911 to the file, instead of any buffer contents, and END is ignored.")
2912 (start
, end
, filename
, append
, visit
)
2913 Lisp_Object start
, end
, filename
, append
, visit
;
2921 int count
= specpdl_ptr
- specpdl
;
2923 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2925 Lisp_Object handler
;
2926 Lisp_Object visit_file
;
2927 Lisp_Object annotations
;
2928 int visiting
, quietly
;
2929 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2931 int buffer_file_type
2932 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2935 if (!NILP (start
) && !STRINGP (start
))
2936 validate_region (&start
, &end
);
2938 filename
= Fexpand_file_name (filename
, Qnil
);
2939 if (STRINGP (visit
))
2940 visit_file
= Fexpand_file_name (visit
, Qnil
);
2942 visit_file
= filename
;
2944 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2945 quietly
= !NILP (visit
);
2949 GCPRO4 (start
, filename
, annotations
, visit_file
);
2951 /* If the file name has special constructs in it,
2952 call the corresponding file handler. */
2953 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
2954 /* If FILENAME has no handler, see if VISIT has one. */
2955 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2956 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
2958 if (!NILP (handler
))
2961 val
= call6 (handler
, Qwrite_region
, start
, end
,
2962 filename
, append
, visit
);
2966 current_buffer
->save_modified
= MODIFF
;
2967 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2968 current_buffer
->filename
= visit_file
;
2974 /* Special kludge to simplify auto-saving. */
2977 XFASTINT (start
) = BEG
;
2981 annotations
= build_annotations (start
, end
);
2983 #ifdef CLASH_DETECTION
2985 lock_file (visit_file
);
2986 #endif /* CLASH_DETECTION */
2988 fn
= XSTRING (filename
)->data
;
2992 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
2994 desc
= open (fn
, O_WRONLY
);
2999 if (auto_saving
) /* Overwrite any previous version of autosave file */
3001 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3002 desc
= open (fn
, O_RDWR
);
3004 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3005 ? XSTRING (current_buffer
->filename
)->data
: 0,
3008 else /* Write to temporary name and rename if no errors */
3010 Lisp_Object temp_name
;
3011 temp_name
= Ffile_name_directory (filename
);
3013 if (!NILP (temp_name
))
3015 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3016 build_string ("$$SAVE$$")));
3017 fname
= XSTRING (filename
)->data
;
3018 fn
= XSTRING (temp_name
)->data
;
3019 desc
= creat_copy_attrs (fname
, fn
);
3022 /* If we can't open the temporary file, try creating a new
3023 version of the original file. VMS "creat" creates a
3024 new version rather than truncating an existing file. */
3027 desc
= creat (fn
, 0666);
3028 #if 0 /* This can clobber an existing file and fail to replace it,
3029 if the user runs out of space. */
3032 /* We can't make a new version;
3033 try to truncate and rewrite existing version if any. */
3035 desc
= open (fn
, O_RDWR
);
3041 desc
= creat (fn
, 0666);
3046 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3047 S_IREAD
| S_IWRITE
);
3048 #else /* not MSDOS */
3049 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3050 #endif /* not MSDOS */
3051 #endif /* not VMS */
3057 #ifdef CLASH_DETECTION
3059 if (!auto_saving
) unlock_file (visit_file
);
3061 #endif /* CLASH_DETECTION */
3062 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3065 record_unwind_protect (close_file_unwind
, make_number (desc
));
3068 if (lseek (desc
, 0, 2) < 0)
3070 #ifdef CLASH_DETECTION
3071 if (!auto_saving
) unlock_file (visit_file
);
3072 #endif /* CLASH_DETECTION */
3073 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3078 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3079 * if we do writes that don't end with a carriage return. Furthermore
3080 * it cannot handle writes of more then 16K. The modified
3081 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3082 * this EXCEPT for the last record (iff it doesn't end with a carriage
3083 * return). This implies that if your buffer doesn't end with a carriage
3084 * return, you get one free... tough. However it also means that if
3085 * we make two calls to sys_write (a la the following code) you can
3086 * get one at the gap as well. The easiest way to fix this (honest)
3087 * is to move the gap to the next newline (or the end of the buffer).
3092 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3093 move_gap (find_next_newline (GPT
, 1));
3099 if (STRINGP (start
))
3101 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3102 XSTRING (start
)->size
, 0, &annotations
);
3105 else if (XINT (start
) != XINT (end
))
3108 if (XINT (start
) < GPT
)
3110 register int end1
= XINT (end
);
3112 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3113 min (GPT
, end1
) - tem
, tem
, &annotations
);
3114 nwritten
+= min (GPT
, end1
) - tem
;
3118 if (XINT (end
) > GPT
&& !failure
)
3121 tem
= max (tem
, GPT
);
3122 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3124 nwritten
+= XINT (end
) - tem
;
3130 /* If file was empty, still need to write the annotations */
3131 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3139 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3140 Disk full in NFS may be reported here. */
3141 /* mib says that closing the file will try to write as fast as NFS can do
3142 it, and that means the fsync here is not crucial for autosave files. */
3143 if (!auto_saving
&& fsync (desc
) < 0)
3144 failure
= 1, save_errno
= errno
;
3147 /* Spurious "file has changed on disk" warnings have been
3148 observed on Suns as well.
3149 It seems that `close' can change the modtime, under nfs.
3151 (This has supposedly been fixed in Sunos 4,
3152 but who knows about all the other machines with NFS?) */
3155 /* On VMS and APOLLO, must do the stat after the close
3156 since closing changes the modtime. */
3159 /* Recall that #if defined does not work on VMS. */
3166 /* NFS can report a write failure now. */
3167 if (close (desc
) < 0)
3168 failure
= 1, save_errno
= errno
;
3171 /* If we wrote to a temporary name and had no errors, rename to real name. */
3175 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3183 /* Discard the unwind protect */
3184 specpdl_ptr
= specpdl
+ count
;
3186 #ifdef CLASH_DETECTION
3188 unlock_file (visit_file
);
3189 #endif /* CLASH_DETECTION */
3191 /* Do this before reporting IO error
3192 to avoid a "file has changed on disk" warning on
3193 next attempt to save. */
3195 current_buffer
->modtime
= st
.st_mtime
;
3198 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3202 current_buffer
->save_modified
= MODIFF
;
3203 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3204 current_buffer
->filename
= visit_file
;
3210 message ("Wrote %s", XSTRING (visit_file
)->data
);
3215 Lisp_Object
merge ();
3217 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3218 "Return t if (car A) is numerically less than (car B).")
3222 return Flss (Fcar (a
), Fcar (b
));
3225 /* Build the complete list of annotations appropriate for writing out
3226 the text between START and END, by calling all the functions in
3227 write-region-annotate-functions and merging the lists they return. */
3230 build_annotations (start
, end
)
3231 Lisp_Object start
, end
;
3233 Lisp_Object annotations
;
3235 struct gcpro gcpro1
, gcpro2
;
3238 p
= Vwrite_region_annotate_functions
;
3239 GCPRO2 (annotations
, p
);
3242 res
= call2 (Fcar (p
), start
, end
);
3243 Flength (res
); /* Check basic validity of return value */
3244 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3251 /* Write to descriptor DESC the LEN characters starting at ADDR,
3252 assuming they start at position POS in the buffer.
3253 Intersperse with them the annotations from *ANNOT
3254 (those which fall within the range of positions POS to POS + LEN),
3255 each at its appropriate position.
3257 Modify *ANNOT by discarding elements as we output them.
3258 The return value is negative in case of system call failure. */
3261 a_write (desc
, addr
, len
, pos
, annot
)
3263 register char *addr
;
3270 int lastpos
= pos
+ len
;
3274 tem
= Fcar_safe (Fcar (*annot
));
3275 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3276 nextpos
= XFASTINT (tem
);
3278 return e_write (desc
, addr
, lastpos
- pos
);
3281 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3283 addr
+= nextpos
- pos
;
3286 tem
= Fcdr (Fcar (*annot
));
3289 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3292 *annot
= Fcdr (*annot
);
3297 e_write (desc
, addr
, len
)
3299 register char *addr
;
3302 char buf
[16 * 1024];
3303 register char *p
, *end
;
3305 if (!EQ (current_buffer
->selective_display
, Qt
))
3306 return write (desc
, addr
, len
) - len
;
3310 end
= p
+ sizeof buf
;
3315 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3324 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3330 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3331 Sverify_visited_file_modtime
, 1, 1, 0,
3332 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3333 This means that the file has not been changed since it was visited or saved.")
3339 Lisp_Object handler
;
3341 CHECK_BUFFER (buf
, 0);
3344 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3345 if (b
->modtime
== 0) return Qt
;
3347 /* If the file name has special constructs in it,
3348 call the corresponding file handler. */
3349 handler
= Ffind_file_name_handler (b
->filename
,
3350 Qverify_visited_file_modtime
);
3351 if (!NILP (handler
))
3352 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3354 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3356 /* If the file doesn't exist now and didn't exist before,
3357 we say that it isn't modified, provided the error is a tame one. */
3358 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3363 if (st
.st_mtime
== b
->modtime
3364 /* If both are positive, accept them if they are off by one second. */
3365 || (st
.st_mtime
> 0 && b
->modtime
> 0
3366 && (st
.st_mtime
== b
->modtime
+ 1
3367 || st
.st_mtime
== b
->modtime
- 1)))
3372 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3373 Sclear_visited_file_modtime
, 0, 0, 0,
3374 "Clear out records of last mod time of visited file.\n\
3375 Next attempt to save will certainly not complain of a discrepancy.")
3378 current_buffer
->modtime
= 0;
3382 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3383 Svisited_file_modtime
, 0, 0, 0,
3384 "Return the current buffer's recorded visited file modification time.\n\
3385 The value is a list of the form (HIGH . LOW), like the time values\n\
3386 that `file-attributes' returns.")
3389 return long_to_cons (current_buffer
->modtime
);
3392 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3393 Sset_visited_file_modtime
, 0, 1, 0,
3394 "Update buffer's recorded modification time from the visited file's time.\n\
3395 Useful if the buffer was not read from the file normally\n\
3396 or if the file itself has been changed for some known benign reason.\n\
3397 An argument specifies the modification time value to use\n\
3398 \(instead of that of the visited file), in the form of a list\n\
3399 \(HIGH . LOW) or (HIGH LOW).")
3401 Lisp_Object time_list
;
3403 if (!NILP (time_list
))
3404 current_buffer
->modtime
= cons_to_long (time_list
);
3407 register Lisp_Object filename
;
3409 Lisp_Object handler
;
3411 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3413 /* If the file name has special constructs in it,
3414 call the corresponding file handler. */
3415 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3416 if (!NILP (handler
))
3417 /* The handler can find the file name the same way we did. */
3418 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3419 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3420 current_buffer
->modtime
= st
.st_mtime
;
3429 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3432 message ("Autosaving...error for %s", name
);
3433 Fsleep_for (make_number (1), Qnil
);
3434 message ("Autosaving...error!for %s", name
);
3435 Fsleep_for (make_number (1), Qnil
);
3436 message ("Autosaving...error for %s", name
);
3437 Fsleep_for (make_number (1), Qnil
);
3447 /* Get visited file's mode to become the auto save file's mode. */
3448 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3449 /* But make sure we can overwrite it later! */
3450 auto_save_mode_bits
= st
.st_mode
| 0600;
3452 auto_save_mode_bits
= 0666;
3455 Fwrite_region (Qnil
, Qnil
,
3456 current_buffer
->auto_save_file_name
,
3460 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3461 "Auto-save all buffers that need it.\n\
3462 This is all buffers that have auto-saving enabled\n\
3463 and are changed since last auto-saved.\n\
3464 Auto-saving writes the buffer into a file\n\
3465 so that your editing is not lost if the system crashes.\n\
3466 This file is not the file you visited; that changes only when you save.\n\
3467 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3468 Non-nil first argument means do not print any message if successful.\n\
3469 Non-nil second argument means save only current buffer.")
3470 (no_message
, current_only
)
3471 Lisp_Object no_message
, current_only
;
3473 struct buffer
*old
= current_buffer
, *b
;
3474 Lisp_Object tail
, buf
;
3476 char *omessage
= echo_area_glyphs
;
3477 int omessage_length
= echo_area_glyphs_length
;
3478 extern int minibuf_level
;
3479 int do_handled_files
;
3482 /* Ordinarily don't quit within this function,
3483 but don't make it impossible to quit (in case we get hung in I/O). */
3487 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3488 point to non-strings reached from Vbuffer_alist. */
3494 if (!NILP (Vrun_hooks
))
3495 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3497 /* First, save all files which don't have handlers. If Emacs is
3498 crashing, the handlers may tweak what is causing Emacs to crash
3499 in the first place, and it would be a shame if Emacs failed to
3500 autosave perfectly ordinary files because it couldn't handle some
3502 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3503 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3504 tail
= XCONS (tail
)->cdr
)
3506 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3509 if (!NILP (current_only
)
3510 && b
!= current_buffer
)
3513 /* Check for auto save enabled
3514 and file changed since last auto save
3515 and file changed since last real save. */
3516 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3517 && b
->save_modified
< BUF_MODIFF (b
)
3518 && b
->auto_save_modified
< BUF_MODIFF (b
)
3519 /* -1 means we've turned off autosaving for a while--see below. */
3520 && XINT (b
->save_length
) >= 0
3521 && (do_handled_files
3522 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3525 EMACS_TIME before_time
, after_time
;
3527 EMACS_GET_TIME (before_time
);
3529 /* If we had a failure, don't try again for 20 minutes. */
3530 if (b
->auto_save_failure_time
>= 0
3531 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3534 if ((XFASTINT (b
->save_length
) * 10
3535 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3536 /* A short file is likely to change a large fraction;
3537 spare the user annoying messages. */
3538 && XFASTINT (b
->save_length
) > 5000
3539 /* These messages are frequent and annoying for `*mail*'. */
3540 && !EQ (b
->filename
, Qnil
)
3541 && NILP (no_message
))
3543 /* It has shrunk too much; turn off auto-saving here. */
3544 message ("Buffer %s has shrunk a lot; auto save turned off there",
3545 XSTRING (b
->name
)->data
);
3546 /* Turn off auto-saving until there's a real save,
3547 and prevent any more warnings. */
3548 XSET (b
->save_length
, Lisp_Int
, -1);
3549 Fsleep_for (make_number (1), Qnil
);
3552 set_buffer_internal (b
);
3553 if (!auto_saved
&& NILP (no_message
))
3554 message1 ("Auto-saving...");
3555 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3557 b
->auto_save_modified
= BUF_MODIFF (b
);
3558 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3559 set_buffer_internal (old
);
3561 EMACS_GET_TIME (after_time
);
3563 /* If auto-save took more than 60 seconds,
3564 assume it was an NFS failure that got a timeout. */
3565 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3566 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3570 /* Prevent another auto save till enough input events come in. */
3571 record_auto_save ();
3573 if (auto_saved
&& NILP (no_message
))
3576 message2 (omessage
, omessage_length
);
3578 message1 ("Auto-saving...done");
3587 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3588 Sset_buffer_auto_saved
, 0, 0, 0,
3589 "Mark current buffer as auto-saved with its current text.\n\
3590 No auto-save file will be written until the buffer changes again.")
3593 current_buffer
->auto_save_modified
= MODIFF
;
3594 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3595 current_buffer
->auto_save_failure_time
= -1;
3599 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3600 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3601 "Clear any record of a recent auto-save failure in the current buffer.")
3604 current_buffer
->auto_save_failure_time
= -1;
3608 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3610 "Return t if buffer has been auto-saved since last read in or saved.")
3613 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3616 /* Reading and completing file names */
3617 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3619 /* In the string VAL, change each $ to $$ and return the result. */
3622 double_dollars (val
)
3625 register unsigned char *old
, *new;
3629 osize
= XSTRING (val
)->size
;
3630 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3631 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3632 if (*old
++ == '$') count
++;
3635 old
= XSTRING (val
)->data
;
3636 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3637 new = XSTRING (val
)->data
;
3638 for (n
= osize
; n
> 0; n
--)
3651 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3653 "Internal subroutine for read-file-name. Do not call this.")
3654 (string
, dir
, action
)
3655 Lisp_Object string
, dir
, action
;
3656 /* action is nil for complete, t for return list of completions,
3657 lambda for verify final value */
3659 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3661 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3668 /* No need to protect ACTION--we only compare it with t and nil. */
3669 GCPRO4 (string
, realdir
, name
, specdir
);
3671 if (XSTRING (string
)->size
== 0)
3673 if (EQ (action
, Qlambda
))
3681 orig_string
= string
;
3682 string
= Fsubstitute_in_file_name (string
);
3683 changed
= NILP (Fstring_equal (string
, orig_string
));
3684 name
= Ffile_name_nondirectory (string
);
3685 val
= Ffile_name_directory (string
);
3687 realdir
= Fexpand_file_name (val
, realdir
);
3692 specdir
= Ffile_name_directory (string
);
3693 val
= Ffile_name_completion (name
, realdir
);
3695 if (XTYPE (val
) != Lisp_String
)
3702 if (!NILP (specdir
))
3703 val
= concat2 (specdir
, val
);
3705 return double_dollars (val
);
3708 #endif /* not VMS */
3712 if (EQ (action
, Qt
))
3713 return Ffile_name_all_completions (name
, realdir
);
3714 /* Only other case actually used is ACTION = lambda */
3716 /* Supposedly this helps commands such as `cd' that read directory names,
3717 but can someone explain how it helps them? -- RMS */
3718 if (XSTRING (name
)->size
== 0)
3721 return Ffile_exists_p (string
);
3724 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3725 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3726 Value is not expanded---you must call `expand-file-name' yourself.\n\
3727 Default name to DEFAULT if user enters a null string.\n\
3728 (If DEFAULT is omitted, the visited file name is used.)\n\
3729 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3730 Non-nil and non-t means also require confirmation after completion.\n\
3731 Fifth arg INITIAL specifies text to start with.\n\
3732 DIR defaults to current buffer's directory default.")
3733 (prompt
, dir
, defalt
, mustmatch
, initial
)
3734 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3736 Lisp_Object val
, insdef
, insdef1
, tem
;
3737 struct gcpro gcpro1
, gcpro2
;
3738 register char *homedir
;
3742 dir
= current_buffer
->directory
;
3744 defalt
= current_buffer
->filename
;
3746 /* If dir starts with user's homedir, change that to ~. */
3747 homedir
= (char *) egetenv ("HOME");
3749 && XTYPE (dir
) == Lisp_String
3750 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3751 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3753 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3754 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3755 XSTRING (dir
)->data
[0] = '~';
3758 if (insert_default_directory
)
3761 if (!NILP (initial
))
3763 Lisp_Object args
[2], pos
;
3767 insdef
= Fconcat (2, args
);
3768 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3769 insdef1
= Fcons (double_dollars (insdef
), pos
);
3772 insdef1
= double_dollars (insdef
);
3774 else if (!NILP (initial
))
3777 insdef1
= Fcons (double_dollars (insdef
), 0);
3780 insdef
= Qnil
, insdef1
= Qnil
;
3783 count
= specpdl_ptr
- specpdl
;
3784 specbind (intern ("completion-ignore-case"), Qt
);
3787 GCPRO2 (insdef
, defalt
);
3788 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3789 dir
, mustmatch
, insdef1
,
3790 Qfile_name_history
);
3793 unbind_to (count
, Qnil
);
3798 error ("No file name specified");
3799 tem
= Fstring_equal (val
, insdef
);
3800 if (!NILP (tem
) && !NILP (defalt
))
3802 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3807 error ("No default file name");
3809 return Fsubstitute_in_file_name (val
);
3812 #if 0 /* Old version */
3813 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3814 /* Don't confuse make-docfile by having two doc strings for this function.
3815 make-docfile does not pay attention to #if, for good reason! */
3817 (prompt
, dir
, defalt
, mustmatch
, initial
)
3818 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3820 Lisp_Object val
, insdef
, tem
;
3821 struct gcpro gcpro1
, gcpro2
;
3822 register char *homedir
;
3826 dir
= current_buffer
->directory
;
3828 defalt
= current_buffer
->filename
;
3830 /* If dir starts with user's homedir, change that to ~. */
3831 homedir
= (char *) egetenv ("HOME");
3833 && XTYPE (dir
) == Lisp_String
3834 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3835 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3837 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3838 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3839 XSTRING (dir
)->data
[0] = '~';
3842 if (!NILP (initial
))
3844 else if (insert_default_directory
)
3847 insdef
= build_string ("");
3850 count
= specpdl_ptr
- specpdl
;
3851 specbind (intern ("completion-ignore-case"), Qt
);
3854 GCPRO2 (insdef
, defalt
);
3855 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3857 insert_default_directory
? insdef
: Qnil
,
3858 Qfile_name_history
);
3861 unbind_to (count
, Qnil
);
3866 error ("No file name specified");
3867 tem
= Fstring_equal (val
, insdef
);
3868 if (!NILP (tem
) && !NILP (defalt
))
3870 return Fsubstitute_in_file_name (val
);
3872 #endif /* Old version */
3876 Qexpand_file_name
= intern ("expand-file-name");
3877 Qdirectory_file_name
= intern ("directory-file-name");
3878 Qfile_name_directory
= intern ("file-name-directory");
3879 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3880 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3881 Qfile_name_as_directory
= intern ("file-name-as-directory");
3882 Qcopy_file
= intern ("copy-file");
3883 Qmake_directory
= intern ("make-directory");
3884 Qdelete_directory
= intern ("delete-directory");
3885 Qdelete_file
= intern ("delete-file");
3886 Qrename_file
= intern ("rename-file");
3887 Qadd_name_to_file
= intern ("add-name-to-file");
3888 Qmake_symbolic_link
= intern ("make-symbolic-link");
3889 Qfile_exists_p
= intern ("file-exists-p");
3890 Qfile_executable_p
= intern ("file-executable-p");
3891 Qfile_readable_p
= intern ("file-readable-p");
3892 Qfile_symlink_p
= intern ("file-symlink-p");
3893 Qfile_writable_p
= intern ("file-writable-p");
3894 Qfile_directory_p
= intern ("file-directory-p");
3895 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3896 Qfile_modes
= intern ("file-modes");
3897 Qset_file_modes
= intern ("set-file-modes");
3898 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3899 Qinsert_file_contents
= intern ("insert-file-contents");
3900 Qwrite_region
= intern ("write-region");
3901 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3902 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3904 staticpro (&Qexpand_file_name
);
3905 staticpro (&Qdirectory_file_name
);
3906 staticpro (&Qfile_name_directory
);
3907 staticpro (&Qfile_name_nondirectory
);
3908 staticpro (&Qunhandled_file_name_directory
);
3909 staticpro (&Qfile_name_as_directory
);
3910 staticpro (&Qcopy_file
);
3911 staticpro (&Qmake_directory
);
3912 staticpro (&Qdelete_directory
);
3913 staticpro (&Qdelete_file
);
3914 staticpro (&Qrename_file
);
3915 staticpro (&Qadd_name_to_file
);
3916 staticpro (&Qmake_symbolic_link
);
3917 staticpro (&Qfile_exists_p
);
3918 staticpro (&Qfile_executable_p
);
3919 staticpro (&Qfile_readable_p
);
3920 staticpro (&Qfile_symlink_p
);
3921 staticpro (&Qfile_writable_p
);
3922 staticpro (&Qfile_directory_p
);
3923 staticpro (&Qfile_accessible_directory_p
);
3924 staticpro (&Qfile_modes
);
3925 staticpro (&Qset_file_modes
);
3926 staticpro (&Qfile_newer_than_file_p
);
3927 staticpro (&Qinsert_file_contents
);
3928 staticpro (&Qwrite_region
);
3929 staticpro (&Qverify_visited_file_modtime
);
3931 Qfile_name_history
= intern ("file-name-history");
3932 Fset (Qfile_name_history
, Qnil
);
3933 staticpro (&Qfile_name_history
);
3935 Qfile_error
= intern ("file-error");
3936 staticpro (&Qfile_error
);
3937 Qfile_already_exists
= intern("file-already-exists");
3938 staticpro (&Qfile_already_exists
);
3941 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
3942 staticpro (&Qfind_buffer_file_type
);
3945 Qcar_less_than_car
= intern ("car-less-than-car");
3946 staticpro (&Qcar_less_than_car
);
3948 Fput (Qfile_error
, Qerror_conditions
,
3949 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3950 Fput (Qfile_error
, Qerror_message
,
3951 build_string ("File error"));
3953 Fput (Qfile_already_exists
, Qerror_conditions
,
3954 Fcons (Qfile_already_exists
,
3955 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3956 Fput (Qfile_already_exists
, Qerror_message
,
3957 build_string ("File already exists"));
3959 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3960 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3961 insert_default_directory
= 1;
3963 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3964 "*Non-nil means write new files with record format `stmlf'.\n\
3965 nil means use format `var'. This variable is meaningful only on VMS.");
3966 vms_stmlf_recfm
= 0;
3968 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3969 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3970 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3973 The first argument given to HANDLER is the name of the I/O primitive\n\
3974 to be handled; the remaining arguments are the arguments that were\n\
3975 passed to that primitive. For example, if you do\n\
3976 (file-exists-p FILENAME)\n\
3977 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3978 (funcall HANDLER 'file-exists-p FILENAME)\n\
3979 The function `find-file-name-handler' checks this list for a handler\n\
3980 for its argument.");
3981 Vfile_name_handler_alist
= Qnil
;
3983 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
3984 "A list of functions to be called at the end of `insert-file-contents'.\n\
3985 Each is passed one argument, the number of bytes inserted. It should return\n\
3986 the new byte count, and leave point the same. If `insert-file-contents' is\n\
3987 intercepted by a handler from `file-name-handler-alist', that handler is\n\
3988 responsible for calling the after-insert-file-functions if appropriate.");
3989 Vafter_insert_file_functions
= Qnil
;
3991 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
3992 "A list of functions to be called at the start of `write-region'.\n\
3993 Each is passed two arguments, START and END as for `write-region'. It should\n\
3994 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
3995 inserted at the specified positions of the file being written (1 means to\n\
3996 insert before the first byte written). The POSITIONs must be sorted into\n\
3997 increasing order. If there are several functions in the list, the several\n\
3998 lists are merged destructively.");
3999 Vwrite_region_annotate_functions
= Qnil
;
4001 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4002 "A list of file names for which handlers should not be used.\n\
4003 This applies only to the operation `inhibit-file-name-handlers'.");
4004 Vinhibit_file_name_handlers
= Qnil
;
4006 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4007 "The operation for which `inhibit-file-name-handlers' is applicable.");
4008 Vinhibit_file_name_operation
= Qnil
;
4010 defsubr (&Sfind_file_name_handler
);
4011 defsubr (&Sfile_name_directory
);
4012 defsubr (&Sfile_name_nondirectory
);
4013 defsubr (&Sunhandled_file_name_directory
);
4014 defsubr (&Sfile_name_as_directory
);
4015 defsubr (&Sdirectory_file_name
);
4016 defsubr (&Smake_temp_name
);
4017 defsubr (&Sexpand_file_name
);
4018 defsubr (&Ssubstitute_in_file_name
);
4019 defsubr (&Scopy_file
);
4020 defsubr (&Smake_directory_internal
);
4021 defsubr (&Sdelete_directory
);
4022 defsubr (&Sdelete_file
);
4023 defsubr (&Srename_file
);
4024 defsubr (&Sadd_name_to_file
);
4026 defsubr (&Smake_symbolic_link
);
4027 #endif /* S_IFLNK */
4029 defsubr (&Sdefine_logical_name
);
4032 defsubr (&Ssysnetunam
);
4033 #endif /* HPUX_NET */
4034 defsubr (&Sfile_name_absolute_p
);
4035 defsubr (&Sfile_exists_p
);
4036 defsubr (&Sfile_executable_p
);
4037 defsubr (&Sfile_readable_p
);
4038 defsubr (&Sfile_writable_p
);
4039 defsubr (&Sfile_symlink_p
);
4040 defsubr (&Sfile_directory_p
);
4041 defsubr (&Sfile_accessible_directory_p
);
4042 defsubr (&Sfile_modes
);
4043 defsubr (&Sset_file_modes
);
4044 defsubr (&Sset_default_file_modes
);
4045 defsubr (&Sdefault_file_modes
);
4046 defsubr (&Sfile_newer_than_file_p
);
4047 defsubr (&Sinsert_file_contents
);
4048 defsubr (&Swrite_region
);
4049 defsubr (&Scar_less_than_car
);
4050 defsubr (&Sverify_visited_file_modtime
);
4051 defsubr (&Sclear_visited_file_modtime
);
4052 defsubr (&Svisited_file_modtime
);
4053 defsubr (&Sset_visited_file_modtime
);
4054 defsubr (&Sdo_auto_save
);
4055 defsubr (&Sset_buffer_auto_saved
);
4056 defsubr (&Sclear_buffer_auto_save_failure
);
4057 defsubr (&Srecent_auto_save_p
);
4059 defsubr (&Sread_file_name_internal
);
4060 defsubr (&Sread_file_name
);
4063 defsubr (&Sunix_sync
);