1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include <sys/types.h>
30 #if !defined (S_ISLNK) && defined (S_IFLNK)
31 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
34 #if !defined (S_ISREG) && defined (S_IFREG)
35 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
46 #include <sys/param.h>
68 extern char *strerror ();
85 #include "intervals.h"
94 #endif /* not WINDOWSNT */
97 #define CORRECT_DIR_SEPS(s) \
98 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
99 else unixtodos_filename (s); \
101 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
102 redirector allows the six letters between 'Z' and 'a' as well. */
104 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
107 #define IS_DRIVE(x) isalpha (x)
109 /* Need to lower-case the drive letter, or else expanded
110 filenames will sometimes compare inequal, because
111 `expand-file-name' doesn't always down-case the drive letter. */
112 #define DRIVE_LETTER(x) (tolower (x))
141 #define min(a, b) ((a) < (b) ? (a) : (b))
142 #define max(a, b) ((a) > (b) ? (a) : (b))
144 /* Nonzero during writing of auto-save files */
147 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
148 a new file with the same mode as the original */
149 int auto_save_mode_bits
;
151 /* Alist of elements (REGEXP . HANDLER) for file names
152 whose I/O is done with a special handler. */
153 Lisp_Object Vfile_name_handler_alist
;
155 /* Format for auto-save files */
156 Lisp_Object Vauto_save_file_format
;
158 /* Lisp functions for translating file formats */
159 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
161 /* Functions to be called to process text properties in inserted file. */
162 Lisp_Object Vafter_insert_file_functions
;
164 /* Functions to be called to create text property annotations for file. */
165 Lisp_Object Vwrite_region_annotate_functions
;
167 /* During build_annotations, each time an annotation function is called,
168 this holds the annotations made by the previous functions. */
169 Lisp_Object Vwrite_region_annotations_so_far
;
171 /* File name in which we write a list of all our auto save files. */
172 Lisp_Object Vauto_save_list_file_name
;
174 /* Nonzero means, when reading a filename in the minibuffer,
175 start out by inserting the default directory into the minibuffer. */
176 int insert_default_directory
;
178 /* On VMS, nonzero means write new files with record format stmlf.
179 Zero means use var format. */
182 /* On NT, specifies the directory separator character, used (eg.) when
183 expanding file names. This can be bound to / or \. */
184 Lisp_Object Vdirectory_sep_char
;
186 extern Lisp_Object Vuser_login_name
;
188 extern int minibuf_level
;
190 /* These variables describe handlers that have "already" had a chance
191 to handle the current operation.
193 Vinhibit_file_name_handlers is a list of file name handlers.
194 Vinhibit_file_name_operation is the operation being handled.
195 If we try to handle that operation, we ignore those handlers. */
197 static Lisp_Object Vinhibit_file_name_handlers
;
198 static Lisp_Object Vinhibit_file_name_operation
;
200 Lisp_Object Qfile_error
, Qfile_already_exists
;
202 Lisp_Object Qfile_name_history
;
204 Lisp_Object Qcar_less_than_car
;
206 report_file_error (string
, data
)
210 Lisp_Object errstring
;
212 errstring
= build_string (strerror (errno
));
214 /* System error messages are capitalized. Downcase the initial
215 unless it is followed by a slash. */
216 if (XSTRING (errstring
)->data
[1] != '/')
217 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
220 Fsignal (Qfile_error
,
221 Fcons (build_string (string
), Fcons (errstring
, data
)));
224 close_file_unwind (fd
)
227 close (XFASTINT (fd
));
230 /* Restore point, having saved it as a marker. */
232 restore_point_unwind (location
)
233 Lisp_Object location
;
235 SET_PT (marker_position (location
));
236 Fset_marker (location
, Qnil
, Qnil
);
239 Lisp_Object Qexpand_file_name
;
240 Lisp_Object Qsubstitute_in_file_name
;
241 Lisp_Object Qdirectory_file_name
;
242 Lisp_Object Qfile_name_directory
;
243 Lisp_Object Qfile_name_nondirectory
;
244 Lisp_Object Qunhandled_file_name_directory
;
245 Lisp_Object Qfile_name_as_directory
;
246 Lisp_Object Qcopy_file
;
247 Lisp_Object Qmake_directory_internal
;
248 Lisp_Object Qdelete_directory
;
249 Lisp_Object Qdelete_file
;
250 Lisp_Object Qrename_file
;
251 Lisp_Object Qadd_name_to_file
;
252 Lisp_Object Qmake_symbolic_link
;
253 Lisp_Object Qfile_exists_p
;
254 Lisp_Object Qfile_executable_p
;
255 Lisp_Object Qfile_readable_p
;
256 Lisp_Object Qfile_writable_p
;
257 Lisp_Object Qfile_symlink_p
;
258 Lisp_Object Qaccess_file
;
259 Lisp_Object Qfile_directory_p
;
260 Lisp_Object Qfile_regular_p
;
261 Lisp_Object Qfile_accessible_directory_p
;
262 Lisp_Object Qfile_modes
;
263 Lisp_Object Qset_file_modes
;
264 Lisp_Object Qfile_newer_than_file_p
;
265 Lisp_Object Qinsert_file_contents
;
266 Lisp_Object Qwrite_region
;
267 Lisp_Object Qverify_visited_file_modtime
;
268 Lisp_Object Qset_visited_file_modtime
;
270 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
271 "Return FILENAME's handler function for OPERATION, if it has one.\n\
272 Otherwise, return nil.\n\
273 A file name is handled if one of the regular expressions in\n\
274 `file-name-handler-alist' matches it.\n\n\
275 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
276 any handlers that are members of `inhibit-file-name-handlers',\n\
277 but we still do run any other handlers. This lets handlers\n\
278 use the standard functions without calling themselves recursively.")
279 (filename
, operation
)
280 Lisp_Object filename
, operation
;
282 /* This function must not munge the match data. */
283 Lisp_Object chain
, inhibited_handlers
;
285 CHECK_STRING (filename
, 0);
287 if (EQ (operation
, Vinhibit_file_name_operation
))
288 inhibited_handlers
= Vinhibit_file_name_handlers
;
290 inhibited_handlers
= Qnil
;
292 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
293 chain
= XCONS (chain
)->cdr
)
296 elt
= XCONS (chain
)->car
;
300 string
= XCONS (elt
)->car
;
301 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
303 Lisp_Object handler
, tem
;
305 handler
= XCONS (elt
)->cdr
;
306 tem
= Fmemq (handler
, inhibited_handlers
);
317 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
319 "Return the directory component in file name FILENAME.\n\
320 Return nil if FILENAME does not include a directory.\n\
321 Otherwise return a directory spec.\n\
322 Given a Unix syntax file name, returns a string ending in slash;\n\
323 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
325 Lisp_Object filename
;
327 register unsigned char *beg
;
328 register unsigned char *p
;
331 CHECK_STRING (filename
, 0);
333 /* If the file name has special constructs in it,
334 call the corresponding file handler. */
335 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
337 return call2 (handler
, Qfile_name_directory
, filename
);
339 #ifdef FILE_SYSTEM_CASE
340 filename
= FILE_SYSTEM_CASE (filename
);
342 beg
= XSTRING (filename
)->data
;
344 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
346 p
= beg
+ XSTRING (filename
)->size
;
348 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
350 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
353 /* only recognise drive specifier at beginning */
354 && !(p
[-1] == ':' && p
== beg
+ 2)
361 /* Expansion of "c:" to drive and default directory. */
362 if (p
== beg
+ 2 && beg
[1] == ':')
364 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
365 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
366 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
368 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
371 p
= beg
+ strlen (beg
);
374 CORRECT_DIR_SEPS (beg
);
376 return make_string (beg
, p
- beg
);
379 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
381 "Return file name FILENAME sans its directory.\n\
382 For example, in a Unix-syntax file name,\n\
383 this is everything after the last slash,\n\
384 or the entire name if it contains no slash.")
386 Lisp_Object filename
;
388 register unsigned char *beg
, *p
, *end
;
391 CHECK_STRING (filename
, 0);
393 /* If the file name has special constructs in it,
394 call the corresponding file handler. */
395 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
397 return call2 (handler
, Qfile_name_nondirectory
, filename
);
399 beg
= XSTRING (filename
)->data
;
400 end
= p
= beg
+ XSTRING (filename
)->size
;
402 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
404 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
407 /* only recognise drive specifier at beginning */
408 && !(p
[-1] == ':' && p
== beg
+ 2)
412 return make_string (p
, end
- p
);
415 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
416 "Return a directly usable directory name somehow associated with FILENAME.\n\
417 A `directly usable' directory name is one that may be used without the\n\
418 intervention of any file handler.\n\
419 If FILENAME is a directly usable file itself, return\n\
420 (file-name-directory FILENAME).\n\
421 The `call-process' and `start-process' functions use this function to\n\
422 get a current directory to run processes in.")
424 Lisp_Object filename
;
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
432 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
434 return Ffile_name_directory (filename
);
439 file_name_as_directory (out
, in
)
442 int size
= strlen (in
) - 1;
447 /* Is it already a directory string? */
448 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
450 /* Is it a VMS directory file name? If so, hack VMS syntax. */
451 else if (! index (in
, '/')
452 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
453 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
454 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
455 || ! strncmp (&in
[size
- 5], ".dir", 4))
456 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
457 && in
[size
] == '1')))
459 register char *p
, *dot
;
463 dir:x.dir --> dir:[x]
464 dir:[x]y.dir --> dir:[x.y] */
466 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
469 strncpy (out
, in
, p
- in
);
488 dot
= index (p
, '.');
491 /* blindly remove any extension */
492 size
= strlen (out
) + (dot
- p
);
493 strncat (out
, p
, dot
- p
);
504 /* For Unix syntax, Append a slash if necessary */
505 if (!IS_DIRECTORY_SEP (out
[size
]))
507 out
[size
+ 1] = DIRECTORY_SEP
;
508 out
[size
+ 2] = '\0';
511 CORRECT_DIR_SEPS (out
);
517 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
518 Sfile_name_as_directory
, 1, 1, 0,
519 "Return a string representing file FILENAME interpreted as a directory.\n\
520 This operation exists because a directory is also a file, but its name as\n\
521 a directory is different from its name as a file.\n\
522 The result can be used as the value of `default-directory'\n\
523 or passed as second argument to `expand-file-name'.\n\
524 For a Unix-syntax file name, just appends a slash.\n\
525 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
532 CHECK_STRING (file
, 0);
536 /* If the file name has special constructs in it,
537 call the corresponding file handler. */
538 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
540 return call2 (handler
, Qfile_name_as_directory
, file
);
542 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
543 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
547 * Convert from directory name to filename.
549 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
550 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
551 * On UNIX, it's simple: just make sure there isn't a terminating /
553 * Value is nonzero if the string output is different from the input.
556 directory_file_name (src
, dst
)
564 struct FAB fab
= cc$rms_fab
;
565 struct NAM nam
= cc$rms_nam
;
566 char esa
[NAM$C_MAXRSS
];
571 if (! index (src
, '/')
572 && (src
[slen
- 1] == ']'
573 || src
[slen
- 1] == ':'
574 || src
[slen
- 1] == '>'))
576 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
578 fab
.fab$b_fns
= slen
;
579 fab
.fab$l_nam
= &nam
;
580 fab
.fab$l_fop
= FAB$M_NAM
;
583 nam
.nam$b_ess
= sizeof esa
;
584 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
586 /* We call SYS$PARSE to handle such things as [--] for us. */
587 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
589 slen
= nam
.nam$b_esl
;
590 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
595 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
597 /* what about when we have logical_name:???? */
598 if (src
[slen
- 1] == ':')
599 { /* Xlate logical name and see what we get */
600 ptr
= strcpy (dst
, src
); /* upper case for getenv */
603 if ('a' <= *ptr
&& *ptr
<= 'z')
607 dst
[slen
- 1] = 0; /* remove colon */
608 if (!(src
= egetenv (dst
)))
610 /* should we jump to the beginning of this procedure?
611 Good points: allows us to use logical names that xlate
613 Bad points: can be a problem if we just translated to a device
615 For now, I'll punt and always expect VMS names, and hope for
618 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
619 { /* no recursion here! */
625 { /* not a directory spec */
630 bracket
= src
[slen
- 1];
632 /* If bracket is ']' or '>', bracket - 2 is the corresponding
634 ptr
= index (src
, bracket
- 2);
636 { /* no opening bracket */
640 if (!(rptr
= rindex (src
, '.')))
643 strncpy (dst
, src
, slen
);
647 dst
[slen
++] = bracket
;
652 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
653 then translate the device and recurse. */
654 if (dst
[slen
- 1] == ':'
655 && dst
[slen
- 2] != ':' /* skip decnet nodes */
656 && strcmp (src
+ slen
, "[000000]") == 0)
658 dst
[slen
- 1] = '\0';
659 if ((ptr
= egetenv (dst
))
660 && (rlen
= strlen (ptr
) - 1) > 0
661 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
662 && ptr
[rlen
- 1] == '.')
664 char * buf
= (char *) alloca (strlen (ptr
) + 1);
668 return directory_file_name (buf
, dst
);
673 strcat (dst
, "[000000]");
677 rlen
= strlen (rptr
) - 1;
678 strncat (dst
, rptr
, rlen
);
679 dst
[slen
+ rlen
] = '\0';
680 strcat (dst
, ".DIR.1");
684 /* Process as Unix format: just remove any final slash.
685 But leave "/" unchanged; do not change it to "". */
688 /* Handle // as root for apollo's. */
689 if ((slen
> 2 && dst
[slen
- 1] == '/')
690 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
694 && IS_DIRECTORY_SEP (dst
[slen
- 1])
696 && !IS_ANY_SEP (dst
[slen
- 2])
702 CORRECT_DIR_SEPS (dst
);
707 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
709 "Returns the file name of the directory named DIRECTORY.\n\
710 This is the name of the file that holds the data for the directory DIRECTORY.\n\
711 This operation exists because a directory is also a file, but its name as\n\
712 a directory is different from its name as a file.\n\
713 In Unix-syntax, this function just removes the final slash.\n\
714 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
715 it returns a file name such as \"[X]Y.DIR.1\".")
717 Lisp_Object directory
;
722 CHECK_STRING (directory
, 0);
724 if (NILP (directory
))
727 /* If the file name has special constructs in it,
728 call the corresponding file handler. */
729 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
731 return call2 (handler
, Qdirectory_file_name
, directory
);
734 /* 20 extra chars is insufficient for VMS, since we might perform a
735 logical name translation. an equivalence string can be up to 255
736 chars long, so grab that much extra space... - sss */
737 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
739 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
741 directory_file_name (XSTRING (directory
)->data
, buf
);
742 return build_string (buf
);
745 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
746 "Generate temporary file name (string) starting with PREFIX (a string).\n\
747 The Emacs process number forms part of the result,\n\
748 so there is no danger of generating a name being used by another process.")
754 /* Don't use too many characters of the restricted 8+3 DOS
756 val
= concat2 (prefix
, build_string ("a.XXX"));
758 val
= concat2 (prefix
, build_string ("XXXXXX"));
760 mktemp (XSTRING (val
)->data
);
762 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
767 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
768 "Convert filename NAME to absolute, and canonicalize it.\n\
769 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
770 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
771 the current buffer's value of default-directory is used.\n\
772 File name components that are `.' are removed, and \n\
773 so are file name components followed by `..', along with the `..' itself;\n\
774 note that these simplifications are done without checking the resulting\n\
775 file names in the file system.\n\
776 An initial `~/' expands to your home directory.\n\
777 An initial `~USER/' expands to USER's home directory.\n\
778 See also the function `substitute-in-file-name'.")
779 (name
, default_directory
)
780 Lisp_Object name
, default_directory
;
784 register unsigned char *newdir
, *p
, *o
;
786 unsigned char *target
;
789 unsigned char * colon
= 0;
790 unsigned char * close
= 0;
791 unsigned char * slash
= 0;
792 unsigned char * brack
= 0;
793 int lbrack
= 0, rbrack
= 0;
798 int collapse_newdir
= 1;
803 CHECK_STRING (name
, 0);
805 /* If the file name has special constructs in it,
806 call the corresponding file handler. */
807 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
809 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
811 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
812 if (NILP (default_directory
))
813 default_directory
= current_buffer
->directory
;
814 CHECK_STRING (default_directory
, 1);
816 if (!NILP (default_directory
))
818 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
820 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
823 o
= XSTRING (default_directory
)->data
;
825 /* Make sure DEFAULT_DIRECTORY is properly expanded.
826 It would be better to do this down below where we actually use
827 default_directory. Unfortunately, calling Fexpand_file_name recursively
828 could invoke GC, and the strings might be relocated. This would
829 be annoying because we have pointers into strings lying around
830 that would need adjusting, and people would add new pointers to
831 the code and forget to adjust them, resulting in intermittent bugs.
832 Putting this call here avoids all that crud.
834 The EQ test avoids infinite recursion. */
835 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
836 /* Save time in some common cases - as long as default_directory
837 is not relative, it can be canonicalized with name below (if it
838 is needed at all) without requiring it to be expanded now. */
840 /* Detect MSDOS file names with drive specifiers. */
841 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
843 /* Detect Windows file names in UNC format. */
844 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
846 #else /* not DOS_NT */
847 /* Detect Unix absolute file names (/... alone is not absolute on
849 && ! (IS_DIRECTORY_SEP (o
[0]))
850 #endif /* not DOS_NT */
856 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
861 /* Filenames on VMS are always upper case. */
862 name
= Fupcase (name
);
864 #ifdef FILE_SYSTEM_CASE
865 name
= FILE_SYSTEM_CASE (name
);
868 nm
= XSTRING (name
)->data
;
871 /* We will force directory separators to be either all \ or /, so make
872 a local copy to modify, even if there ends up being no change. */
873 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
875 /* Find and remove drive specifier if present; this makes nm absolute
876 even if the rest of the name appears to be relative. */
878 unsigned char *colon
= rindex (nm
, ':');
881 /* Only recognize colon as part of drive specifier if there is a
882 single alphabetic character preceeding the colon (and if the
883 character before the drive letter, if present, is a directory
884 separator); this is to support the remote system syntax used by
885 ange-ftp, and the "po:username" syntax for POP mailboxes. */
889 else if (IS_DRIVE (colon
[-1])
890 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
897 while (--colon
>= nm
)
904 /* Handle // and /~ in middle of file name
905 by discarding everything through the first / of that sequence. */
909 /* Since we are expecting the name to be absolute, we can assume
910 that each element starts with a "/". */
912 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
913 #if defined (APOLLO) || defined (WINDOWSNT)
914 /* // at start of filename is meaningful on Apollo
915 and WindowsNT systems */
917 #endif /* APOLLO || WINDOWSNT */
921 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
928 /* Discard any previous drive specifier if nm is now in UNC format. */
929 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
935 /* If nm is absolute, look for /./ or /../ sequences; if none are
936 found, we can probably return right away. We will avoid allocating
937 a new string if name is already fully expanded. */
939 IS_DIRECTORY_SEP (nm
[0])
944 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
951 /* If it turns out that the filename we want to return is just a
952 suffix of FILENAME, we don't need to go through and edit
953 things; we just need to construct a new string using data
954 starting at the middle of FILENAME. If we set lose to a
955 non-zero value, that means we've discovered that we can't do
962 /* Since we know the name is absolute, we can assume that each
963 element starts with a "/". */
965 /* "." and ".." are hairy. */
966 if (IS_DIRECTORY_SEP (p
[0])
968 && (IS_DIRECTORY_SEP (p
[2])
970 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
977 /* if dev:[dir]/, move nm to / */
978 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
979 nm
= (brack
? brack
+ 1 : colon
+ 1);
988 /* VMS pre V4.4,convert '-'s in filenames. */
989 if (lbrack
== rbrack
)
991 if (dots
< 2) /* this is to allow negative version numbers */
996 if (lbrack
> rbrack
&&
997 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
998 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1004 /* count open brackets, reset close bracket pointer */
1005 if (p
[0] == '[' || p
[0] == '<')
1006 lbrack
++, brack
= 0;
1007 /* count close brackets, set close bracket pointer */
1008 if (p
[0] == ']' || p
[0] == '>')
1009 rbrack
++, brack
= p
;
1010 /* detect ][ or >< */
1011 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1013 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1014 nm
= p
+ 1, lose
= 1;
1015 if (p
[0] == ':' && (colon
|| slash
))
1016 /* if dev1:[dir]dev2:, move nm to dev2: */
1022 /* if /name/dev:, move nm to dev: */
1025 /* if node::dev:, move colon following dev */
1026 else if (colon
&& colon
[-1] == ':')
1028 /* if dev1:dev2:, move nm to dev2: */
1029 else if (colon
&& colon
[-1] != ':')
1034 if (p
[0] == ':' && !colon
)
1040 if (lbrack
== rbrack
)
1043 else if (p
[0] == '.')
1051 if (index (nm
, '/'))
1052 return build_string (sys_translate_unix (nm
));
1055 /* Make sure directories are all separated with / or \ as
1056 desired, but avoid allocation of a new string when not
1058 CORRECT_DIR_SEPS (nm
);
1060 if (IS_DIRECTORY_SEP (nm
[1]))
1062 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1063 name
= build_string (nm
);
1067 /* drive must be set, so this is okay */
1068 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1070 name
= make_string (nm
- 2, p
- nm
+ 2);
1071 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1072 XSTRING (name
)->data
[1] = ':';
1075 #else /* not DOS_NT */
1076 if (nm
== XSTRING (name
)->data
)
1078 return build_string (nm
);
1079 #endif /* not DOS_NT */
1083 /* At this point, nm might or might not be an absolute file name. We
1084 need to expand ~ or ~user if present, otherwise prefix nm with
1085 default_directory if nm is not absolute, and finally collapse /./
1086 and /foo/../ sequences.
1088 We set newdir to be the appropriate prefix if one is needed:
1089 - the relevant user directory if nm starts with ~ or ~user
1090 - the specified drive's working dir (DOS/NT only) if nm does not
1092 - the value of default_directory.
1094 Note that these prefixes are not guaranteed to be absolute (except
1095 for the working dir of a drive). Therefore, to ensure we always
1096 return an absolute name, if the final prefix is not absolute we
1097 append it to the current working directory. */
1101 if (nm
[0] == '~') /* prefix ~ */
1103 if (IS_DIRECTORY_SEP (nm
[1])
1107 || nm
[1] == 0) /* ~ by itself */
1109 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1110 newdir
= (unsigned char *) "";
1113 collapse_newdir
= 0;
1116 nm
++; /* Don't leave the slash in nm. */
1119 else /* ~user/filename */
1121 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1126 o
= (unsigned char *) alloca (p
- nm
+ 1);
1127 bcopy ((char *) nm
, o
, p
- nm
);
1130 pw
= (struct passwd
*) getpwnam (o
+ 1);
1133 newdir
= (unsigned char *) pw
-> pw_dir
;
1135 nm
= p
+ 1; /* skip the terminator */
1139 collapse_newdir
= 0;
1144 /* If we don't find a user of that name, leave the name
1145 unchanged; don't move nm forward to p. */
1150 /* On DOS and Windows, nm is absolute if a drive name was specified;
1151 use the drive's current directory as the prefix if needed. */
1152 if (!newdir
&& drive
)
1154 /* Get default directory if needed to make nm absolute. */
1155 if (!IS_DIRECTORY_SEP (nm
[0]))
1157 newdir
= alloca (MAXPATHLEN
+ 1);
1158 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1163 /* Either nm starts with /, or drive isn't mounted. */
1164 newdir
= alloca (4);
1165 newdir
[0] = DRIVE_LETTER (drive
);
1173 /* Finally, if no prefix has been specified and nm is not absolute,
1174 then it must be expanded relative to default_directory. */
1178 /* /... alone is not absolute on DOS and Windows. */
1179 && !IS_DIRECTORY_SEP (nm
[0])
1182 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1189 newdir
= XSTRING (default_directory
)->data
;
1195 /* First ensure newdir is an absolute name. */
1197 /* Detect MSDOS file names with drive specifiers. */
1198 ! (IS_DRIVE (newdir
[0])
1199 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1201 /* Detect Windows file names in UNC format. */
1202 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1206 /* Effectively, let newdir be (expand-file-name newdir cwd).
1207 Because of the admonition against calling expand-file-name
1208 when we have pointers into lisp strings, we accomplish this
1209 indirectly by prepending newdir to nm if necessary, and using
1210 cwd (or the wd of newdir's drive) as the new newdir. */
1212 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1217 if (!IS_DIRECTORY_SEP (nm
[0]))
1219 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1220 file_name_as_directory (tmp
, newdir
);
1224 newdir
= alloca (MAXPATHLEN
+ 1);
1227 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1234 /* Strip off drive name from prefix, if present. */
1235 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1241 /* Keep only a prefix from newdir if nm starts with slash
1242 (//server/share for UNC, nothing otherwise). */
1243 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1246 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1248 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1250 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1252 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1264 /* Get rid of any slash at the end of newdir, unless newdir is
1265 just // (an incomplete UNC name). */
1266 length
= strlen (newdir
);
1267 if (IS_DIRECTORY_SEP (newdir
[length
- 1])
1269 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1273 unsigned char *temp
= (unsigned char *) alloca (length
);
1274 bcopy (newdir
, temp
, length
- 1);
1275 temp
[length
- 1] = 0;
1283 /* Now concatenate the directory and name to new space in the stack frame */
1284 tlen
+= strlen (nm
) + 1;
1286 /* Add reserved space for drive name. (The Microsoft x86 compiler
1287 produces incorrect code if the following two lines are combined.) */
1288 target
= (unsigned char *) alloca (tlen
+ 2);
1290 #else /* not DOS_NT */
1291 target
= (unsigned char *) alloca (tlen
);
1292 #endif /* not DOS_NT */
1298 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1299 strcpy (target
, newdir
);
1302 file_name_as_directory (target
, newdir
);
1305 strcat (target
, nm
);
1307 if (index (target
, '/'))
1308 strcpy (target
, sys_translate_unix (target
));
1311 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1313 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1321 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1327 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1328 /* brackets are offset from each other by 2 */
1331 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1332 /* convert [foo][bar] to [bar] */
1333 while (o
[-1] != '[' && o
[-1] != '<')
1335 else if (*p
== '-' && *o
!= '.')
1338 else if (p
[0] == '-' && o
[-1] == '.' &&
1339 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1340 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1344 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1345 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1347 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1349 /* else [foo.-] ==> [-] */
1355 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1356 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1362 if (!IS_DIRECTORY_SEP (*p
))
1366 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1367 #if defined (APOLLO) || defined (WINDOWSNT)
1368 /* // at start of filename is meaningful in Apollo
1369 and WindowsNT systems */
1371 #endif /* APOLLO || WINDOWSNT */
1377 else if (IS_DIRECTORY_SEP (p
[0])
1379 && (IS_DIRECTORY_SEP (p
[2])
1382 /* If "/." is the entire filename, keep the "/". Otherwise,
1383 just delete the whole "/.". */
1384 if (o
== target
&& p
[2] == '\0')
1388 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1389 /* `/../' is the "superroot" on certain file systems. */
1391 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1393 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1395 if (o
== target
&& IS_ANY_SEP (*o
))
1403 #endif /* not VMS */
1407 /* At last, set drive name. */
1409 /* Except for network file name. */
1410 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1411 #endif /* WINDOWSNT */
1413 if (!drive
) abort ();
1415 target
[0] = DRIVE_LETTER (drive
);
1418 CORRECT_DIR_SEPS (target
);
1421 return make_string (target
, o
- target
);
1425 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1426 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1427 "Convert FILENAME to absolute, and canonicalize it.\n\
1428 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1429 (does not start with slash); if DEFAULT is nil or missing,\n\
1430 the current buffer's value of default-directory is used.\n\
1431 Filenames containing `.' or `..' as components are simplified;\n\
1432 initial `~/' expands to your home directory.\n\
1433 See also the function `substitute-in-file-name'.")
1435 Lisp_Object name
, defalt
;
1439 register unsigned char *newdir
, *p
, *o
;
1441 unsigned char *target
;
1445 unsigned char * colon
= 0;
1446 unsigned char * close
= 0;
1447 unsigned char * slash
= 0;
1448 unsigned char * brack
= 0;
1449 int lbrack
= 0, rbrack
= 0;
1453 CHECK_STRING (name
, 0);
1456 /* Filenames on VMS are always upper case. */
1457 name
= Fupcase (name
);
1460 nm
= XSTRING (name
)->data
;
1462 /* If nm is absolute, flush ...// and detect /./ and /../.
1463 If no /./ or /../ we can return right away. */
1475 if (p
[0] == '/' && p
[1] == '/'
1477 /* // at start of filename is meaningful on Apollo system */
1482 if (p
[0] == '/' && p
[1] == '~')
1483 nm
= p
+ 1, lose
= 1;
1484 if (p
[0] == '/' && p
[1] == '.'
1485 && (p
[2] == '/' || p
[2] == 0
1486 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1492 /* if dev:[dir]/, move nm to / */
1493 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1494 nm
= (brack
? brack
+ 1 : colon
+ 1);
1495 lbrack
= rbrack
= 0;
1503 /* VMS pre V4.4,convert '-'s in filenames. */
1504 if (lbrack
== rbrack
)
1506 if (dots
< 2) /* this is to allow negative version numbers */
1511 if (lbrack
> rbrack
&&
1512 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1513 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1519 /* count open brackets, reset close bracket pointer */
1520 if (p
[0] == '[' || p
[0] == '<')
1521 lbrack
++, brack
= 0;
1522 /* count close brackets, set close bracket pointer */
1523 if (p
[0] == ']' || p
[0] == '>')
1524 rbrack
++, brack
= p
;
1525 /* detect ][ or >< */
1526 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1528 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1529 nm
= p
+ 1, lose
= 1;
1530 if (p
[0] == ':' && (colon
|| slash
))
1531 /* if dev1:[dir]dev2:, move nm to dev2: */
1537 /* If /name/dev:, move nm to dev: */
1540 /* If node::dev:, move colon following dev */
1541 else if (colon
&& colon
[-1] == ':')
1543 /* If dev1:dev2:, move nm to dev2: */
1544 else if (colon
&& colon
[-1] != ':')
1549 if (p
[0] == ':' && !colon
)
1555 if (lbrack
== rbrack
)
1558 else if (p
[0] == '.')
1566 if (index (nm
, '/'))
1567 return build_string (sys_translate_unix (nm
));
1569 if (nm
== XSTRING (name
)->data
)
1571 return build_string (nm
);
1575 /* Now determine directory to start with and put it in NEWDIR */
1579 if (nm
[0] == '~') /* prefix ~ */
1584 || nm
[1] == 0)/* ~/filename */
1586 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1587 newdir
= (unsigned char *) "";
1590 nm
++; /* Don't leave the slash in nm. */
1593 else /* ~user/filename */
1595 /* Get past ~ to user */
1596 unsigned char *user
= nm
+ 1;
1597 /* Find end of name. */
1598 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1599 int len
= ptr
? ptr
- user
: strlen (user
);
1601 unsigned char *ptr1
= index (user
, ':');
1602 if (ptr1
!= 0 && ptr1
- user
< len
)
1605 /* Copy the user name into temp storage. */
1606 o
= (unsigned char *) alloca (len
+ 1);
1607 bcopy ((char *) user
, o
, len
);
1610 /* Look up the user name. */
1611 pw
= (struct passwd
*) getpwnam (o
+ 1);
1613 error ("\"%s\" isn't a registered user", o
+ 1);
1615 newdir
= (unsigned char *) pw
->pw_dir
;
1617 /* Discard the user name from NM. */
1624 #endif /* not VMS */
1628 defalt
= current_buffer
->directory
;
1629 CHECK_STRING (defalt
, 1);
1630 newdir
= XSTRING (defalt
)->data
;
1633 /* Now concatenate the directory and name to new space in the stack frame */
1635 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1636 target
= (unsigned char *) alloca (tlen
);
1642 if (nm
[0] == 0 || nm
[0] == '/')
1643 strcpy (target
, newdir
);
1646 file_name_as_directory (target
, newdir
);
1649 strcat (target
, nm
);
1651 if (index (target
, '/'))
1652 strcpy (target
, sys_translate_unix (target
));
1655 /* Now canonicalize by removing /. and /foo/.. if they appear */
1663 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1669 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1670 /* brackets are offset from each other by 2 */
1673 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1674 /* convert [foo][bar] to [bar] */
1675 while (o
[-1] != '[' && o
[-1] != '<')
1677 else if (*p
== '-' && *o
!= '.')
1680 else if (p
[0] == '-' && o
[-1] == '.' &&
1681 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1682 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1686 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1687 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1689 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1691 /* else [foo.-] ==> [-] */
1697 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1698 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1708 else if (!strncmp (p
, "//", 2)
1710 /* // at start of filename is meaningful in Apollo system */
1718 else if (p
[0] == '/' && p
[1] == '.' &&
1719 (p
[2] == '/' || p
[2] == 0))
1721 else if (!strncmp (p
, "/..", 3)
1722 /* `/../' is the "superroot" on certain file systems. */
1724 && (p
[3] == '/' || p
[3] == 0))
1726 while (o
!= target
&& *--o
!= '/')
1729 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1733 if (o
== target
&& *o
== '/')
1741 #endif /* not VMS */
1744 return make_string (target
, o
- target
);
1748 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1749 Ssubstitute_in_file_name
, 1, 1, 0,
1750 "Substitute environment variables referred to in FILENAME.\n\
1751 `$FOO' where FOO is an environment variable name means to substitute\n\
1752 the value of that variable. The variable name should be terminated\n\
1753 with a character not a letter, digit or underscore; otherwise, enclose\n\
1754 the entire variable name in braces.\n\
1755 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1756 On VMS, `$' substitution is not done; this function does little and only\n\
1757 duplicates what `expand-file-name' does.")
1759 Lisp_Object filename
;
1763 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1764 unsigned char *target
;
1766 int substituted
= 0;
1768 Lisp_Object handler
;
1770 CHECK_STRING (filename
, 0);
1772 /* If the file name has special constructs in it,
1773 call the corresponding file handler. */
1774 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1775 if (!NILP (handler
))
1776 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1778 nm
= XSTRING (filename
)->data
;
1780 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1781 CORRECT_DIR_SEPS (nm
);
1782 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1784 endp
= nm
+ XSTRING (filename
)->size
;
1786 /* If /~ or // appears, discard everything through first slash. */
1788 for (p
= nm
; p
!= endp
; p
++)
1791 #if defined (APOLLO) || defined (WINDOWSNT)
1792 /* // at start of file name is meaningful in Apollo and
1793 WindowsNT systems */
1794 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1795 #else /* not (APOLLO || WINDOWSNT) */
1796 || IS_DIRECTORY_SEP (p
[0])
1797 #endif /* not (APOLLO || WINDOWSNT) */
1802 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1804 || IS_DIRECTORY_SEP (p
[-1])))
1810 /* see comment in expand-file-name about drive specifiers */
1811 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1812 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1821 return build_string (nm
);
1824 /* See if any variables are substituted into the string
1825 and find the total length of their values in `total' */
1827 for (p
= nm
; p
!= endp
;)
1837 /* "$$" means a single "$" */
1846 while (p
!= endp
&& *p
!= '}') p
++;
1847 if (*p
!= '}') goto missingclose
;
1853 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1857 /* Copy out the variable name */
1858 target
= (unsigned char *) alloca (s
- o
+ 1);
1859 strncpy (target
, o
, s
- o
);
1862 strupr (target
); /* $home == $HOME etc. */
1865 /* Get variable value */
1866 o
= (unsigned char *) egetenv (target
);
1867 if (!o
) goto badvar
;
1868 total
+= strlen (o
);
1875 /* If substitution required, recopy the string and do it */
1876 /* Make space in stack frame for the new copy */
1877 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1880 /* Copy the rest of the name through, replacing $ constructs with values */
1897 while (p
!= endp
&& *p
!= '}') p
++;
1898 if (*p
!= '}') goto missingclose
;
1904 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1908 /* Copy out the variable name */
1909 target
= (unsigned char *) alloca (s
- o
+ 1);
1910 strncpy (target
, o
, s
- o
);
1913 strupr (target
); /* $home == $HOME etc. */
1916 /* Get variable value */
1917 o
= (unsigned char *) egetenv (target
);
1927 /* If /~ or // appears, discard everything through first slash. */
1929 for (p
= xnm
; p
!= x
; p
++)
1931 #if defined (APOLLO) || defined (WINDOWSNT)
1932 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1933 #else /* not (APOLLO || WINDOWSNT) */
1934 || IS_DIRECTORY_SEP (p
[0])
1935 #endif /* not (APOLLO || WINDOWSNT) */
1937 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1940 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1941 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1945 return make_string (xnm
, x
- xnm
);
1948 error ("Bad format environment-variable substitution");
1950 error ("Missing \"}\" in environment-variable substitution");
1952 error ("Substituting nonexistent environment variable \"%s\"", target
);
1955 #endif /* not VMS */
1958 /* A slightly faster and more convenient way to get
1959 (directory-file-name (expand-file-name FOO)). */
1962 expand_and_dir_to_file (filename
, defdir
)
1963 Lisp_Object filename
, defdir
;
1965 register Lisp_Object absname
;
1967 absname
= Fexpand_file_name (filename
, defdir
);
1970 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1971 if (c
== ':' || c
== ']' || c
== '>')
1972 absname
= Fdirectory_file_name (absname
);
1975 /* Remove final slash, if any (unless this is the root dir).
1976 stat behaves differently depending! */
1977 if (XSTRING (absname
)->size
> 1
1978 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1979 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1980 /* We cannot take shortcuts; they might be wrong for magic file names. */
1981 absname
= Fdirectory_file_name (absname
);
1986 /* Signal an error if the file ABSNAME already exists.
1987 If INTERACTIVE is nonzero, ask the user whether to proceed,
1988 and bypass the error if the user says to go ahead.
1989 QUERYSTRING is a name for the action that is being considered
1991 *STATPTR is used to store the stat information if the file exists.
1992 If the file does not exist, STATPTR->st_mode is set to 0. */
1995 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1996 Lisp_Object absname
;
1997 unsigned char *querystring
;
1999 struct stat
*statptr
;
2001 register Lisp_Object tem
;
2002 struct stat statbuf
;
2003 struct gcpro gcpro1
;
2005 /* stat is a good way to tell whether the file exists,
2006 regardless of what access permissions it has. */
2007 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2010 Fsignal (Qfile_already_exists
,
2011 Fcons (build_string ("File already exists"),
2012 Fcons (absname
, Qnil
)));
2014 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2015 XSTRING (absname
)->data
, querystring
));
2018 Fsignal (Qfile_already_exists
,
2019 Fcons (build_string ("File already exists"),
2020 Fcons (absname
, Qnil
)));
2027 statptr
->st_mode
= 0;
2032 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2033 "fCopy file: \nFCopy %s to file: \np\nP",
2034 "Copy FILE to NEWNAME. Both args must be strings.\n\
2035 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2036 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2037 A number as third arg means request confirmation if NEWNAME already exists.\n\
2038 This is what happens in interactive use with M-x.\n\
2039 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2040 last-modified time as the old one. (This works on only some systems.)\n\
2041 A prefix arg makes KEEP-TIME non-nil.")
2042 (file
, newname
, ok_if_already_exists
, keep_date
)
2043 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2046 char buf
[16 * 1024];
2047 struct stat st
, out_st
;
2048 Lisp_Object handler
;
2049 struct gcpro gcpro1
, gcpro2
;
2050 int count
= specpdl_ptr
- specpdl
;
2051 int input_file_statable_p
;
2053 GCPRO2 (file
, newname
);
2054 CHECK_STRING (file
, 0);
2055 CHECK_STRING (newname
, 1);
2056 file
= Fexpand_file_name (file
, Qnil
);
2057 newname
= Fexpand_file_name (newname
, Qnil
);
2059 /* If the input file name has special constructs in it,
2060 call the corresponding file handler. */
2061 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2062 /* Likewise for output file name. */
2064 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2065 if (!NILP (handler
))
2066 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2067 ok_if_already_exists
, keep_date
));
2069 if (NILP (ok_if_already_exists
)
2070 || INTEGERP (ok_if_already_exists
))
2071 barf_or_query_if_file_exists (newname
, "copy to it",
2072 INTEGERP (ok_if_already_exists
), &out_st
);
2073 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2076 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2078 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2080 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2082 /* We can only copy regular files and symbolic links. Other files are not
2084 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2086 #if !defined (MSDOS) || __DJGPP__ > 1
2087 if (out_st
.st_mode
!= 0
2088 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2091 report_file_error ("Input and output files are the same",
2092 Fcons (file
, Fcons (newname
, Qnil
)));
2096 #if defined (S_ISREG) && defined (S_ISLNK)
2097 if (input_file_statable_p
)
2099 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2101 #if defined (EISDIR)
2102 /* Get a better looking error message. */
2105 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2108 #endif /* S_ISREG && S_ISLNK */
2111 /* Create the copy file with the same record format as the input file */
2112 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2115 /* System's default file type was set to binary by _fmode in emacs.c. */
2116 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2117 #else /* not MSDOS */
2118 ofd
= creat (XSTRING (newname
)->data
, 0666);
2119 #endif /* not MSDOS */
2122 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2124 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2128 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2129 if (write (ofd
, buf
, n
) != n
)
2130 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2133 /* Closing the output clobbers the file times on some systems. */
2134 if (close (ofd
) < 0)
2135 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2137 if (input_file_statable_p
)
2139 if (!NILP (keep_date
))
2141 EMACS_TIME atime
, mtime
;
2142 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2143 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2144 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2145 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2148 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2150 #if defined (__DJGPP__) && __DJGPP__ > 1
2151 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2152 and if it can't, it tells so. Otherwise, under MSDOS we usually
2153 get only the READ bit, which will make the copied file read-only,
2154 so it's better not to chmod at all. */
2155 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2156 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2157 #endif /* DJGPP version 2 or newer */
2163 /* Discard the unwind protects. */
2164 specpdl_ptr
= specpdl
+ count
;
2170 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2171 Smake_directory_internal
, 1, 1, 0,
2172 "Create a new directory named DIRECTORY.")
2174 Lisp_Object directory
;
2177 Lisp_Object handler
;
2179 CHECK_STRING (directory
, 0);
2180 directory
= Fexpand_file_name (directory
, Qnil
);
2182 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2183 if (!NILP (handler
))
2184 return call2 (handler
, Qmake_directory_internal
, directory
);
2186 dir
= XSTRING (directory
)->data
;
2189 if (mkdir (dir
) != 0)
2191 if (mkdir (dir
, 0777) != 0)
2193 report_file_error ("Creating directory", Flist (1, &directory
));
2198 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2199 "Delete the directory named DIRECTORY.")
2201 Lisp_Object directory
;
2204 Lisp_Object handler
;
2206 CHECK_STRING (directory
, 0);
2207 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2208 dir
= XSTRING (directory
)->data
;
2210 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2211 if (!NILP (handler
))
2212 return call2 (handler
, Qdelete_directory
, directory
);
2214 if (rmdir (dir
) != 0)
2215 report_file_error ("Removing directory", Flist (1, &directory
));
2220 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2221 "Delete file named FILENAME.\n\
2222 If file has multiple names, it continues to exist with the other names.")
2224 Lisp_Object filename
;
2226 Lisp_Object handler
;
2227 CHECK_STRING (filename
, 0);
2228 filename
= Fexpand_file_name (filename
, Qnil
);
2230 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2231 if (!NILP (handler
))
2232 return call2 (handler
, Qdelete_file
, filename
);
2234 if (0 > unlink (XSTRING (filename
)->data
))
2235 report_file_error ("Removing old name", Flist (1, &filename
));
2240 internal_delete_file_1 (ignore
)
2246 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2249 internal_delete_file (filename
)
2250 Lisp_Object filename
;
2252 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2253 Qt
, internal_delete_file_1
));
2256 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2257 "fRename file: \nFRename %s to file: \np",
2258 "Rename FILE as NEWNAME. Both args strings.\n\
2259 If file has names other than FILE, it continues to have those names.\n\
2260 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2261 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2262 A number as third arg means request confirmation if NEWNAME already exists.\n\
2263 This is what happens in interactive use with M-x.")
2264 (file
, newname
, ok_if_already_exists
)
2265 Lisp_Object file
, newname
, ok_if_already_exists
;
2268 Lisp_Object args
[2];
2270 Lisp_Object handler
;
2271 struct gcpro gcpro1
, gcpro2
;
2273 GCPRO2 (file
, newname
);
2274 CHECK_STRING (file
, 0);
2275 CHECK_STRING (newname
, 1);
2276 file
= Fexpand_file_name (file
, Qnil
);
2277 newname
= Fexpand_file_name (newname
, Qnil
);
2279 /* If the file name has special constructs in it,
2280 call the corresponding file handler. */
2281 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2283 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2284 if (!NILP (handler
))
2285 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2286 file
, newname
, ok_if_already_exists
));
2288 if (NILP (ok_if_already_exists
)
2289 || INTEGERP (ok_if_already_exists
))
2290 barf_or_query_if_file_exists (newname
, "rename to it",
2291 INTEGERP (ok_if_already_exists
), 0);
2293 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2295 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2296 || 0 > unlink (XSTRING (file
)->data
))
2301 Fcopy_file (file
, newname
,
2302 /* We have already prompted if it was an integer,
2303 so don't have copy-file prompt again. */
2304 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2305 Fdelete_file (file
);
2312 report_file_error ("Renaming", Flist (2, args
));
2315 report_file_error ("Renaming", Flist (2, &file
));
2322 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2323 "fAdd name to file: \nFName to add to %s: \np",
2324 "Give FILE additional name NEWNAME. Both args strings.\n\
2325 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2326 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2327 A number as third arg means request confirmation if NEWNAME already exists.\n\
2328 This is what happens in interactive use with M-x.")
2329 (file
, newname
, ok_if_already_exists
)
2330 Lisp_Object file
, newname
, ok_if_already_exists
;
2333 Lisp_Object args
[2];
2335 Lisp_Object handler
;
2336 struct gcpro gcpro1
, gcpro2
;
2338 GCPRO2 (file
, newname
);
2339 CHECK_STRING (file
, 0);
2340 CHECK_STRING (newname
, 1);
2341 file
= Fexpand_file_name (file
, Qnil
);
2342 newname
= Fexpand_file_name (newname
, Qnil
);
2344 /* If the file name has special constructs in it,
2345 call the corresponding file handler. */
2346 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2347 if (!NILP (handler
))
2348 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2349 newname
, ok_if_already_exists
));
2351 /* If the new name has special constructs in it,
2352 call the corresponding file handler. */
2353 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2354 if (!NILP (handler
))
2355 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2356 newname
, ok_if_already_exists
));
2358 if (NILP (ok_if_already_exists
)
2359 || INTEGERP (ok_if_already_exists
))
2360 barf_or_query_if_file_exists (newname
, "make it a new name",
2361 INTEGERP (ok_if_already_exists
), 0);
2363 /* Windows does not support this operation. */
2364 report_file_error ("Adding new name", Flist (2, &file
));
2365 #else /* not WINDOWSNT */
2367 unlink (XSTRING (newname
)->data
);
2368 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2373 report_file_error ("Adding new name", Flist (2, args
));
2375 report_file_error ("Adding new name", Flist (2, &file
));
2378 #endif /* not WINDOWSNT */
2385 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2386 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2387 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2388 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2389 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2390 A number as third arg means request confirmation if LINKNAME already exists.\n\
2391 This happens for interactive use with M-x.")
2392 (filename
, linkname
, ok_if_already_exists
)
2393 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2396 Lisp_Object args
[2];
2398 Lisp_Object handler
;
2399 struct gcpro gcpro1
, gcpro2
;
2401 GCPRO2 (filename
, linkname
);
2402 CHECK_STRING (filename
, 0);
2403 CHECK_STRING (linkname
, 1);
2404 /* If the link target has a ~, we must expand it to get
2405 a truly valid file name. Otherwise, do not expand;
2406 we want to permit links to relative file names. */
2407 if (XSTRING (filename
)->data
[0] == '~')
2408 filename
= Fexpand_file_name (filename
, Qnil
);
2409 linkname
= Fexpand_file_name (linkname
, Qnil
);
2411 /* If the file name has special constructs in it,
2412 call the corresponding file handler. */
2413 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2414 if (!NILP (handler
))
2415 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2416 linkname
, ok_if_already_exists
));
2418 /* If the new link name has special constructs in it,
2419 call the corresponding file handler. */
2420 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2421 if (!NILP (handler
))
2422 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2423 linkname
, ok_if_already_exists
));
2425 if (NILP (ok_if_already_exists
)
2426 || INTEGERP (ok_if_already_exists
))
2427 barf_or_query_if_file_exists (linkname
, "make it a link",
2428 INTEGERP (ok_if_already_exists
), 0);
2429 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2431 /* If we didn't complain already, silently delete existing file. */
2432 if (errno
== EEXIST
)
2434 unlink (XSTRING (linkname
)->data
);
2435 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2445 report_file_error ("Making symbolic link", Flist (2, args
));
2447 report_file_error ("Making symbolic link", Flist (2, &filename
));
2453 #endif /* S_IFLNK */
2457 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2458 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2459 "Define the job-wide logical name NAME to have the value STRING.\n\
2460 If STRING is nil or a null string, the logical name NAME is deleted.")
2465 CHECK_STRING (name
, 0);
2467 delete_logical_name (XSTRING (name
)->data
);
2470 CHECK_STRING (string
, 1);
2472 if (XSTRING (string
)->size
== 0)
2473 delete_logical_name (XSTRING (name
)->data
);
2475 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2484 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2485 "Open a network connection to PATH using LOGIN as the login string.")
2487 Lisp_Object path
, login
;
2491 CHECK_STRING (path
, 0);
2492 CHECK_STRING (login
, 0);
2494 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2496 if (netresult
== -1)
2501 #endif /* HPUX_NET */
2503 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2505 "Return t if file FILENAME specifies an absolute file name.\n\
2506 On Unix, this is a name starting with a `/' or a `~'.")
2508 Lisp_Object filename
;
2512 CHECK_STRING (filename
, 0);
2513 ptr
= XSTRING (filename
)->data
;
2514 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2516 /* ??? This criterion is probably wrong for '<'. */
2517 || index (ptr
, ':') || index (ptr
, '<')
2518 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2522 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2530 /* Return nonzero if file FILENAME exists and can be executed. */
2533 check_executable (filename
)
2537 int len
= strlen (filename
);
2540 if (stat (filename
, &st
) < 0)
2542 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2543 return ((st
.st_mode
& S_IEXEC
) != 0);
2545 return (S_ISREG (st
.st_mode
)
2547 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2548 || stricmp (suffix
, ".exe") == 0
2549 || stricmp (suffix
, ".bat") == 0)
2550 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2551 #endif /* not WINDOWSNT */
2552 #else /* not DOS_NT */
2553 #ifdef HAVE_EUIDACCESS
2554 return (euidaccess (filename
, 1) >= 0);
2556 /* Access isn't quite right because it uses the real uid
2557 and we really want to test with the effective uid.
2558 But Unix doesn't give us a right way to do it. */
2559 return (access (filename
, 1) >= 0);
2561 #endif /* not DOS_NT */
2564 /* Return nonzero if file FILENAME exists and can be written. */
2567 check_writable (filename
)
2572 if (stat (filename
, &st
) < 0)
2574 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2575 #else /* not MSDOS */
2576 #ifdef HAVE_EUIDACCESS
2577 return (euidaccess (filename
, 2) >= 0);
2579 /* Access isn't quite right because it uses the real uid
2580 and we really want to test with the effective uid.
2581 But Unix doesn't give us a right way to do it.
2582 Opening with O_WRONLY could work for an ordinary file,
2583 but would lose for directories. */
2584 return (access (filename
, 2) >= 0);
2586 #endif /* not MSDOS */
2589 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2590 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2591 See also `file-readable-p' and `file-attributes'.")
2593 Lisp_Object filename
;
2595 Lisp_Object absname
;
2596 Lisp_Object handler
;
2597 struct stat statbuf
;
2599 CHECK_STRING (filename
, 0);
2600 absname
= Fexpand_file_name (filename
, Qnil
);
2602 /* If the file name has special constructs in it,
2603 call the corresponding file handler. */
2604 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2605 if (!NILP (handler
))
2606 return call2 (handler
, Qfile_exists_p
, absname
);
2608 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2611 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2612 "Return t if FILENAME can be executed by you.\n\
2613 For a directory, this means you can access files in that directory.")
2615 Lisp_Object filename
;
2618 Lisp_Object absname
;
2619 Lisp_Object handler
;
2621 CHECK_STRING (filename
, 0);
2622 absname
= Fexpand_file_name (filename
, Qnil
);
2624 /* If the file name has special constructs in it,
2625 call the corresponding file handler. */
2626 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2627 if (!NILP (handler
))
2628 return call2 (handler
, Qfile_executable_p
, absname
);
2630 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2633 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2634 "Return t if file FILENAME exists and you can read it.\n\
2635 See also `file-exists-p' and `file-attributes'.")
2637 Lisp_Object filename
;
2639 Lisp_Object absname
;
2640 Lisp_Object handler
;
2643 CHECK_STRING (filename
, 0);
2644 absname
= Fexpand_file_name (filename
, Qnil
);
2646 /* If the file name has special constructs in it,
2647 call the corresponding file handler. */
2648 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2649 if (!NILP (handler
))
2650 return call2 (handler
, Qfile_readable_p
, absname
);
2653 /* Under MS-DOS and Windows, open does not work for directories. */
2654 if (access (XSTRING (absname
)->data
, 0) == 0)
2657 #else /* not DOS_NT */
2658 desc
= open (XSTRING (absname
)->data
, O_RDONLY
);
2663 #endif /* not DOS_NT */
2666 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2668 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2669 "Return t if file FILENAME can be written or created by you.")
2671 Lisp_Object filename
;
2673 Lisp_Object absname
, dir
;
2674 Lisp_Object handler
;
2675 struct stat statbuf
;
2677 CHECK_STRING (filename
, 0);
2678 absname
= Fexpand_file_name (filename
, Qnil
);
2680 /* If the file name has special constructs in it,
2681 call the corresponding file handler. */
2682 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2683 if (!NILP (handler
))
2684 return call2 (handler
, Qfile_writable_p
, absname
);
2686 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2687 return (check_writable (XSTRING (absname
)->data
)
2689 dir
= Ffile_name_directory (absname
);
2692 dir
= Fdirectory_file_name (dir
);
2696 dir
= Fdirectory_file_name (dir
);
2698 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2702 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2703 "Access file FILENAME, and get an error if that does not work.\n\
2704 The second argument STRING is used in the error message.\n\
2705 If there is no error, we return nil.")
2707 Lisp_Object filename
, string
;
2709 Lisp_Object handler
;
2712 CHECK_STRING (filename
, 0);
2714 /* If the file name has special constructs in it,
2715 call the corresponding file handler. */
2716 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2717 if (!NILP (handler
))
2718 return call3 (handler
, Qaccess_file
, filename
, string
);
2720 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2722 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2728 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2729 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2730 The value is the name of the file to which it is linked.\n\
2731 Otherwise returns nil.")
2733 Lisp_Object filename
;
2740 Lisp_Object handler
;
2742 CHECK_STRING (filename
, 0);
2743 filename
= Fexpand_file_name (filename
, Qnil
);
2745 /* If the file name has special constructs in it,
2746 call the corresponding file handler. */
2747 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2748 if (!NILP (handler
))
2749 return call2 (handler
, Qfile_symlink_p
, filename
);
2754 buf
= (char *) xmalloc (bufsize
);
2755 bzero (buf
, bufsize
);
2756 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2757 if (valsize
< bufsize
) break;
2758 /* Buffer was not long enough */
2767 val
= make_string (buf
, valsize
);
2770 #else /* not S_IFLNK */
2772 #endif /* not S_IFLNK */
2775 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2776 "Return t if file FILENAME is the name of a directory as a file.\n\
2777 A directory name spec may be given instead; then the value is t\n\
2778 if the directory so specified exists and really is a directory.")
2780 Lisp_Object filename
;
2782 register Lisp_Object absname
;
2784 Lisp_Object handler
;
2786 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2788 /* If the file name has special constructs in it,
2789 call the corresponding file handler. */
2790 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2791 if (!NILP (handler
))
2792 return call2 (handler
, Qfile_directory_p
, absname
);
2794 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2796 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2799 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2800 "Return t if file FILENAME is the name of a directory as a file,\n\
2801 and files in that directory can be opened by you. In order to use a\n\
2802 directory as a buffer's current directory, this predicate must return true.\n\
2803 A directory name spec may be given instead; then the value is t\n\
2804 if the directory so specified exists and really is a readable and\n\
2805 searchable directory.")
2807 Lisp_Object filename
;
2809 Lisp_Object handler
;
2811 struct gcpro gcpro1
;
2813 /* If the file name has special constructs in it,
2814 call the corresponding file handler. */
2815 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2816 if (!NILP (handler
))
2817 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2819 /* It's an unlikely combination, but yes we really do need to gcpro:
2820 Suppose that file-accessible-directory-p has no handler, but
2821 file-directory-p does have a handler; this handler causes a GC which
2822 relocates the string in `filename'; and finally file-directory-p
2823 returns non-nil. Then we would end up passing a garbaged string
2824 to file-executable-p. */
2826 tem
= (NILP (Ffile_directory_p (filename
))
2827 || NILP (Ffile_executable_p (filename
)));
2829 return tem
? Qnil
: Qt
;
2832 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2833 "Return t if file FILENAME is the name of a regular file.\n\
2834 This is the sort of file that holds an ordinary stream of data bytes.")
2836 Lisp_Object filename
;
2838 register Lisp_Object absname
;
2840 Lisp_Object handler
;
2842 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2844 /* If the file name has special constructs in it,
2845 call the corresponding file handler. */
2846 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2847 if (!NILP (handler
))
2848 return call2 (handler
, Qfile_regular_p
, absname
);
2850 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2852 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2855 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2856 "Return mode bits of file named FILENAME, as an integer.")
2858 Lisp_Object filename
;
2860 Lisp_Object absname
;
2862 Lisp_Object handler
;
2864 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2866 /* If the file name has special constructs in it,
2867 call the corresponding file handler. */
2868 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2869 if (!NILP (handler
))
2870 return call2 (handler
, Qfile_modes
, absname
);
2872 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2874 #if defined (MSDOS) && __DJGPP__ < 2
2875 if (check_executable (XSTRING (absname
)->data
))
2876 st
.st_mode
|= S_IEXEC
;
2877 #endif /* MSDOS && __DJGPP__ < 2 */
2879 return make_number (st
.st_mode
& 07777);
2882 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2883 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2884 Only the 12 low bits of MODE are used.")
2886 Lisp_Object filename
, mode
;
2888 Lisp_Object absname
;
2889 Lisp_Object handler
;
2891 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2892 CHECK_NUMBER (mode
, 1);
2894 /* If the file name has special constructs in it,
2895 call the corresponding file handler. */
2896 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2897 if (!NILP (handler
))
2898 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2900 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2901 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2906 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2907 "Set the file permission bits for newly created files.\n\
2908 The argument MODE should be an integer; only the low 9 bits are used.\n\
2909 This setting is inherited by subprocesses.")
2913 CHECK_NUMBER (mode
, 0);
2915 umask ((~ XINT (mode
)) & 0777);
2920 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2921 "Return the default file protection for created files.\n\
2922 The value is an integer.")
2928 realmask
= umask (0);
2931 XSETINT (value
, (~ realmask
) & 0777);
2937 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2938 "Tell Unix to finish all pending disk updates.")
2947 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2948 "Return t if file FILE1 is newer than file FILE2.\n\
2949 If FILE1 does not exist, the answer is nil;\n\
2950 otherwise, if FILE2 does not exist, the answer is t.")
2952 Lisp_Object file1
, file2
;
2954 Lisp_Object absname1
, absname2
;
2957 Lisp_Object handler
;
2958 struct gcpro gcpro1
, gcpro2
;
2960 CHECK_STRING (file1
, 0);
2961 CHECK_STRING (file2
, 0);
2964 GCPRO2 (absname1
, file2
);
2965 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2966 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2969 /* If the file name has special constructs in it,
2970 call the corresponding file handler. */
2971 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2973 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2974 if (!NILP (handler
))
2975 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2977 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2980 mtime1
= st
.st_mtime
;
2982 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2985 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2989 Lisp_Object Qfind_buffer_file_type
;
2992 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2994 "Insert contents of file FILENAME after point.\n\
2995 Returns list of absolute file name and length of data inserted.\n\
2996 If second argument VISIT is non-nil, the buffer's visited filename\n\
2997 and last save file modtime are set, and it is marked unmodified.\n\
2998 If visiting and the file does not exist, visiting is completed\n\
2999 before the error is signaled.\n\n\
3000 The optional third and fourth arguments BEG and END\n\
3001 specify what portion of the file to insert.\n\
3002 If VISIT is non-nil, BEG and END must be nil.\n\
3003 If optional fifth argument REPLACE is non-nil,\n\
3004 it means replace the current buffer contents (in the accessible portion)\n\
3005 with the file contents. This is better than simply deleting and inserting\n\
3006 the whole thing because (1) it preserves some marker positions\n\
3007 and (2) it puts less data in the undo list.")
3008 (filename
, visit
, beg
, end
, replace
)
3009 Lisp_Object filename
, visit
, beg
, end
, replace
;
3013 register int inserted
= 0;
3014 register int how_much
;
3015 int count
= specpdl_ptr
- specpdl
;
3016 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3017 Lisp_Object handler
, val
, insval
;
3020 int not_regular
= 0;
3022 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3023 error ("Cannot do file visiting in an indirect buffer");
3025 if (!NILP (current_buffer
->read_only
))
3026 Fbarf_if_buffer_read_only ();
3031 GCPRO3 (filename
, val
, p
);
3033 CHECK_STRING (filename
, 0);
3034 filename
= Fexpand_file_name (filename
, Qnil
);
3036 /* If the file name has special constructs in it,
3037 call the corresponding file handler. */
3038 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3039 if (!NILP (handler
))
3041 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3042 visit
, beg
, end
, replace
);
3049 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3051 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3052 || fstat (fd
, &st
) < 0)
3053 #endif /* not APOLLO */
3055 if (fd
>= 0) close (fd
);
3058 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3065 /* This code will need to be changed in order to work on named
3066 pipes, and it's probably just not worth it. So we should at
3067 least signal an error. */
3068 if (!S_ISREG (st
.st_mode
))
3071 Fsignal (Qfile_error
,
3072 Fcons (build_string ("not a regular file"),
3073 Fcons (filename
, Qnil
)));
3081 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3084 /* Replacement should preserve point as it preserves markers. */
3085 if (!NILP (replace
))
3086 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3088 record_unwind_protect (close_file_unwind
, make_number (fd
));
3090 /* Supposedly happens on VMS. */
3092 error ("File size is negative");
3094 if (!NILP (beg
) || !NILP (end
))
3096 error ("Attempt to visit less than an entire file");
3099 CHECK_NUMBER (beg
, 0);
3101 XSETFASTINT (beg
, 0);
3104 CHECK_NUMBER (end
, 0);
3107 XSETINT (end
, st
.st_size
);
3108 if (XINT (end
) != st
.st_size
)
3109 error ("maximum buffer size exceeded");
3112 /* If requested, replace the accessible part of the buffer
3113 with the file contents. Avoid replacing text at the
3114 beginning or end of the buffer that matches the file contents;
3115 that preserves markers pointing to the unchanged parts. */
3117 /* On MSDOS, replace mode doesn't really work, except for binary files,
3118 and it's not worth supporting just for them. */
3119 if (!NILP (replace
))
3122 XSETFASTINT (beg
, 0);
3123 XSETFASTINT (end
, st
.st_size
);
3124 del_range_1 (BEGV
, ZV
, 0);
3126 #else /* not DOS_NT */
3127 if (!NILP (replace
))
3129 unsigned char buffer
[1 << 14];
3130 int same_at_start
= BEGV
;
3131 int same_at_end
= ZV
;
3136 /* Count how many chars at the start of the file
3137 match the text at the beginning of the buffer. */
3142 nread
= read (fd
, buffer
, sizeof buffer
);
3144 error ("IO error reading %s: %s",
3145 XSTRING (filename
)->data
, strerror (errno
));
3146 else if (nread
== 0)
3149 while (bufpos
< nread
&& same_at_start
< ZV
3150 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
3151 same_at_start
++, bufpos
++;
3152 /* If we found a discrepancy, stop the scan.
3153 Otherwise loop around and scan the next bufferful. */
3154 if (bufpos
!= nread
)
3158 /* If the file matches the buffer completely,
3159 there's no need to replace anything. */
3160 if (same_at_start
- BEGV
== st
.st_size
)
3164 /* Truncate the buffer to the size of the file. */
3165 del_range_1 (same_at_start
, same_at_end
, 0);
3170 /* Count how many chars at the end of the file
3171 match the text at the end of the buffer. */
3174 int total_read
, nread
, bufpos
, curpos
, trial
;
3176 /* At what file position are we now scanning? */
3177 curpos
= st
.st_size
- (ZV
- same_at_end
);
3178 /* If the entire file matches the buffer tail, stop the scan. */
3181 /* How much can we scan in the next step? */
3182 trial
= min (curpos
, sizeof buffer
);
3183 if (lseek (fd
, curpos
- trial
, 0) < 0)
3184 report_file_error ("Setting file position",
3185 Fcons (filename
, Qnil
));
3188 while (total_read
< trial
)
3190 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3192 error ("IO error reading %s: %s",
3193 XSTRING (filename
)->data
, strerror (errno
));
3194 total_read
+= nread
;
3196 /* Scan this bufferful from the end, comparing with
3197 the Emacs buffer. */
3198 bufpos
= total_read
;
3199 /* Compare with same_at_start to avoid counting some buffer text
3200 as matching both at the file's beginning and at the end. */
3201 while (bufpos
> 0 && same_at_end
> same_at_start
3202 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
3203 same_at_end
--, bufpos
--;
3204 /* If we found a discrepancy, stop the scan.
3205 Otherwise loop around and scan the preceding bufferful. */
3208 /* If display current starts at beginning of line,
3209 keep it that way. */
3210 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3211 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3215 /* Don't try to reuse the same piece of text twice. */
3216 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3218 same_at_end
+= overlap
;
3220 /* Arrange to read only the nonmatching middle part of the file. */
3221 XSETFASTINT (beg
, same_at_start
- BEGV
);
3222 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3224 del_range_1 (same_at_start
, same_at_end
, 0);
3225 /* Insert from the file at the proper position. */
3226 SET_PT (same_at_start
);
3228 #endif /* not DOS_NT */
3230 total
= XINT (end
) - XINT (beg
);
3233 register Lisp_Object temp
;
3235 /* Make sure point-max won't overflow after this insertion. */
3236 XSETINT (temp
, total
);
3237 if (total
!= XINT (temp
))
3238 error ("maximum buffer size exceeded");
3241 if (NILP (visit
) && total
> 0)
3242 prepare_to_modify_buffer (PT
, PT
);
3245 if (GAP_SIZE
< total
)
3246 make_gap (total
- GAP_SIZE
);
3248 if (XINT (beg
) != 0 || !NILP (replace
))
3250 if (lseek (fd
, XINT (beg
), 0) < 0)
3251 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3255 while (inserted
< total
)
3257 /* try is reserved in some compilers (Microsoft C) */
3258 int trytry
= min (total
- inserted
, 64 << 10);
3261 /* Allow quitting out of the actual I/O. */
3264 this = read (fd
, &FETCH_CHAR (PT
+ inserted
- 1) + 1, trytry
);
3281 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3282 /* Determine file type from name and remove LFs from CR-LFs if the file
3283 is deemed to be a text file. */
3285 current_buffer
->buffer_file_type
3286 = call1 (Qfind_buffer_file_type
, filename
);
3287 if (NILP (current_buffer
->buffer_file_type
))
3290 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (PT
- 1) + 1);
3293 GPT
-= reduced_size
;
3294 GAP_SIZE
+= reduced_size
;
3295 inserted
-= reduced_size
;
3302 record_insert (PT
, inserted
);
3304 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3305 offset_intervals (current_buffer
, PT
, inserted
);
3311 /* Discard the unwind protect for closing the file. */
3315 error ("IO error reading %s: %s",
3316 XSTRING (filename
)->data
, strerror (errno
));
3323 if (!EQ (current_buffer
->undo_list
, Qt
))
3324 current_buffer
->undo_list
= Qnil
;
3326 stat (XSTRING (filename
)->data
, &st
);
3331 current_buffer
->modtime
= st
.st_mtime
;
3332 current_buffer
->filename
= filename
;
3335 SAVE_MODIFF
= MODIFF
;
3336 current_buffer
->auto_save_modified
= MODIFF
;
3337 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3338 #ifdef CLASH_DETECTION
3341 if (!NILP (current_buffer
->file_truename
))
3342 unlock_file (current_buffer
->file_truename
);
3343 unlock_file (filename
);
3345 #endif /* CLASH_DETECTION */
3347 Fsignal (Qfile_error
,
3348 Fcons (build_string ("not a regular file"),
3349 Fcons (filename
, Qnil
)));
3351 /* If visiting nonexistent file, return nil. */
3352 if (current_buffer
->modtime
== -1)
3353 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3356 /* Decode file format */
3359 insval
= call3 (Qformat_decode
,
3360 Qnil
, make_number (inserted
), visit
);
3361 CHECK_NUMBER (insval
, 0);
3362 inserted
= XFASTINT (insval
);
3365 if (inserted
> 0 && NILP (visit
) && total
> 0)
3366 signal_after_change (PT
, 0, inserted
);
3370 p
= Vafter_insert_file_functions
;
3373 insval
= call1 (Fcar (p
), make_number (inserted
));
3376 CHECK_NUMBER (insval
, 0);
3377 inserted
= XFASTINT (insval
);
3385 val
= Fcons (filename
,
3386 Fcons (make_number (inserted
),
3389 RETURN_UNGCPRO (unbind_to (count
, val
));
3392 static Lisp_Object
build_annotations ();
3394 /* If build_annotations switched buffers, switch back to BUF.
3395 Kill the temporary buffer that was selected in the meantime. */
3398 build_annotations_unwind (buf
)
3403 if (XBUFFER (buf
) == current_buffer
)
3405 tembuf
= Fcurrent_buffer ();
3407 Fkill_buffer (tembuf
);
3411 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3412 "r\nFWrite region to file: ",
3413 "Write current region into specified file.\n\
3414 When called from a program, takes three arguments:\n\
3415 START, END and FILENAME. START and END are buffer positions.\n\
3416 Optional fourth argument APPEND if non-nil means\n\
3417 append to existing file contents (if any).\n\
3418 Optional fifth argument VISIT if t means\n\
3419 set the last-save-file-modtime of buffer to this file's modtime\n\
3420 and mark buffer not modified.\n\
3421 If VISIT is a string, it is a second file name;\n\
3422 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3423 VISIT is also the file name to lock and unlock for clash detection.\n\
3424 If VISIT is neither t nor nil nor a string,\n\
3425 that means do not print the \"Wrote file\" message.\n\
3426 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3427 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3428 Kludgy feature: if START is a string, then that string is written\n\
3429 to the file, instead of any buffer contents, and END is ignored.")
3430 (start
, end
, filename
, append
, visit
, lockname
)
3431 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3439 int count
= specpdl_ptr
- specpdl
;
3442 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3444 Lisp_Object handler
;
3445 Lisp_Object visit_file
;
3446 Lisp_Object annotations
;
3447 int visiting
, quietly
;
3448 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3449 struct buffer
*given_buffer
;
3451 int buffer_file_type
3452 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3455 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3456 error ("Cannot do file visiting in an indirect buffer");
3458 if (!NILP (start
) && !STRINGP (start
))
3459 validate_region (&start
, &end
);
3461 GCPRO3 (filename
, visit
, lockname
);
3462 filename
= Fexpand_file_name (filename
, Qnil
);
3463 if (STRINGP (visit
))
3464 visit_file
= Fexpand_file_name (visit
, Qnil
);
3466 visit_file
= filename
;
3469 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3470 quietly
= !NILP (visit
);
3474 if (NILP (lockname
))
3475 lockname
= visit_file
;
3477 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3479 /* If the file name has special constructs in it,
3480 call the corresponding file handler. */
3481 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3482 /* If FILENAME has no handler, see if VISIT has one. */
3483 if (NILP (handler
) && STRINGP (visit
))
3484 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3486 if (!NILP (handler
))
3489 val
= call6 (handler
, Qwrite_region
, start
, end
,
3490 filename
, append
, visit
);
3494 SAVE_MODIFF
= MODIFF
;
3495 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3496 current_buffer
->filename
= visit_file
;
3502 /* Special kludge to simplify auto-saving. */
3505 XSETFASTINT (start
, BEG
);
3506 XSETFASTINT (end
, Z
);
3509 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3510 count1
= specpdl_ptr
- specpdl
;
3512 given_buffer
= current_buffer
;
3513 annotations
= build_annotations (start
, end
);
3514 if (current_buffer
!= given_buffer
)
3520 #ifdef CLASH_DETECTION
3523 /* If we've locked this file for some other buffer,
3524 query before proceeding. */
3525 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3526 call2 (intern ("ask-user-about-lock"), fn
, Vuser_login_name
);
3528 lock_file (lockname
);
3530 #endif /* CLASH_DETECTION */
3532 fn
= XSTRING (filename
)->data
;
3536 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3537 #else /* not DOS_NT */
3538 desc
= open (fn
, O_WRONLY
);
3539 #endif /* not DOS_NT */
3543 if (auto_saving
) /* Overwrite any previous version of autosave file */
3545 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3546 desc
= open (fn
, O_RDWR
);
3548 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3549 ? XSTRING (current_buffer
->filename
)->data
: 0,
3552 else /* Write to temporary name and rename if no errors */
3554 Lisp_Object temp_name
;
3555 temp_name
= Ffile_name_directory (filename
);
3557 if (!NILP (temp_name
))
3559 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3560 build_string ("$$SAVE$$")));
3561 fname
= XSTRING (filename
)->data
;
3562 fn
= XSTRING (temp_name
)->data
;
3563 desc
= creat_copy_attrs (fname
, fn
);
3566 /* If we can't open the temporary file, try creating a new
3567 version of the original file. VMS "creat" creates a
3568 new version rather than truncating an existing file. */
3571 desc
= creat (fn
, 0666);
3572 #if 0 /* This can clobber an existing file and fail to replace it,
3573 if the user runs out of space. */
3576 /* We can't make a new version;
3577 try to truncate and rewrite existing version if any. */
3579 desc
= open (fn
, O_RDWR
);
3585 desc
= creat (fn
, 0666);
3590 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3591 S_IREAD
| S_IWRITE
);
3592 #else /* not DOS_NT */
3593 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3594 #endif /* not DOS_NT */
3595 #endif /* not VMS */
3601 #ifdef CLASH_DETECTION
3603 if (!auto_saving
) unlock_file (lockname
);
3605 #endif /* CLASH_DETECTION */
3606 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3609 record_unwind_protect (close_file_unwind
, make_number (desc
));
3612 if (lseek (desc
, 0, 2) < 0)
3614 #ifdef CLASH_DETECTION
3615 if (!auto_saving
) unlock_file (lockname
);
3616 #endif /* CLASH_DETECTION */
3617 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3622 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3623 * if we do writes that don't end with a carriage return. Furthermore
3624 * it cannot handle writes of more then 16K. The modified
3625 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3626 * this EXCEPT for the last record (iff it doesn't end with a carriage
3627 * return). This implies that if your buffer doesn't end with a carriage
3628 * return, you get one free... tough. However it also means that if
3629 * we make two calls to sys_write (a la the following code) you can
3630 * get one at the gap as well. The easiest way to fix this (honest)
3631 * is to move the gap to the next newline (or the end of the buffer).
3636 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3637 move_gap (find_next_newline (GPT
, 1));
3643 if (STRINGP (start
))
3645 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3646 XSTRING (start
)->size
, 0, &annotations
);
3649 else if (XINT (start
) != XINT (end
))
3652 if (XINT (start
) < GPT
)
3654 register int end1
= XINT (end
);
3656 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3657 min (GPT
, end1
) - tem
, tem
, &annotations
);
3658 nwritten
+= min (GPT
, end1
) - tem
;
3662 if (XINT (end
) > GPT
&& !failure
)
3665 tem
= max (tem
, GPT
);
3666 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3668 nwritten
+= XINT (end
) - tem
;
3674 /* If file was empty, still need to write the annotations */
3675 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3682 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3683 Disk full in NFS may be reported here. */
3684 /* mib says that closing the file will try to write as fast as NFS can do
3685 it, and that means the fsync here is not crucial for autosave files. */
3686 if (!auto_saving
&& fsync (desc
) < 0)
3688 /* If fsync fails with EINTR, don't treat that as serious. */
3690 failure
= 1, save_errno
= errno
;
3694 /* Spurious "file has changed on disk" warnings have been
3695 observed on Suns as well.
3696 It seems that `close' can change the modtime, under nfs.
3698 (This has supposedly been fixed in Sunos 4,
3699 but who knows about all the other machines with NFS?) */
3702 /* On VMS and APOLLO, must do the stat after the close
3703 since closing changes the modtime. */
3706 /* Recall that #if defined does not work on VMS. */
3713 /* NFS can report a write failure now. */
3714 if (close (desc
) < 0)
3715 failure
= 1, save_errno
= errno
;
3718 /* If we wrote to a temporary name and had no errors, rename to real name. */
3722 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3730 /* Discard the unwind protect for close_file_unwind. */
3731 specpdl_ptr
= specpdl
+ count1
;
3732 /* Restore the original current buffer. */
3733 visit_file
= unbind_to (count
, visit_file
);
3735 #ifdef CLASH_DETECTION
3737 unlock_file (lockname
);
3738 #endif /* CLASH_DETECTION */
3740 /* Do this before reporting IO error
3741 to avoid a "file has changed on disk" warning on
3742 next attempt to save. */
3744 current_buffer
->modtime
= st
.st_mtime
;
3747 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3751 SAVE_MODIFF
= MODIFF
;
3752 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3753 current_buffer
->filename
= visit_file
;
3754 update_mode_lines
++;
3760 message ("Wrote %s", XSTRING (visit_file
)->data
);
3765 Lisp_Object
merge ();
3767 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3768 "Return t if (car A) is numerically less than (car B).")
3772 return Flss (Fcar (a
), Fcar (b
));
3775 /* Build the complete list of annotations appropriate for writing out
3776 the text between START and END, by calling all the functions in
3777 write-region-annotate-functions and merging the lists they return.
3778 If one of these functions switches to a different buffer, we assume
3779 that buffer contains altered text. Therefore, the caller must
3780 make sure to restore the current buffer in all cases,
3781 as save-excursion would do. */
3784 build_annotations (start
, end
)
3785 Lisp_Object start
, end
;
3787 Lisp_Object annotations
;
3789 struct gcpro gcpro1
, gcpro2
;
3790 Lisp_Object original_buffer
;
3792 XSETBUFFER (original_buffer
, current_buffer
);
3795 p
= Vwrite_region_annotate_functions
;
3796 GCPRO2 (annotations
, p
);
3799 struct buffer
*given_buffer
= current_buffer
;
3800 Vwrite_region_annotations_so_far
= annotations
;
3801 res
= call2 (Fcar (p
), start
, end
);
3802 /* If the function makes a different buffer current,
3803 assume that means this buffer contains altered text to be output.
3804 Reset START and END from the buffer bounds
3805 and discard all previous annotations because they should have
3806 been dealt with by this function. */
3807 if (current_buffer
!= given_buffer
)
3813 Flength (res
); /* Check basic validity of return value */
3814 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3818 /* Now do the same for annotation functions implied by the file-format */
3819 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3820 p
= Vauto_save_file_format
;
3822 p
= current_buffer
->file_format
;
3825 struct buffer
*given_buffer
= current_buffer
;
3826 Vwrite_region_annotations_so_far
= annotations
;
3827 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
3829 if (current_buffer
!= given_buffer
)
3836 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3843 /* Write to descriptor DESC the LEN characters starting at ADDR,
3844 assuming they start at position POS in the buffer.
3845 Intersperse with them the annotations from *ANNOT
3846 (those which fall within the range of positions POS to POS + LEN),
3847 each at its appropriate position.
3849 Modify *ANNOT by discarding elements as we output them.
3850 The return value is negative in case of system call failure. */
3853 a_write (desc
, addr
, len
, pos
, annot
)
3855 register char *addr
;
3862 int lastpos
= pos
+ len
;
3864 while (NILP (*annot
) || CONSP (*annot
))
3866 tem
= Fcar_safe (Fcar (*annot
));
3867 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3868 nextpos
= XFASTINT (tem
);
3870 return e_write (desc
, addr
, lastpos
- pos
);
3873 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3875 addr
+= nextpos
- pos
;
3878 tem
= Fcdr (Fcar (*annot
));
3881 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3884 *annot
= Fcdr (*annot
);
3889 e_write (desc
, addr
, len
)
3891 register char *addr
;
3894 char buf
[16 * 1024];
3895 register char *p
, *end
;
3897 if (!EQ (current_buffer
->selective_display
, Qt
))
3898 return write (desc
, addr
, len
) - len
;
3902 end
= p
+ sizeof buf
;
3907 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3916 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3922 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3923 Sverify_visited_file_modtime
, 1, 1, 0,
3924 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3925 This means that the file has not been changed since it was visited or saved.")
3931 Lisp_Object handler
;
3933 CHECK_BUFFER (buf
, 0);
3936 if (!STRINGP (b
->filename
)) return Qt
;
3937 if (b
->modtime
== 0) return Qt
;
3939 /* If the file name has special constructs in it,
3940 call the corresponding file handler. */
3941 handler
= Ffind_file_name_handler (b
->filename
,
3942 Qverify_visited_file_modtime
);
3943 if (!NILP (handler
))
3944 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3946 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3948 /* If the file doesn't exist now and didn't exist before,
3949 we say that it isn't modified, provided the error is a tame one. */
3950 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3955 if (st
.st_mtime
== b
->modtime
3956 /* If both are positive, accept them if they are off by one second. */
3957 || (st
.st_mtime
> 0 && b
->modtime
> 0
3958 && (st
.st_mtime
== b
->modtime
+ 1
3959 || st
.st_mtime
== b
->modtime
- 1)))
3964 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3965 Sclear_visited_file_modtime
, 0, 0, 0,
3966 "Clear out records of last mod time of visited file.\n\
3967 Next attempt to save will certainly not complain of a discrepancy.")
3970 current_buffer
->modtime
= 0;
3974 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3975 Svisited_file_modtime
, 0, 0, 0,
3976 "Return the current buffer's recorded visited file modification time.\n\
3977 The value is a list of the form (HIGH . LOW), like the time values\n\
3978 that `file-attributes' returns.")
3981 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3984 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3985 Sset_visited_file_modtime
, 0, 1, 0,
3986 "Update buffer's recorded modification time from the visited file's time.\n\
3987 Useful if the buffer was not read from the file normally\n\
3988 or if the file itself has been changed for some known benign reason.\n\
3989 An argument specifies the modification time value to use\n\
3990 \(instead of that of the visited file), in the form of a list\n\
3991 \(HIGH . LOW) or (HIGH LOW).")
3993 Lisp_Object time_list
;
3995 if (!NILP (time_list
))
3996 current_buffer
->modtime
= cons_to_long (time_list
);
3999 register Lisp_Object filename
;
4001 Lisp_Object handler
;
4003 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4005 /* If the file name has special constructs in it,
4006 call the corresponding file handler. */
4007 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4008 if (!NILP (handler
))
4009 /* The handler can find the file name the same way we did. */
4010 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4011 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4012 current_buffer
->modtime
= st
.st_mtime
;
4022 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4023 Fsleep_for (make_number (1), Qnil
);
4024 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4025 Fsleep_for (make_number (1), Qnil
);
4026 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4027 Fsleep_for (make_number (1), Qnil
);
4037 /* Get visited file's mode to become the auto save file's mode. */
4038 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4039 /* But make sure we can overwrite it later! */
4040 auto_save_mode_bits
= st
.st_mode
| 0600;
4042 auto_save_mode_bits
= 0666;
4045 Fwrite_region (Qnil
, Qnil
,
4046 current_buffer
->auto_save_file_name
,
4047 Qnil
, Qlambda
, Qnil
);
4051 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4055 if (XINT (desc
) >= 0)
4056 close (XINT (desc
));
4060 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4061 "Auto-save all buffers that need it.\n\
4062 This is all buffers that have auto-saving enabled\n\
4063 and are changed since last auto-saved.\n\
4064 Auto-saving writes the buffer into a file\n\
4065 so that your editing is not lost if the system crashes.\n\
4066 This file is not the file you visited; that changes only when you save.\n\
4067 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4068 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4069 A non-nil CURRENT-ONLY argument means save only current buffer.")
4070 (no_message
, current_only
)
4071 Lisp_Object no_message
, current_only
;
4073 struct buffer
*old
= current_buffer
, *b
;
4074 Lisp_Object tail
, buf
;
4076 char *omessage
= echo_area_glyphs
;
4077 int omessage_length
= echo_area_glyphs_length
;
4078 int do_handled_files
;
4081 int count
= specpdl_ptr
- specpdl
;
4084 /* Ordinarily don't quit within this function,
4085 but don't make it impossible to quit (in case we get hung in I/O). */
4089 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4090 point to non-strings reached from Vbuffer_alist. */
4095 if (!NILP (Vrun_hooks
))
4096 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4098 if (STRINGP (Vauto_save_list_file_name
))
4100 Lisp_Object listfile
;
4101 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4103 listdesc
= open (XSTRING (listfile
)->data
,
4104 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4105 S_IREAD
| S_IWRITE
);
4106 #else /* not DOS_NT */
4107 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4108 #endif /* not DOS_NT */
4113 /* Arrange to close that file whether or not we get an error.
4114 Also reset auto_saving to 0. */
4115 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4119 /* First, save all files which don't have handlers. If Emacs is
4120 crashing, the handlers may tweak what is causing Emacs to crash
4121 in the first place, and it would be a shame if Emacs failed to
4122 autosave perfectly ordinary files because it couldn't handle some
4124 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4125 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4127 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4130 /* Record all the buffers that have auto save mode
4131 in the special file that lists them. For each of these buffers,
4132 Record visited name (if any) and auto save name. */
4133 if (STRINGP (b
->auto_save_file_name
)
4134 && listdesc
>= 0 && do_handled_files
== 0)
4136 if (!NILP (b
->filename
))
4138 write (listdesc
, XSTRING (b
->filename
)->data
,
4139 XSTRING (b
->filename
)->size
);
4141 write (listdesc
, "\n", 1);
4142 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4143 XSTRING (b
->auto_save_file_name
)->size
);
4144 write (listdesc
, "\n", 1);
4147 if (!NILP (current_only
)
4148 && b
!= current_buffer
)
4151 /* Don't auto-save indirect buffers.
4152 The base buffer takes care of it. */
4156 /* Check for auto save enabled
4157 and file changed since last auto save
4158 and file changed since last real save. */
4159 if (STRINGP (b
->auto_save_file_name
)
4160 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4161 && b
->auto_save_modified
< BUF_MODIFF (b
)
4162 /* -1 means we've turned off autosaving for a while--see below. */
4163 && XINT (b
->save_length
) >= 0
4164 && (do_handled_files
4165 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4168 EMACS_TIME before_time
, after_time
;
4170 EMACS_GET_TIME (before_time
);
4172 /* If we had a failure, don't try again for 20 minutes. */
4173 if (b
->auto_save_failure_time
>= 0
4174 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4177 if ((XFASTINT (b
->save_length
) * 10
4178 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4179 /* A short file is likely to change a large fraction;
4180 spare the user annoying messages. */
4181 && XFASTINT (b
->save_length
) > 5000
4182 /* These messages are frequent and annoying for `*mail*'. */
4183 && !EQ (b
->filename
, Qnil
)
4184 && NILP (no_message
))
4186 /* It has shrunk too much; turn off auto-saving here. */
4187 message ("Buffer %s has shrunk a lot; auto save turned off there",
4188 XSTRING (b
->name
)->data
);
4189 /* Turn off auto-saving until there's a real save,
4190 and prevent any more warnings. */
4191 XSETINT (b
->save_length
, -1);
4192 Fsleep_for (make_number (1), Qnil
);
4195 set_buffer_internal (b
);
4196 if (!auto_saved
&& NILP (no_message
))
4197 message1 ("Auto-saving...");
4198 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4200 b
->auto_save_modified
= BUF_MODIFF (b
);
4201 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4202 set_buffer_internal (old
);
4204 EMACS_GET_TIME (after_time
);
4206 /* If auto-save took more than 60 seconds,
4207 assume it was an NFS failure that got a timeout. */
4208 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4209 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4213 /* Prevent another auto save till enough input events come in. */
4214 record_auto_save ();
4216 if (auto_saved
&& NILP (no_message
))
4220 sit_for (1, 0, 0, 0);
4221 message2 (omessage
, omessage_length
);
4224 message1 ("Auto-saving...done");
4229 unbind_to (count
, Qnil
);
4233 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4234 Sset_buffer_auto_saved
, 0, 0, 0,
4235 "Mark current buffer as auto-saved with its current text.\n\
4236 No auto-save file will be written until the buffer changes again.")
4239 current_buffer
->auto_save_modified
= MODIFF
;
4240 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4241 current_buffer
->auto_save_failure_time
= -1;
4245 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4246 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4247 "Clear any record of a recent auto-save failure in the current buffer.")
4250 current_buffer
->auto_save_failure_time
= -1;
4254 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4256 "Return t if buffer has been auto-saved since last read in or saved.")
4259 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4262 /* Reading and completing file names */
4263 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4265 /* In the string VAL, change each $ to $$ and return the result. */
4268 double_dollars (val
)
4271 register unsigned char *old
, *new;
4275 osize
= XSTRING (val
)->size
;
4276 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4277 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4278 if (*old
++ == '$') count
++;
4281 old
= XSTRING (val
)->data
;
4282 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4283 new = XSTRING (val
)->data
;
4284 for (n
= osize
; n
> 0; n
--)
4297 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4299 "Internal subroutine for read-file-name. Do not call this.")
4300 (string
, dir
, action
)
4301 Lisp_Object string
, dir
, action
;
4302 /* action is nil for complete, t for return list of completions,
4303 lambda for verify final value */
4305 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4307 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4314 /* No need to protect ACTION--we only compare it with t and nil. */
4315 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4317 if (XSTRING (string
)->size
== 0)
4319 if (EQ (action
, Qlambda
))
4327 orig_string
= string
;
4328 string
= Fsubstitute_in_file_name (string
);
4329 changed
= NILP (Fstring_equal (string
, orig_string
));
4330 name
= Ffile_name_nondirectory (string
);
4331 val
= Ffile_name_directory (string
);
4333 realdir
= Fexpand_file_name (val
, realdir
);
4338 specdir
= Ffile_name_directory (string
);
4339 val
= Ffile_name_completion (name
, realdir
);
4344 return double_dollars (string
);
4348 if (!NILP (specdir
))
4349 val
= concat2 (specdir
, val
);
4351 return double_dollars (val
);
4354 #endif /* not VMS */
4358 if (EQ (action
, Qt
))
4359 return Ffile_name_all_completions (name
, realdir
);
4360 /* Only other case actually used is ACTION = lambda */
4362 /* Supposedly this helps commands such as `cd' that read directory names,
4363 but can someone explain how it helps them? -- RMS */
4364 if (XSTRING (name
)->size
== 0)
4367 return Ffile_exists_p (string
);
4370 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4371 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4372 Value is not expanded---you must call `expand-file-name' yourself.\n\
4373 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4374 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4375 except that if INITIAL is specified, that combined with DIR is used.)\n\
4376 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4377 Non-nil and non-t means also require confirmation after completion.\n\
4378 Fifth arg INITIAL specifies text to start with.\n\
4379 DIR defaults to current buffer's directory default.")
4380 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4381 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4383 Lisp_Object val
, insdef
, insdef1
, tem
;
4384 struct gcpro gcpro1
, gcpro2
;
4385 register char *homedir
;
4389 dir
= current_buffer
->directory
;
4390 if (NILP (default_filename
))
4392 if (! NILP (initial
))
4393 default_filename
= Fexpand_file_name (initial
, dir
);
4395 default_filename
= current_buffer
->filename
;
4398 /* If dir starts with user's homedir, change that to ~. */
4399 homedir
= (char *) egetenv ("HOME");
4401 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4402 CORRECT_DIR_SEPS (homedir
);
4406 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4407 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4409 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4410 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4411 XSTRING (dir
)->data
[0] = '~';
4414 if (insert_default_directory
)
4417 if (!NILP (initial
))
4419 Lisp_Object args
[2], pos
;
4423 insdef
= Fconcat (2, args
);
4424 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4425 insdef1
= Fcons (double_dollars (insdef
), pos
);
4428 insdef1
= double_dollars (insdef
);
4430 else if (!NILP (initial
))
4433 insdef1
= Fcons (double_dollars (insdef
), 0);
4436 insdef
= Qnil
, insdef1
= Qnil
;
4439 count
= specpdl_ptr
- specpdl
;
4440 specbind (intern ("completion-ignore-case"), Qt
);
4443 GCPRO2 (insdef
, default_filename
);
4444 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4445 dir
, mustmatch
, insdef1
,
4446 Qfile_name_history
);
4449 unbind_to (count
, Qnil
);
4454 error ("No file name specified");
4455 tem
= Fstring_equal (val
, insdef
);
4456 if (!NILP (tem
) && !NILP (default_filename
))
4457 return default_filename
;
4458 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4460 if (!NILP (default_filename
))
4461 return default_filename
;
4463 error ("No default file name");
4465 return Fsubstitute_in_file_name (val
);
4468 #if 0 /* Old version */
4469 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4470 /* Don't confuse make-docfile by having two doc strings for this function.
4471 make-docfile does not pay attention to #if, for good reason! */
4473 (prompt
, dir
, defalt
, mustmatch
, initial
)
4474 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4476 Lisp_Object val
, insdef
, tem
;
4477 struct gcpro gcpro1
, gcpro2
;
4478 register char *homedir
;
4482 dir
= current_buffer
->directory
;
4484 defalt
= current_buffer
->filename
;
4486 /* If dir starts with user's homedir, change that to ~. */
4487 homedir
= (char *) egetenv ("HOME");
4490 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4491 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4493 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4494 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4495 XSTRING (dir
)->data
[0] = '~';
4498 if (!NILP (initial
))
4500 else if (insert_default_directory
)
4503 insdef
= build_string ("");
4506 count
= specpdl_ptr
- specpdl
;
4507 specbind (intern ("completion-ignore-case"), Qt
);
4510 GCPRO2 (insdef
, defalt
);
4511 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4513 insert_default_directory
? insdef
: Qnil
,
4514 Qfile_name_history
);
4517 unbind_to (count
, Qnil
);
4522 error ("No file name specified");
4523 tem
= Fstring_equal (val
, insdef
);
4524 if (!NILP (tem
) && !NILP (defalt
))
4526 return Fsubstitute_in_file_name (val
);
4528 #endif /* Old version */
4532 Qexpand_file_name
= intern ("expand-file-name");
4533 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4534 Qdirectory_file_name
= intern ("directory-file-name");
4535 Qfile_name_directory
= intern ("file-name-directory");
4536 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4537 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4538 Qfile_name_as_directory
= intern ("file-name-as-directory");
4539 Qcopy_file
= intern ("copy-file");
4540 Qmake_directory_internal
= intern ("make-directory-internal");
4541 Qdelete_directory
= intern ("delete-directory");
4542 Qdelete_file
= intern ("delete-file");
4543 Qrename_file
= intern ("rename-file");
4544 Qadd_name_to_file
= intern ("add-name-to-file");
4545 Qmake_symbolic_link
= intern ("make-symbolic-link");
4546 Qfile_exists_p
= intern ("file-exists-p");
4547 Qfile_executable_p
= intern ("file-executable-p");
4548 Qfile_readable_p
= intern ("file-readable-p");
4549 Qfile_writable_p
= intern ("file-writable-p");
4550 Qfile_symlink_p
= intern ("file-symlink-p");
4551 Qaccess_file
= intern ("access-file");
4552 Qfile_directory_p
= intern ("file-directory-p");
4553 Qfile_regular_p
= intern ("file-regular-p");
4554 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4555 Qfile_modes
= intern ("file-modes");
4556 Qset_file_modes
= intern ("set-file-modes");
4557 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4558 Qinsert_file_contents
= intern ("insert-file-contents");
4559 Qwrite_region
= intern ("write-region");
4560 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4561 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4563 staticpro (&Qexpand_file_name
);
4564 staticpro (&Qsubstitute_in_file_name
);
4565 staticpro (&Qdirectory_file_name
);
4566 staticpro (&Qfile_name_directory
);
4567 staticpro (&Qfile_name_nondirectory
);
4568 staticpro (&Qunhandled_file_name_directory
);
4569 staticpro (&Qfile_name_as_directory
);
4570 staticpro (&Qcopy_file
);
4571 staticpro (&Qmake_directory_internal
);
4572 staticpro (&Qdelete_directory
);
4573 staticpro (&Qdelete_file
);
4574 staticpro (&Qrename_file
);
4575 staticpro (&Qadd_name_to_file
);
4576 staticpro (&Qmake_symbolic_link
);
4577 staticpro (&Qfile_exists_p
);
4578 staticpro (&Qfile_executable_p
);
4579 staticpro (&Qfile_readable_p
);
4580 staticpro (&Qfile_writable_p
);
4581 staticpro (&Qaccess_file
);
4582 staticpro (&Qfile_symlink_p
);
4583 staticpro (&Qfile_directory_p
);
4584 staticpro (&Qfile_regular_p
);
4585 staticpro (&Qfile_accessible_directory_p
);
4586 staticpro (&Qfile_modes
);
4587 staticpro (&Qset_file_modes
);
4588 staticpro (&Qfile_newer_than_file_p
);
4589 staticpro (&Qinsert_file_contents
);
4590 staticpro (&Qwrite_region
);
4591 staticpro (&Qverify_visited_file_modtime
);
4592 staticpro (&Qset_visited_file_modtime
);
4594 Qfile_name_history
= intern ("file-name-history");
4595 Fset (Qfile_name_history
, Qnil
);
4596 staticpro (&Qfile_name_history
);
4598 Qfile_error
= intern ("file-error");
4599 staticpro (&Qfile_error
);
4600 Qfile_already_exists
= intern ("file-already-exists");
4601 staticpro (&Qfile_already_exists
);
4604 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4605 staticpro (&Qfind_buffer_file_type
);
4608 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4609 "*Format in which to write auto-save files.\n\
4610 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4611 If it is t, which is the default, auto-save files are written in the\n\
4612 same format as a regular save would use.");
4613 Vauto_save_file_format
= Qt
;
4615 Qformat_decode
= intern ("format-decode");
4616 staticpro (&Qformat_decode
);
4617 Qformat_annotate_function
= intern ("format-annotate-function");
4618 staticpro (&Qformat_annotate_function
);
4620 Qcar_less_than_car
= intern ("car-less-than-car");
4621 staticpro (&Qcar_less_than_car
);
4623 Fput (Qfile_error
, Qerror_conditions
,
4624 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4625 Fput (Qfile_error
, Qerror_message
,
4626 build_string ("File error"));
4628 Fput (Qfile_already_exists
, Qerror_conditions
,
4629 Fcons (Qfile_already_exists
,
4630 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4631 Fput (Qfile_already_exists
, Qerror_message
,
4632 build_string ("File already exists"));
4634 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4635 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4636 insert_default_directory
= 1;
4638 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4639 "*Non-nil means write new files with record format `stmlf'.\n\
4640 nil means use format `var'. This variable is meaningful only on VMS.");
4641 vms_stmlf_recfm
= 0;
4643 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
4644 "Directory separator character for built-in functions that return file names.\n\
4645 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
4646 This variable affects the built-in functions only on Windows,\n\
4647 on other platforms, it is initialized so that Lisp code can find out\n\
4648 what the normal separator is.");
4649 Vdirectory_sep_char
= '/';
4651 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4652 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4653 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4656 The first argument given to HANDLER is the name of the I/O primitive\n\
4657 to be handled; the remaining arguments are the arguments that were\n\
4658 passed to that primitive. For example, if you do\n\
4659 (file-exists-p FILENAME)\n\
4660 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4661 (funcall HANDLER 'file-exists-p FILENAME)\n\
4662 The function `find-file-name-handler' checks this list for a handler\n\
4663 for its argument.");
4664 Vfile_name_handler_alist
= Qnil
;
4666 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4667 "A list of functions to be called at the end of `insert-file-contents'.\n\
4668 Each is passed one argument, the number of bytes inserted. It should return\n\
4669 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4670 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4671 responsible for calling the after-insert-file-functions if appropriate.");
4672 Vafter_insert_file_functions
= Qnil
;
4674 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4675 "A list of functions to be called at the start of `write-region'.\n\
4676 Each is passed two arguments, START and END as for `write-region'.\n\
4677 These are usually two numbers but not always; see the documentation\n\
4678 for `write-region'. The function should return a list of pairs\n\
4679 of the form (POSITION . STRING), consisting of strings to be effectively\n\
4680 inserted at the specified positions of the file being written (1 means to\n\
4681 insert before the first byte written). The POSITIONs must be sorted into\n\
4682 increasing order. If there are several functions in the list, the several\n\
4683 lists are merged destructively.");
4684 Vwrite_region_annotate_functions
= Qnil
;
4686 DEFVAR_LISP ("write-region-annotations-so-far",
4687 &Vwrite_region_annotations_so_far
,
4688 "When an annotation function is called, this holds the previous annotations.\n\
4689 These are the annotations made by other annotation functions\n\
4690 that were already called. See also `write-region-annotate-functions'.");
4691 Vwrite_region_annotations_so_far
= Qnil
;
4693 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4694 "A list of file name handlers that temporarily should not be used.\n\
4695 This applies only to the operation `inhibit-file-name-operation'.");
4696 Vinhibit_file_name_handlers
= Qnil
;
4698 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4699 "The operation for which `inhibit-file-name-handlers' is applicable.");
4700 Vinhibit_file_name_operation
= Qnil
;
4702 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4703 "File name in which we write a list of all auto save file names.\n\
4704 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4705 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4707 Vauto_save_list_file_name
= Qnil
;
4709 defsubr (&Sfind_file_name_handler
);
4710 defsubr (&Sfile_name_directory
);
4711 defsubr (&Sfile_name_nondirectory
);
4712 defsubr (&Sunhandled_file_name_directory
);
4713 defsubr (&Sfile_name_as_directory
);
4714 defsubr (&Sdirectory_file_name
);
4715 defsubr (&Smake_temp_name
);
4716 defsubr (&Sexpand_file_name
);
4717 defsubr (&Ssubstitute_in_file_name
);
4718 defsubr (&Scopy_file
);
4719 defsubr (&Smake_directory_internal
);
4720 defsubr (&Sdelete_directory
);
4721 defsubr (&Sdelete_file
);
4722 defsubr (&Srename_file
);
4723 defsubr (&Sadd_name_to_file
);
4725 defsubr (&Smake_symbolic_link
);
4726 #endif /* S_IFLNK */
4728 defsubr (&Sdefine_logical_name
);
4731 defsubr (&Ssysnetunam
);
4732 #endif /* HPUX_NET */
4733 defsubr (&Sfile_name_absolute_p
);
4734 defsubr (&Sfile_exists_p
);
4735 defsubr (&Sfile_executable_p
);
4736 defsubr (&Sfile_readable_p
);
4737 defsubr (&Sfile_writable_p
);
4738 defsubr (&Saccess_file
);
4739 defsubr (&Sfile_symlink_p
);
4740 defsubr (&Sfile_directory_p
);
4741 defsubr (&Sfile_accessible_directory_p
);
4742 defsubr (&Sfile_regular_p
);
4743 defsubr (&Sfile_modes
);
4744 defsubr (&Sset_file_modes
);
4745 defsubr (&Sset_default_file_modes
);
4746 defsubr (&Sdefault_file_modes
);
4747 defsubr (&Sfile_newer_than_file_p
);
4748 defsubr (&Sinsert_file_contents
);
4749 defsubr (&Swrite_region
);
4750 defsubr (&Scar_less_than_car
);
4751 defsubr (&Sverify_visited_file_modtime
);
4752 defsubr (&Sclear_visited_file_modtime
);
4753 defsubr (&Svisited_file_modtime
);
4754 defsubr (&Sset_visited_file_modtime
);
4755 defsubr (&Sdo_auto_save
);
4756 defsubr (&Sset_buffer_auto_saved
);
4757 defsubr (&Sclear_buffer_auto_save_failure
);
4758 defsubr (&Srecent_auto_save_p
);
4760 defsubr (&Sread_file_name_internal
);
4761 defsubr (&Sread_file_name
);
4764 defsubr (&Sunix_sync
);