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>
25 #if !defined (S_ISLNK) && defined (S_IFLNK)
26 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
29 #if !defined (S_ISREG) && defined (S_IFREG)
30 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
41 #include <sys/param.h>
59 extern char *strerror ();
74 #include "intervals.h"
100 #define min(a, b) ((a) < (b) ? (a) : (b))
101 #define max(a, b) ((a) > (b) ? (a) : (b))
103 /* Nonzero during writing of auto-save files */
106 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
107 a new file with the same mode as the original */
108 int auto_save_mode_bits
;
110 /* Alist of elements (REGEXP . HANDLER) for file names
111 whose I/O is done with a special handler. */
112 Lisp_Object Vfile_name_handler_alist
;
114 /* Functions to be called to process text properties in inserted file. */
115 Lisp_Object Vafter_insert_file_functions
;
117 /* Functions to be called to create text property annotations for file. */
118 Lisp_Object Vwrite_region_annotate_functions
;
120 /* Nonzero means, when reading a filename in the minibuffer,
121 start out by inserting the default directory into the minibuffer. */
122 int insert_default_directory
;
124 /* On VMS, nonzero means write new files with record format stmlf.
125 Zero means use var format. */
128 Lisp_Object Qfile_error
, Qfile_already_exists
;
130 Lisp_Object Qfile_name_history
;
132 Lisp_Object Qcar_less_than_car
;
134 report_file_error (string
, data
)
138 Lisp_Object errstring
;
140 errstring
= build_string (strerror (errno
));
142 /* System error messages are capitalized. Downcase the initial
143 unless it is followed by a slash. */
144 if (XSTRING (errstring
)->data
[1] != '/')
145 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
148 Fsignal (Qfile_error
,
149 Fcons (build_string (string
), Fcons (errstring
, data
)));
152 close_file_unwind (fd
)
155 close (XFASTINT (fd
));
158 /* Restore point, having saved it as a marker. */
160 restore_point_unwind (location
)
161 Lisp_Object location
;
163 SET_PT (marker_position (location
));
164 Fset_marker (location
, Qnil
, Qnil
);
167 Lisp_Object Qexpand_file_name
;
168 Lisp_Object Qdirectory_file_name
;
169 Lisp_Object Qfile_name_directory
;
170 Lisp_Object Qfile_name_nondirectory
;
171 Lisp_Object Qunhandled_file_name_directory
;
172 Lisp_Object Qfile_name_as_directory
;
173 Lisp_Object Qcopy_file
;
174 Lisp_Object Qmake_directory
;
175 Lisp_Object Qdelete_directory
;
176 Lisp_Object Qdelete_file
;
177 Lisp_Object Qrename_file
;
178 Lisp_Object Qadd_name_to_file
;
179 Lisp_Object Qmake_symbolic_link
;
180 Lisp_Object Qfile_exists_p
;
181 Lisp_Object Qfile_executable_p
;
182 Lisp_Object Qfile_readable_p
;
183 Lisp_Object Qfile_symlink_p
;
184 Lisp_Object Qfile_writable_p
;
185 Lisp_Object Qfile_directory_p
;
186 Lisp_Object Qfile_accessible_directory_p
;
187 Lisp_Object Qfile_modes
;
188 Lisp_Object Qset_file_modes
;
189 Lisp_Object Qfile_newer_than_file_p
;
190 Lisp_Object Qinsert_file_contents
;
191 Lisp_Object Qwrite_region
;
192 Lisp_Object Qverify_visited_file_modtime
;
193 Lisp_Object Qset_visited_file_modtime
;
195 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 1, 1, 0,
196 "Return FILENAME's handler function, if its syntax is handled specially.\n\
197 Otherwise, return nil.\n\
198 A file name is handled if one of the regular expressions in\n\
199 `file-name-handler-alist' matches it.")
201 Lisp_Object filename
;
203 /* This function must not munge the match data. */
206 CHECK_STRING (filename
, 0);
208 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
209 chain
= XCONS (chain
)->cdr
)
212 elt
= XCONS (chain
)->car
;
213 if (XTYPE (elt
) == Lisp_Cons
)
216 string
= XCONS (elt
)->car
;
217 if (XTYPE (string
) == Lisp_String
218 && fast_string_match (string
, filename
) >= 0)
219 return XCONS (elt
)->cdr
;
227 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
229 "Return the directory component in file name NAME.\n\
230 Return nil if NAME does not include a directory.\n\
231 Otherwise return a directory spec.\n\
232 Given a Unix syntax file name, returns a string ending in slash;\n\
233 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
237 register unsigned char *beg
;
238 register unsigned char *p
;
241 CHECK_STRING (file
, 0);
243 /* If the file name has special constructs in it,
244 call the corresponding file handler. */
245 handler
= Ffind_file_name_handler (file
);
247 return call2 (handler
, Qfile_name_directory
, file
);
249 #ifdef FILE_SYSTEM_CASE
250 file
= FILE_SYSTEM_CASE (file
);
252 beg
= XSTRING (file
)->data
;
253 p
= beg
+ XSTRING (file
)->size
;
255 while (p
!= beg
&& p
[-1] != '/'
257 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
267 /* Expansion of "c:" to drive and default directory. */
268 if (p
== beg
+ 2 && beg
[1] == ':')
270 int drive
= (*beg
) - 'a';
271 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
272 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
273 if (getdefdir (drive
+ 1, res
+ 2))
275 res
[0] = drive
+ 'a';
277 if (res
[strlen (res
) - 1] != '/')
280 p
= beg
+ strlen (beg
);
284 return make_string (beg
, p
- beg
);
287 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
289 "Return file name NAME sans its directory.\n\
290 For example, in a Unix-syntax file name,\n\
291 this is everything after the last slash,\n\
292 or the entire name if it contains no slash.")
296 register unsigned char *beg
, *p
, *end
;
299 CHECK_STRING (file
, 0);
301 /* If the file name has special constructs in it,
302 call the corresponding file handler. */
303 handler
= Ffind_file_name_handler (file
);
305 return call2 (handler
, Qfile_name_nondirectory
, file
);
307 beg
= XSTRING (file
)->data
;
308 end
= p
= beg
+ XSTRING (file
)->size
;
310 while (p
!= beg
&& p
[-1] != '/'
312 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
319 return make_string (p
, end
- p
);
322 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
323 "Return a directly usable directory name somehow associated with FILENAME.\n\
324 A `directly usable' directory name is one that may be used without the\n\
325 intervention of any file handler.\n\
326 If FILENAME is a directly usable file itself, return\n\
327 (file-name-directory FILENAME).\n\
328 The `call-process' and `start-process' functions use this function to\n\
329 get a current directory to run processes in.")
331 Lisp_Object filename
;
335 /* If the file name has special constructs in it,
336 call the corresponding file handler. */
337 handler
= Ffind_file_name_handler (filename
);
339 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
341 return Ffile_name_directory (filename
);
346 file_name_as_directory (out
, in
)
349 int size
= strlen (in
) - 1;
354 /* Is it already a directory string? */
355 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
357 /* Is it a VMS directory file name? If so, hack VMS syntax. */
358 else if (! index (in
, '/')
359 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
360 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
361 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
362 || ! strncmp (&in
[size
- 5], ".dir", 4))
363 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
364 && in
[size
] == '1')))
366 register char *p
, *dot
;
370 dir:x.dir --> dir:[x]
371 dir:[x]y.dir --> dir:[x.y] */
373 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
376 strncpy (out
, in
, p
- in
);
395 dot
= index (p
, '.');
398 /* blindly remove any extension */
399 size
= strlen (out
) + (dot
- p
);
400 strncat (out
, p
, dot
- p
);
411 /* For Unix syntax, Append a slash if necessary */
413 if (out
[size
] != ':' && out
[size
] != '/')
415 if (out
[size
] != '/')
422 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
423 Sfile_name_as_directory
, 1, 1, 0,
424 "Return a string representing file FILENAME interpreted as a directory.\n\
425 This operation exists because a directory is also a file, but its name as\n\
426 a directory is different from its name as a file.\n\
427 The result can be used as the value of `default-directory'\n\
428 or passed as second argument to `expand-file-name'.\n\
429 For a Unix-syntax file name, just appends a slash.\n\
430 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
437 CHECK_STRING (file
, 0);
441 /* If the file name has special constructs in it,
442 call the corresponding file handler. */
443 handler
= Ffind_file_name_handler (file
);
445 return call2 (handler
, Qfile_name_as_directory
, file
);
447 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
448 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
452 * Convert from directory name to filename.
454 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
455 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
456 * On UNIX, it's simple: just make sure there is a terminating /
458 * Value is nonzero if the string output is different from the input.
461 directory_file_name (src
, dst
)
469 struct FAB fab
= cc$rms_fab
;
470 struct NAM nam
= cc$rms_nam
;
471 char esa
[NAM$C_MAXRSS
];
476 if (! index (src
, '/')
477 && (src
[slen
- 1] == ']'
478 || src
[slen
- 1] == ':'
479 || src
[slen
- 1] == '>'))
481 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
483 fab
.fab$b_fns
= slen
;
484 fab
.fab$l_nam
= &nam
;
485 fab
.fab$l_fop
= FAB$M_NAM
;
488 nam
.nam$b_ess
= sizeof esa
;
489 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
491 /* We call SYS$PARSE to handle such things as [--] for us. */
492 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
494 slen
= nam
.nam$b_esl
;
495 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
500 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
502 /* what about when we have logical_name:???? */
503 if (src
[slen
- 1] == ':')
504 { /* Xlate logical name and see what we get */
505 ptr
= strcpy (dst
, src
); /* upper case for getenv */
508 if ('a' <= *ptr
&& *ptr
<= 'z')
512 dst
[slen
- 1] = 0; /* remove colon */
513 if (!(src
= egetenv (dst
)))
515 /* should we jump to the beginning of this procedure?
516 Good points: allows us to use logical names that xlate
518 Bad points: can be a problem if we just translated to a device
520 For now, I'll punt and always expect VMS names, and hope for
523 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
524 { /* no recursion here! */
530 { /* not a directory spec */
535 bracket
= src
[slen
- 1];
537 /* If bracket is ']' or '>', bracket - 2 is the corresponding
539 ptr
= index (src
, bracket
- 2);
541 { /* no opening bracket */
545 if (!(rptr
= rindex (src
, '.')))
548 strncpy (dst
, src
, slen
);
552 dst
[slen
++] = bracket
;
557 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
558 then translate the device and recurse. */
559 if (dst
[slen
- 1] == ':'
560 && dst
[slen
- 2] != ':' /* skip decnet nodes */
561 && strcmp(src
+ slen
, "[000000]") == 0)
563 dst
[slen
- 1] = '\0';
564 if ((ptr
= egetenv (dst
))
565 && (rlen
= strlen (ptr
) - 1) > 0
566 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
567 && ptr
[rlen
- 1] == '.')
569 char * buf
= (char *) alloca (strlen (ptr
) + 1);
573 return directory_file_name (buf
, dst
);
578 strcat (dst
, "[000000]");
582 rlen
= strlen (rptr
) - 1;
583 strncat (dst
, rptr
, rlen
);
584 dst
[slen
+ rlen
] = '\0';
585 strcat (dst
, ".DIR.1");
589 /* Process as Unix format: just remove any final slash.
590 But leave "/" unchanged; do not change it to "". */
593 && dst
[slen
- 1] == '/'
595 && dst
[slen
- 2] != ':'
602 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
604 "Returns the file name of the directory named DIR.\n\
605 This is the name of the file that holds the data for the directory DIR.\n\
606 This operation exists because a directory is also a file, but its name as\n\
607 a directory is different from its name as a file.\n\
608 In Unix-syntax, this function just removes the final slash.\n\
609 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
610 it returns a file name such as \"[X]Y.DIR.1\".")
612 Lisp_Object directory
;
617 CHECK_STRING (directory
, 0);
619 if (NILP (directory
))
622 /* If the file name has special constructs in it,
623 call the corresponding file handler. */
624 handler
= Ffind_file_name_handler (directory
);
626 return call2 (handler
, Qdirectory_file_name
, directory
);
629 /* 20 extra chars is insufficient for VMS, since we might perform a
630 logical name translation. an equivalence string can be up to 255
631 chars long, so grab that much extra space... - sss */
632 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
634 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
636 directory_file_name (XSTRING (directory
)->data
, buf
);
637 return build_string (buf
);
640 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
641 "Generate temporary file name (string) starting with PREFIX (a string).\n\
642 The Emacs process number forms part of the result,\n\
643 so there is no danger of generating a name being used by another process.")
648 val
= concat2 (prefix
, build_string ("XXXXXX"));
649 mktemp (XSTRING (val
)->data
);
653 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
654 "Convert FILENAME to absolute, and canonicalize it.\n\
655 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
656 (does not start with slash); if DEFAULT is nil or missing,\n\
657 the current buffer's value of default-directory is used.\n\
658 Path components that are `.' are removed, and \n\
659 path components followed by `..' are removed, along with the `..' itself;\n\
660 note that these simplifications are done without checking the resulting\n\
661 paths in the file system.\n\
662 An initial `~/' expands to your home directory.\n\
663 An initial `~USER/' expands to USER's home directory.\n\
664 See also the function `substitute-in-file-name'.")
666 Lisp_Object name
, defalt
;
670 register unsigned char *newdir
, *p
, *o
;
672 unsigned char *target
;
675 unsigned char * colon
= 0;
676 unsigned char * close
= 0;
677 unsigned char * slash
= 0;
678 unsigned char * brack
= 0;
679 int lbrack
= 0, rbrack
= 0;
682 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
685 unsigned char *tmp
, *defdir
;
689 CHECK_STRING (name
, 0);
691 /* If the file name has special constructs in it,
692 call the corresponding file handler. */
693 handler
= Ffind_file_name_handler (name
);
695 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
697 /* Use the buffer's default-directory if DEFALT is omitted. */
699 defalt
= current_buffer
->directory
;
700 CHECK_STRING (defalt
, 1);
702 /* Make sure DEFALT is properly expanded.
703 It would be better to do this down below where we actually use
704 defalt. Unfortunately, calling Fexpand_file_name recursively
705 could invoke GC, and the strings might be relocated. This would
706 be annoying because we have pointers into strings lying around
707 that would need adjusting, and people would add new pointers to
708 the code and forget to adjust them, resulting in intermittent bugs.
709 Putting this call here avoids all that crud.
711 The EQ test avoids infinite recursion. */
712 if (! NILP (defalt
) && !EQ (defalt
, name
)
713 /* This saves time in a common case. */
714 && XSTRING (defalt
)->data
[0] != '/')
719 defalt
= Fexpand_file_name (defalt
, Qnil
);
724 /* Filenames on VMS are always upper case. */
725 name
= Fupcase (name
);
727 #ifdef FILE_SYSTEM_CASE
728 name
= FILE_SYSTEM_CASE (name
);
731 nm
= XSTRING (name
)->data
;
734 /* firstly, strip drive name. */
736 unsigned char *colon
= rindex (nm
, ':');
742 drive
= tolower (colon
[-1]) - 'a';
746 defdir
= alloca (MAXPATHLEN
+ 1);
747 relpath
= getdefdir (drive
+ 1, defdir
);
753 /* If nm is absolute, flush ...// and detect /./ and /../.
754 If no /./ or /../ we can return right away. */
762 /* If it turns out that the filename we want to return is just a
763 suffix of FILENAME, we don't need to go through and edit
764 things; we just need to construct a new string using data
765 starting at the middle of FILENAME. If we set lose to a
766 non-zero value, that means we've discovered that we can't do
773 /* Since we know the path is absolute, we can assume that each
774 element starts with a "/". */
776 /* "//" anywhere isn't necessarily hairy; we just start afresh
777 with the second slash. */
778 if (p
[0] == '/' && p
[1] == '/'
780 /* // at start of filename is meaningful on Apollo system */
786 /* "~" is hairy as the start of any path element. */
787 if (p
[0] == '/' && p
[1] == '~')
788 nm
= p
+ 1, lose
= 1;
790 /* "." and ".." are hairy. */
795 || (p
[2] == '.' && (p
[3] == '/'
802 /* if dev:[dir]/, move nm to / */
803 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
804 nm
= (brack
? brack
+ 1 : colon
+ 1);
813 /* VMS pre V4.4,convert '-'s in filenames. */
814 if (lbrack
== rbrack
)
816 if (dots
< 2) /* this is to allow negative version numbers */
821 if (lbrack
> rbrack
&&
822 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
823 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
829 /* count open brackets, reset close bracket pointer */
830 if (p
[0] == '[' || p
[0] == '<')
832 /* count close brackets, set close bracket pointer */
833 if (p
[0] == ']' || p
[0] == '>')
835 /* detect ][ or >< */
836 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
838 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
839 nm
= p
+ 1, lose
= 1;
840 if (p
[0] == ':' && (colon
|| slash
))
841 /* if dev1:[dir]dev2:, move nm to dev2: */
847 /* if /pathname/dev:, move nm to dev: */
850 /* if node::dev:, move colon following dev */
851 else if (colon
&& colon
[-1] == ':')
853 /* if dev1:dev2:, move nm to dev2: */
854 else if (colon
&& colon
[-1] != ':')
859 if (p
[0] == ':' && !colon
)
865 if (lbrack
== rbrack
)
868 else if (p
[0] == '.')
877 return build_string (sys_translate_unix (nm
));
880 if (nm
== XSTRING (name
)->data
)
882 return build_string (nm
);
887 /* Now determine directory to start with and put it in newdir */
891 if (nm
[0] == '~') /* prefix ~ */
897 || nm
[1] == 0) /* ~ by itself */
899 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
900 newdir
= (unsigned char *) "";
902 dostounix_filename (newdir
);
906 nm
++; /* Don't leave the slash in nm. */
909 else /* ~user/filename */
911 for (p
= nm
; *p
&& (*p
!= '/'
916 o
= (unsigned char *) alloca (p
- nm
+ 1);
917 bcopy ((char *) nm
, o
, p
- nm
);
920 pw
= (struct passwd
*) getpwnam (o
+ 1);
923 newdir
= (unsigned char *) pw
-> pw_dir
;
925 nm
= p
+ 1; /* skip the terminator */
931 /* If we don't find a user of that name, leave the name
932 unchanged; don't move nm forward to p. */
945 newdir
= XSTRING (defalt
)->data
;
949 if (newdir
== 0 && relpath
)
954 /* Get rid of any slash at the end of newdir. */
955 int length
= strlen (newdir
);
956 /* Adding `length > 1 &&' makes ~ expand into / when homedir
957 is the root dir. People disagree about whether that is right.
958 Anyway, we can't take the risk of this change now. */
960 if (newdir
[1] != ':' && length
> 1)
962 if (newdir
[length
- 1] == '/')
964 unsigned char *temp
= (unsigned char *) alloca (length
);
965 bcopy (newdir
, temp
, length
- 1);
966 temp
[length
- 1] = 0;
974 /* Now concatenate the directory and name to new space in the stack frame */
975 tlen
+= strlen (nm
) + 1;
977 /* Add reserved space for drive name. */
978 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
980 target
= (unsigned char *) alloca (tlen
);
987 if (nm
[0] == 0 || nm
[0] == '/')
988 strcpy (target
, newdir
);
991 file_name_as_directory (target
, newdir
);
996 if (index (target
, '/'))
997 strcpy (target
, sys_translate_unix (target
));
1000 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1008 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1014 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1015 /* brackets are offset from each other by 2 */
1018 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1019 /* convert [foo][bar] to [bar] */
1020 while (o
[-1] != '[' && o
[-1] != '<')
1022 else if (*p
== '-' && *o
!= '.')
1025 else if (p
[0] == '-' && o
[-1] == '.' &&
1026 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1027 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1031 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1032 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1034 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1036 /* else [foo.-] ==> [-] */
1042 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1043 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1053 else if (!strncmp (p
, "//", 2)
1055 /* // at start of filename is meaningful in Apollo system */
1063 else if (p
[0] == '/'
1068 /* If "/." is the entire filename, keep the "/". Otherwise,
1069 just delete the whole "/.". */
1070 if (o
== target
&& p
[2] == '\0')
1074 else if (!strncmp (p
, "/..", 3)
1075 /* `/../' is the "superroot" on certain file systems. */
1077 && (p
[3] == '/' || p
[3] == 0))
1079 while (o
!= target
&& *--o
!= '/')
1082 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1086 if (o
== target
&& *o
== '/')
1094 #endif /* not VMS */
1098 /* at last, set drive name. */
1099 if (target
[1] != ':')
1102 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1107 return make_string (target
, o
- target
);
1110 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1111 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1112 "Convert FILENAME to absolute, and canonicalize it.\n\
1113 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1114 (does not start with slash); if DEFAULT is nil or missing,\n\
1115 the current buffer's value of default-directory is used.\n\
1116 Filenames containing `.' or `..' as components are simplified;\n\
1117 initial `~/' expands to your home directory.\n\
1118 See also the function `substitute-in-file-name'.")
1120 Lisp_Object name, defalt;
1124 register unsigned char *newdir, *p, *o;
1126 unsigned char *target;
1130 unsigned char * colon = 0;
1131 unsigned char * close = 0;
1132 unsigned char * slash = 0;
1133 unsigned char * brack = 0;
1134 int lbrack = 0, rbrack = 0;
1138 CHECK_STRING (name
, 0);
1141 /* Filenames on VMS are always upper case. */
1142 name
= Fupcase (name
);
1145 nm
= XSTRING (name
)->data
;
1147 /* If nm is absolute, flush ...// and detect /./ and /../.
1148 If no /./ or /../ we can return right away. */
1160 if (p
[0] == '/' && p
[1] == '/'
1162 /* // at start of filename is meaningful on Apollo system */
1167 if (p
[0] == '/' && p
[1] == '~')
1168 nm
= p
+ 1, lose
= 1;
1169 if (p
[0] == '/' && p
[1] == '.'
1170 && (p
[2] == '/' || p
[2] == 0
1171 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1177 /* if dev:[dir]/, move nm to / */
1178 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1179 nm
= (brack
? brack
+ 1 : colon
+ 1);
1180 lbrack
= rbrack
= 0;
1188 /* VMS pre V4.4,convert '-'s in filenames. */
1189 if (lbrack
== rbrack
)
1191 if (dots
< 2) /* this is to allow negative version numbers */
1196 if (lbrack
> rbrack
&&
1197 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1198 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1204 /* count open brackets, reset close bracket pointer */
1205 if (p
[0] == '[' || p
[0] == '<')
1206 lbrack
++, brack
= 0;
1207 /* count close brackets, set close bracket pointer */
1208 if (p
[0] == ']' || p
[0] == '>')
1209 rbrack
++, brack
= p
;
1210 /* detect ][ or >< */
1211 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1213 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1214 nm
= p
+ 1, lose
= 1;
1215 if (p
[0] == ':' && (colon
|| slash
))
1216 /* if dev1:[dir]dev2:, move nm to dev2: */
1222 /* if /pathname/dev:, move nm to dev: */
1225 /* if node::dev:, move colon following dev */
1226 else if (colon
&& colon
[-1] == ':')
1228 /* if dev1:dev2:, move nm to dev2: */
1229 else if (colon
&& colon
[-1] != ':')
1234 if (p
[0] == ':' && !colon
)
1240 if (lbrack
== rbrack
)
1243 else if (p
[0] == '.')
1251 if (index (nm
, '/'))
1252 return build_string (sys_translate_unix (nm
));
1254 if (nm
== XSTRING (name
)->data
)
1256 return build_string (nm
);
1260 /* Now determine directory to start with and put it in NEWDIR */
1264 if (nm
[0] == '~') /* prefix ~ */
1269 || nm
[1] == 0)/* ~/filename */
1271 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1272 newdir
= (unsigned char *) "";
1275 nm
++; /* Don't leave the slash in nm. */
1278 else /* ~user/filename */
1280 /* Get past ~ to user */
1281 unsigned char *user
= nm
+ 1;
1282 /* Find end of name. */
1283 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1284 int len
= ptr
? ptr
- user
: strlen (user
);
1286 unsigned char *ptr1
= index (user
, ':');
1287 if (ptr1
!= 0 && ptr1
- user
< len
)
1290 /* Copy the user name into temp storage. */
1291 o
= (unsigned char *) alloca (len
+ 1);
1292 bcopy ((char *) user
, o
, len
);
1295 /* Look up the user name. */
1296 pw
= (struct passwd
*) getpwnam (o
+ 1);
1298 error ("\"%s\" isn't a registered user", o
+ 1);
1300 newdir
= (unsigned char *) pw
->pw_dir
;
1302 /* Discard the user name from NM. */
1309 #endif /* not VMS */
1313 defalt
= current_buffer
->directory
;
1314 CHECK_STRING (defalt
, 1);
1315 newdir
= XSTRING (defalt
)->data
;
1318 /* Now concatenate the directory and name to new space in the stack frame */
1320 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1321 target
= (unsigned char *) alloca (tlen
);
1327 if (nm
[0] == 0 || nm
[0] == '/')
1328 strcpy (target
, newdir
);
1331 file_name_as_directory (target
, newdir
);
1334 strcat (target
, nm
);
1336 if (index (target
, '/'))
1337 strcpy (target
, sys_translate_unix (target
));
1340 /* Now canonicalize by removing /. and /foo/.. if they appear */
1348 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1354 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1355 /* brackets are offset from each other by 2 */
1358 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1359 /* convert [foo][bar] to [bar] */
1360 while (o
[-1] != '[' && o
[-1] != '<')
1362 else if (*p
== '-' && *o
!= '.')
1365 else if (p
[0] == '-' && o
[-1] == '.' &&
1366 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1367 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1371 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1372 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1374 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1376 /* else [foo.-] ==> [-] */
1382 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1383 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1393 else if (!strncmp (p
, "//", 2)
1395 /* // at start of filename is meaningful in Apollo system */
1403 else if (p
[0] == '/' && p
[1] == '.' &&
1404 (p
[2] == '/' || p
[2] == 0))
1406 else if (!strncmp (p
, "/..", 3)
1407 /* `/../' is the "superroot" on certain file systems. */
1409 && (p
[3] == '/' || p
[3] == 0))
1411 while (o
!= target
&& *--o
!= '/')
1414 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1418 if (o
== target
&& *o
== '/')
1426 #endif /* not VMS */
1429 return make_string (target
, o
- target
);
1433 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1434 Ssubstitute_in_file_name
, 1, 1, 0,
1435 "Substitute environment variables referred to in FILENAME.\n\
1436 `$FOO' where FOO is an environment variable name means to substitute\n\
1437 the value of that variable. The variable name should be terminated\n\
1438 with a character not a letter, digit or underscore; otherwise, enclose\n\
1439 the entire variable name in braces.\n\
1440 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1441 On VMS, `$' substitution is not done; this function does little and only\n\
1442 duplicates what `expand-file-name' does.")
1448 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1449 unsigned char *target
;
1451 int substituted
= 0;
1454 CHECK_STRING (string
, 0);
1456 nm
= XSTRING (string
)->data
;
1457 endp
= nm
+ XSTRING (string
)->size
;
1459 /* If /~ or // appears, discard everything through first slash. */
1461 for (p
= nm
; p
!= endp
; p
++)
1465 /* // at start of file name is meaningful in Apollo system */
1466 (p
[0] == '/' && p
- 1 != nm
)
1467 #else /* not APOLLO */
1469 #endif /* not APOLLO */
1473 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1484 if (p
[0] && p
[1] == ':')
1493 return build_string (nm
);
1496 /* See if any variables are substituted into the string
1497 and find the total length of their values in `total' */
1499 for (p
= nm
; p
!= endp
;)
1509 /* "$$" means a single "$" */
1518 while (p
!= endp
&& *p
!= '}') p
++;
1519 if (*p
!= '}') goto missingclose
;
1525 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1529 /* Copy out the variable name */
1530 target
= (unsigned char *) alloca (s
- o
+ 1);
1531 strncpy (target
, o
, s
- o
);
1534 strupr (target
); /* $home == $HOME etc. */
1537 /* Get variable value */
1538 o
= (unsigned char *) egetenv (target
);
1539 if (!o
) goto badvar
;
1540 total
+= strlen (o
);
1547 /* If substitution required, recopy the string and do it */
1548 /* Make space in stack frame for the new copy */
1549 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1552 /* Copy the rest of the name through, replacing $ constructs with values */
1569 while (p
!= endp
&& *p
!= '}') p
++;
1570 if (*p
!= '}') goto missingclose
;
1576 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1580 /* Copy out the variable name */
1581 target
= (unsigned char *) alloca (s
- o
+ 1);
1582 strncpy (target
, o
, s
- o
);
1585 strupr (target
); /* $home == $HOME etc. */
1588 /* Get variable value */
1589 o
= (unsigned char *) egetenv (target
);
1599 /* If /~ or // appears, discard everything through first slash. */
1601 for (p
= xnm
; p
!= x
; p
++)
1604 /* // at start of file name is meaningful in Apollo system */
1605 (p
[0] == '/' && p
- 1 != xnm
)
1606 #else /* not APOLLO */
1608 #endif /* not APOLLO */
1610 && p
!= nm
&& p
[-1] == '/')
1613 else if (p
[0] && p
[1] == ':')
1617 return make_string (xnm
, x
- xnm
);
1620 error ("Bad format environment-variable substitution");
1622 error ("Missing \"}\" in environment-variable substitution");
1624 error ("Substituting nonexistent environment variable \"%s\"", target
);
1627 #endif /* not VMS */
1630 /* A slightly faster and more convenient way to get
1631 (directory-file-name (expand-file-name FOO)). */
1634 expand_and_dir_to_file (filename
, defdir
)
1635 Lisp_Object filename
, defdir
;
1637 register Lisp_Object abspath
;
1639 abspath
= Fexpand_file_name (filename
, defdir
);
1642 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1643 if (c
== ':' || c
== ']' || c
== '>')
1644 abspath
= Fdirectory_file_name (abspath
);
1647 /* Remove final slash, if any (unless path is root).
1648 stat behaves differently depending! */
1649 if (XSTRING (abspath
)->size
> 1
1650 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1651 /* We cannot take shortcuts; they might be wrong for magic file names. */
1652 abspath
= Fdirectory_file_name (abspath
);
1657 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1658 Lisp_Object absname
;
1659 unsigned char *querystring
;
1662 register Lisp_Object tem
;
1663 struct gcpro gcpro1
;
1665 if (access (XSTRING (absname
)->data
, 4) >= 0)
1668 Fsignal (Qfile_already_exists
,
1669 Fcons (build_string ("File already exists"),
1670 Fcons (absname
, Qnil
)));
1672 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1673 XSTRING (absname
)->data
, querystring
));
1676 Fsignal (Qfile_already_exists
,
1677 Fcons (build_string ("File already exists"),
1678 Fcons (absname
, Qnil
)));
1683 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1684 "fCopy file: \nFCopy %s to file: \np\nP",
1685 "Copy FILE to NEWNAME. Both args must be strings.\n\
1686 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1687 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1688 A number as third arg means request confirmation if NEWNAME already exists.\n\
1689 This is what happens in interactive use with M-x.\n\
1690 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1691 last-modified time as the old one. (This works on only some systems.)\n\
1692 A prefix arg makes KEEP-TIME non-nil.")
1693 (filename
, newname
, ok_if_already_exists
, keep_date
)
1694 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1697 char buf
[16 * 1024];
1699 Lisp_Object handler
;
1700 struct gcpro gcpro1
, gcpro2
;
1701 int count
= specpdl_ptr
- specpdl
;
1702 Lisp_Object args
[6];
1703 int input_file_statable_p
;
1705 GCPRO2 (filename
, newname
);
1706 CHECK_STRING (filename
, 0);
1707 CHECK_STRING (newname
, 1);
1708 filename
= Fexpand_file_name (filename
, Qnil
);
1709 newname
= Fexpand_file_name (newname
, Qnil
);
1711 /* If the input file name has special constructs in it,
1712 call the corresponding file handler. */
1713 handler
= Ffind_file_name_handler (filename
);
1714 /* Likewise for output file name. */
1716 handler
= Ffind_file_name_handler (newname
);
1717 if (!NILP (handler
))
1718 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1719 ok_if_already_exists
, keep_date
));
1721 if (NILP (ok_if_already_exists
)
1722 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1723 barf_or_query_if_file_exists (newname
, "copy to it",
1724 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1726 ifd
= open (XSTRING (filename
)->data
, 0);
1728 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1730 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1732 /* We can only copy regular files and symbolic links. Other files are not
1734 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1736 #if defined (S_ISREG) && defined (S_ISLNK)
1737 if (input_file_statable_p
)
1739 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1741 #if defined (EISDIR)
1742 /* Get a better looking error message. */
1745 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1748 #endif /* S_ISREG && S_ISLNK */
1751 /* Create the copy file with the same record format as the input file */
1752 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1755 /* System's default file type was set to binary by _fmode in emacs.c. */
1756 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1757 #else /* not MSDOS */
1758 ofd
= creat (XSTRING (newname
)->data
, 0666);
1759 #endif /* not MSDOS */
1762 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1764 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1768 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1769 if (write (ofd
, buf
, n
) != n
)
1770 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1773 if (input_file_statable_p
)
1775 if (!NILP (keep_date
))
1777 EMACS_TIME atime
, mtime
;
1778 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1779 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1780 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1783 if (!egetenv ("USE_DOMAIN_ACLS"))
1785 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1788 /* Discard the unwind protects. */
1789 specpdl_ptr
= specpdl
+ count
;
1792 if (close (ofd
) < 0)
1793 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1799 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1800 Smake_directory_internal
, 1, 1, 0,
1801 "Create a directory. One argument, a file name string.")
1803 Lisp_Object dirname
;
1806 Lisp_Object handler
;
1808 CHECK_STRING (dirname
, 0);
1809 dirname
= Fexpand_file_name (dirname
, Qnil
);
1811 handler
= Ffind_file_name_handler (dirname
);
1812 if (!NILP (handler
))
1813 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1815 dir
= XSTRING (dirname
)->data
;
1817 if (mkdir (dir
, 0777) != 0)
1818 report_file_error ("Creating directory", Flist (1, &dirname
));
1823 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1824 "Delete a directory. One argument, a file name string.")
1826 Lisp_Object dirname
;
1829 Lisp_Object handler
;
1831 CHECK_STRING (dirname
, 0);
1832 dirname
= Fexpand_file_name (dirname
, Qnil
);
1833 dir
= XSTRING (dirname
)->data
;
1835 handler
= Ffind_file_name_handler (dirname
);
1836 if (!NILP (handler
))
1837 return call2 (handler
, Qdelete_directory
, dirname
);
1839 if (rmdir (dir
) != 0)
1840 report_file_error ("Removing directory", Flist (1, &dirname
));
1845 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1846 "Delete specified file. One argument, a file name string.\n\
1847 If file has multiple names, it continues to exist with the other names.")
1849 Lisp_Object filename
;
1851 Lisp_Object handler
;
1852 CHECK_STRING (filename
, 0);
1853 filename
= Fexpand_file_name (filename
, Qnil
);
1855 handler
= Ffind_file_name_handler (filename
);
1856 if (!NILP (handler
))
1857 return call2 (handler
, Qdelete_file
, filename
);
1859 if (0 > unlink (XSTRING (filename
)->data
))
1860 report_file_error ("Removing old name", Flist (1, &filename
));
1864 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1865 "fRename file: \nFRename %s to file: \np",
1866 "Rename FILE as NEWNAME. Both args strings.\n\
1867 If file has names other than FILE, it continues to have those names.\n\
1868 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1869 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1870 A number as third arg means request confirmation if NEWNAME already exists.\n\
1871 This is what happens in interactive use with M-x.")
1872 (filename
, newname
, ok_if_already_exists
)
1873 Lisp_Object filename
, newname
, ok_if_already_exists
;
1876 Lisp_Object args
[2];
1878 Lisp_Object handler
;
1879 struct gcpro gcpro1
, gcpro2
;
1881 GCPRO2 (filename
, newname
);
1882 CHECK_STRING (filename
, 0);
1883 CHECK_STRING (newname
, 1);
1884 filename
= Fexpand_file_name (filename
, Qnil
);
1885 newname
= Fexpand_file_name (newname
, Qnil
);
1887 /* If the file name has special constructs in it,
1888 call the corresponding file handler. */
1889 handler
= Ffind_file_name_handler (filename
);
1891 handler
= Ffind_file_name_handler (newname
);
1892 if (!NILP (handler
))
1893 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1894 filename
, newname
, ok_if_already_exists
));
1896 if (NILP (ok_if_already_exists
)
1897 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1898 barf_or_query_if_file_exists (newname
, "rename to it",
1899 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1901 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1903 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1904 || 0 > unlink (XSTRING (filename
)->data
))
1909 Fcopy_file (filename
, newname
,
1910 /* We have already prompted if it was an integer,
1911 so don't have copy-file prompt again. */
1912 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1913 Fdelete_file (filename
);
1920 report_file_error ("Renaming", Flist (2, args
));
1923 report_file_error ("Renaming", Flist (2, &filename
));
1930 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1931 "fAdd name to file: \nFName to add to %s: \np",
1932 "Give FILE additional name NEWNAME. Both args strings.\n\
1933 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1934 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1935 A number as third arg means request confirmation if NEWNAME already exists.\n\
1936 This is what happens in interactive use with M-x.")
1937 (filename
, newname
, ok_if_already_exists
)
1938 Lisp_Object filename
, newname
, ok_if_already_exists
;
1941 Lisp_Object args
[2];
1943 Lisp_Object handler
;
1944 struct gcpro gcpro1
, gcpro2
;
1946 GCPRO2 (filename
, newname
);
1947 CHECK_STRING (filename
, 0);
1948 CHECK_STRING (newname
, 1);
1949 filename
= Fexpand_file_name (filename
, Qnil
);
1950 newname
= Fexpand_file_name (newname
, Qnil
);
1952 /* If the file name has special constructs in it,
1953 call the corresponding file handler. */
1954 handler
= Ffind_file_name_handler (filename
);
1955 if (!NILP (handler
))
1956 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
1957 newname
, ok_if_already_exists
));
1959 if (NILP (ok_if_already_exists
)
1960 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1961 barf_or_query_if_file_exists (newname
, "make it a new name",
1962 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1963 unlink (XSTRING (newname
)->data
);
1964 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1969 report_file_error ("Adding new name", Flist (2, args
));
1971 report_file_error ("Adding new name", Flist (2, &filename
));
1980 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1981 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1982 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1983 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1984 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1985 A number as third arg means request confirmation if NEWNAME already exists.\n\
1986 This happens for interactive use with M-x.")
1987 (filename
, linkname
, ok_if_already_exists
)
1988 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1991 Lisp_Object args
[2];
1993 Lisp_Object handler
;
1994 struct gcpro gcpro1
, gcpro2
;
1996 GCPRO2 (filename
, linkname
);
1997 CHECK_STRING (filename
, 0);
1998 CHECK_STRING (linkname
, 1);
1999 /* If the link target has a ~, we must expand it to get
2000 a truly valid file name. Otherwise, do not expand;
2001 we want to permit links to relative file names. */
2002 if (XSTRING (filename
)->data
[0] == '~')
2003 filename
= Fexpand_file_name (filename
, Qnil
);
2004 linkname
= Fexpand_file_name (linkname
, Qnil
);
2006 /* If the file name has special constructs in it,
2007 call the corresponding file handler. */
2008 handler
= Ffind_file_name_handler (filename
);
2009 if (!NILP (handler
))
2010 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2011 linkname
, ok_if_already_exists
));
2013 if (NILP (ok_if_already_exists
)
2014 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2015 barf_or_query_if_file_exists (linkname
, "make it a link",
2016 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2017 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2019 /* If we didn't complain already, silently delete existing file. */
2020 if (errno
== EEXIST
)
2022 unlink (XSTRING (linkname
)->data
);
2023 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2030 report_file_error ("Making symbolic link", Flist (2, args
));
2032 report_file_error ("Making symbolic link", Flist (2, &filename
));
2038 #endif /* S_IFLNK */
2042 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2043 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2044 "Define the job-wide logical name NAME to have the value STRING.\n\
2045 If STRING is nil or a null string, the logical name NAME is deleted.")
2047 Lisp_Object varname
;
2050 CHECK_STRING (varname
, 0);
2052 delete_logical_name (XSTRING (varname
)->data
);
2055 CHECK_STRING (string
, 1);
2057 if (XSTRING (string
)->size
== 0)
2058 delete_logical_name (XSTRING (varname
)->data
);
2060 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2069 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2070 "Open a network connection to PATH using LOGIN as the login string.")
2072 Lisp_Object path
, login
;
2076 CHECK_STRING (path
, 0);
2077 CHECK_STRING (login
, 0);
2079 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2081 if (netresult
== -1)
2086 #endif /* HPUX_NET */
2088 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2090 "Return t if file FILENAME specifies an absolute path name.\n\
2091 On Unix, this is a name starting with a `/' or a `~'.")
2093 Lisp_Object filename
;
2097 CHECK_STRING (filename
, 0);
2098 ptr
= XSTRING (filename
)->data
;
2099 if (*ptr
== '/' || *ptr
== '~'
2101 /* ??? This criterion is probably wrong for '<'. */
2102 || index (ptr
, ':') || index (ptr
, '<')
2103 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2107 || (*ptr
!= 0 && ptr
[1] == ':' && ptr
[2] == '/')
2115 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2116 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2117 See also `file-readable-p' and `file-attributes'.")
2119 Lisp_Object filename
;
2121 Lisp_Object abspath
;
2122 Lisp_Object handler
;
2124 CHECK_STRING (filename
, 0);
2125 abspath
= Fexpand_file_name (filename
, Qnil
);
2127 /* If the file name has special constructs in it,
2128 call the corresponding file handler. */
2129 handler
= Ffind_file_name_handler (abspath
);
2130 if (!NILP (handler
))
2131 return call2 (handler
, Qfile_exists_p
, abspath
);
2133 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2136 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2137 "Return t if FILENAME can be executed by you.\n\
2138 For a directory, this means you can access files in that directory.")
2140 Lisp_Object filename
;
2143 Lisp_Object abspath
;
2144 Lisp_Object handler
;
2146 CHECK_STRING (filename
, 0);
2147 abspath
= Fexpand_file_name (filename
, Qnil
);
2149 /* If the file name has special constructs in it,
2150 call the corresponding file handler. */
2151 handler
= Ffind_file_name_handler (abspath
);
2152 if (!NILP (handler
))
2153 return call2 (handler
, Qfile_executable_p
, abspath
);
2155 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2158 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2159 "Return t if file FILENAME exists and you can read it.\n\
2160 See also `file-exists-p' and `file-attributes'.")
2162 Lisp_Object filename
;
2164 Lisp_Object abspath
;
2165 Lisp_Object handler
;
2167 CHECK_STRING (filename
, 0);
2168 abspath
= Fexpand_file_name (filename
, Qnil
);
2170 /* If the file name has special constructs in it,
2171 call the corresponding file handler. */
2172 handler
= Ffind_file_name_handler (abspath
);
2173 if (!NILP (handler
))
2174 return call2 (handler
, Qfile_readable_p
, abspath
);
2176 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2179 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2180 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2181 The value is the name of the file to which it is linked.\n\
2182 Otherwise returns nil.")
2184 Lisp_Object filename
;
2191 Lisp_Object handler
;
2193 CHECK_STRING (filename
, 0);
2194 filename
= Fexpand_file_name (filename
, Qnil
);
2196 /* If the file name has special constructs in it,
2197 call the corresponding file handler. */
2198 handler
= Ffind_file_name_handler (filename
);
2199 if (!NILP (handler
))
2200 return call2 (handler
, Qfile_symlink_p
, filename
);
2205 buf
= (char *) xmalloc (bufsize
);
2206 bzero (buf
, bufsize
);
2207 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2208 if (valsize
< bufsize
) break;
2209 /* Buffer was not long enough */
2218 val
= make_string (buf
, valsize
);
2221 #else /* not S_IFLNK */
2223 #endif /* not S_IFLNK */
2226 #ifdef SOLARIS_BROKEN_ACCESS
2227 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2228 considered by the access system call. This is Sun's bug, but we
2229 still have to make Emacs work. */
2231 #include <sys/statvfs.h>
2237 struct statvfs statvfsb
;
2239 if (statvfs(path
, &statvfsb
))
2240 return 1; /* error from statvfs, be conservative and say not wrtable */
2242 /* Otherwise, fsys is ro if bit is set. */
2243 return statvfsb
.f_flag
& ST_RDONLY
;
2246 /* But on every other os, access has already done the right thing. */
2247 #define ro_fsys(path) 0
2250 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2252 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2253 "Return t if file FILENAME can be written or created by you.")
2255 Lisp_Object filename
;
2257 Lisp_Object abspath
, dir
;
2258 Lisp_Object handler
;
2260 CHECK_STRING (filename
, 0);
2261 abspath
= Fexpand_file_name (filename
, Qnil
);
2263 /* If the file name has special constructs in it,
2264 call the corresponding file handler. */
2265 handler
= Ffind_file_name_handler (abspath
);
2266 if (!NILP (handler
))
2267 return call2 (handler
, Qfile_writable_p
, abspath
);
2269 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2270 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2271 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2273 dir
= Ffile_name_directory (abspath
);
2276 dir
= Fdirectory_file_name (dir
);
2280 dir
= Fdirectory_file_name (dir
);
2282 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2283 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2287 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2288 "Return t if file FILENAME is the name of a directory as a file.\n\
2289 A directory name spec may be given instead; then the value is t\n\
2290 if the directory so specified exists and really is a directory.")
2292 Lisp_Object filename
;
2294 register Lisp_Object abspath
;
2296 Lisp_Object handler
;
2298 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2300 /* If the file name has special constructs in it,
2301 call the corresponding file handler. */
2302 handler
= Ffind_file_name_handler (abspath
);
2303 if (!NILP (handler
))
2304 return call2 (handler
, Qfile_directory_p
, abspath
);
2306 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2308 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2311 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2312 "Return t if file FILENAME is the name of a directory as a file,\n\
2313 and files in that directory can be opened by you. In order to use a\n\
2314 directory as a buffer's current directory, this predicate must return true.\n\
2315 A directory name spec may be given instead; then the value is t\n\
2316 if the directory so specified exists and really is a readable and\n\
2317 searchable directory.")
2319 Lisp_Object filename
;
2321 Lisp_Object handler
;
2323 /* If the file name has special constructs in it,
2324 call the corresponding file handler. */
2325 handler
= Ffind_file_name_handler (filename
);
2326 if (!NILP (handler
))
2327 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2329 if (NILP (Ffile_directory_p (filename
))
2330 || NILP (Ffile_executable_p (filename
)))
2336 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2337 "Return mode bits of FILE, as an integer.")
2339 Lisp_Object filename
;
2341 Lisp_Object abspath
;
2343 Lisp_Object handler
;
2345 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2347 /* If the file name has special constructs in it,
2348 call the corresponding file handler. */
2349 handler
= Ffind_file_name_handler (abspath
);
2350 if (!NILP (handler
))
2351 return call2 (handler
, Qfile_modes
, abspath
);
2353 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2359 if (S_ISREG (st
.st_mode
)
2360 && (len
= XSTRING (abspath
)->size
) >= 5
2361 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2362 || stricmp (suffix
, ".exe") == 0
2363 || stricmp (suffix
, ".bat") == 0))
2364 st
.st_mode
|= S_IEXEC
;
2368 return make_number (st
.st_mode
& 07777);
2371 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2372 "Set mode bits of FILE to MODE (an integer).\n\
2373 Only the 12 low bits of MODE are used.")
2375 Lisp_Object filename
, mode
;
2377 Lisp_Object abspath
;
2378 Lisp_Object handler
;
2380 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2381 CHECK_NUMBER (mode
, 1);
2383 /* If the file name has special constructs in it,
2384 call the corresponding file handler. */
2385 handler
= Ffind_file_name_handler (abspath
);
2386 if (!NILP (handler
))
2387 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2390 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2391 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2393 if (!egetenv ("USE_DOMAIN_ACLS"))
2396 struct timeval tvp
[2];
2398 /* chmod on apollo also change the file's modtime; need to save the
2399 modtime and then restore it. */
2400 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2402 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2406 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2407 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2409 /* reset the old accessed and modified times. */
2410 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2412 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2415 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2416 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2423 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2424 "Set the file permission bits for newly created files.\n\
2425 The argument MODE should be an integer; only the low 9 bits are used.\n\
2426 This setting is inherited by subprocesses.")
2430 CHECK_NUMBER (mode
, 0);
2432 umask ((~ XINT (mode
)) & 0777);
2437 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2438 "Return the default file protection for created files.\n\
2439 The value is an integer.")
2445 realmask
= umask (0);
2448 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2454 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2455 "Tell Unix to finish all pending disk updates.")
2464 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2465 "Return t if file FILE1 is newer than file FILE2.\n\
2466 If FILE1 does not exist, the answer is nil;\n\
2467 otherwise, if FILE2 does not exist, the answer is t.")
2469 Lisp_Object file1
, file2
;
2471 Lisp_Object abspath1
, abspath2
;
2474 Lisp_Object handler
;
2475 struct gcpro gcpro1
, gcpro2
;
2477 CHECK_STRING (file1
, 0);
2478 CHECK_STRING (file2
, 0);
2481 GCPRO2 (abspath1
, file2
);
2482 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2483 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2486 /* If the file name has special constructs in it,
2487 call the corresponding file handler. */
2488 handler
= Ffind_file_name_handler (abspath1
);
2490 handler
= Ffind_file_name_handler (abspath2
);
2491 if (!NILP (handler
))
2492 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2494 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2497 mtime1
= st
.st_mtime
;
2499 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2502 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2506 Lisp_Object Qfind_buffer_file_type
;
2509 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2511 "Insert contents of file FILENAME after point.\n\
2512 Returns list of absolute file name and length of data inserted.\n\
2513 If second argument VISIT is non-nil, the buffer's visited filename\n\
2514 and last save file modtime are set, and it is marked unmodified.\n\
2515 If visiting and the file does not exist, visiting is completed\n\
2516 before the error is signaled.\n\n\
2517 The optional third and fourth arguments BEG and END\n\
2518 specify what portion of the file to insert.\n\
2519 If VISIT is non-nil, BEG and END must be nil.\n\
2520 If optional fifth argument REPLACE is non-nil,\n\
2521 it means replace the current buffer contents (in the accessible portion)\n\
2522 with the file contents. This is better than simply deleting and inserting\n\
2523 the whole thing because (1) it preserves some marker positions\n\
2524 and (2) it puts less data in the undo list.")
2525 (filename
, visit
, beg
, end
, replace
)
2526 Lisp_Object filename
, visit
, beg
, end
, replace
;
2530 register int inserted
= 0;
2531 register int how_much
;
2532 int count
= specpdl_ptr
- specpdl
;
2533 struct gcpro gcpro1
, gcpro2
;
2534 Lisp_Object handler
, val
, insval
;
2541 GCPRO2 (filename
, p
);
2542 if (!NILP (current_buffer
->read_only
))
2543 Fbarf_if_buffer_read_only();
2545 CHECK_STRING (filename
, 0);
2546 filename
= Fexpand_file_name (filename
, Qnil
);
2548 /* If the file name has special constructs in it,
2549 call the corresponding file handler. */
2550 handler
= Ffind_file_name_handler (filename
);
2551 if (!NILP (handler
))
2553 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2554 visit
, beg
, end
, replace
);
2561 if (stat (XSTRING (filename
)->data
, &st
) < 0
2562 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2564 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2565 || fstat (fd
, &st
) < 0)
2566 #endif /* not APOLLO */
2568 if (fd
>= 0) close (fd
);
2570 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2576 /* Replacement should preserve point as it preserves markers. */
2577 if (!NILP (replace
))
2578 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2580 record_unwind_protect (close_file_unwind
, make_number (fd
));
2583 /* This code will need to be changed in order to work on named
2584 pipes, and it's probably just not worth it. So we should at
2585 least signal an error. */
2586 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2587 Fsignal (Qfile_error
,
2588 Fcons (build_string ("reading from named pipe"),
2589 Fcons (filename
, Qnil
)));
2592 /* Supposedly happens on VMS. */
2594 error ("File size is negative");
2596 if (!NILP (beg
) || !NILP (end
))
2598 error ("Attempt to visit less than an entire file");
2601 CHECK_NUMBER (beg
, 0);
2606 CHECK_NUMBER (end
, 0);
2609 XSETINT (end
, st
.st_size
);
2610 if (XINT (end
) != st
.st_size
)
2611 error ("maximum buffer size exceeded");
2614 /* If requested, replace the accessible part of the buffer
2615 with the file contents. Avoid replacing text at the
2616 beginning or end of the buffer that matches the file contents;
2617 that preserves markers pointing to the unchanged parts. */
2618 if (!NILP (replace
))
2620 char buffer
[1 << 14];
2621 int same_at_start
= BEGV
;
2622 int same_at_end
= ZV
;
2627 /* Count how many chars at the start of the file
2628 match the text at the beginning of the buffer. */
2633 nread
= read (fd
, buffer
, sizeof buffer
);
2635 error ("IO error reading %s: %s",
2636 XSTRING (filename
)->data
, strerror (errno
));
2637 else if (nread
== 0)
2640 while (bufpos
< nread
&& same_at_start
< ZV
2641 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2642 same_at_start
++, bufpos
++;
2643 /* If we found a discrepancy, stop the scan.
2644 Otherwise loop around and scan the next bufferfull. */
2645 if (bufpos
!= nread
)
2649 /* If the file matches the buffer completely,
2650 there's no need to replace anything. */
2651 if (same_at_start
== ZV
)
2659 /* Count how many chars at the end of the file
2660 match the text at the end of the buffer. */
2663 int total_read
, nread
, bufpos
, curpos
, trial
;
2665 /* At what file position are we now scanning? */
2666 curpos
= st
.st_size
- (ZV
- same_at_end
);
2667 /* How much can we scan in the next step? */
2668 trial
= min (curpos
, sizeof buffer
);
2669 if (lseek (fd
, curpos
- trial
, 0) < 0)
2670 report_file_error ("Setting file position",
2671 Fcons (filename
, Qnil
));
2674 while (total_read
< trial
)
2676 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2678 error ("IO error reading %s: %s",
2679 XSTRING (filename
)->data
, strerror (errno
));
2680 total_read
+= nread
;
2682 /* Scan this bufferfull from the end, comparing with
2683 the Emacs buffer. */
2684 bufpos
= total_read
;
2685 /* Compare with same_at_start to avoid counting some buffer text
2686 as matching both at the file's beginning and at the end. */
2687 while (bufpos
> 0 && same_at_end
> same_at_start
2688 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2689 same_at_end
--, bufpos
--;
2690 /* If we found a discrepancy, stop the scan.
2691 Otherwise loop around and scan the preceding bufferfull. */
2697 /* Don't try to reuse the same piece of text twice. */
2698 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2700 same_at_end
+= overlap
;
2702 /* Arrange to read only the nonmatching middle part of the file. */
2703 XFASTINT (beg
) = same_at_start
- BEGV
;
2704 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2706 del_range_1 (same_at_start
, same_at_end
, 0);
2707 /* Insert from the file at the proper position. */
2708 SET_PT (same_at_start
);
2711 total
= XINT (end
) - XINT (beg
);
2714 register Lisp_Object temp
;
2716 /* Make sure point-max won't overflow after this insertion. */
2717 XSET (temp
, Lisp_Int
, total
);
2718 if (total
!= XINT (temp
))
2719 error ("maximum buffer size exceeded");
2722 if (NILP (visit
) && total
> 0)
2723 prepare_to_modify_buffer (point
, point
);
2726 if (GAP_SIZE
< total
)
2727 make_gap (total
- GAP_SIZE
);
2729 if (XINT (beg
) != 0 || !NILP (replace
))
2731 if (lseek (fd
, XINT (beg
), 0) < 0)
2732 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2736 while (inserted
< total
)
2738 int try = min (total
- inserted
, 64 << 10);
2741 /* Allow quitting out of the actual I/O. */
2744 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2761 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2762 /* Determine file type from name and remove LFs from CR-LFs if the file
2763 is deemed to be a text file. */
2765 struct gcpro gcpro1
;
2769 code
= call1 (Qfind_buffer_file_type
, filename
);
2771 if (XTYPE (code
) == Lisp_Int
)
2772 XFASTINT (current_buffer
->buffer_file_type
) = XFASTINT (code
);
2773 if (XFASTINT (current_buffer
->buffer_file_type
) == 0)
2776 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2779 GPT
-= reduced_size
;
2780 GAP_SIZE
+= reduced_size
;
2781 inserted
-= reduced_size
;
2788 record_insert (point
, inserted
);
2790 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2791 offset_intervals (current_buffer
, point
, inserted
);
2797 /* Discard the unwind protect for closing the file. */
2801 error ("IO error reading %s: %s",
2802 XSTRING (filename
)->data
, strerror (errno
));
2809 if (!EQ (current_buffer
->undo_list
, Qt
))
2810 current_buffer
->undo_list
= Qnil
;
2812 stat (XSTRING (filename
)->data
, &st
);
2817 current_buffer
->modtime
= st
.st_mtime
;
2818 current_buffer
->filename
= filename
;
2821 current_buffer
->save_modified
= MODIFF
;
2822 current_buffer
->auto_save_modified
= MODIFF
;
2823 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2824 #ifdef CLASH_DETECTION
2827 if (!NILP (current_buffer
->filename
))
2828 unlock_file (current_buffer
->filename
);
2829 unlock_file (filename
);
2831 #endif /* CLASH_DETECTION */
2832 /* If visiting nonexistent file, return nil. */
2833 if (current_buffer
->modtime
== -1)
2834 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2837 if (inserted
> 0 && NILP (visit
) && total
> 0)
2838 signal_after_change (point
, 0, inserted
);
2842 p
= Vafter_insert_file_functions
;
2845 insval
= call1 (Fcar (p
), make_number (inserted
));
2848 CHECK_NUMBER (insval
, 0);
2849 inserted
= XFASTINT (insval
);
2857 val
= Fcons (filename
,
2858 Fcons (make_number (inserted
),
2861 RETURN_UNGCPRO (unbind_to (count
, val
));
2864 static Lisp_Object
build_annotations ();
2866 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2867 "r\nFWrite region to file: ",
2868 "Write current region into specified file.\n\
2869 When called from a program, takes three arguments:\n\
2870 START, END and FILENAME. START and END are buffer positions.\n\
2871 Optional fourth argument APPEND if non-nil means\n\
2872 append to existing file contents (if any).\n\
2873 Optional fifth argument VISIT if t means\n\
2874 set the last-save-file-modtime of buffer to this file's modtime\n\
2875 and mark buffer not modified.\n\
2876 If VISIT is a string, it is a second file name;\n\
2877 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2878 VISIT is also the file name to lock and unlock for clash detection.\n\
2879 If VISIT is neither t nor nil nor a string,\n\
2880 that means do not print the \"Wrote file\" message.\n\
2881 Kludgy feature: if START is a string, then that string is written\n\
2882 to the file, instead of any buffer contents, and END is ignored.")
2883 (start
, end
, filename
, append
, visit
)
2884 Lisp_Object start
, end
, filename
, append
, visit
;
2892 int count
= specpdl_ptr
- specpdl
;
2894 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2896 Lisp_Object handler
;
2897 Lisp_Object visit_file
;
2898 Lisp_Object annotations
;
2899 int visiting
, quietly
;
2900 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2902 int buffer_file_type
2903 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2906 if (!NILP (start
) && !STRINGP (start
))
2907 validate_region (&start
, &end
);
2909 filename
= Fexpand_file_name (filename
, Qnil
);
2910 if (STRINGP (visit
))
2911 visit_file
= Fexpand_file_name (visit
, Qnil
);
2913 visit_file
= filename
;
2915 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2916 quietly
= !NILP (visit
);
2920 GCPRO4 (start
, filename
, annotations
, visit_file
);
2922 /* If the file name has special constructs in it,
2923 call the corresponding file handler. */
2924 handler
= Ffind_file_name_handler (filename
);
2925 /* If FILENAME has no handler, see if VISIT has one. */
2926 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2927 handler
= Ffind_file_name_handler (visit
);
2929 if (!NILP (handler
))
2932 val
= call6 (handler
, Qwrite_region
, start
, end
,
2933 filename
, append
, visit
);
2937 current_buffer
->save_modified
= MODIFF
;
2938 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2939 current_buffer
->filename
= visit_file
;
2945 /* Special kludge to simplify auto-saving. */
2948 XFASTINT (start
) = BEG
;
2952 annotations
= build_annotations (start
, end
);
2954 #ifdef CLASH_DETECTION
2956 lock_file (visit_file
);
2957 #endif /* CLASH_DETECTION */
2959 fn
= XSTRING (filename
)->data
;
2963 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
2965 desc
= open (fn
, O_WRONLY
);
2970 if (auto_saving
) /* Overwrite any previous version of autosave file */
2972 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2973 desc
= open (fn
, O_RDWR
);
2975 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
2976 ? XSTRING (current_buffer
->filename
)->data
: 0,
2979 else /* Write to temporary name and rename if no errors */
2981 Lisp_Object temp_name
;
2982 temp_name
= Ffile_name_directory (filename
);
2984 if (!NILP (temp_name
))
2986 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2987 build_string ("$$SAVE$$")));
2988 fname
= XSTRING (filename
)->data
;
2989 fn
= XSTRING (temp_name
)->data
;
2990 desc
= creat_copy_attrs (fname
, fn
);
2993 /* If we can't open the temporary file, try creating a new
2994 version of the original file. VMS "creat" creates a
2995 new version rather than truncating an existing file. */
2998 desc
= creat (fn
, 0666);
2999 #if 0 /* This can clobber an existing file and fail to replace it,
3000 if the user runs out of space. */
3003 /* We can't make a new version;
3004 try to truncate and rewrite existing version if any. */
3006 desc
= open (fn
, O_RDWR
);
3012 desc
= creat (fn
, 0666);
3017 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3018 S_IREAD
| S_IWRITE
);
3019 #else /* not MSDOS */
3020 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3021 #endif /* not MSDOS */
3022 #endif /* not VMS */
3028 #ifdef CLASH_DETECTION
3030 if (!auto_saving
) unlock_file (visit_file
);
3032 #endif /* CLASH_DETECTION */
3033 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3036 record_unwind_protect (close_file_unwind
, make_number (desc
));
3039 if (lseek (desc
, 0, 2) < 0)
3041 #ifdef CLASH_DETECTION
3042 if (!auto_saving
) unlock_file (visit_file
);
3043 #endif /* CLASH_DETECTION */
3044 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3049 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3050 * if we do writes that don't end with a carriage return. Furthermore
3051 * it cannot handle writes of more then 16K. The modified
3052 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3053 * this EXCEPT for the last record (iff it doesn't end with a carriage
3054 * return). This implies that if your buffer doesn't end with a carriage
3055 * return, you get one free... tough. However it also means that if
3056 * we make two calls to sys_write (a la the following code) you can
3057 * get one at the gap as well. The easiest way to fix this (honest)
3058 * is to move the gap to the next newline (or the end of the buffer).
3063 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3064 move_gap (find_next_newline (GPT
, 1));
3070 if (STRINGP (start
))
3072 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3073 XSTRING (start
)->size
, 0, &annotations
);
3076 else if (XINT (start
) != XINT (end
))
3079 if (XINT (start
) < GPT
)
3081 register int end1
= XINT (end
);
3083 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3084 min (GPT
, end1
) - tem
, tem
, &annotations
);
3085 nwritten
+= min (GPT
, end1
) - tem
;
3089 if (XINT (end
) > GPT
&& !failure
)
3092 tem
= max (tem
, GPT
);
3093 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3095 nwritten
+= XINT (end
) - tem
;
3101 /* If file was empty, still need to write the annotations */
3102 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3110 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3111 Disk full in NFS may be reported here. */
3112 /* mib says that closing the file will try to write as fast as NFS can do
3113 it, and that means the fsync here is not crucial for autosave files. */
3114 if (!auto_saving
&& fsync (desc
) < 0)
3115 failure
= 1, save_errno
= errno
;
3118 /* Spurious "file has changed on disk" warnings have been
3119 observed on Suns as well.
3120 It seems that `close' can change the modtime, under nfs.
3122 (This has supposedly been fixed in Sunos 4,
3123 but who knows about all the other machines with NFS?) */
3126 /* On VMS and APOLLO, must do the stat after the close
3127 since closing changes the modtime. */
3130 /* Recall that #if defined does not work on VMS. */
3137 /* NFS can report a write failure now. */
3138 if (close (desc
) < 0)
3139 failure
= 1, save_errno
= errno
;
3142 /* If we wrote to a temporary name and had no errors, rename to real name. */
3146 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3154 /* Discard the unwind protect */
3155 specpdl_ptr
= specpdl
+ count
;
3157 #ifdef CLASH_DETECTION
3159 unlock_file (visit_file
);
3160 #endif /* CLASH_DETECTION */
3162 /* Do this before reporting IO error
3163 to avoid a "file has changed on disk" warning on
3164 next attempt to save. */
3166 current_buffer
->modtime
= st
.st_mtime
;
3169 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3173 current_buffer
->save_modified
= MODIFF
;
3174 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3175 current_buffer
->filename
= visit_file
;
3181 message ("Wrote %s", XSTRING (visit_file
)->data
);
3186 Lisp_Object
merge ();
3188 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3189 "Return t if (car A) is numerically less than (car B).")
3193 return Flss (Fcar (a
), Fcar (b
));
3196 /* Build the complete list of annotations appropriate for writing out
3197 the text between START and END, by calling all the functions in
3198 write-region-annotate-functions and merging the lists they return. */
3201 build_annotations (start
, end
)
3202 Lisp_Object start
, end
;
3204 Lisp_Object annotations
;
3206 struct gcpro gcpro1
, gcpro2
;
3209 p
= Vwrite_region_annotate_functions
;
3210 GCPRO2 (annotations
, p
);
3213 res
= call2 (Fcar (p
), start
, end
);
3214 Flength (res
); /* Check basic validity of return value */
3215 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3222 /* Write to descriptor DESC the LEN characters starting at ADDR,
3223 assuming they start at position POS in the buffer.
3224 Intersperse with them the annotations from *ANNOT
3225 (those which fall within the range of positions POS to POS + LEN),
3226 each at its appropriate position.
3228 Modify *ANNOT by discarding elements as we output them.
3229 The return value is negative in case of system call failure. */
3232 a_write (desc
, addr
, len
, pos
, annot
)
3234 register char *addr
;
3241 int lastpos
= pos
+ len
;
3245 tem
= Fcar_safe (Fcar (*annot
));
3246 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3247 nextpos
= XFASTINT (tem
);
3249 return e_write (desc
, addr
, lastpos
- pos
);
3252 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3254 addr
+= nextpos
- pos
;
3257 tem
= Fcdr (Fcar (*annot
));
3260 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3263 *annot
= Fcdr (*annot
);
3268 e_write (desc
, addr
, len
)
3270 register char *addr
;
3273 char buf
[16 * 1024];
3274 register char *p
, *end
;
3276 if (!EQ (current_buffer
->selective_display
, Qt
))
3277 return write (desc
, addr
, len
) - len
;
3281 end
= p
+ sizeof buf
;
3286 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3295 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3301 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3302 Sverify_visited_file_modtime
, 1, 1, 0,
3303 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3304 This means that the file has not been changed since it was visited or saved.")
3310 Lisp_Object handler
;
3312 CHECK_BUFFER (buf
, 0);
3315 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3316 if (b
->modtime
== 0) return Qt
;
3318 /* If the file name has special constructs in it,
3319 call the corresponding file handler. */
3320 handler
= Ffind_file_name_handler (b
->filename
);
3321 if (!NILP (handler
))
3322 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3324 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3326 /* If the file doesn't exist now and didn't exist before,
3327 we say that it isn't modified, provided the error is a tame one. */
3328 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3333 if (st
.st_mtime
== b
->modtime
3334 /* If both are positive, accept them if they are off by one second. */
3335 || (st
.st_mtime
> 0 && b
->modtime
> 0
3336 && (st
.st_mtime
== b
->modtime
+ 1
3337 || st
.st_mtime
== b
->modtime
- 1)))
3342 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3343 Sclear_visited_file_modtime
, 0, 0, 0,
3344 "Clear out records of last mod time of visited file.\n\
3345 Next attempt to save will certainly not complain of a discrepancy.")
3348 current_buffer
->modtime
= 0;
3352 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3353 Svisited_file_modtime
, 0, 0, 0,
3354 "Return the current buffer's recorded visited file modification time.\n\
3355 The value is a list of the form (HIGH . LOW), like the time values\n\
3356 that `file-attributes' returns.")
3359 return long_to_cons (current_buffer
->modtime
);
3362 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3363 Sset_visited_file_modtime
, 0, 1, 0,
3364 "Update buffer's recorded modification time from the visited file's time.\n\
3365 Useful if the buffer was not read from the file normally\n\
3366 or if the file itself has been changed for some known benign reason.\n\
3367 An argument specifies the modification time value to use\n\
3368 \(instead of that of the visited file), in the form of a list\n\
3369 \(HIGH . LOW) or (HIGH LOW).")
3371 Lisp_Object time_list
;
3373 if (!NILP (time_list
))
3374 current_buffer
->modtime
= cons_to_long (time_list
);
3377 register Lisp_Object filename
;
3379 Lisp_Object handler
;
3381 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3383 /* If the file name has special constructs in it,
3384 call the corresponding file handler. */
3385 handler
= Ffind_file_name_handler (filename
);
3386 if (!NILP (handler
))
3387 /* The handler can find the file name the same way we did. */
3388 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3389 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3390 current_buffer
->modtime
= st
.st_mtime
;
3399 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3402 message ("Autosaving...error for %s", name
);
3403 Fsleep_for (make_number (1), Qnil
);
3404 message ("Autosaving...error!for %s", name
);
3405 Fsleep_for (make_number (1), Qnil
);
3406 message ("Autosaving...error for %s", name
);
3407 Fsleep_for (make_number (1), Qnil
);
3417 /* Get visited file's mode to become the auto save file's mode. */
3418 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3419 /* But make sure we can overwrite it later! */
3420 auto_save_mode_bits
= st
.st_mode
| 0600;
3422 auto_save_mode_bits
= 0666;
3425 Fwrite_region (Qnil
, Qnil
,
3426 current_buffer
->auto_save_file_name
,
3430 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3431 "Auto-save all buffers that need it.\n\
3432 This is all buffers that have auto-saving enabled\n\
3433 and are changed since last auto-saved.\n\
3434 Auto-saving writes the buffer into a file\n\
3435 so that your editing is not lost if the system crashes.\n\
3436 This file is not the file you visited; that changes only when you save.\n\
3437 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3438 Non-nil first argument means do not print any message if successful.\n\
3439 Non-nil second argument means save only current buffer.")
3440 (no_message
, current_only
)
3441 Lisp_Object no_message
, current_only
;
3443 struct buffer
*old
= current_buffer
, *b
;
3444 Lisp_Object tail
, buf
;
3446 char *omessage
= echo_area_glyphs
;
3447 int omessage_length
= echo_area_glyphs_length
;
3448 extern int minibuf_level
;
3449 int do_handled_files
;
3452 /* Ordinarily don't quit within this function,
3453 but don't make it impossible to quit (in case we get hung in I/O). */
3457 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3458 point to non-strings reached from Vbuffer_alist. */
3464 if (!NILP (Vrun_hooks
))
3465 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3467 /* First, save all files which don't have handlers. If Emacs is
3468 crashing, the handlers may tweak what is causing Emacs to crash
3469 in the first place, and it would be a shame if Emacs failed to
3470 autosave perfectly ordinary files because it couldn't handle some
3472 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3473 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3474 tail
= XCONS (tail
)->cdr
)
3476 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3479 if (!NILP (current_only
)
3480 && b
!= current_buffer
)
3483 /* Check for auto save enabled
3484 and file changed since last auto save
3485 and file changed since last real save. */
3486 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3487 && b
->save_modified
< BUF_MODIFF (b
)
3488 && b
->auto_save_modified
< BUF_MODIFF (b
)
3489 && (do_handled_files
3490 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3492 EMACS_TIME before_time
, after_time
;
3494 EMACS_GET_TIME (before_time
);
3496 /* If we had a failure, don't try again for 20 minutes. */
3497 if (b
->auto_save_failure_time
>= 0
3498 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3501 if ((XFASTINT (b
->save_length
) * 10
3502 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3503 /* A short file is likely to change a large fraction;
3504 spare the user annoying messages. */
3505 && XFASTINT (b
->save_length
) > 5000
3506 /* These messages are frequent and annoying for `*mail*'. */
3507 && !EQ (b
->filename
, Qnil
)
3508 && NILP (no_message
))
3510 /* It has shrunk too much; turn off auto-saving here. */
3511 message ("Buffer %s has shrunk a lot; auto save turned off there",
3512 XSTRING (b
->name
)->data
);
3513 /* User can reenable saving with M-x auto-save. */
3514 b
->auto_save_file_name
= Qnil
;
3515 /* Prevent warning from repeating if user does so. */
3516 XFASTINT (b
->save_length
) = 0;
3517 Fsleep_for (make_number (1), Qnil
);
3520 set_buffer_internal (b
);
3521 if (!auto_saved
&& NILP (no_message
))
3522 message1 ("Auto-saving...");
3523 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3525 b
->auto_save_modified
= BUF_MODIFF (b
);
3526 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3527 set_buffer_internal (old
);
3529 EMACS_GET_TIME (after_time
);
3531 /* If auto-save took more than 60 seconds,
3532 assume it was an NFS failure that got a timeout. */
3533 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3534 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3538 /* Prevent another auto save till enough input events come in. */
3539 record_auto_save ();
3541 if (auto_saved
&& NILP (no_message
))
3544 message2 (omessage
, omessage_length
);
3546 message1 ("Auto-saving...done");
3555 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3556 Sset_buffer_auto_saved
, 0, 0, 0,
3557 "Mark current buffer as auto-saved with its current text.\n\
3558 No auto-save file will be written until the buffer changes again.")
3561 current_buffer
->auto_save_modified
= MODIFF
;
3562 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3563 current_buffer
->auto_save_failure_time
= -1;
3567 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3568 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3569 "Clear any record of a recent auto-save failure in the current buffer.")
3572 current_buffer
->auto_save_failure_time
= -1;
3576 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3578 "Return t if buffer has been auto-saved since last read in or saved.")
3581 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3584 /* Reading and completing file names */
3585 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3587 /* In the string VAL, change each $ to $$ and return the result. */
3590 double_dollars (val
)
3593 register unsigned char *old
, *new;
3597 osize
= XSTRING (val
)->size
;
3598 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3599 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3600 if (*old
++ == '$') count
++;
3603 old
= XSTRING (val
)->data
;
3604 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3605 new = XSTRING (val
)->data
;
3606 for (n
= osize
; n
> 0; n
--)
3619 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3621 "Internal subroutine for read-file-name. Do not call this.")
3622 (string
, dir
, action
)
3623 Lisp_Object string
, dir
, action
;
3624 /* action is nil for complete, t for return list of completions,
3625 lambda for verify final value */
3627 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3629 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3636 /* No need to protect ACTION--we only compare it with t and nil. */
3637 GCPRO4 (string
, realdir
, name
, specdir
);
3639 if (XSTRING (string
)->size
== 0)
3641 if (EQ (action
, Qlambda
))
3649 orig_string
= string
;
3650 string
= Fsubstitute_in_file_name (string
);
3651 changed
= NILP (Fstring_equal (string
, orig_string
));
3652 name
= Ffile_name_nondirectory (string
);
3653 val
= Ffile_name_directory (string
);
3655 realdir
= Fexpand_file_name (val
, realdir
);
3660 specdir
= Ffile_name_directory (string
);
3661 val
= Ffile_name_completion (name
, realdir
);
3663 if (XTYPE (val
) != Lisp_String
)
3670 if (!NILP (specdir
))
3671 val
= concat2 (specdir
, val
);
3673 return double_dollars (val
);
3676 #endif /* not VMS */
3680 if (EQ (action
, Qt
))
3681 return Ffile_name_all_completions (name
, realdir
);
3682 /* Only other case actually used is ACTION = lambda */
3684 /* Supposedly this helps commands such as `cd' that read directory names,
3685 but can someone explain how it helps them? -- RMS */
3686 if (XSTRING (name
)->size
== 0)
3689 return Ffile_exists_p (string
);
3692 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3693 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3694 Value is not expanded---you must call `expand-file-name' yourself.\n\
3695 Default name to DEFAULT if user enters a null string.\n\
3696 (If DEFAULT is omitted, the visited file name is used.)\n\
3697 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3698 Non-nil and non-t means also require confirmation after completion.\n\
3699 Fifth arg INITIAL specifies text to start with.\n\
3700 DIR defaults to current buffer's directory default.")
3701 (prompt
, dir
, defalt
, mustmatch
, initial
)
3702 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3704 Lisp_Object val
, insdef
, insdef1
, tem
;
3705 struct gcpro gcpro1
, gcpro2
;
3706 register char *homedir
;
3710 dir
= current_buffer
->directory
;
3712 defalt
= current_buffer
->filename
;
3714 /* If dir starts with user's homedir, change that to ~. */
3715 homedir
= (char *) egetenv ("HOME");
3717 && XTYPE (dir
) == Lisp_String
3718 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3719 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3721 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3722 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3723 XSTRING (dir
)->data
[0] = '~';
3726 if (insert_default_directory
)
3729 if (!NILP (initial
))
3731 Lisp_Object args
[2], pos
;
3735 insdef
= Fconcat (2, args
);
3736 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3737 insdef1
= Fcons (double_dollars (insdef
), pos
);
3740 insdef1
= double_dollars (insdef
);
3742 else if (!NILP (initial
))
3745 insdef1
= Fcons (double_dollars (insdef
), 0);
3748 insdef
= Qnil
, insdef1
= Qnil
;
3751 count
= specpdl_ptr
- specpdl
;
3752 specbind (intern ("completion-ignore-case"), Qt
);
3755 GCPRO2 (insdef
, defalt
);
3756 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3757 dir
, mustmatch
, insdef1
,
3758 Qfile_name_history
);
3761 unbind_to (count
, Qnil
);
3766 error ("No file name specified");
3767 tem
= Fstring_equal (val
, insdef
);
3768 if (!NILP (tem
) && !NILP (defalt
))
3770 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3775 error ("No default file name");
3777 return Fsubstitute_in_file_name (val
);
3780 #if 0 /* Old version */
3781 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3782 /* Don't confuse make-docfile by having two doc strings for this function.
3783 make-docfile does not pay attention to #if, for good reason! */
3785 (prompt
, dir
, defalt
, mustmatch
, initial
)
3786 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3788 Lisp_Object val
, insdef
, tem
;
3789 struct gcpro gcpro1
, gcpro2
;
3790 register char *homedir
;
3794 dir
= current_buffer
->directory
;
3796 defalt
= current_buffer
->filename
;
3798 /* If dir starts with user's homedir, change that to ~. */
3799 homedir
= (char *) egetenv ("HOME");
3801 && XTYPE (dir
) == Lisp_String
3802 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3803 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3805 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3806 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3807 XSTRING (dir
)->data
[0] = '~';
3810 if (!NILP (initial
))
3812 else if (insert_default_directory
)
3815 insdef
= build_string ("");
3818 count
= specpdl_ptr
- specpdl
;
3819 specbind (intern ("completion-ignore-case"), Qt
);
3822 GCPRO2 (insdef
, defalt
);
3823 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3825 insert_default_directory
? insdef
: Qnil
,
3826 Qfile_name_history
);
3829 unbind_to (count
, Qnil
);
3834 error ("No file name specified");
3835 tem
= Fstring_equal (val
, insdef
);
3836 if (!NILP (tem
) && !NILP (defalt
))
3838 return Fsubstitute_in_file_name (val
);
3840 #endif /* Old version */
3844 Qexpand_file_name
= intern ("expand-file-name");
3845 Qdirectory_file_name
= intern ("directory-file-name");
3846 Qfile_name_directory
= intern ("file-name-directory");
3847 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3848 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3849 Qfile_name_as_directory
= intern ("file-name-as-directory");
3850 Qcopy_file
= intern ("copy-file");
3851 Qmake_directory
= intern ("make-directory");
3852 Qdelete_directory
= intern ("delete-directory");
3853 Qdelete_file
= intern ("delete-file");
3854 Qrename_file
= intern ("rename-file");
3855 Qadd_name_to_file
= intern ("add-name-to-file");
3856 Qmake_symbolic_link
= intern ("make-symbolic-link");
3857 Qfile_exists_p
= intern ("file-exists-p");
3858 Qfile_executable_p
= intern ("file-executable-p");
3859 Qfile_readable_p
= intern ("file-readable-p");
3860 Qfile_symlink_p
= intern ("file-symlink-p");
3861 Qfile_writable_p
= intern ("file-writable-p");
3862 Qfile_directory_p
= intern ("file-directory-p");
3863 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3864 Qfile_modes
= intern ("file-modes");
3865 Qset_file_modes
= intern ("set-file-modes");
3866 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3867 Qinsert_file_contents
= intern ("insert-file-contents");
3868 Qwrite_region
= intern ("write-region");
3869 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3870 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3872 staticpro (&Qexpand_file_name
);
3873 staticpro (&Qdirectory_file_name
);
3874 staticpro (&Qfile_name_directory
);
3875 staticpro (&Qfile_name_nondirectory
);
3876 staticpro (&Qunhandled_file_name_directory
);
3877 staticpro (&Qfile_name_as_directory
);
3878 staticpro (&Qcopy_file
);
3879 staticpro (&Qmake_directory
);
3880 staticpro (&Qdelete_directory
);
3881 staticpro (&Qdelete_file
);
3882 staticpro (&Qrename_file
);
3883 staticpro (&Qadd_name_to_file
);
3884 staticpro (&Qmake_symbolic_link
);
3885 staticpro (&Qfile_exists_p
);
3886 staticpro (&Qfile_executable_p
);
3887 staticpro (&Qfile_readable_p
);
3888 staticpro (&Qfile_symlink_p
);
3889 staticpro (&Qfile_writable_p
);
3890 staticpro (&Qfile_directory_p
);
3891 staticpro (&Qfile_accessible_directory_p
);
3892 staticpro (&Qfile_modes
);
3893 staticpro (&Qset_file_modes
);
3894 staticpro (&Qfile_newer_than_file_p
);
3895 staticpro (&Qinsert_file_contents
);
3896 staticpro (&Qwrite_region
);
3897 staticpro (&Qverify_visited_file_modtime
);
3899 Qfile_name_history
= intern ("file-name-history");
3900 Fset (Qfile_name_history
, Qnil
);
3901 staticpro (&Qfile_name_history
);
3903 Qfile_error
= intern ("file-error");
3904 staticpro (&Qfile_error
);
3905 Qfile_already_exists
= intern("file-already-exists");
3906 staticpro (&Qfile_already_exists
);
3909 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
3910 staticpro (&Qfind_buffer_file_type
);
3913 Qcar_less_than_car
= intern ("car-less-than-car");
3914 staticpro (&Qcar_less_than_car
);
3916 Fput (Qfile_error
, Qerror_conditions
,
3917 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3918 Fput (Qfile_error
, Qerror_message
,
3919 build_string ("File error"));
3921 Fput (Qfile_already_exists
, Qerror_conditions
,
3922 Fcons (Qfile_already_exists
,
3923 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3924 Fput (Qfile_already_exists
, Qerror_message
,
3925 build_string ("File already exists"));
3927 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3928 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3929 insert_default_directory
= 1;
3931 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3932 "*Non-nil means write new files with record format `stmlf'.\n\
3933 nil means use format `var'. This variable is meaningful only on VMS.");
3934 vms_stmlf_recfm
= 0;
3936 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3937 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3938 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3941 The first argument given to HANDLER is the name of the I/O primitive\n\
3942 to be handled; the remaining arguments are the arguments that were\n\
3943 passed to that primitive. For example, if you do\n\
3944 (file-exists-p FILENAME)\n\
3945 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3946 (funcall HANDLER 'file-exists-p FILENAME)\n\
3947 The function `find-file-name-handler' checks this list for a handler\n\
3948 for its argument.");
3949 Vfile_name_handler_alist
= Qnil
;
3951 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
3952 "A list of functions to be called at the end of `insert-file-contents'.\n\
3953 Each is passed one argument, the number of bytes inserted. It should return\n\
3954 the new byte count, and leave point the same. If `insert-file-contents' is\n\
3955 intercepted by a handler from `file-name-handler-alist', that handler is\n\
3956 responsible for calling the after-insert-file-functions if appropriate.");
3957 Vafter_insert_file_functions
= Qnil
;
3959 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
3960 "A list of functions to be called at the start of `write-region'.\n\
3961 Each is passed two arguments, START and END as for `write-region'. It should\n\
3962 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
3963 inserted at the specified positions of the file being written (1 means to\n\
3964 insert before the first byte written). The POSITIONs must be sorted into\n\
3965 increasing order. If there are several functions in the list, the several\n\
3966 lists are merged destructively.");
3967 Vwrite_region_annotate_functions
= Qnil
;
3969 defsubr (&Sfind_file_name_handler
);
3970 defsubr (&Sfile_name_directory
);
3971 defsubr (&Sfile_name_nondirectory
);
3972 defsubr (&Sunhandled_file_name_directory
);
3973 defsubr (&Sfile_name_as_directory
);
3974 defsubr (&Sdirectory_file_name
);
3975 defsubr (&Smake_temp_name
);
3976 defsubr (&Sexpand_file_name
);
3977 defsubr (&Ssubstitute_in_file_name
);
3978 defsubr (&Scopy_file
);
3979 defsubr (&Smake_directory_internal
);
3980 defsubr (&Sdelete_directory
);
3981 defsubr (&Sdelete_file
);
3982 defsubr (&Srename_file
);
3983 defsubr (&Sadd_name_to_file
);
3985 defsubr (&Smake_symbolic_link
);
3986 #endif /* S_IFLNK */
3988 defsubr (&Sdefine_logical_name
);
3991 defsubr (&Ssysnetunam
);
3992 #endif /* HPUX_NET */
3993 defsubr (&Sfile_name_absolute_p
);
3994 defsubr (&Sfile_exists_p
);
3995 defsubr (&Sfile_executable_p
);
3996 defsubr (&Sfile_readable_p
);
3997 defsubr (&Sfile_writable_p
);
3998 defsubr (&Sfile_symlink_p
);
3999 defsubr (&Sfile_directory_p
);
4000 defsubr (&Sfile_accessible_directory_p
);
4001 defsubr (&Sfile_modes
);
4002 defsubr (&Sset_file_modes
);
4003 defsubr (&Sset_default_file_modes
);
4004 defsubr (&Sdefault_file_modes
);
4005 defsubr (&Sfile_newer_than_file_p
);
4006 defsubr (&Sinsert_file_contents
);
4007 defsubr (&Swrite_region
);
4008 defsubr (&Scar_less_than_car
);
4009 defsubr (&Sverify_visited_file_modtime
);
4010 defsubr (&Sclear_visited_file_modtime
);
4011 defsubr (&Svisited_file_modtime
);
4012 defsubr (&Sset_visited_file_modtime
);
4013 defsubr (&Sdo_auto_save
);
4014 defsubr (&Sset_buffer_auto_saved
);
4015 defsubr (&Sclear_buffer_auto_save_failure
);
4016 defsubr (&Srecent_auto_save_p
);
4018 defsubr (&Sread_file_name_internal
);
4019 defsubr (&Sread_file_name
);
4022 defsubr (&Sunix_sync
);