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 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 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 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 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)
2355 return make_number (st
.st_mode
& 07777);
2358 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2359 "Set mode bits of FILE to MODE (an integer).\n\
2360 Only the 12 low bits of MODE are used.")
2362 Lisp_Object filename
, mode
;
2364 Lisp_Object abspath
;
2365 Lisp_Object handler
;
2367 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2368 CHECK_NUMBER (mode
, 1);
2370 /* If the file name has special constructs in it,
2371 call the corresponding file handler. */
2372 handler
= Ffind_file_name_handler (abspath
);
2373 if (!NILP (handler
))
2374 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2377 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2378 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2380 if (!egetenv ("USE_DOMAIN_ACLS"))
2383 struct timeval tvp
[2];
2385 /* chmod on apollo also change the file's modtime; need to save the
2386 modtime and then restore it. */
2387 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2389 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2393 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2394 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2396 /* reset the old accessed and modified times. */
2397 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2399 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2402 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2403 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2410 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2411 "Set the file permission bits for newly created files.\n\
2412 The argument MODE should be an integer; only the low 9 bits are used.\n\
2413 This setting is inherited by subprocesses.")
2417 CHECK_NUMBER (mode
, 0);
2419 umask ((~ XINT (mode
)) & 0777);
2424 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2425 "Return the default file protection for created files.\n\
2426 The value is an integer.")
2432 realmask
= umask (0);
2435 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2441 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2442 "Tell Unix to finish all pending disk updates.")
2451 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2452 "Return t if file FILE1 is newer than file FILE2.\n\
2453 If FILE1 does not exist, the answer is nil;\n\
2454 otherwise, if FILE2 does not exist, the answer is t.")
2456 Lisp_Object file1
, file2
;
2458 Lisp_Object abspath1
, abspath2
;
2461 Lisp_Object handler
;
2462 struct gcpro gcpro1
, gcpro2
;
2464 CHECK_STRING (file1
, 0);
2465 CHECK_STRING (file2
, 0);
2468 GCPRO2 (abspath1
, file2
);
2469 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2470 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2473 /* If the file name has special constructs in it,
2474 call the corresponding file handler. */
2475 handler
= Ffind_file_name_handler (abspath1
);
2477 handler
= Ffind_file_name_handler (abspath2
);
2478 if (!NILP (handler
))
2479 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2481 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2484 mtime1
= st
.st_mtime
;
2486 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2489 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2493 Lisp_Object Qfind_buffer_file_type
;
2496 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2498 "Insert contents of file FILENAME after point.\n\
2499 Returns list of absolute file name and length of data inserted.\n\
2500 If second argument VISIT is non-nil, the buffer's visited filename\n\
2501 and last save file modtime are set, and it is marked unmodified.\n\
2502 If visiting and the file does not exist, visiting is completed\n\
2503 before the error is signaled.\n\n\
2504 The optional third and fourth arguments BEG and END\n\
2505 specify what portion of the file to insert.\n\
2506 If VISIT is non-nil, BEG and END must be nil.\n\
2507 If optional fifth argument REPLACE is non-nil,\n\
2508 it means replace the current buffer contents (in the accessible portion)\n\
2509 with the file contents. This is better than simply deleting and inserting\n\
2510 the whole thing because (1) it preserves some marker positions\n\
2511 and (2) it puts less data in the undo list.")
2512 (filename
, visit
, beg
, end
, replace
)
2513 Lisp_Object filename
, visit
, beg
, end
, replace
;
2517 register int inserted
= 0;
2518 register int how_much
;
2519 int count
= specpdl_ptr
- specpdl
;
2520 struct gcpro gcpro1
, gcpro2
;
2521 Lisp_Object handler
, val
, insval
;
2528 GCPRO2 (filename
, p
);
2529 if (!NILP (current_buffer
->read_only
))
2530 Fbarf_if_buffer_read_only();
2532 CHECK_STRING (filename
, 0);
2533 filename
= Fexpand_file_name (filename
, Qnil
);
2535 /* If the file name has special constructs in it,
2536 call the corresponding file handler. */
2537 handler
= Ffind_file_name_handler (filename
);
2538 if (!NILP (handler
))
2540 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2541 visit
, beg
, end
, replace
);
2548 if (stat (XSTRING (filename
)->data
, &st
) < 0
2549 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2551 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2552 || fstat (fd
, &st
) < 0)
2553 #endif /* not APOLLO */
2555 if (fd
>= 0) close (fd
);
2557 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2563 /* Replacement should preserve point as it preserves markers. */
2564 if (!NILP (replace
))
2565 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2567 record_unwind_protect (close_file_unwind
, make_number (fd
));
2570 /* This code will need to be changed in order to work on named
2571 pipes, and it's probably just not worth it. So we should at
2572 least signal an error. */
2573 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2574 Fsignal (Qfile_error
,
2575 Fcons (build_string ("reading from named pipe"),
2576 Fcons (filename
, Qnil
)));
2579 /* Supposedly happens on VMS. */
2581 error ("File size is negative");
2583 if (!NILP (beg
) || !NILP (end
))
2585 error ("Attempt to visit less than an entire file");
2588 CHECK_NUMBER (beg
, 0);
2593 CHECK_NUMBER (end
, 0);
2596 XSETINT (end
, st
.st_size
);
2597 if (XINT (end
) != st
.st_size
)
2598 error ("maximum buffer size exceeded");
2601 /* If requested, replace the accessible part of the buffer
2602 with the file contents. Avoid replacing text at the
2603 beginning or end of the buffer that matches the file contents;
2604 that preserves markers pointing to the unchanged parts. */
2605 if (!NILP (replace
))
2607 char buffer
[1 << 14];
2608 int same_at_start
= BEGV
;
2609 int same_at_end
= ZV
;
2614 /* Count how many chars at the start of the file
2615 match the text at the beginning of the buffer. */
2620 nread
= read (fd
, buffer
, sizeof buffer
);
2622 error ("IO error reading %s: %s",
2623 XSTRING (filename
)->data
, strerror (errno
));
2624 else if (nread
== 0)
2627 while (bufpos
< nread
&& same_at_start
< ZV
2628 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2629 same_at_start
++, bufpos
++;
2630 /* If we found a discrepancy, stop the scan.
2631 Otherwise loop around and scan the next bufferfull. */
2632 if (bufpos
!= nread
)
2636 /* If the file matches the buffer completely,
2637 there's no need to replace anything. */
2638 if (same_at_start
== ZV
)
2646 /* Count how many chars at the end of the file
2647 match the text at the end of the buffer. */
2650 int total_read
, nread
, bufpos
, curpos
, trial
;
2652 /* At what file position are we now scanning? */
2653 curpos
= st
.st_size
- (ZV
- same_at_end
);
2654 /* How much can we scan in the next step? */
2655 trial
= min (curpos
, sizeof buffer
);
2656 if (lseek (fd
, curpos
- trial
, 0) < 0)
2657 report_file_error ("Setting file position",
2658 Fcons (filename
, Qnil
));
2661 while (total_read
< trial
)
2663 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2665 error ("IO error reading %s: %s",
2666 XSTRING (filename
)->data
, strerror (errno
));
2667 total_read
+= nread
;
2669 /* Scan this bufferfull from the end, comparing with
2670 the Emacs buffer. */
2671 bufpos
= total_read
;
2672 /* Compare with same_at_start to avoid counting some buffer text
2673 as matching both at the file's beginning and at the end. */
2674 while (bufpos
> 0 && same_at_end
> same_at_start
2675 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2676 same_at_end
--, bufpos
--;
2677 /* If we found a discrepancy, stop the scan.
2678 Otherwise loop around and scan the preceding bufferfull. */
2684 /* Don't try to reuse the same piece of text twice. */
2685 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2687 same_at_end
+= overlap
;
2689 /* Arrange to read only the nonmatching middle part of the file. */
2690 XFASTINT (beg
) = same_at_start
- BEGV
;
2691 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2693 del_range_1 (same_at_start
, same_at_end
, 0);
2694 /* Insert from the file at the proper position. */
2695 SET_PT (same_at_start
);
2698 total
= XINT (end
) - XINT (beg
);
2701 register Lisp_Object temp
;
2703 /* Make sure point-max won't overflow after this insertion. */
2704 XSET (temp
, Lisp_Int
, total
);
2705 if (total
!= XINT (temp
))
2706 error ("maximum buffer size exceeded");
2709 if (NILP (visit
) && total
> 0)
2710 prepare_to_modify_buffer (point
, point
);
2713 if (GAP_SIZE
< total
)
2714 make_gap (total
- GAP_SIZE
);
2716 if (XINT (beg
) != 0 || !NILP (replace
))
2718 if (lseek (fd
, XINT (beg
), 0) < 0)
2719 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2723 while (inserted
< total
)
2725 int try = min (total
- inserted
, 64 << 10);
2728 /* Allow quitting out of the actual I/O. */
2731 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2748 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2749 /* Determine file type from name and remove LFs from CR-LFs if the file
2750 is deemed to be a text file. */
2752 struct gcpro gcpro1
;
2753 Lisp_Object code
= Qnil
;
2755 code
= call1 (Qfind_buffer_file_type
, filename
);
2757 if (XTYPE (code
) == Lisp_Int
)
2758 XFASTINT (current_buffer
->buffer_file_type
) = XFASTINT (code
);
2759 if (XFASTINT (current_buffer
->buffer_file_type
) == 0)
2762 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2765 GPT
-= reduced_size
;
2766 GAP_SIZE
+= reduced_size
;
2767 inserted
-= reduced_size
;
2774 record_insert (point
, inserted
);
2776 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2777 offset_intervals (current_buffer
, point
, inserted
);
2783 /* Discard the unwind protect for closing the file. */
2787 error ("IO error reading %s: %s",
2788 XSTRING (filename
)->data
, strerror (errno
));
2795 if (!EQ (current_buffer
->undo_list
, Qt
))
2796 current_buffer
->undo_list
= Qnil
;
2798 stat (XSTRING (filename
)->data
, &st
);
2803 current_buffer
->modtime
= st
.st_mtime
;
2804 current_buffer
->filename
= filename
;
2807 current_buffer
->save_modified
= MODIFF
;
2808 current_buffer
->auto_save_modified
= MODIFF
;
2809 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2810 #ifdef CLASH_DETECTION
2813 if (!NILP (current_buffer
->filename
))
2814 unlock_file (current_buffer
->filename
);
2815 unlock_file (filename
);
2817 #endif /* CLASH_DETECTION */
2818 /* If visiting nonexistent file, return nil. */
2819 if (current_buffer
->modtime
== -1)
2820 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2823 if (inserted
> 0 && NILP (visit
) && total
> 0)
2824 signal_after_change (point
, 0, inserted
);
2828 p
= Vafter_insert_file_functions
;
2831 insval
= call1 (Fcar (p
), make_number (inserted
));
2834 CHECK_NUMBER (insval
, 0);
2835 inserted
= XFASTINT (insval
);
2843 val
= Fcons (filename
,
2844 Fcons (make_number (inserted
),
2847 RETURN_UNGCPRO (unbind_to (count
, val
));
2850 static Lisp_Object
build_annotations ();
2852 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2853 "r\nFWrite region to file: ",
2854 "Write current region into specified file.\n\
2855 When called from a program, takes three arguments:\n\
2856 START, END and FILENAME. START and END are buffer positions.\n\
2857 Optional fourth argument APPEND if non-nil means\n\
2858 append to existing file contents (if any).\n\
2859 Optional fifth argument VISIT if t means\n\
2860 set the last-save-file-modtime of buffer to this file's modtime\n\
2861 and mark buffer not modified.\n\
2862 If VISIT is a string, it is a second file name;\n\
2863 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2864 VISIT is also the file name to lock and unlock for clash detection.\n\
2865 If VISIT is neither t nor nil nor a string,\n\
2866 that means do not print the \"Wrote file\" message.\n\
2867 Kludgy feature: if START is a string, then that string is written\n\
2868 to the file, instead of any buffer contents, and END is ignored.")
2869 (start
, end
, filename
, append
, visit
)
2870 Lisp_Object start
, end
, filename
, append
, visit
;
2878 int count
= specpdl_ptr
- specpdl
;
2880 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2882 Lisp_Object handler
;
2883 Lisp_Object visit_file
;
2884 Lisp_Object annotations
;
2885 int visiting
, quietly
;
2886 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2888 int buffer_file_type
2889 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2892 if (!NILP (start
) && !STRINGP (start
))
2893 validate_region (&start
, &end
);
2895 filename
= Fexpand_file_name (filename
, Qnil
);
2896 if (STRINGP (visit
))
2897 visit_file
= Fexpand_file_name (visit
, Qnil
);
2899 visit_file
= filename
;
2901 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2902 quietly
= !NILP (visit
);
2906 GCPRO4 (start
, filename
, annotations
, visit_file
);
2908 /* If the file name has special constructs in it,
2909 call the corresponding file handler. */
2910 handler
= Ffind_file_name_handler (filename
);
2911 /* If FILENAME has no handler, see if VISIT has one. */
2912 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2913 handler
= Ffind_file_name_handler (visit
);
2915 if (!NILP (handler
))
2918 val
= call6 (handler
, Qwrite_region
, start
, end
,
2919 filename
, append
, visit
);
2923 current_buffer
->save_modified
= MODIFF
;
2924 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2925 current_buffer
->filename
= visit_file
;
2931 /* Special kludge to simplify auto-saving. */
2934 XFASTINT (start
) = BEG
;
2938 annotations
= build_annotations (start
, end
);
2940 #ifdef CLASH_DETECTION
2942 lock_file (visit_file
);
2943 #endif /* CLASH_DETECTION */
2945 fn
= XSTRING (filename
)->data
;
2949 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
2951 desc
= open (fn
, O_WRONLY
);
2956 if (auto_saving
) /* Overwrite any previous version of autosave file */
2958 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2959 desc
= open (fn
, O_RDWR
);
2961 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
2962 ? XSTRING (current_buffer
->filename
)->data
: 0,
2965 else /* Write to temporary name and rename if no errors */
2967 Lisp_Object temp_name
;
2968 temp_name
= Ffile_name_directory (filename
);
2970 if (!NILP (temp_name
))
2972 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2973 build_string ("$$SAVE$$")));
2974 fname
= XSTRING (filename
)->data
;
2975 fn
= XSTRING (temp_name
)->data
;
2976 desc
= creat_copy_attrs (fname
, fn
);
2979 /* If we can't open the temporary file, try creating a new
2980 version of the original file. VMS "creat" creates a
2981 new version rather than truncating an existing file. */
2984 desc
= creat (fn
, 0666);
2985 #if 0 /* This can clobber an existing file and fail to replace it,
2986 if the user runs out of space. */
2989 /* We can't make a new version;
2990 try to truncate and rewrite existing version if any. */
2992 desc
= open (fn
, O_RDWR
);
2998 desc
= creat (fn
, 0666);
3003 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3004 S_IREAD
| S_IWRITE
);
3005 #else /* not MSDOS */
3006 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3007 #endif /* not MSDOS */
3008 #endif /* not VMS */
3014 #ifdef CLASH_DETECTION
3016 if (!auto_saving
) unlock_file (visit_file
);
3018 #endif /* CLASH_DETECTION */
3019 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3022 record_unwind_protect (close_file_unwind
, make_number (desc
));
3025 if (lseek (desc
, 0, 2) < 0)
3027 #ifdef CLASH_DETECTION
3028 if (!auto_saving
) unlock_file (visit_file
);
3029 #endif /* CLASH_DETECTION */
3030 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3035 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3036 * if we do writes that don't end with a carriage return. Furthermore
3037 * it cannot handle writes of more then 16K. The modified
3038 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3039 * this EXCEPT for the last record (iff it doesn't end with a carriage
3040 * return). This implies that if your buffer doesn't end with a carriage
3041 * return, you get one free... tough. However it also means that if
3042 * we make two calls to sys_write (a la the following code) you can
3043 * get one at the gap as well. The easiest way to fix this (honest)
3044 * is to move the gap to the next newline (or the end of the buffer).
3049 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3050 move_gap (find_next_newline (GPT
, 1));
3056 if (STRINGP (start
))
3058 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3059 XSTRING (start
)->size
, 0, &annotations
);
3062 else if (XINT (start
) != XINT (end
))
3065 if (XINT (start
) < GPT
)
3067 register int end1
= XINT (end
);
3069 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3070 min (GPT
, end1
) - tem
, tem
, &annotations
);
3071 nwritten
+= min (GPT
, end1
) - tem
;
3075 if (XINT (end
) > GPT
&& !failure
)
3078 tem
= max (tem
, GPT
);
3079 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3081 nwritten
+= XINT (end
) - tem
;
3087 /* If file was empty, still need to write the annotations */
3088 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3096 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3097 Disk full in NFS may be reported here. */
3098 /* mib says that closing the file will try to write as fast as NFS can do
3099 it, and that means the fsync here is not crucial for autosave files. */
3100 if (!auto_saving
&& fsync (desc
) < 0)
3101 failure
= 1, save_errno
= errno
;
3104 /* Spurious "file has changed on disk" warnings have been
3105 observed on Suns as well.
3106 It seems that `close' can change the modtime, under nfs.
3108 (This has supposedly been fixed in Sunos 4,
3109 but who knows about all the other machines with NFS?) */
3112 /* On VMS and APOLLO, must do the stat after the close
3113 since closing changes the modtime. */
3116 /* Recall that #if defined does not work on VMS. */
3123 /* NFS can report a write failure now. */
3124 if (close (desc
) < 0)
3125 failure
= 1, save_errno
= errno
;
3128 /* If we wrote to a temporary name and had no errors, rename to real name. */
3132 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3140 /* Discard the unwind protect */
3141 specpdl_ptr
= specpdl
+ count
;
3143 #ifdef CLASH_DETECTION
3145 unlock_file (visit_file
);
3146 #endif /* CLASH_DETECTION */
3148 /* Do this before reporting IO error
3149 to avoid a "file has changed on disk" warning on
3150 next attempt to save. */
3152 current_buffer
->modtime
= st
.st_mtime
;
3155 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3159 current_buffer
->save_modified
= MODIFF
;
3160 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3161 current_buffer
->filename
= visit_file
;
3167 message ("Wrote %s", XSTRING (visit_file
)->data
);
3172 Lisp_Object
merge ();
3174 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3175 "Return t if (car A) is numerically less than (car B).")
3179 return Flss (Fcar (a
), Fcar (b
));
3182 /* Build the complete list of annotations appropriate for writing out
3183 the text between START and END, by calling all the functions in
3184 write-region-annotate-functions and merging the lists they return. */
3187 build_annotations (start
, end
)
3188 Lisp_Object start
, end
;
3190 Lisp_Object annotations
;
3192 struct gcpro gcpro1
, gcpro2
;
3195 p
= Vwrite_region_annotate_functions
;
3196 GCPRO2 (annotations
, p
);
3199 res
= call2 (Fcar (p
), start
, end
);
3200 Flength (res
); /* Check basic validity of return value */
3201 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3208 /* Write to descriptor DESC the LEN characters starting at ADDR,
3209 assuming they start at position POS in the buffer.
3210 Intersperse with them the annotations from *ANNOT
3211 (those which fall within the range of positions POS to POS + LEN),
3212 each at its appropriate position.
3214 Modify *ANNOT by discarding elements as we output them.
3215 The return value is negative in case of system call failure. */
3218 a_write (desc
, addr
, len
, pos
, annot
)
3220 register char *addr
;
3227 int lastpos
= pos
+ len
;
3231 tem
= Fcar_safe (Fcar (*annot
));
3232 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3233 nextpos
= XFASTINT (tem
);
3235 return e_write (desc
, addr
, lastpos
- pos
);
3238 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3240 addr
+= nextpos
- pos
;
3243 tem
= Fcdr (Fcar (*annot
));
3246 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3249 *annot
= Fcdr (*annot
);
3254 e_write (desc
, addr
, len
)
3256 register char *addr
;
3259 char buf
[16 * 1024];
3260 register char *p
, *end
;
3262 if (!EQ (current_buffer
->selective_display
, Qt
))
3263 return write (desc
, addr
, len
) - len
;
3267 end
= p
+ sizeof buf
;
3272 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3281 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3287 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3288 Sverify_visited_file_modtime
, 1, 1, 0,
3289 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3290 This means that the file has not been changed since it was visited or saved.")
3296 Lisp_Object handler
;
3298 CHECK_BUFFER (buf
, 0);
3301 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3302 if (b
->modtime
== 0) return Qt
;
3304 /* If the file name has special constructs in it,
3305 call the corresponding file handler. */
3306 handler
= Ffind_file_name_handler (b
->filename
);
3307 if (!NILP (handler
))
3308 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3310 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3312 /* If the file doesn't exist now and didn't exist before,
3313 we say that it isn't modified, provided the error is a tame one. */
3314 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3319 if (st
.st_mtime
== b
->modtime
3320 /* If both are positive, accept them if they are off by one second. */
3321 || (st
.st_mtime
> 0 && b
->modtime
> 0
3322 && (st
.st_mtime
== b
->modtime
+ 1
3323 || st
.st_mtime
== b
->modtime
- 1)))
3328 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3329 Sclear_visited_file_modtime
, 0, 0, 0,
3330 "Clear out records of last mod time of visited file.\n\
3331 Next attempt to save will certainly not complain of a discrepancy.")
3334 current_buffer
->modtime
= 0;
3338 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3339 Svisited_file_modtime
, 0, 0, 0,
3340 "Return the current buffer's recorded visited file modification time.\n\
3341 The value is a list of the form (HIGH . LOW), like the time values\n\
3342 that `file-attributes' returns.")
3345 return long_to_cons (current_buffer
->modtime
);
3348 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3349 Sset_visited_file_modtime
, 0, 1, 0,
3350 "Update buffer's recorded modification time from the visited file's time.\n\
3351 Useful if the buffer was not read from the file normally\n\
3352 or if the file itself has been changed for some known benign reason.\n\
3353 An argument specifies the modification time value to use\n\
3354 \(instead of that of the visited file), in the form of a list\n\
3355 \(HIGH . LOW) or (HIGH LOW).")
3357 Lisp_Object time_list
;
3359 if (!NILP (time_list
))
3360 current_buffer
->modtime
= cons_to_long (time_list
);
3363 register Lisp_Object filename
;
3365 Lisp_Object handler
;
3367 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3369 /* If the file name has special constructs in it,
3370 call the corresponding file handler. */
3371 handler
= Ffind_file_name_handler (filename
);
3372 if (!NILP (handler
))
3373 /* The handler can find the file name the same way we did. */
3374 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3375 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3376 current_buffer
->modtime
= st
.st_mtime
;
3385 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3388 message ("Autosaving...error for %s", name
);
3389 Fsleep_for (make_number (1), Qnil
);
3390 message ("Autosaving...error!for %s", name
);
3391 Fsleep_for (make_number (1), Qnil
);
3392 message ("Autosaving...error for %s", name
);
3393 Fsleep_for (make_number (1), Qnil
);
3403 /* Get visited file's mode to become the auto save file's mode. */
3404 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3405 /* But make sure we can overwrite it later! */
3406 auto_save_mode_bits
= st
.st_mode
| 0600;
3408 auto_save_mode_bits
= 0666;
3411 Fwrite_region (Qnil
, Qnil
,
3412 current_buffer
->auto_save_file_name
,
3416 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3417 "Auto-save all buffers that need it.\n\
3418 This is all buffers that have auto-saving enabled\n\
3419 and are changed since last auto-saved.\n\
3420 Auto-saving writes the buffer into a file\n\
3421 so that your editing is not lost if the system crashes.\n\
3422 This file is not the file you visited; that changes only when you save.\n\
3423 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3424 Non-nil first argument means do not print any message if successful.\n\
3425 Non-nil second argument means save only current buffer.")
3426 (no_message
, current_only
)
3427 Lisp_Object no_message
, current_only
;
3429 struct buffer
*old
= current_buffer
, *b
;
3430 Lisp_Object tail
, buf
;
3432 char *omessage
= echo_area_glyphs
;
3433 int omessage_length
= echo_area_glyphs_length
;
3434 extern int minibuf_level
;
3435 int do_handled_files
;
3438 /* Ordinarily don't quit within this function,
3439 but don't make it impossible to quit (in case we get hung in I/O). */
3443 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3444 point to non-strings reached from Vbuffer_alist. */
3450 if (!NILP (Vrun_hooks
))
3451 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3453 /* First, save all files which don't have handlers. If Emacs is
3454 crashing, the handlers may tweak what is causing Emacs to crash
3455 in the first place, and it would be a shame if Emacs failed to
3456 autosave perfectly ordinary files because it couldn't handle some
3458 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3459 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3460 tail
= XCONS (tail
)->cdr
)
3462 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3465 if (!NILP (current_only
)
3466 && b
!= current_buffer
)
3469 /* Check for auto save enabled
3470 and file changed since last auto save
3471 and file changed since last real save. */
3472 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3473 && b
->save_modified
< BUF_MODIFF (b
)
3474 && b
->auto_save_modified
< BUF_MODIFF (b
)
3475 && (do_handled_files
3476 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3478 EMACS_TIME before_time
, after_time
;
3480 EMACS_GET_TIME (before_time
);
3482 /* If we had a failure, don't try again for 20 minutes. */
3483 if (b
->auto_save_failure_time
>= 0
3484 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3487 if ((XFASTINT (b
->save_length
) * 10
3488 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3489 /* A short file is likely to change a large fraction;
3490 spare the user annoying messages. */
3491 && XFASTINT (b
->save_length
) > 5000
3492 /* These messages are frequent and annoying for `*mail*'. */
3493 && !EQ (b
->filename
, Qnil
)
3494 && NILP (no_message
))
3496 /* It has shrunk too much; turn off auto-saving here. */
3497 message ("Buffer %s has shrunk a lot; auto save turned off there",
3498 XSTRING (b
->name
)->data
);
3499 /* User can reenable saving with M-x auto-save. */
3500 b
->auto_save_file_name
= Qnil
;
3501 /* Prevent warning from repeating if user does so. */
3502 XFASTINT (b
->save_length
) = 0;
3503 Fsleep_for (make_number (1), Qnil
);
3506 set_buffer_internal (b
);
3507 if (!auto_saved
&& NILP (no_message
))
3508 message1 ("Auto-saving...");
3509 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3511 b
->auto_save_modified
= BUF_MODIFF (b
);
3512 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3513 set_buffer_internal (old
);
3515 EMACS_GET_TIME (after_time
);
3517 /* If auto-save took more than 60 seconds,
3518 assume it was an NFS failure that got a timeout. */
3519 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3520 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3524 /* Prevent another auto save till enough input events come in. */
3525 record_auto_save ();
3527 if (auto_saved
&& NILP (no_message
))
3530 message2 (omessage
, omessage_length
);
3532 message1 ("Auto-saving...done");
3541 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3542 Sset_buffer_auto_saved
, 0, 0, 0,
3543 "Mark current buffer as auto-saved with its current text.\n\
3544 No auto-save file will be written until the buffer changes again.")
3547 current_buffer
->auto_save_modified
= MODIFF
;
3548 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3549 current_buffer
->auto_save_failure_time
= -1;
3553 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3554 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3555 "Clear any record of a recent auto-save failure in the current buffer.")
3558 current_buffer
->auto_save_failure_time
= -1;
3562 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3564 "Return t if buffer has been auto-saved since last read in or saved.")
3567 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3570 /* Reading and completing file names */
3571 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3573 /* In the string VAL, change each $ to $$ and return the result. */
3576 double_dollars (val
)
3579 register unsigned char *old
, *new;
3583 osize
= XSTRING (val
)->size
;
3584 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3585 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3586 if (*old
++ == '$') count
++;
3589 old
= XSTRING (val
)->data
;
3590 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3591 new = XSTRING (val
)->data
;
3592 for (n
= osize
; n
> 0; n
--)
3605 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3607 "Internal subroutine for read-file-name. Do not call this.")
3608 (string
, dir
, action
)
3609 Lisp_Object string
, dir
, action
;
3610 /* action is nil for complete, t for return list of completions,
3611 lambda for verify final value */
3613 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3615 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3622 /* No need to protect ACTION--we only compare it with t and nil. */
3623 GCPRO4 (string
, realdir
, name
, specdir
);
3625 if (XSTRING (string
)->size
== 0)
3627 if (EQ (action
, Qlambda
))
3635 orig_string
= string
;
3636 string
= Fsubstitute_in_file_name (string
);
3637 changed
= NILP (Fstring_equal (string
, orig_string
));
3638 name
= Ffile_name_nondirectory (string
);
3639 val
= Ffile_name_directory (string
);
3641 realdir
= Fexpand_file_name (val
, realdir
);
3646 specdir
= Ffile_name_directory (string
);
3647 val
= Ffile_name_completion (name
, realdir
);
3649 if (XTYPE (val
) != Lisp_String
)
3656 if (!NILP (specdir
))
3657 val
= concat2 (specdir
, val
);
3659 return double_dollars (val
);
3662 #endif /* not VMS */
3666 if (EQ (action
, Qt
))
3667 return Ffile_name_all_completions (name
, realdir
);
3668 /* Only other case actually used is ACTION = lambda */
3670 /* Supposedly this helps commands such as `cd' that read directory names,
3671 but can someone explain how it helps them? -- RMS */
3672 if (XSTRING (name
)->size
== 0)
3675 return Ffile_exists_p (string
);
3678 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3679 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3680 Value is not expanded---you must call `expand-file-name' yourself.\n\
3681 Default name to DEFAULT if user enters a null string.\n\
3682 (If DEFAULT is omitted, the visited file name is used.)\n\
3683 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3684 Non-nil and non-t means also require confirmation after completion.\n\
3685 Fifth arg INITIAL specifies text to start with.\n\
3686 DIR defaults to current buffer's directory default.")
3687 (prompt
, dir
, defalt
, mustmatch
, initial
)
3688 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3690 Lisp_Object val
, insdef
, insdef1
, tem
;
3691 struct gcpro gcpro1
, gcpro2
;
3692 register char *homedir
;
3696 dir
= current_buffer
->directory
;
3698 defalt
= current_buffer
->filename
;
3700 /* If dir starts with user's homedir, change that to ~. */
3701 homedir
= (char *) egetenv ("HOME");
3703 && XTYPE (dir
) == Lisp_String
3704 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3705 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3707 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3708 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3709 XSTRING (dir
)->data
[0] = '~';
3712 if (insert_default_directory
)
3715 if (!NILP (initial
))
3717 Lisp_Object args
[2], pos
;
3721 insdef
= Fconcat (2, args
);
3722 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3723 insdef1
= Fcons (double_dollars (insdef
), pos
);
3726 insdef1
= double_dollars (insdef
);
3728 else if (!NILP (initial
))
3731 insdef1
= Fcons (double_dollars (insdef
), 0);
3734 insdef
= Qnil
, insdef1
= Qnil
;
3737 count
= specpdl_ptr
- specpdl
;
3738 specbind (intern ("completion-ignore-case"), Qt
);
3741 GCPRO2 (insdef
, defalt
);
3742 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3743 dir
, mustmatch
, insdef1
,
3744 Qfile_name_history
);
3747 unbind_to (count
, Qnil
);
3752 error ("No file name specified");
3753 tem
= Fstring_equal (val
, insdef
);
3754 if (!NILP (tem
) && !NILP (defalt
))
3756 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3761 error ("No default file name");
3763 return Fsubstitute_in_file_name (val
);
3766 #if 0 /* Old version */
3767 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3768 /* Don't confuse make-docfile by having two doc strings for this function.
3769 make-docfile does not pay attention to #if, for good reason! */
3771 (prompt
, dir
, defalt
, mustmatch
, initial
)
3772 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3774 Lisp_Object val
, insdef
, tem
;
3775 struct gcpro gcpro1
, gcpro2
;
3776 register char *homedir
;
3780 dir
= current_buffer
->directory
;
3782 defalt
= current_buffer
->filename
;
3784 /* If dir starts with user's homedir, change that to ~. */
3785 homedir
= (char *) egetenv ("HOME");
3787 && XTYPE (dir
) == Lisp_String
3788 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3789 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3791 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3792 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3793 XSTRING (dir
)->data
[0] = '~';
3796 if (!NILP (initial
))
3798 else if (insert_default_directory
)
3801 insdef
= build_string ("");
3804 count
= specpdl_ptr
- specpdl
;
3805 specbind (intern ("completion-ignore-case"), Qt
);
3808 GCPRO2 (insdef
, defalt
);
3809 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3811 insert_default_directory
? insdef
: Qnil
,
3812 Qfile_name_history
);
3815 unbind_to (count
, Qnil
);
3820 error ("No file name specified");
3821 tem
= Fstring_equal (val
, insdef
);
3822 if (!NILP (tem
) && !NILP (defalt
))
3824 return Fsubstitute_in_file_name (val
);
3826 #endif /* Old version */
3830 Qexpand_file_name
= intern ("expand-file-name");
3831 Qdirectory_file_name
= intern ("directory-file-name");
3832 Qfile_name_directory
= intern ("file-name-directory");
3833 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3834 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3835 Qfile_name_as_directory
= intern ("file-name-as-directory");
3836 Qcopy_file
= intern ("copy-file");
3837 Qmake_directory
= intern ("make-directory");
3838 Qdelete_directory
= intern ("delete-directory");
3839 Qdelete_file
= intern ("delete-file");
3840 Qrename_file
= intern ("rename-file");
3841 Qadd_name_to_file
= intern ("add-name-to-file");
3842 Qmake_symbolic_link
= intern ("make-symbolic-link");
3843 Qfile_exists_p
= intern ("file-exists-p");
3844 Qfile_executable_p
= intern ("file-executable-p");
3845 Qfile_readable_p
= intern ("file-readable-p");
3846 Qfile_symlink_p
= intern ("file-symlink-p");
3847 Qfile_writable_p
= intern ("file-writable-p");
3848 Qfile_directory_p
= intern ("file-directory-p");
3849 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3850 Qfile_modes
= intern ("file-modes");
3851 Qset_file_modes
= intern ("set-file-modes");
3852 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3853 Qinsert_file_contents
= intern ("insert-file-contents");
3854 Qwrite_region
= intern ("write-region");
3855 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3856 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3858 staticpro (&Qexpand_file_name
);
3859 staticpro (&Qdirectory_file_name
);
3860 staticpro (&Qfile_name_directory
);
3861 staticpro (&Qfile_name_nondirectory
);
3862 staticpro (&Qunhandled_file_name_directory
);
3863 staticpro (&Qfile_name_as_directory
);
3864 staticpro (&Qcopy_file
);
3865 staticpro (&Qmake_directory
);
3866 staticpro (&Qdelete_directory
);
3867 staticpro (&Qdelete_file
);
3868 staticpro (&Qrename_file
);
3869 staticpro (&Qadd_name_to_file
);
3870 staticpro (&Qmake_symbolic_link
);
3871 staticpro (&Qfile_exists_p
);
3872 staticpro (&Qfile_executable_p
);
3873 staticpro (&Qfile_readable_p
);
3874 staticpro (&Qfile_symlink_p
);
3875 staticpro (&Qfile_writable_p
);
3876 staticpro (&Qfile_directory_p
);
3877 staticpro (&Qfile_accessible_directory_p
);
3878 staticpro (&Qfile_modes
);
3879 staticpro (&Qset_file_modes
);
3880 staticpro (&Qfile_newer_than_file_p
);
3881 staticpro (&Qinsert_file_contents
);
3882 staticpro (&Qwrite_region
);
3883 staticpro (&Qverify_visited_file_modtime
);
3885 Qfile_name_history
= intern ("file-name-history");
3886 Fset (Qfile_name_history
, Qnil
);
3887 staticpro (&Qfile_name_history
);
3889 Qfile_error
= intern ("file-error");
3890 staticpro (&Qfile_error
);
3891 Qfile_already_exists
= intern("file-already-exists");
3892 staticpro (&Qfile_already_exists
);
3895 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
3896 staticpro (&Qfind_buffer_file_type
);
3899 Qcar_less_than_car
= intern ("car-less-than-car");
3900 staticpro (&Qcar_less_than_car
);
3902 Fput (Qfile_error
, Qerror_conditions
,
3903 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3904 Fput (Qfile_error
, Qerror_message
,
3905 build_string ("File error"));
3907 Fput (Qfile_already_exists
, Qerror_conditions
,
3908 Fcons (Qfile_already_exists
,
3909 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3910 Fput (Qfile_already_exists
, Qerror_message
,
3911 build_string ("File already exists"));
3913 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3914 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3915 insert_default_directory
= 1;
3917 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3918 "*Non-nil means write new files with record format `stmlf'.\n\
3919 nil means use format `var'. This variable is meaningful only on VMS.");
3920 vms_stmlf_recfm
= 0;
3922 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3923 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3924 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3927 The first argument given to HANDLER is the name of the I/O primitive\n\
3928 to be handled; the remaining arguments are the arguments that were\n\
3929 passed to that primitive. For example, if you do\n\
3930 (file-exists-p FILENAME)\n\
3931 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3932 (funcall HANDLER 'file-exists-p FILENAME)\n\
3933 The function `find-file-name-handler' checks this list for a handler\n\
3934 for its argument.");
3935 Vfile_name_handler_alist
= Qnil
;
3937 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
3938 "A list of functions to be called at the end of `insert-file-contents'.\n\
3939 Each is passed one argument, the number of bytes inserted. It should return\n\
3940 the new byte count, and leave point the same. If `insert-file-contents' is\n\
3941 intercepted by a handler from `file-name-handler-alist', that handler is\n\
3942 responsible for calling the after-insert-file-functions if appropriate.");
3943 Vafter_insert_file_functions
= Qnil
;
3945 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
3946 "A list of functions to be called at the start of `write-region'.\n\
3947 Each is passed two arguments, START and END as for `write-region'. It should\n\
3948 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
3949 inserted at the specified positions of the file being written (1 means to\n\
3950 insert before the first byte written). The POSITIONs must be sorted into\n\
3951 increasing order. If there are several functions in the list, the several\n\
3952 lists are merged destructively.");
3953 Vwrite_region_annotate_functions
= Qnil
;
3955 defsubr (&Sfind_file_name_handler
);
3956 defsubr (&Sfile_name_directory
);
3957 defsubr (&Sfile_name_nondirectory
);
3958 defsubr (&Sunhandled_file_name_directory
);
3959 defsubr (&Sfile_name_as_directory
);
3960 defsubr (&Sdirectory_file_name
);
3961 defsubr (&Smake_temp_name
);
3962 defsubr (&Sexpand_file_name
);
3963 defsubr (&Ssubstitute_in_file_name
);
3964 defsubr (&Scopy_file
);
3965 defsubr (&Smake_directory_internal
);
3966 defsubr (&Sdelete_directory
);
3967 defsubr (&Sdelete_file
);
3968 defsubr (&Srename_file
);
3969 defsubr (&Sadd_name_to_file
);
3971 defsubr (&Smake_symbolic_link
);
3972 #endif /* S_IFLNK */
3974 defsubr (&Sdefine_logical_name
);
3977 defsubr (&Ssysnetunam
);
3978 #endif /* HPUX_NET */
3979 defsubr (&Sfile_name_absolute_p
);
3980 defsubr (&Sfile_exists_p
);
3981 defsubr (&Sfile_executable_p
);
3982 defsubr (&Sfile_readable_p
);
3983 defsubr (&Sfile_writable_p
);
3984 defsubr (&Sfile_symlink_p
);
3985 defsubr (&Sfile_directory_p
);
3986 defsubr (&Sfile_accessible_directory_p
);
3987 defsubr (&Sfile_modes
);
3988 defsubr (&Sset_file_modes
);
3989 defsubr (&Sset_default_file_modes
);
3990 defsubr (&Sdefault_file_modes
);
3991 defsubr (&Sfile_newer_than_file_p
);
3992 defsubr (&Sinsert_file_contents
);
3993 defsubr (&Swrite_region
);
3994 defsubr (&Scar_less_than_car
);
3995 defsubr (&Sverify_visited_file_modtime
);
3996 defsubr (&Sclear_visited_file_modtime
);
3997 defsubr (&Svisited_file_modtime
);
3998 defsubr (&Sset_visited_file_modtime
);
3999 defsubr (&Sdo_auto_save
);
4000 defsubr (&Sset_buffer_auto_saved
);
4001 defsubr (&Sclear_buffer_auto_save_failure
);
4002 defsubr (&Srecent_auto_save_p
);
4004 defsubr (&Sread_file_name_internal
);
4005 defsubr (&Sread_file_name
);
4008 defsubr (&Sunix_sync
);