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 code
= call1 (Qfind_buffer_file_type
, filename
);
2801 if (XTYPE (code
) == Lisp_Int
)
2802 XFASTINT (current_buffer
->buffer_file_type
) = XFASTINT (code
);
2803 if (XFASTINT (current_buffer
->buffer_file_type
) == 0)
2806 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2809 GPT
-= reduced_size
;
2810 GAP_SIZE
+= reduced_size
;
2811 inserted
-= reduced_size
;
2818 record_insert (point
, inserted
);
2820 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2821 offset_intervals (current_buffer
, point
, inserted
);
2827 /* Discard the unwind protect for closing the file. */
2831 error ("IO error reading %s: %s",
2832 XSTRING (filename
)->data
, strerror (errno
));
2839 if (!EQ (current_buffer
->undo_list
, Qt
))
2840 current_buffer
->undo_list
= Qnil
;
2842 stat (XSTRING (filename
)->data
, &st
);
2847 current_buffer
->modtime
= st
.st_mtime
;
2848 current_buffer
->filename
= filename
;
2851 current_buffer
->save_modified
= MODIFF
;
2852 current_buffer
->auto_save_modified
= MODIFF
;
2853 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2854 #ifdef CLASH_DETECTION
2857 if (!NILP (current_buffer
->filename
))
2858 unlock_file (current_buffer
->filename
);
2859 unlock_file (filename
);
2861 #endif /* CLASH_DETECTION */
2862 /* If visiting nonexistent file, return nil. */
2863 if (current_buffer
->modtime
== -1)
2864 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2867 if (inserted
> 0 && NILP (visit
) && total
> 0)
2868 signal_after_change (point
, 0, inserted
);
2872 p
= Vafter_insert_file_functions
;
2875 insval
= call1 (Fcar (p
), make_number (inserted
));
2878 CHECK_NUMBER (insval
, 0);
2879 inserted
= XFASTINT (insval
);
2887 val
= Fcons (filename
,
2888 Fcons (make_number (inserted
),
2891 RETURN_UNGCPRO (unbind_to (count
, val
));
2894 static Lisp_Object
build_annotations ();
2896 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2897 "r\nFWrite region to file: ",
2898 "Write current region into specified file.\n\
2899 When called from a program, takes three arguments:\n\
2900 START, END and FILENAME. START and END are buffer positions.\n\
2901 Optional fourth argument APPEND if non-nil means\n\
2902 append to existing file contents (if any).\n\
2903 Optional fifth argument VISIT if t means\n\
2904 set the last-save-file-modtime of buffer to this file's modtime\n\
2905 and mark buffer not modified.\n\
2906 If VISIT is a string, it is a second file name;\n\
2907 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2908 VISIT is also the file name to lock and unlock for clash detection.\n\
2909 If VISIT is neither t nor nil nor a string,\n\
2910 that means do not print the \"Wrote file\" message.\n\
2911 Kludgy feature: if START is a string, then that string is written\n\
2912 to the file, instead of any buffer contents, and END is ignored.")
2913 (start
, end
, filename
, append
, visit
)
2914 Lisp_Object start
, end
, filename
, append
, visit
;
2922 int count
= specpdl_ptr
- specpdl
;
2924 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2926 Lisp_Object handler
;
2927 Lisp_Object visit_file
;
2928 Lisp_Object annotations
;
2929 int visiting
, quietly
;
2930 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2932 int buffer_file_type
2933 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2936 if (!NILP (start
) && !STRINGP (start
))
2937 validate_region (&start
, &end
);
2939 filename
= Fexpand_file_name (filename
, Qnil
);
2940 if (STRINGP (visit
))
2941 visit_file
= Fexpand_file_name (visit
, Qnil
);
2943 visit_file
= filename
;
2945 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2946 quietly
= !NILP (visit
);
2950 GCPRO4 (start
, filename
, annotations
, visit_file
);
2952 /* If the file name has special constructs in it,
2953 call the corresponding file handler. */
2954 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
2955 /* If FILENAME has no handler, see if VISIT has one. */
2956 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2957 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
2959 if (!NILP (handler
))
2962 val
= call6 (handler
, Qwrite_region
, start
, end
,
2963 filename
, append
, visit
);
2967 current_buffer
->save_modified
= MODIFF
;
2968 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2969 current_buffer
->filename
= visit_file
;
2975 /* Special kludge to simplify auto-saving. */
2978 XFASTINT (start
) = BEG
;
2982 annotations
= build_annotations (start
, end
);
2984 #ifdef CLASH_DETECTION
2986 lock_file (visit_file
);
2987 #endif /* CLASH_DETECTION */
2989 fn
= XSTRING (filename
)->data
;
2993 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
2995 desc
= open (fn
, O_WRONLY
);
3000 if (auto_saving
) /* Overwrite any previous version of autosave file */
3002 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3003 desc
= open (fn
, O_RDWR
);
3005 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3006 ? XSTRING (current_buffer
->filename
)->data
: 0,
3009 else /* Write to temporary name and rename if no errors */
3011 Lisp_Object temp_name
;
3012 temp_name
= Ffile_name_directory (filename
);
3014 if (!NILP (temp_name
))
3016 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3017 build_string ("$$SAVE$$")));
3018 fname
= XSTRING (filename
)->data
;
3019 fn
= XSTRING (temp_name
)->data
;
3020 desc
= creat_copy_attrs (fname
, fn
);
3023 /* If we can't open the temporary file, try creating a new
3024 version of the original file. VMS "creat" creates a
3025 new version rather than truncating an existing file. */
3028 desc
= creat (fn
, 0666);
3029 #if 0 /* This can clobber an existing file and fail to replace it,
3030 if the user runs out of space. */
3033 /* We can't make a new version;
3034 try to truncate and rewrite existing version if any. */
3036 desc
= open (fn
, O_RDWR
);
3042 desc
= creat (fn
, 0666);
3047 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3048 S_IREAD
| S_IWRITE
);
3049 #else /* not MSDOS */
3050 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3051 #endif /* not MSDOS */
3052 #endif /* not VMS */
3058 #ifdef CLASH_DETECTION
3060 if (!auto_saving
) unlock_file (visit_file
);
3062 #endif /* CLASH_DETECTION */
3063 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3066 record_unwind_protect (close_file_unwind
, make_number (desc
));
3069 if (lseek (desc
, 0, 2) < 0)
3071 #ifdef CLASH_DETECTION
3072 if (!auto_saving
) unlock_file (visit_file
);
3073 #endif /* CLASH_DETECTION */
3074 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3079 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3080 * if we do writes that don't end with a carriage return. Furthermore
3081 * it cannot handle writes of more then 16K. The modified
3082 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3083 * this EXCEPT for the last record (iff it doesn't end with a carriage
3084 * return). This implies that if your buffer doesn't end with a carriage
3085 * return, you get one free... tough. However it also means that if
3086 * we make two calls to sys_write (a la the following code) you can
3087 * get one at the gap as well. The easiest way to fix this (honest)
3088 * is to move the gap to the next newline (or the end of the buffer).
3093 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3094 move_gap (find_next_newline (GPT
, 1));
3100 if (STRINGP (start
))
3102 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3103 XSTRING (start
)->size
, 0, &annotations
);
3106 else if (XINT (start
) != XINT (end
))
3109 if (XINT (start
) < GPT
)
3111 register int end1
= XINT (end
);
3113 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3114 min (GPT
, end1
) - tem
, tem
, &annotations
);
3115 nwritten
+= min (GPT
, end1
) - tem
;
3119 if (XINT (end
) > GPT
&& !failure
)
3122 tem
= max (tem
, GPT
);
3123 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3125 nwritten
+= XINT (end
) - tem
;
3131 /* If file was empty, still need to write the annotations */
3132 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3140 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3141 Disk full in NFS may be reported here. */
3142 /* mib says that closing the file will try to write as fast as NFS can do
3143 it, and that means the fsync here is not crucial for autosave files. */
3144 if (!auto_saving
&& fsync (desc
) < 0)
3145 failure
= 1, save_errno
= errno
;
3148 /* Spurious "file has changed on disk" warnings have been
3149 observed on Suns as well.
3150 It seems that `close' can change the modtime, under nfs.
3152 (This has supposedly been fixed in Sunos 4,
3153 but who knows about all the other machines with NFS?) */
3156 /* On VMS and APOLLO, must do the stat after the close
3157 since closing changes the modtime. */
3160 /* Recall that #if defined does not work on VMS. */
3167 /* NFS can report a write failure now. */
3168 if (close (desc
) < 0)
3169 failure
= 1, save_errno
= errno
;
3172 /* If we wrote to a temporary name and had no errors, rename to real name. */
3176 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3184 /* Discard the unwind protect */
3185 specpdl_ptr
= specpdl
+ count
;
3187 #ifdef CLASH_DETECTION
3189 unlock_file (visit_file
);
3190 #endif /* CLASH_DETECTION */
3192 /* Do this before reporting IO error
3193 to avoid a "file has changed on disk" warning on
3194 next attempt to save. */
3196 current_buffer
->modtime
= st
.st_mtime
;
3199 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3203 current_buffer
->save_modified
= MODIFF
;
3204 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3205 current_buffer
->filename
= visit_file
;
3211 message ("Wrote %s", XSTRING (visit_file
)->data
);
3216 Lisp_Object
merge ();
3218 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3219 "Return t if (car A) is numerically less than (car B).")
3223 return Flss (Fcar (a
), Fcar (b
));
3226 /* Build the complete list of annotations appropriate for writing out
3227 the text between START and END, by calling all the functions in
3228 write-region-annotate-functions and merging the lists they return. */
3231 build_annotations (start
, end
)
3232 Lisp_Object start
, end
;
3234 Lisp_Object annotations
;
3236 struct gcpro gcpro1
, gcpro2
;
3239 p
= Vwrite_region_annotate_functions
;
3240 GCPRO2 (annotations
, p
);
3243 res
= call2 (Fcar (p
), start
, end
);
3244 Flength (res
); /* Check basic validity of return value */
3245 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3252 /* Write to descriptor DESC the LEN characters starting at ADDR,
3253 assuming they start at position POS in the buffer.
3254 Intersperse with them the annotations from *ANNOT
3255 (those which fall within the range of positions POS to POS + LEN),
3256 each at its appropriate position.
3258 Modify *ANNOT by discarding elements as we output them.
3259 The return value is negative in case of system call failure. */
3262 a_write (desc
, addr
, len
, pos
, annot
)
3264 register char *addr
;
3271 int lastpos
= pos
+ len
;
3275 tem
= Fcar_safe (Fcar (*annot
));
3276 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3277 nextpos
= XFASTINT (tem
);
3279 return e_write (desc
, addr
, lastpos
- pos
);
3282 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3284 addr
+= nextpos
- pos
;
3287 tem
= Fcdr (Fcar (*annot
));
3290 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3293 *annot
= Fcdr (*annot
);
3298 e_write (desc
, addr
, len
)
3300 register char *addr
;
3303 char buf
[16 * 1024];
3304 register char *p
, *end
;
3306 if (!EQ (current_buffer
->selective_display
, Qt
))
3307 return write (desc
, addr
, len
) - len
;
3311 end
= p
+ sizeof buf
;
3316 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3325 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3331 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3332 Sverify_visited_file_modtime
, 1, 1, 0,
3333 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3334 This means that the file has not been changed since it was visited or saved.")
3340 Lisp_Object handler
;
3342 CHECK_BUFFER (buf
, 0);
3345 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3346 if (b
->modtime
== 0) return Qt
;
3348 /* If the file name has special constructs in it,
3349 call the corresponding file handler. */
3350 handler
= Ffind_file_name_handler (b
->filename
,
3351 Qverify_visited_file_modtime
);
3352 if (!NILP (handler
))
3353 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3355 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3357 /* If the file doesn't exist now and didn't exist before,
3358 we say that it isn't modified, provided the error is a tame one. */
3359 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3364 if (st
.st_mtime
== b
->modtime
3365 /* If both are positive, accept them if they are off by one second. */
3366 || (st
.st_mtime
> 0 && b
->modtime
> 0
3367 && (st
.st_mtime
== b
->modtime
+ 1
3368 || st
.st_mtime
== b
->modtime
- 1)))
3373 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3374 Sclear_visited_file_modtime
, 0, 0, 0,
3375 "Clear out records of last mod time of visited file.\n\
3376 Next attempt to save will certainly not complain of a discrepancy.")
3379 current_buffer
->modtime
= 0;
3383 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3384 Svisited_file_modtime
, 0, 0, 0,
3385 "Return the current buffer's recorded visited file modification time.\n\
3386 The value is a list of the form (HIGH . LOW), like the time values\n\
3387 that `file-attributes' returns.")
3390 return long_to_cons (current_buffer
->modtime
);
3393 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3394 Sset_visited_file_modtime
, 0, 1, 0,
3395 "Update buffer's recorded modification time from the visited file's time.\n\
3396 Useful if the buffer was not read from the file normally\n\
3397 or if the file itself has been changed for some known benign reason.\n\
3398 An argument specifies the modification time value to use\n\
3399 \(instead of that of the visited file), in the form of a list\n\
3400 \(HIGH . LOW) or (HIGH LOW).")
3402 Lisp_Object time_list
;
3404 if (!NILP (time_list
))
3405 current_buffer
->modtime
= cons_to_long (time_list
);
3408 register Lisp_Object filename
;
3410 Lisp_Object handler
;
3412 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3414 /* If the file name has special constructs in it,
3415 call the corresponding file handler. */
3416 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3417 if (!NILP (handler
))
3418 /* The handler can find the file name the same way we did. */
3419 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3420 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3421 current_buffer
->modtime
= st
.st_mtime
;
3430 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3433 message ("Autosaving...error for %s", name
);
3434 Fsleep_for (make_number (1), Qnil
);
3435 message ("Autosaving...error!for %s", name
);
3436 Fsleep_for (make_number (1), Qnil
);
3437 message ("Autosaving...error for %s", name
);
3438 Fsleep_for (make_number (1), Qnil
);
3448 /* Get visited file's mode to become the auto save file's mode. */
3449 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3450 /* But make sure we can overwrite it later! */
3451 auto_save_mode_bits
= st
.st_mode
| 0600;
3453 auto_save_mode_bits
= 0666;
3456 Fwrite_region (Qnil
, Qnil
,
3457 current_buffer
->auto_save_file_name
,
3461 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3462 "Auto-save all buffers that need it.\n\
3463 This is all buffers that have auto-saving enabled\n\
3464 and are changed since last auto-saved.\n\
3465 Auto-saving writes the buffer into a file\n\
3466 so that your editing is not lost if the system crashes.\n\
3467 This file is not the file you visited; that changes only when you save.\n\
3468 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3469 Non-nil first argument means do not print any message if successful.\n\
3470 Non-nil second argument means save only current buffer.")
3471 (no_message
, current_only
)
3472 Lisp_Object no_message
, current_only
;
3474 struct buffer
*old
= current_buffer
, *b
;
3475 Lisp_Object tail
, buf
;
3477 char *omessage
= echo_area_glyphs
;
3478 int omessage_length
= echo_area_glyphs_length
;
3479 extern int minibuf_level
;
3480 int do_handled_files
;
3483 /* Ordinarily don't quit within this function,
3484 but don't make it impossible to quit (in case we get hung in I/O). */
3488 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3489 point to non-strings reached from Vbuffer_alist. */
3495 if (!NILP (Vrun_hooks
))
3496 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3498 /* First, save all files which don't have handlers. If Emacs is
3499 crashing, the handlers may tweak what is causing Emacs to crash
3500 in the first place, and it would be a shame if Emacs failed to
3501 autosave perfectly ordinary files because it couldn't handle some
3503 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3504 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3505 tail
= XCONS (tail
)->cdr
)
3507 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3510 if (!NILP (current_only
)
3511 && b
!= current_buffer
)
3514 /* Check for auto save enabled
3515 and file changed since last auto save
3516 and file changed since last real save. */
3517 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3518 && b
->save_modified
< BUF_MODIFF (b
)
3519 && b
->auto_save_modified
< BUF_MODIFF (b
)
3520 /* -1 means we've turned off autosaving for a while--see below. */
3521 && XINT (b
->save_length
) >= 0
3522 && (do_handled_files
3523 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3526 EMACS_TIME before_time
, after_time
;
3528 EMACS_GET_TIME (before_time
);
3530 /* If we had a failure, don't try again for 20 minutes. */
3531 if (b
->auto_save_failure_time
>= 0
3532 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3535 if ((XFASTINT (b
->save_length
) * 10
3536 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3537 /* A short file is likely to change a large fraction;
3538 spare the user annoying messages. */
3539 && XFASTINT (b
->save_length
) > 5000
3540 /* These messages are frequent and annoying for `*mail*'. */
3541 && !EQ (b
->filename
, Qnil
)
3542 && NILP (no_message
))
3544 /* It has shrunk too much; turn off auto-saving here. */
3545 message ("Buffer %s has shrunk a lot; auto save turned off there",
3546 XSTRING (b
->name
)->data
);
3547 /* Turn off auto-saving until there's a real save,
3548 and prevent any more warnings. */
3549 XSET (b
->save_length
, Lisp_Int
, -1);
3550 Fsleep_for (make_number (1), Qnil
);
3553 set_buffer_internal (b
);
3554 if (!auto_saved
&& NILP (no_message
))
3555 message1 ("Auto-saving...");
3556 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3558 b
->auto_save_modified
= BUF_MODIFF (b
);
3559 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3560 set_buffer_internal (old
);
3562 EMACS_GET_TIME (after_time
);
3564 /* If auto-save took more than 60 seconds,
3565 assume it was an NFS failure that got a timeout. */
3566 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3567 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3571 /* Prevent another auto save till enough input events come in. */
3572 record_auto_save ();
3574 if (auto_saved
&& NILP (no_message
))
3577 message2 (omessage
, omessage_length
);
3579 message1 ("Auto-saving...done");
3588 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3589 Sset_buffer_auto_saved
, 0, 0, 0,
3590 "Mark current buffer as auto-saved with its current text.\n\
3591 No auto-save file will be written until the buffer changes again.")
3594 current_buffer
->auto_save_modified
= MODIFF
;
3595 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3596 current_buffer
->auto_save_failure_time
= -1;
3600 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3601 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3602 "Clear any record of a recent auto-save failure in the current buffer.")
3605 current_buffer
->auto_save_failure_time
= -1;
3609 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3611 "Return t if buffer has been auto-saved since last read in or saved.")
3614 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3617 /* Reading and completing file names */
3618 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3620 /* In the string VAL, change each $ to $$ and return the result. */
3623 double_dollars (val
)
3626 register unsigned char *old
, *new;
3630 osize
= XSTRING (val
)->size
;
3631 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3632 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3633 if (*old
++ == '$') count
++;
3636 old
= XSTRING (val
)->data
;
3637 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3638 new = XSTRING (val
)->data
;
3639 for (n
= osize
; n
> 0; n
--)
3652 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3654 "Internal subroutine for read-file-name. Do not call this.")
3655 (string
, dir
, action
)
3656 Lisp_Object string
, dir
, action
;
3657 /* action is nil for complete, t for return list of completions,
3658 lambda for verify final value */
3660 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3662 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3669 /* No need to protect ACTION--we only compare it with t and nil. */
3670 GCPRO4 (string
, realdir
, name
, specdir
);
3672 if (XSTRING (string
)->size
== 0)
3674 if (EQ (action
, Qlambda
))
3682 orig_string
= string
;
3683 string
= Fsubstitute_in_file_name (string
);
3684 changed
= NILP (Fstring_equal (string
, orig_string
));
3685 name
= Ffile_name_nondirectory (string
);
3686 val
= Ffile_name_directory (string
);
3688 realdir
= Fexpand_file_name (val
, realdir
);
3693 specdir
= Ffile_name_directory (string
);
3694 val
= Ffile_name_completion (name
, realdir
);
3696 if (XTYPE (val
) != Lisp_String
)
3703 if (!NILP (specdir
))
3704 val
= concat2 (specdir
, val
);
3706 return double_dollars (val
);
3709 #endif /* not VMS */
3713 if (EQ (action
, Qt
))
3714 return Ffile_name_all_completions (name
, realdir
);
3715 /* Only other case actually used is ACTION = lambda */
3717 /* Supposedly this helps commands such as `cd' that read directory names,
3718 but can someone explain how it helps them? -- RMS */
3719 if (XSTRING (name
)->size
== 0)
3722 return Ffile_exists_p (string
);
3725 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3726 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3727 Value is not expanded---you must call `expand-file-name' yourself.\n\
3728 Default name to DEFAULT if user enters a null string.\n\
3729 (If DEFAULT is omitted, the visited file name is used.)\n\
3730 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3731 Non-nil and non-t means also require confirmation after completion.\n\
3732 Fifth arg INITIAL specifies text to start with.\n\
3733 DIR defaults to current buffer's directory default.")
3734 (prompt
, dir
, defalt
, mustmatch
, initial
)
3735 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3737 Lisp_Object val
, insdef
, insdef1
, tem
;
3738 struct gcpro gcpro1
, gcpro2
;
3739 register char *homedir
;
3743 dir
= current_buffer
->directory
;
3745 defalt
= current_buffer
->filename
;
3747 /* If dir starts with user's homedir, change that to ~. */
3748 homedir
= (char *) egetenv ("HOME");
3750 && XTYPE (dir
) == Lisp_String
3751 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3752 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3754 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3755 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3756 XSTRING (dir
)->data
[0] = '~';
3759 if (insert_default_directory
)
3762 if (!NILP (initial
))
3764 Lisp_Object args
[2], pos
;
3768 insdef
= Fconcat (2, args
);
3769 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3770 insdef1
= Fcons (double_dollars (insdef
), pos
);
3773 insdef1
= double_dollars (insdef
);
3775 else if (!NILP (initial
))
3778 insdef1
= Fcons (double_dollars (insdef
), 0);
3781 insdef
= Qnil
, insdef1
= Qnil
;
3784 count
= specpdl_ptr
- specpdl
;
3785 specbind (intern ("completion-ignore-case"), Qt
);
3788 GCPRO2 (insdef
, defalt
);
3789 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3790 dir
, mustmatch
, insdef1
,
3791 Qfile_name_history
);
3794 unbind_to (count
, Qnil
);
3799 error ("No file name specified");
3800 tem
= Fstring_equal (val
, insdef
);
3801 if (!NILP (tem
) && !NILP (defalt
))
3803 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3808 error ("No default file name");
3810 return Fsubstitute_in_file_name (val
);
3813 #if 0 /* Old version */
3814 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3815 /* Don't confuse make-docfile by having two doc strings for this function.
3816 make-docfile does not pay attention to #if, for good reason! */
3818 (prompt
, dir
, defalt
, mustmatch
, initial
)
3819 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3821 Lisp_Object val
, insdef
, tem
;
3822 struct gcpro gcpro1
, gcpro2
;
3823 register char *homedir
;
3827 dir
= current_buffer
->directory
;
3829 defalt
= current_buffer
->filename
;
3831 /* If dir starts with user's homedir, change that to ~. */
3832 homedir
= (char *) egetenv ("HOME");
3834 && XTYPE (dir
) == Lisp_String
3835 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3836 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3838 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3839 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3840 XSTRING (dir
)->data
[0] = '~';
3843 if (!NILP (initial
))
3845 else if (insert_default_directory
)
3848 insdef
= build_string ("");
3851 count
= specpdl_ptr
- specpdl
;
3852 specbind (intern ("completion-ignore-case"), Qt
);
3855 GCPRO2 (insdef
, defalt
);
3856 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3858 insert_default_directory
? insdef
: Qnil
,
3859 Qfile_name_history
);
3862 unbind_to (count
, Qnil
);
3867 error ("No file name specified");
3868 tem
= Fstring_equal (val
, insdef
);
3869 if (!NILP (tem
) && !NILP (defalt
))
3871 return Fsubstitute_in_file_name (val
);
3873 #endif /* Old version */
3877 Qexpand_file_name
= intern ("expand-file-name");
3878 Qdirectory_file_name
= intern ("directory-file-name");
3879 Qfile_name_directory
= intern ("file-name-directory");
3880 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3881 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3882 Qfile_name_as_directory
= intern ("file-name-as-directory");
3883 Qcopy_file
= intern ("copy-file");
3884 Qmake_directory
= intern ("make-directory");
3885 Qdelete_directory
= intern ("delete-directory");
3886 Qdelete_file
= intern ("delete-file");
3887 Qrename_file
= intern ("rename-file");
3888 Qadd_name_to_file
= intern ("add-name-to-file");
3889 Qmake_symbolic_link
= intern ("make-symbolic-link");
3890 Qfile_exists_p
= intern ("file-exists-p");
3891 Qfile_executable_p
= intern ("file-executable-p");
3892 Qfile_readable_p
= intern ("file-readable-p");
3893 Qfile_symlink_p
= intern ("file-symlink-p");
3894 Qfile_writable_p
= intern ("file-writable-p");
3895 Qfile_directory_p
= intern ("file-directory-p");
3896 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3897 Qfile_modes
= intern ("file-modes");
3898 Qset_file_modes
= intern ("set-file-modes");
3899 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3900 Qinsert_file_contents
= intern ("insert-file-contents");
3901 Qwrite_region
= intern ("write-region");
3902 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3903 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3905 staticpro (&Qexpand_file_name
);
3906 staticpro (&Qdirectory_file_name
);
3907 staticpro (&Qfile_name_directory
);
3908 staticpro (&Qfile_name_nondirectory
);
3909 staticpro (&Qunhandled_file_name_directory
);
3910 staticpro (&Qfile_name_as_directory
);
3911 staticpro (&Qcopy_file
);
3912 staticpro (&Qmake_directory
);
3913 staticpro (&Qdelete_directory
);
3914 staticpro (&Qdelete_file
);
3915 staticpro (&Qrename_file
);
3916 staticpro (&Qadd_name_to_file
);
3917 staticpro (&Qmake_symbolic_link
);
3918 staticpro (&Qfile_exists_p
);
3919 staticpro (&Qfile_executable_p
);
3920 staticpro (&Qfile_readable_p
);
3921 staticpro (&Qfile_symlink_p
);
3922 staticpro (&Qfile_writable_p
);
3923 staticpro (&Qfile_directory_p
);
3924 staticpro (&Qfile_accessible_directory_p
);
3925 staticpro (&Qfile_modes
);
3926 staticpro (&Qset_file_modes
);
3927 staticpro (&Qfile_newer_than_file_p
);
3928 staticpro (&Qinsert_file_contents
);
3929 staticpro (&Qwrite_region
);
3930 staticpro (&Qverify_visited_file_modtime
);
3932 Qfile_name_history
= intern ("file-name-history");
3933 Fset (Qfile_name_history
, Qnil
);
3934 staticpro (&Qfile_name_history
);
3936 Qfile_error
= intern ("file-error");
3937 staticpro (&Qfile_error
);
3938 Qfile_already_exists
= intern("file-already-exists");
3939 staticpro (&Qfile_already_exists
);
3942 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
3943 staticpro (&Qfind_buffer_file_type
);
3946 Qcar_less_than_car
= intern ("car-less-than-car");
3947 staticpro (&Qcar_less_than_car
);
3949 Fput (Qfile_error
, Qerror_conditions
,
3950 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3951 Fput (Qfile_error
, Qerror_message
,
3952 build_string ("File error"));
3954 Fput (Qfile_already_exists
, Qerror_conditions
,
3955 Fcons (Qfile_already_exists
,
3956 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3957 Fput (Qfile_already_exists
, Qerror_message
,
3958 build_string ("File already exists"));
3960 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3961 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3962 insert_default_directory
= 1;
3964 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3965 "*Non-nil means write new files with record format `stmlf'.\n\
3966 nil means use format `var'. This variable is meaningful only on VMS.");
3967 vms_stmlf_recfm
= 0;
3969 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3970 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3971 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3974 The first argument given to HANDLER is the name of the I/O primitive\n\
3975 to be handled; the remaining arguments are the arguments that were\n\
3976 passed to that primitive. For example, if you do\n\
3977 (file-exists-p FILENAME)\n\
3978 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3979 (funcall HANDLER 'file-exists-p FILENAME)\n\
3980 The function `find-file-name-handler' checks this list for a handler\n\
3981 for its argument.");
3982 Vfile_name_handler_alist
= Qnil
;
3984 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
3985 "A list of functions to be called at the end of `insert-file-contents'.\n\
3986 Each is passed one argument, the number of bytes inserted. It should return\n\
3987 the new byte count, and leave point the same. If `insert-file-contents' is\n\
3988 intercepted by a handler from `file-name-handler-alist', that handler is\n\
3989 responsible for calling the after-insert-file-functions if appropriate.");
3990 Vafter_insert_file_functions
= Qnil
;
3992 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
3993 "A list of functions to be called at the start of `write-region'.\n\
3994 Each is passed two arguments, START and END as for `write-region'. It should\n\
3995 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
3996 inserted at the specified positions of the file being written (1 means to\n\
3997 insert before the first byte written). The POSITIONs must be sorted into\n\
3998 increasing order. If there are several functions in the list, the several\n\
3999 lists are merged destructively.");
4000 Vwrite_region_annotate_functions
= Qnil
;
4002 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4003 "A list of file names for which handlers should not be used.\n\
4004 This applies only to the operation `inhibit-file-name-handlers'.");
4005 Vinhibit_file_name_handlers
= Qnil
;
4007 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4008 "The operation for which `inhibit-file-name-handlers' is applicable.");
4009 Vinhibit_file_name_operation
= Qnil
;
4011 defsubr (&Sfind_file_name_handler
);
4012 defsubr (&Sfile_name_directory
);
4013 defsubr (&Sfile_name_nondirectory
);
4014 defsubr (&Sunhandled_file_name_directory
);
4015 defsubr (&Sfile_name_as_directory
);
4016 defsubr (&Sdirectory_file_name
);
4017 defsubr (&Smake_temp_name
);
4018 defsubr (&Sexpand_file_name
);
4019 defsubr (&Ssubstitute_in_file_name
);
4020 defsubr (&Scopy_file
);
4021 defsubr (&Smake_directory_internal
);
4022 defsubr (&Sdelete_directory
);
4023 defsubr (&Sdelete_file
);
4024 defsubr (&Srename_file
);
4025 defsubr (&Sadd_name_to_file
);
4027 defsubr (&Smake_symbolic_link
);
4028 #endif /* S_IFLNK */
4030 defsubr (&Sdefine_logical_name
);
4033 defsubr (&Ssysnetunam
);
4034 #endif /* HPUX_NET */
4035 defsubr (&Sfile_name_absolute_p
);
4036 defsubr (&Sfile_exists_p
);
4037 defsubr (&Sfile_executable_p
);
4038 defsubr (&Sfile_readable_p
);
4039 defsubr (&Sfile_writable_p
);
4040 defsubr (&Sfile_symlink_p
);
4041 defsubr (&Sfile_directory_p
);
4042 defsubr (&Sfile_accessible_directory_p
);
4043 defsubr (&Sfile_modes
);
4044 defsubr (&Sset_file_modes
);
4045 defsubr (&Sset_default_file_modes
);
4046 defsubr (&Sdefault_file_modes
);
4047 defsubr (&Sfile_newer_than_file_p
);
4048 defsubr (&Sinsert_file_contents
);
4049 defsubr (&Swrite_region
);
4050 defsubr (&Scar_less_than_car
);
4051 defsubr (&Sverify_visited_file_modtime
);
4052 defsubr (&Sclear_visited_file_modtime
);
4053 defsubr (&Svisited_file_modtime
);
4054 defsubr (&Sset_visited_file_modtime
);
4055 defsubr (&Sdo_auto_save
);
4056 defsubr (&Sset_buffer_auto_saved
);
4057 defsubr (&Sclear_buffer_auto_save_failure
);
4058 defsubr (&Srecent_auto_save_p
);
4060 defsubr (&Sread_file_name_internal
);
4061 defsubr (&Sread_file_name
);
4064 defsubr (&Sunix_sync
);