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
)
905 /* Discard any previous drive specifier if nm is now in UNC format. */
906 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
912 /* If nm is absolute, look for /./ or /../ sequences; if none are
913 found, we can probably return right away. We will avoid allocating
914 a new string if name is already fully expanded. */
916 IS_DIRECTORY_SEP (nm
[0])
921 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
928 /* If it turns out that the filename we want to return is just a
929 suffix of FILENAME, we don't need to go through and edit
930 things; we just need to construct a new string using data
931 starting at the middle of FILENAME. If we set lose to a
932 non-zero value, that means we've discovered that we can't do
939 /* Since we know the name is absolute, we can assume that each
940 element starts with a "/". */
942 /* "." and ".." are hairy. */
943 if (IS_DIRECTORY_SEP (p
[0])
945 && (IS_DIRECTORY_SEP (p
[2])
947 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
954 /* if dev:[dir]/, move nm to / */
955 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
956 nm
= (brack
? brack
+ 1 : colon
+ 1);
965 /* VMS pre V4.4,convert '-'s in filenames. */
966 if (lbrack
== rbrack
)
968 if (dots
< 2) /* this is to allow negative version numbers */
973 if (lbrack
> rbrack
&&
974 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
975 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
981 /* count open brackets, reset close bracket pointer */
982 if (p
[0] == '[' || p
[0] == '<')
984 /* count close brackets, set close bracket pointer */
985 if (p
[0] == ']' || p
[0] == '>')
987 /* detect ][ or >< */
988 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
990 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
991 nm
= p
+ 1, lose
= 1;
992 if (p
[0] == ':' && (colon
|| slash
))
993 /* if dev1:[dir]dev2:, move nm to dev2: */
999 /* if /name/dev:, move nm to dev: */
1002 /* if node::dev:, move colon following dev */
1003 else if (colon
&& colon
[-1] == ':')
1005 /* if dev1:dev2:, move nm to dev2: */
1006 else if (colon
&& colon
[-1] != ':')
1011 if (p
[0] == ':' && !colon
)
1017 if (lbrack
== rbrack
)
1020 else if (p
[0] == '.')
1028 if (index (nm
, '/'))
1029 return build_string (sys_translate_unix (nm
));
1032 /* Make sure directories are all separated with / or \ as
1033 desired, but avoid allocation of a new string when not
1035 CORRECT_DIR_SEPS (nm
);
1037 if (IS_DIRECTORY_SEP (nm
[1]))
1039 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1040 name
= build_string (nm
);
1044 /* drive must be set, so this is okay */
1045 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1047 name
= make_string (nm
- 2, p
- nm
+ 2);
1048 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1049 XSTRING (name
)->data
[1] = ':';
1052 #else /* not DOS_NT */
1053 if (nm
== XSTRING (name
)->data
)
1055 return build_string (nm
);
1056 #endif /* not DOS_NT */
1060 /* At this point, nm might or might not be an absolute file name. We
1061 need to expand ~ or ~user if present, otherwise prefix nm with
1062 default_directory if nm is not absolute, and finally collapse /./
1063 and /foo/../ sequences.
1065 We set newdir to be the appropriate prefix if one is needed:
1066 - the relevant user directory if nm starts with ~ or ~user
1067 - the specified drive's working dir (DOS/NT only) if nm does not
1069 - the value of default_directory.
1071 Note that these prefixes are not guaranteed to be absolute (except
1072 for the working dir of a drive). Therefore, to ensure we always
1073 return an absolute name, if the final prefix is not absolute we
1074 append it to the current working directory. */
1078 if (nm
[0] == '~') /* prefix ~ */
1080 if (IS_DIRECTORY_SEP (nm
[1])
1084 || nm
[1] == 0) /* ~ by itself */
1086 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1087 newdir
= (unsigned char *) "";
1090 collapse_newdir
= 0;
1093 nm
++; /* Don't leave the slash in nm. */
1096 else /* ~user/filename */
1098 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1103 o
= (unsigned char *) alloca (p
- nm
+ 1);
1104 bcopy ((char *) nm
, o
, p
- nm
);
1107 pw
= (struct passwd
*) getpwnam (o
+ 1);
1110 newdir
= (unsigned char *) pw
-> pw_dir
;
1112 nm
= p
+ 1; /* skip the terminator */
1116 collapse_newdir
= 0;
1121 /* If we don't find a user of that name, leave the name
1122 unchanged; don't move nm forward to p. */
1127 /* On DOS and Windows, nm is absolute if a drive name was specified;
1128 use the drive's current directory as the prefix if needed. */
1129 if (!newdir
&& drive
)
1131 /* Get default directory if needed to make nm absolute. */
1132 if (!IS_DIRECTORY_SEP (nm
[0]))
1134 newdir
= alloca (MAXPATHLEN
+ 1);
1135 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1140 /* Either nm starts with /, or drive isn't mounted. */
1141 newdir
= alloca (4);
1142 newdir
[0] = DRIVE_LETTER (drive
);
1150 /* Finally, if no prefix has been specified and nm is not absolute,
1151 then it must be expanded relative to default_directory. */
1155 /* /... alone is not absolute on DOS and Windows. */
1156 && !IS_DIRECTORY_SEP (nm
[0])
1159 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1166 newdir
= XSTRING (default_directory
)->data
;
1172 /* First ensure newdir is an absolute name. */
1174 /* Detect MSDOS file names with drive specifiers. */
1175 ! (IS_DRIVE (newdir
[0])
1176 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1178 /* Detect Windows file names in UNC format. */
1179 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1183 /* Effectively, let newdir be (expand-file-name newdir cwd).
1184 Because of the admonition against calling expand-file-name
1185 when we have pointers into lisp strings, we accomplish this
1186 indirectly by prepending newdir to nm if necessary, and using
1187 cwd (or the wd of newdir's drive) as the new newdir. */
1189 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1194 if (!IS_DIRECTORY_SEP (nm
[0]))
1196 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1197 file_name_as_directory (tmp
, newdir
);
1201 newdir
= alloca (MAXPATHLEN
+ 1);
1204 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1211 /* Strip off drive name from prefix, if present. */
1212 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1218 /* Keep only a prefix from newdir if nm starts with slash
1219 (//server/share for UNC, nothing otherwise). */
1220 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1223 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1225 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1227 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1229 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1241 /* Get rid of any slash at the end of newdir, unless newdir is
1242 just // (an incomplete UNC name). */
1243 length
= strlen (newdir
);
1244 if (IS_DIRECTORY_SEP (newdir
[length
- 1])
1246 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1250 unsigned char *temp
= (unsigned char *) alloca (length
);
1251 bcopy (newdir
, temp
, length
- 1);
1252 temp
[length
- 1] = 0;
1260 /* Now concatenate the directory and name to new space in the stack frame */
1261 tlen
+= strlen (nm
) + 1;
1263 /* Add reserved space for drive name. (The Microsoft x86 compiler
1264 produces incorrect code if the following two lines are combined.) */
1265 target
= (unsigned char *) alloca (tlen
+ 2);
1267 #else /* not DOS_NT */
1268 target
= (unsigned char *) alloca (tlen
);
1269 #endif /* not DOS_NT */
1275 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1276 strcpy (target
, newdir
);
1279 file_name_as_directory (target
, newdir
);
1282 strcat (target
, nm
);
1284 if (index (target
, '/'))
1285 strcpy (target
, sys_translate_unix (target
));
1288 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1290 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1298 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1304 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1305 /* brackets are offset from each other by 2 */
1308 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1309 /* convert [foo][bar] to [bar] */
1310 while (o
[-1] != '[' && o
[-1] != '<')
1312 else if (*p
== '-' && *o
!= '.')
1315 else if (p
[0] == '-' && o
[-1] == '.' &&
1316 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1317 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1321 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1322 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1324 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1326 /* else [foo.-] ==> [-] */
1332 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1333 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1339 if (!IS_DIRECTORY_SEP (*p
))
1343 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1344 #if defined (APOLLO) || defined (WINDOWSNT)
1345 /* // at start of filename is meaningful in Apollo
1346 and WindowsNT systems */
1348 #endif /* APOLLO || WINDOWSNT */
1354 else if (IS_DIRECTORY_SEP (p
[0])
1356 && (IS_DIRECTORY_SEP (p
[2])
1359 /* If "/." is the entire filename, keep the "/". Otherwise,
1360 just delete the whole "/.". */
1361 if (o
== target
&& p
[2] == '\0')
1365 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1366 /* `/../' is the "superroot" on certain file systems. */
1368 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1370 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1372 if (o
== target
&& IS_ANY_SEP (*o
))
1380 #endif /* not VMS */
1384 /* At last, set drive name. */
1386 /* Except for network file name. */
1387 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1388 #endif /* WINDOWSNT */
1390 if (!drive
) abort ();
1392 target
[0] = DRIVE_LETTER (drive
);
1395 CORRECT_DIR_SEPS (target
);
1398 return make_string (target
, o
- target
);
1402 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1403 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1404 "Convert FILENAME to absolute, and canonicalize it.\n\
1405 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1406 (does not start with slash); if DEFAULT is nil or missing,\n\
1407 the current buffer's value of default-directory is used.\n\
1408 Filenames containing `.' or `..' as components are simplified;\n\
1409 initial `~/' expands to your home directory.\n\
1410 See also the function `substitute-in-file-name'.")
1412 Lisp_Object name
, defalt
;
1416 register unsigned char *newdir
, *p
, *o
;
1418 unsigned char *target
;
1422 unsigned char * colon
= 0;
1423 unsigned char * close
= 0;
1424 unsigned char * slash
= 0;
1425 unsigned char * brack
= 0;
1426 int lbrack
= 0, rbrack
= 0;
1430 CHECK_STRING (name
, 0);
1433 /* Filenames on VMS are always upper case. */
1434 name
= Fupcase (name
);
1437 nm
= XSTRING (name
)->data
;
1439 /* If nm is absolute, flush ...// and detect /./ and /../.
1440 If no /./ or /../ we can return right away. */
1452 if (p
[0] == '/' && p
[1] == '/'
1454 /* // at start of filename is meaningful on Apollo system */
1459 if (p
[0] == '/' && p
[1] == '~')
1460 nm
= p
+ 1, lose
= 1;
1461 if (p
[0] == '/' && p
[1] == '.'
1462 && (p
[2] == '/' || p
[2] == 0
1463 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1469 /* if dev:[dir]/, move nm to / */
1470 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1471 nm
= (brack
? brack
+ 1 : colon
+ 1);
1472 lbrack
= rbrack
= 0;
1480 /* VMS pre V4.4,convert '-'s in filenames. */
1481 if (lbrack
== rbrack
)
1483 if (dots
< 2) /* this is to allow negative version numbers */
1488 if (lbrack
> rbrack
&&
1489 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1490 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1496 /* count open brackets, reset close bracket pointer */
1497 if (p
[0] == '[' || p
[0] == '<')
1498 lbrack
++, brack
= 0;
1499 /* count close brackets, set close bracket pointer */
1500 if (p
[0] == ']' || p
[0] == '>')
1501 rbrack
++, brack
= p
;
1502 /* detect ][ or >< */
1503 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1505 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1506 nm
= p
+ 1, lose
= 1;
1507 if (p
[0] == ':' && (colon
|| slash
))
1508 /* if dev1:[dir]dev2:, move nm to dev2: */
1514 /* If /name/dev:, move nm to dev: */
1517 /* If node::dev:, move colon following dev */
1518 else if (colon
&& colon
[-1] == ':')
1520 /* If dev1:dev2:, move nm to dev2: */
1521 else if (colon
&& colon
[-1] != ':')
1526 if (p
[0] == ':' && !colon
)
1532 if (lbrack
== rbrack
)
1535 else if (p
[0] == '.')
1543 if (index (nm
, '/'))
1544 return build_string (sys_translate_unix (nm
));
1546 if (nm
== XSTRING (name
)->data
)
1548 return build_string (nm
);
1552 /* Now determine directory to start with and put it in NEWDIR */
1556 if (nm
[0] == '~') /* prefix ~ */
1561 || nm
[1] == 0)/* ~/filename */
1563 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1564 newdir
= (unsigned char *) "";
1567 nm
++; /* Don't leave the slash in nm. */
1570 else /* ~user/filename */
1572 /* Get past ~ to user */
1573 unsigned char *user
= nm
+ 1;
1574 /* Find end of name. */
1575 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1576 int len
= ptr
? ptr
- user
: strlen (user
);
1578 unsigned char *ptr1
= index (user
, ':');
1579 if (ptr1
!= 0 && ptr1
- user
< len
)
1582 /* Copy the user name into temp storage. */
1583 o
= (unsigned char *) alloca (len
+ 1);
1584 bcopy ((char *) user
, o
, len
);
1587 /* Look up the user name. */
1588 pw
= (struct passwd
*) getpwnam (o
+ 1);
1590 error ("\"%s\" isn't a registered user", o
+ 1);
1592 newdir
= (unsigned char *) pw
->pw_dir
;
1594 /* Discard the user name from NM. */
1601 #endif /* not VMS */
1605 defalt
= current_buffer
->directory
;
1606 CHECK_STRING (defalt
, 1);
1607 newdir
= XSTRING (defalt
)->data
;
1610 /* Now concatenate the directory and name to new space in the stack frame */
1612 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1613 target
= (unsigned char *) alloca (tlen
);
1619 if (nm
[0] == 0 || nm
[0] == '/')
1620 strcpy (target
, newdir
);
1623 file_name_as_directory (target
, newdir
);
1626 strcat (target
, nm
);
1628 if (index (target
, '/'))
1629 strcpy (target
, sys_translate_unix (target
));
1632 /* Now canonicalize by removing /. and /foo/.. if they appear */
1640 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1646 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1647 /* brackets are offset from each other by 2 */
1650 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1651 /* convert [foo][bar] to [bar] */
1652 while (o
[-1] != '[' && o
[-1] != '<')
1654 else if (*p
== '-' && *o
!= '.')
1657 else if (p
[0] == '-' && o
[-1] == '.' &&
1658 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1659 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1663 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1664 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1666 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1668 /* else [foo.-] ==> [-] */
1674 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1675 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1685 else if (!strncmp (p
, "//", 2)
1687 /* // at start of filename is meaningful in Apollo system */
1695 else if (p
[0] == '/' && p
[1] == '.' &&
1696 (p
[2] == '/' || p
[2] == 0))
1698 else if (!strncmp (p
, "/..", 3)
1699 /* `/../' is the "superroot" on certain file systems. */
1701 && (p
[3] == '/' || p
[3] == 0))
1703 while (o
!= target
&& *--o
!= '/')
1706 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1710 if (o
== target
&& *o
== '/')
1718 #endif /* not VMS */
1721 return make_string (target
, o
- target
);
1725 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1726 Ssubstitute_in_file_name
, 1, 1, 0,
1727 "Substitute environment variables referred to in FILENAME.\n\
1728 `$FOO' where FOO is an environment variable name means to substitute\n\
1729 the value of that variable. The variable name should be terminated\n\
1730 with a character not a letter, digit or underscore; otherwise, enclose\n\
1731 the entire variable name in braces.\n\
1732 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1733 On VMS, `$' substitution is not done; this function does little and only\n\
1734 duplicates what `expand-file-name' does.")
1736 Lisp_Object filename
;
1740 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1741 unsigned char *target
;
1743 int substituted
= 0;
1745 Lisp_Object handler
;
1747 CHECK_STRING (filename
, 0);
1749 /* If the file name has special constructs in it,
1750 call the corresponding file handler. */
1751 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1752 if (!NILP (handler
))
1753 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1755 nm
= XSTRING (filename
)->data
;
1757 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1758 CORRECT_DIR_SEPS (nm
);
1759 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1761 endp
= nm
+ XSTRING (filename
)->size
;
1763 /* If /~ or // appears, discard everything through first slash. */
1765 for (p
= nm
; p
!= endp
; p
++)
1768 #if defined (APOLLO) || defined (WINDOWSNT)
1769 /* // at start of file name is meaningful in Apollo and
1770 WindowsNT systems */
1771 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1772 #else /* not (APOLLO || WINDOWSNT) */
1773 || IS_DIRECTORY_SEP (p
[0])
1774 #endif /* not (APOLLO || WINDOWSNT) */
1779 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1781 || IS_DIRECTORY_SEP (p
[-1])))
1787 /* see comment in expand-file-name about drive specifiers */
1788 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1789 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1798 return build_string (nm
);
1801 /* See if any variables are substituted into the string
1802 and find the total length of their values in `total' */
1804 for (p
= nm
; p
!= endp
;)
1814 /* "$$" means a single "$" */
1823 while (p
!= endp
&& *p
!= '}') p
++;
1824 if (*p
!= '}') goto missingclose
;
1830 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1834 /* Copy out the variable name */
1835 target
= (unsigned char *) alloca (s
- o
+ 1);
1836 strncpy (target
, o
, s
- o
);
1839 strupr (target
); /* $home == $HOME etc. */
1842 /* Get variable value */
1843 o
= (unsigned char *) egetenv (target
);
1844 if (!o
) goto badvar
;
1845 total
+= strlen (o
);
1852 /* If substitution required, recopy the string and do it */
1853 /* Make space in stack frame for the new copy */
1854 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1857 /* Copy the rest of the name through, replacing $ constructs with values */
1874 while (p
!= endp
&& *p
!= '}') p
++;
1875 if (*p
!= '}') goto missingclose
;
1881 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1885 /* Copy out the variable name */
1886 target
= (unsigned char *) alloca (s
- o
+ 1);
1887 strncpy (target
, o
, s
- o
);
1890 strupr (target
); /* $home == $HOME etc. */
1893 /* Get variable value */
1894 o
= (unsigned char *) egetenv (target
);
1904 /* If /~ or // appears, discard everything through first slash. */
1906 for (p
= xnm
; p
!= x
; p
++)
1908 #if defined (APOLLO) || defined (WINDOWSNT)
1909 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1910 #else /* not (APOLLO || WINDOWSNT) */
1911 || IS_DIRECTORY_SEP (p
[0])
1912 #endif /* not (APOLLO || WINDOWSNT) */
1914 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1917 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1918 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1922 return make_string (xnm
, x
- xnm
);
1925 error ("Bad format environment-variable substitution");
1927 error ("Missing \"}\" in environment-variable substitution");
1929 error ("Substituting nonexistent environment variable \"%s\"", target
);
1932 #endif /* not VMS */
1935 /* A slightly faster and more convenient way to get
1936 (directory-file-name (expand-file-name FOO)). */
1939 expand_and_dir_to_file (filename
, defdir
)
1940 Lisp_Object filename
, defdir
;
1942 register Lisp_Object absname
;
1944 absname
= Fexpand_file_name (filename
, defdir
);
1947 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1948 if (c
== ':' || c
== ']' || c
== '>')
1949 absname
= Fdirectory_file_name (absname
);
1952 /* Remove final slash, if any (unless this is the root dir).
1953 stat behaves differently depending! */
1954 if (XSTRING (absname
)->size
> 1
1955 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1956 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1957 /* We cannot take shortcuts; they might be wrong for magic file names. */
1958 absname
= Fdirectory_file_name (absname
);
1963 /* Signal an error if the file ABSNAME already exists.
1964 If INTERACTIVE is nonzero, ask the user whether to proceed,
1965 and bypass the error if the user says to go ahead.
1966 QUERYSTRING is a name for the action that is being considered
1968 *STATPTR is used to store the stat information if the file exists.
1969 If the file does not exist, STATPTR->st_mode is set to 0. */
1972 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1973 Lisp_Object absname
;
1974 unsigned char *querystring
;
1976 struct stat
*statptr
;
1978 register Lisp_Object tem
;
1979 struct stat statbuf
;
1980 struct gcpro gcpro1
;
1982 /* stat is a good way to tell whether the file exists,
1983 regardless of what access permissions it has. */
1984 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1987 Fsignal (Qfile_already_exists
,
1988 Fcons (build_string ("File already exists"),
1989 Fcons (absname
, Qnil
)));
1991 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1992 XSTRING (absname
)->data
, querystring
));
1995 Fsignal (Qfile_already_exists
,
1996 Fcons (build_string ("File already exists"),
1997 Fcons (absname
, Qnil
)));
2004 statptr
->st_mode
= 0;
2009 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2010 "fCopy file: \nFCopy %s to file: \np\nP",
2011 "Copy FILE to NEWNAME. Both args must be strings.\n\
2012 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2013 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2014 A number as third arg means request confirmation if NEWNAME already exists.\n\
2015 This is what happens in interactive use with M-x.\n\
2016 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2017 last-modified time as the old one. (This works on only some systems.)\n\
2018 A prefix arg makes KEEP-TIME non-nil.")
2019 (file
, newname
, ok_if_already_exists
, keep_date
)
2020 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2023 char buf
[16 * 1024];
2024 struct stat st
, out_st
;
2025 Lisp_Object handler
;
2026 struct gcpro gcpro1
, gcpro2
;
2027 int count
= specpdl_ptr
- specpdl
;
2028 int input_file_statable_p
;
2030 GCPRO2 (file
, newname
);
2031 CHECK_STRING (file
, 0);
2032 CHECK_STRING (newname
, 1);
2033 file
= Fexpand_file_name (file
, Qnil
);
2034 newname
= Fexpand_file_name (newname
, Qnil
);
2036 /* If the input file name has special constructs in it,
2037 call the corresponding file handler. */
2038 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2039 /* Likewise for output file name. */
2041 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2042 if (!NILP (handler
))
2043 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2044 ok_if_already_exists
, keep_date
));
2046 if (NILP (ok_if_already_exists
)
2047 || INTEGERP (ok_if_already_exists
))
2048 barf_or_query_if_file_exists (newname
, "copy to it",
2049 INTEGERP (ok_if_already_exists
), &out_st
);
2050 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2053 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2055 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2057 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2059 /* We can only copy regular files and symbolic links. Other files are not
2061 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2063 #if !defined (MSDOS) || __DJGPP__ > 1
2064 if (out_st
.st_mode
!= 0
2065 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2068 report_file_error ("Input and output files are the same",
2069 Fcons (file
, Fcons (newname
, Qnil
)));
2073 #if defined (S_ISREG) && defined (S_ISLNK)
2074 if (input_file_statable_p
)
2076 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2078 #if defined (EISDIR)
2079 /* Get a better looking error message. */
2082 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2085 #endif /* S_ISREG && S_ISLNK */
2088 /* Create the copy file with the same record format as the input file */
2089 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2092 /* System's default file type was set to binary by _fmode in emacs.c. */
2093 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2094 #else /* not MSDOS */
2095 ofd
= creat (XSTRING (newname
)->data
, 0666);
2096 #endif /* not MSDOS */
2099 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2101 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2105 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2106 if (write (ofd
, buf
, n
) != n
)
2107 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2110 /* Closing the output clobbers the file times on some systems. */
2111 if (close (ofd
) < 0)
2112 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2114 if (input_file_statable_p
)
2116 if (!NILP (keep_date
))
2118 EMACS_TIME atime
, mtime
;
2119 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2120 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2121 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2122 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2125 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2127 #if defined (__DJGPP__) && __DJGPP__ > 1
2128 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2129 and if it can't, it tells so. Otherwise, under MSDOS we usually
2130 get only the READ bit, which will make the copied file read-only,
2131 so it's better not to chmod at all. */
2132 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2133 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2134 #endif /* DJGPP version 2 or newer */
2140 /* Discard the unwind protects. */
2141 specpdl_ptr
= specpdl
+ count
;
2147 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2148 Smake_directory_internal
, 1, 1, 0,
2149 "Create a new directory named DIRECTORY.")
2151 Lisp_Object directory
;
2154 Lisp_Object handler
;
2156 CHECK_STRING (directory
, 0);
2157 directory
= Fexpand_file_name (directory
, Qnil
);
2159 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2160 if (!NILP (handler
))
2161 return call2 (handler
, Qmake_directory_internal
, directory
);
2163 dir
= XSTRING (directory
)->data
;
2166 if (mkdir (dir
) != 0)
2168 if (mkdir (dir
, 0777) != 0)
2170 report_file_error ("Creating directory", Flist (1, &directory
));
2175 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2176 "Delete the directory named DIRECTORY.")
2178 Lisp_Object directory
;
2181 Lisp_Object handler
;
2183 CHECK_STRING (directory
, 0);
2184 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2185 dir
= XSTRING (directory
)->data
;
2187 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2188 if (!NILP (handler
))
2189 return call2 (handler
, Qdelete_directory
, directory
);
2191 if (rmdir (dir
) != 0)
2192 report_file_error ("Removing directory", Flist (1, &directory
));
2197 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2198 "Delete file named FILENAME.\n\
2199 If file has multiple names, it continues to exist with the other names.")
2201 Lisp_Object filename
;
2203 Lisp_Object handler
;
2204 CHECK_STRING (filename
, 0);
2205 filename
= Fexpand_file_name (filename
, Qnil
);
2207 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2208 if (!NILP (handler
))
2209 return call2 (handler
, Qdelete_file
, filename
);
2211 if (0 > unlink (XSTRING (filename
)->data
))
2212 report_file_error ("Removing old name", Flist (1, &filename
));
2217 internal_delete_file_1 (ignore
)
2223 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2226 internal_delete_file (filename
)
2227 Lisp_Object filename
;
2229 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2230 Qt
, internal_delete_file_1
));
2233 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2234 "fRename file: \nFRename %s to file: \np",
2235 "Rename FILE as NEWNAME. Both args strings.\n\
2236 If file has names other than FILE, it continues to have those names.\n\
2237 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2238 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2239 A number as third arg means request confirmation if NEWNAME already exists.\n\
2240 This is what happens in interactive use with M-x.")
2241 (file
, newname
, ok_if_already_exists
)
2242 Lisp_Object file
, newname
, ok_if_already_exists
;
2245 Lisp_Object args
[2];
2247 Lisp_Object handler
;
2248 struct gcpro gcpro1
, gcpro2
;
2250 GCPRO2 (file
, newname
);
2251 CHECK_STRING (file
, 0);
2252 CHECK_STRING (newname
, 1);
2253 file
= Fexpand_file_name (file
, Qnil
);
2254 newname
= Fexpand_file_name (newname
, Qnil
);
2256 /* If the file name has special constructs in it,
2257 call the corresponding file handler. */
2258 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2260 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2261 if (!NILP (handler
))
2262 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2263 file
, newname
, ok_if_already_exists
));
2265 if (NILP (ok_if_already_exists
)
2266 || INTEGERP (ok_if_already_exists
))
2267 barf_or_query_if_file_exists (newname
, "rename to it",
2268 INTEGERP (ok_if_already_exists
), 0);
2270 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2272 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2273 || 0 > unlink (XSTRING (file
)->data
))
2278 Fcopy_file (file
, newname
,
2279 /* We have already prompted if it was an integer,
2280 so don't have copy-file prompt again. */
2281 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2282 Fdelete_file (file
);
2289 report_file_error ("Renaming", Flist (2, args
));
2292 report_file_error ("Renaming", Flist (2, &file
));
2299 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2300 "fAdd name to file: \nFName to add to %s: \np",
2301 "Give FILE additional name NEWNAME. Both args strings.\n\
2302 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2303 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2304 A number as third arg means request confirmation if NEWNAME already exists.\n\
2305 This is what happens in interactive use with M-x.")
2306 (file
, newname
, ok_if_already_exists
)
2307 Lisp_Object file
, newname
, ok_if_already_exists
;
2310 Lisp_Object args
[2];
2312 Lisp_Object handler
;
2313 struct gcpro gcpro1
, gcpro2
;
2315 GCPRO2 (file
, newname
);
2316 CHECK_STRING (file
, 0);
2317 CHECK_STRING (newname
, 1);
2318 file
= Fexpand_file_name (file
, Qnil
);
2319 newname
= Fexpand_file_name (newname
, Qnil
);
2321 /* If the file name has special constructs in it,
2322 call the corresponding file handler. */
2323 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2324 if (!NILP (handler
))
2325 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2326 newname
, ok_if_already_exists
));
2328 /* If the new name has special constructs in it,
2329 call the corresponding file handler. */
2330 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2331 if (!NILP (handler
))
2332 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2333 newname
, ok_if_already_exists
));
2335 if (NILP (ok_if_already_exists
)
2336 || INTEGERP (ok_if_already_exists
))
2337 barf_or_query_if_file_exists (newname
, "make it a new name",
2338 INTEGERP (ok_if_already_exists
), 0);
2340 /* Windows does not support this operation. */
2341 report_file_error ("Adding new name", Flist (2, &file
));
2342 #else /* not WINDOWSNT */
2344 unlink (XSTRING (newname
)->data
);
2345 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2350 report_file_error ("Adding new name", Flist (2, args
));
2352 report_file_error ("Adding new name", Flist (2, &file
));
2355 #endif /* not WINDOWSNT */
2362 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2363 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2364 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2365 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2366 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2367 A number as third arg means request confirmation if LINKNAME already exists.\n\
2368 This happens for interactive use with M-x.")
2369 (filename
, linkname
, ok_if_already_exists
)
2370 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2373 Lisp_Object args
[2];
2375 Lisp_Object handler
;
2376 struct gcpro gcpro1
, gcpro2
;
2378 GCPRO2 (filename
, linkname
);
2379 CHECK_STRING (filename
, 0);
2380 CHECK_STRING (linkname
, 1);
2381 /* If the link target has a ~, we must expand it to get
2382 a truly valid file name. Otherwise, do not expand;
2383 we want to permit links to relative file names. */
2384 if (XSTRING (filename
)->data
[0] == '~')
2385 filename
= Fexpand_file_name (filename
, Qnil
);
2386 linkname
= Fexpand_file_name (linkname
, Qnil
);
2388 /* If the file name has special constructs in it,
2389 call the corresponding file handler. */
2390 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2391 if (!NILP (handler
))
2392 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2393 linkname
, ok_if_already_exists
));
2395 /* If the new link name has special constructs in it,
2396 call the corresponding file handler. */
2397 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2398 if (!NILP (handler
))
2399 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2400 linkname
, ok_if_already_exists
));
2402 if (NILP (ok_if_already_exists
)
2403 || INTEGERP (ok_if_already_exists
))
2404 barf_or_query_if_file_exists (linkname
, "make it a link",
2405 INTEGERP (ok_if_already_exists
), 0);
2406 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2408 /* If we didn't complain already, silently delete existing file. */
2409 if (errno
== EEXIST
)
2411 unlink (XSTRING (linkname
)->data
);
2412 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2422 report_file_error ("Making symbolic link", Flist (2, args
));
2424 report_file_error ("Making symbolic link", Flist (2, &filename
));
2430 #endif /* S_IFLNK */
2434 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2435 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2436 "Define the job-wide logical name NAME to have the value STRING.\n\
2437 If STRING is nil or a null string, the logical name NAME is deleted.")
2442 CHECK_STRING (name
, 0);
2444 delete_logical_name (XSTRING (name
)->data
);
2447 CHECK_STRING (string
, 1);
2449 if (XSTRING (string
)->size
== 0)
2450 delete_logical_name (XSTRING (name
)->data
);
2452 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2461 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2462 "Open a network connection to PATH using LOGIN as the login string.")
2464 Lisp_Object path
, login
;
2468 CHECK_STRING (path
, 0);
2469 CHECK_STRING (login
, 0);
2471 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2473 if (netresult
== -1)
2478 #endif /* HPUX_NET */
2480 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2482 "Return t if file FILENAME specifies an absolute file name.\n\
2483 On Unix, this is a name starting with a `/' or a `~'.")
2485 Lisp_Object filename
;
2489 CHECK_STRING (filename
, 0);
2490 ptr
= XSTRING (filename
)->data
;
2491 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2493 /* ??? This criterion is probably wrong for '<'. */
2494 || index (ptr
, ':') || index (ptr
, '<')
2495 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2499 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2507 /* Return nonzero if file FILENAME exists and can be executed. */
2510 check_executable (filename
)
2514 int len
= strlen (filename
);
2517 if (stat (filename
, &st
) < 0)
2519 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2520 return ((st
.st_mode
& S_IEXEC
) != 0);
2522 return (S_ISREG (st
.st_mode
)
2524 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2525 || stricmp (suffix
, ".exe") == 0
2526 || stricmp (suffix
, ".bat") == 0)
2527 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2528 #endif /* not WINDOWSNT */
2529 #else /* not DOS_NT */
2530 #ifdef HAVE_EUIDACCESS
2531 return (euidaccess (filename
, 1) >= 0);
2533 /* Access isn't quite right because it uses the real uid
2534 and we really want to test with the effective uid.
2535 But Unix doesn't give us a right way to do it. */
2536 return (access (filename
, 1) >= 0);
2538 #endif /* not DOS_NT */
2541 /* Return nonzero if file FILENAME exists and can be written. */
2544 check_writable (filename
)
2549 if (stat (filename
, &st
) < 0)
2551 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2552 #else /* not MSDOS */
2553 #ifdef HAVE_EUIDACCESS
2554 return (euidaccess (filename
, 2) >= 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 Opening with O_WRONLY could work for an ordinary file,
2560 but would lose for directories. */
2561 return (access (filename
, 2) >= 0);
2563 #endif /* not MSDOS */
2566 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2567 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2568 See also `file-readable-p' and `file-attributes'.")
2570 Lisp_Object filename
;
2572 Lisp_Object absname
;
2573 Lisp_Object handler
;
2574 struct stat statbuf
;
2576 CHECK_STRING (filename
, 0);
2577 absname
= Fexpand_file_name (filename
, Qnil
);
2579 /* If the file name has special constructs in it,
2580 call the corresponding file handler. */
2581 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2582 if (!NILP (handler
))
2583 return call2 (handler
, Qfile_exists_p
, absname
);
2585 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2588 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2589 "Return t if FILENAME can be executed by you.\n\
2590 For a directory, this means you can access files in that directory.")
2592 Lisp_Object filename
;
2595 Lisp_Object absname
;
2596 Lisp_Object handler
;
2598 CHECK_STRING (filename
, 0);
2599 absname
= Fexpand_file_name (filename
, Qnil
);
2601 /* If the file name has special constructs in it,
2602 call the corresponding file handler. */
2603 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2604 if (!NILP (handler
))
2605 return call2 (handler
, Qfile_executable_p
, absname
);
2607 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2610 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2611 "Return t if file FILENAME exists and you can read it.\n\
2612 See also `file-exists-p' and `file-attributes'.")
2614 Lisp_Object filename
;
2616 Lisp_Object absname
;
2617 Lisp_Object handler
;
2620 CHECK_STRING (filename
, 0);
2621 absname
= Fexpand_file_name (filename
, Qnil
);
2623 /* If the file name has special constructs in it,
2624 call the corresponding file handler. */
2625 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2626 if (!NILP (handler
))
2627 return call2 (handler
, Qfile_readable_p
, absname
);
2630 /* Under MS-DOS and Windows, open does not work for directories. */
2631 if (access (XSTRING (absname
)->data
, 0) == 0)
2634 #else /* not DOS_NT */
2635 desc
= open (XSTRING (absname
)->data
, O_RDONLY
);
2640 #endif /* not DOS_NT */
2643 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2645 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2646 "Return t if file FILENAME can be written or created by you.")
2648 Lisp_Object filename
;
2650 Lisp_Object absname
, dir
;
2651 Lisp_Object handler
;
2652 struct stat statbuf
;
2654 CHECK_STRING (filename
, 0);
2655 absname
= Fexpand_file_name (filename
, Qnil
);
2657 /* If the file name has special constructs in it,
2658 call the corresponding file handler. */
2659 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2660 if (!NILP (handler
))
2661 return call2 (handler
, Qfile_writable_p
, absname
);
2663 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2664 return (check_writable (XSTRING (absname
)->data
)
2666 dir
= Ffile_name_directory (absname
);
2669 dir
= Fdirectory_file_name (dir
);
2673 dir
= Fdirectory_file_name (dir
);
2675 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2679 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2680 "Access file FILENAME, and get an error if that does not work.\n\
2681 The second argument STRING is used in the error message.\n\
2682 If there is no error, we return nil.")
2684 Lisp_Object filename
, string
;
2686 Lisp_Object handler
;
2689 CHECK_STRING (filename
, 0);
2691 /* If the file name has special constructs in it,
2692 call the corresponding file handler. */
2693 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2694 if (!NILP (handler
))
2695 return call3 (handler
, Qaccess_file
, filename
, string
);
2697 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2699 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2705 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2706 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2707 The value is the name of the file to which it is linked.\n\
2708 Otherwise returns nil.")
2710 Lisp_Object filename
;
2717 Lisp_Object handler
;
2719 CHECK_STRING (filename
, 0);
2720 filename
= Fexpand_file_name (filename
, Qnil
);
2722 /* If the file name has special constructs in it,
2723 call the corresponding file handler. */
2724 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2725 if (!NILP (handler
))
2726 return call2 (handler
, Qfile_symlink_p
, filename
);
2731 buf
= (char *) xmalloc (bufsize
);
2732 bzero (buf
, bufsize
);
2733 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2734 if (valsize
< bufsize
) break;
2735 /* Buffer was not long enough */
2744 val
= make_string (buf
, valsize
);
2747 #else /* not S_IFLNK */
2749 #endif /* not S_IFLNK */
2752 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2753 "Return t if file FILENAME is the name of a directory as a file.\n\
2754 A directory name spec may be given instead; then the value is t\n\
2755 if the directory so specified exists and really is a directory.")
2757 Lisp_Object filename
;
2759 register Lisp_Object absname
;
2761 Lisp_Object handler
;
2763 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2765 /* If the file name has special constructs in it,
2766 call the corresponding file handler. */
2767 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2768 if (!NILP (handler
))
2769 return call2 (handler
, Qfile_directory_p
, absname
);
2771 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2773 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2776 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2777 "Return t if file FILENAME is the name of a directory as a file,\n\
2778 and files in that directory can be opened by you. In order to use a\n\
2779 directory as a buffer's current directory, this predicate must return true.\n\
2780 A directory name spec may be given instead; then the value is t\n\
2781 if the directory so specified exists and really is a readable and\n\
2782 searchable directory.")
2784 Lisp_Object filename
;
2786 Lisp_Object handler
;
2788 struct gcpro gcpro1
;
2790 /* If the file name has special constructs in it,
2791 call the corresponding file handler. */
2792 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2793 if (!NILP (handler
))
2794 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2796 /* It's an unlikely combination, but yes we really do need to gcpro:
2797 Suppose that file-accessible-directory-p has no handler, but
2798 file-directory-p does have a handler; this handler causes a GC which
2799 relocates the string in `filename'; and finally file-directory-p
2800 returns non-nil. Then we would end up passing a garbaged string
2801 to file-executable-p. */
2803 tem
= (NILP (Ffile_directory_p (filename
))
2804 || NILP (Ffile_executable_p (filename
)));
2806 return tem
? Qnil
: Qt
;
2809 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2810 "Return t if file FILENAME is the name of a regular file.\n\
2811 This is the sort of file that holds an ordinary stream of data bytes.")
2813 Lisp_Object filename
;
2815 register Lisp_Object absname
;
2817 Lisp_Object handler
;
2819 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2821 /* If the file name has special constructs in it,
2822 call the corresponding file handler. */
2823 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2824 if (!NILP (handler
))
2825 return call2 (handler
, Qfile_regular_p
, absname
);
2827 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2829 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2832 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2833 "Return mode bits of file named FILENAME, as an integer.")
2835 Lisp_Object filename
;
2837 Lisp_Object absname
;
2839 Lisp_Object handler
;
2841 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2843 /* If the file name has special constructs in it,
2844 call the corresponding file handler. */
2845 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2846 if (!NILP (handler
))
2847 return call2 (handler
, Qfile_modes
, absname
);
2849 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2851 #if defined (MSDOS) && __DJGPP__ < 2
2852 if (check_executable (XSTRING (absname
)->data
))
2853 st
.st_mode
|= S_IEXEC
;
2854 #endif /* MSDOS && __DJGPP__ < 2 */
2856 return make_number (st
.st_mode
& 07777);
2859 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2860 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2861 Only the 12 low bits of MODE are used.")
2863 Lisp_Object filename
, mode
;
2865 Lisp_Object absname
;
2866 Lisp_Object handler
;
2868 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2869 CHECK_NUMBER (mode
, 1);
2871 /* If the file name has special constructs in it,
2872 call the corresponding file handler. */
2873 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2874 if (!NILP (handler
))
2875 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2877 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2878 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2883 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2884 "Set the file permission bits for newly created files.\n\
2885 The argument MODE should be an integer; only the low 9 bits are used.\n\
2886 This setting is inherited by subprocesses.")
2890 CHECK_NUMBER (mode
, 0);
2892 umask ((~ XINT (mode
)) & 0777);
2897 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2898 "Return the default file protection for created files.\n\
2899 The value is an integer.")
2905 realmask
= umask (0);
2908 XSETINT (value
, (~ realmask
) & 0777);
2914 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2915 "Tell Unix to finish all pending disk updates.")
2924 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2925 "Return t if file FILE1 is newer than file FILE2.\n\
2926 If FILE1 does not exist, the answer is nil;\n\
2927 otherwise, if FILE2 does not exist, the answer is t.")
2929 Lisp_Object file1
, file2
;
2931 Lisp_Object absname1
, absname2
;
2934 Lisp_Object handler
;
2935 struct gcpro gcpro1
, gcpro2
;
2937 CHECK_STRING (file1
, 0);
2938 CHECK_STRING (file2
, 0);
2941 GCPRO2 (absname1
, file2
);
2942 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2943 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2946 /* If the file name has special constructs in it,
2947 call the corresponding file handler. */
2948 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2950 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2951 if (!NILP (handler
))
2952 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2954 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2957 mtime1
= st
.st_mtime
;
2959 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2962 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2966 Lisp_Object Qfind_buffer_file_type
;
2969 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2971 "Insert contents of file FILENAME after point.\n\
2972 Returns list of absolute file name and length of data inserted.\n\
2973 If second argument VISIT is non-nil, the buffer's visited filename\n\
2974 and last save file modtime are set, and it is marked unmodified.\n\
2975 If visiting and the file does not exist, visiting is completed\n\
2976 before the error is signaled.\n\n\
2977 The optional third and fourth arguments BEG and END\n\
2978 specify what portion of the file to insert.\n\
2979 If VISIT is non-nil, BEG and END must be nil.\n\
2980 If optional fifth argument REPLACE is non-nil,\n\
2981 it means replace the current buffer contents (in the accessible portion)\n\
2982 with the file contents. This is better than simply deleting and inserting\n\
2983 the whole thing because (1) it preserves some marker positions\n\
2984 and (2) it puts less data in the undo list.")
2985 (filename
, visit
, beg
, end
, replace
)
2986 Lisp_Object filename
, visit
, beg
, end
, replace
;
2990 register int inserted
= 0;
2991 register int how_much
;
2992 int count
= specpdl_ptr
- specpdl
;
2993 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2994 Lisp_Object handler
, val
, insval
;
2997 int not_regular
= 0;
2999 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3000 error ("Cannot do file visiting in an indirect buffer");
3002 if (!NILP (current_buffer
->read_only
))
3003 Fbarf_if_buffer_read_only ();
3008 GCPRO3 (filename
, val
, p
);
3010 CHECK_STRING (filename
, 0);
3011 filename
= Fexpand_file_name (filename
, Qnil
);
3013 /* If the file name has special constructs in it,
3014 call the corresponding file handler. */
3015 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3016 if (!NILP (handler
))
3018 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3019 visit
, beg
, end
, replace
);
3026 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3028 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3029 || fstat (fd
, &st
) < 0)
3030 #endif /* not APOLLO */
3032 if (fd
>= 0) close (fd
);
3035 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3042 /* This code will need to be changed in order to work on named
3043 pipes, and it's probably just not worth it. So we should at
3044 least signal an error. */
3045 if (!S_ISREG (st
.st_mode
))
3048 Fsignal (Qfile_error
,
3049 Fcons (build_string ("not a regular file"),
3050 Fcons (filename
, Qnil
)));
3058 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3061 /* Replacement should preserve point as it preserves markers. */
3062 if (!NILP (replace
))
3063 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3065 record_unwind_protect (close_file_unwind
, make_number (fd
));
3067 /* Supposedly happens on VMS. */
3069 error ("File size is negative");
3071 if (!NILP (beg
) || !NILP (end
))
3073 error ("Attempt to visit less than an entire file");
3076 CHECK_NUMBER (beg
, 0);
3078 XSETFASTINT (beg
, 0);
3081 CHECK_NUMBER (end
, 0);
3084 XSETINT (end
, st
.st_size
);
3085 if (XINT (end
) != st
.st_size
)
3086 error ("maximum buffer size exceeded");
3089 /* If requested, replace the accessible part of the buffer
3090 with the file contents. Avoid replacing text at the
3091 beginning or end of the buffer that matches the file contents;
3092 that preserves markers pointing to the unchanged parts. */
3094 /* On MSDOS, replace mode doesn't really work, except for binary files,
3095 and it's not worth supporting just for them. */
3096 if (!NILP (replace
))
3099 XSETFASTINT (beg
, 0);
3100 XSETFASTINT (end
, st
.st_size
);
3101 del_range_1 (BEGV
, ZV
, 0);
3103 #else /* not DOS_NT */
3104 if (!NILP (replace
))
3106 unsigned char buffer
[1 << 14];
3107 int same_at_start
= BEGV
;
3108 int same_at_end
= ZV
;
3113 /* Count how many chars at the start of the file
3114 match the text at the beginning of the buffer. */
3119 nread
= read (fd
, buffer
, sizeof buffer
);
3121 error ("IO error reading %s: %s",
3122 XSTRING (filename
)->data
, strerror (errno
));
3123 else if (nread
== 0)
3126 while (bufpos
< nread
&& same_at_start
< ZV
3127 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
3128 same_at_start
++, bufpos
++;
3129 /* If we found a discrepancy, stop the scan.
3130 Otherwise loop around and scan the next bufferful. */
3131 if (bufpos
!= nread
)
3135 /* If the file matches the buffer completely,
3136 there's no need to replace anything. */
3137 if (same_at_start
- BEGV
== st
.st_size
)
3141 /* Truncate the buffer to the size of the file. */
3142 del_range_1 (same_at_start
, same_at_end
, 0);
3147 /* Count how many chars at the end of the file
3148 match the text at the end of the buffer. */
3151 int total_read
, nread
, bufpos
, curpos
, trial
;
3153 /* At what file position are we now scanning? */
3154 curpos
= st
.st_size
- (ZV
- same_at_end
);
3155 /* If the entire file matches the buffer tail, stop the scan. */
3158 /* How much can we scan in the next step? */
3159 trial
= min (curpos
, sizeof buffer
);
3160 if (lseek (fd
, curpos
- trial
, 0) < 0)
3161 report_file_error ("Setting file position",
3162 Fcons (filename
, Qnil
));
3165 while (total_read
< trial
)
3167 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3169 error ("IO error reading %s: %s",
3170 XSTRING (filename
)->data
, strerror (errno
));
3171 total_read
+= nread
;
3173 /* Scan this bufferful from the end, comparing with
3174 the Emacs buffer. */
3175 bufpos
= total_read
;
3176 /* Compare with same_at_start to avoid counting some buffer text
3177 as matching both at the file's beginning and at the end. */
3178 while (bufpos
> 0 && same_at_end
> same_at_start
3179 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
3180 same_at_end
--, bufpos
--;
3181 /* If we found a discrepancy, stop the scan.
3182 Otherwise loop around and scan the preceding bufferful. */
3185 /* If display current starts at beginning of line,
3186 keep it that way. */
3187 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3188 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3192 /* Don't try to reuse the same piece of text twice. */
3193 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3195 same_at_end
+= overlap
;
3197 /* Arrange to read only the nonmatching middle part of the file. */
3198 XSETFASTINT (beg
, same_at_start
- BEGV
);
3199 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3201 del_range_1 (same_at_start
, same_at_end
, 0);
3202 /* Insert from the file at the proper position. */
3203 SET_PT (same_at_start
);
3205 #endif /* not DOS_NT */
3207 total
= XINT (end
) - XINT (beg
);
3210 register Lisp_Object temp
;
3212 /* Make sure point-max won't overflow after this insertion. */
3213 XSETINT (temp
, total
);
3214 if (total
!= XINT (temp
))
3215 error ("maximum buffer size exceeded");
3218 if (NILP (visit
) && total
> 0)
3219 prepare_to_modify_buffer (PT
, PT
);
3222 if (GAP_SIZE
< total
)
3223 make_gap (total
- GAP_SIZE
);
3225 if (XINT (beg
) != 0 || !NILP (replace
))
3227 if (lseek (fd
, XINT (beg
), 0) < 0)
3228 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3232 while (inserted
< total
)
3234 /* try is reserved in some compilers (Microsoft C) */
3235 int trytry
= min (total
- inserted
, 64 << 10);
3238 /* Allow quitting out of the actual I/O. */
3241 this = read (fd
, &FETCH_CHAR (PT
+ inserted
- 1) + 1, trytry
);
3258 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3259 /* Determine file type from name and remove LFs from CR-LFs if the file
3260 is deemed to be a text file. */
3262 current_buffer
->buffer_file_type
3263 = call1 (Qfind_buffer_file_type
, filename
);
3264 if (NILP (current_buffer
->buffer_file_type
))
3267 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (PT
- 1) + 1);
3270 GPT
-= reduced_size
;
3271 GAP_SIZE
+= reduced_size
;
3272 inserted
-= reduced_size
;
3279 record_insert (PT
, inserted
);
3281 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3282 offset_intervals (current_buffer
, PT
, inserted
);
3288 /* Discard the unwind protect for closing the file. */
3292 error ("IO error reading %s: %s",
3293 XSTRING (filename
)->data
, strerror (errno
));
3300 if (!EQ (current_buffer
->undo_list
, Qt
))
3301 current_buffer
->undo_list
= Qnil
;
3303 stat (XSTRING (filename
)->data
, &st
);
3308 current_buffer
->modtime
= st
.st_mtime
;
3309 current_buffer
->filename
= filename
;
3312 SAVE_MODIFF
= MODIFF
;
3313 current_buffer
->auto_save_modified
= MODIFF
;
3314 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3315 #ifdef CLASH_DETECTION
3318 if (!NILP (current_buffer
->file_truename
))
3319 unlock_file (current_buffer
->file_truename
);
3320 unlock_file (filename
);
3322 #endif /* CLASH_DETECTION */
3324 Fsignal (Qfile_error
,
3325 Fcons (build_string ("not a regular file"),
3326 Fcons (filename
, Qnil
)));
3328 /* If visiting nonexistent file, return nil. */
3329 if (current_buffer
->modtime
== -1)
3330 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3333 /* Decode file format */
3336 insval
= call3 (Qformat_decode
,
3337 Qnil
, make_number (inserted
), visit
);
3338 CHECK_NUMBER (insval
, 0);
3339 inserted
= XFASTINT (insval
);
3342 if (inserted
> 0 && NILP (visit
) && total
> 0)
3343 signal_after_change (PT
, 0, inserted
);
3347 p
= Vafter_insert_file_functions
;
3350 insval
= call1 (Fcar (p
), make_number (inserted
));
3353 CHECK_NUMBER (insval
, 0);
3354 inserted
= XFASTINT (insval
);
3362 val
= Fcons (filename
,
3363 Fcons (make_number (inserted
),
3366 RETURN_UNGCPRO (unbind_to (count
, val
));
3369 static Lisp_Object
build_annotations ();
3371 /* If build_annotations switched buffers, switch back to BUF.
3372 Kill the temporary buffer that was selected in the meantime. */
3375 build_annotations_unwind (buf
)
3380 if (XBUFFER (buf
) == current_buffer
)
3382 tembuf
= Fcurrent_buffer ();
3384 Fkill_buffer (tembuf
);
3388 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3389 "r\nFWrite region to file: ",
3390 "Write current region into specified file.\n\
3391 When called from a program, takes three arguments:\n\
3392 START, END and FILENAME. START and END are buffer positions.\n\
3393 Optional fourth argument APPEND if non-nil means\n\
3394 append to existing file contents (if any).\n\
3395 Optional fifth argument VISIT if t means\n\
3396 set the last-save-file-modtime of buffer to this file's modtime\n\
3397 and mark buffer not modified.\n\
3398 If VISIT is a string, it is a second file name;\n\
3399 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3400 VISIT is also the file name to lock and unlock for clash detection.\n\
3401 If VISIT is neither t nor nil nor a string,\n\
3402 that means do not print the \"Wrote file\" message.\n\
3403 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3404 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3405 Kludgy feature: if START is a string, then that string is written\n\
3406 to the file, instead of any buffer contents, and END is ignored.")
3407 (start
, end
, filename
, append
, visit
, lockname
)
3408 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3416 int count
= specpdl_ptr
- specpdl
;
3419 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3421 Lisp_Object handler
;
3422 Lisp_Object visit_file
;
3423 Lisp_Object annotations
;
3424 int visiting
, quietly
;
3425 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3426 struct buffer
*given_buffer
;
3428 int buffer_file_type
3429 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3432 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3433 error ("Cannot do file visiting in an indirect buffer");
3435 if (!NILP (start
) && !STRINGP (start
))
3436 validate_region (&start
, &end
);
3438 GCPRO3 (filename
, visit
, lockname
);
3439 filename
= Fexpand_file_name (filename
, Qnil
);
3440 if (STRINGP (visit
))
3441 visit_file
= Fexpand_file_name (visit
, Qnil
);
3443 visit_file
= filename
;
3446 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3447 quietly
= !NILP (visit
);
3451 if (NILP (lockname
))
3452 lockname
= visit_file
;
3454 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3456 /* If the file name has special constructs in it,
3457 call the corresponding file handler. */
3458 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3459 /* If FILENAME has no handler, see if VISIT has one. */
3460 if (NILP (handler
) && STRINGP (visit
))
3461 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3463 if (!NILP (handler
))
3466 val
= call6 (handler
, Qwrite_region
, start
, end
,
3467 filename
, append
, visit
);
3471 SAVE_MODIFF
= MODIFF
;
3472 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3473 current_buffer
->filename
= visit_file
;
3479 /* Special kludge to simplify auto-saving. */
3482 XSETFASTINT (start
, BEG
);
3483 XSETFASTINT (end
, Z
);
3486 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3487 count1
= specpdl_ptr
- specpdl
;
3489 given_buffer
= current_buffer
;
3490 annotations
= build_annotations (start
, end
);
3491 if (current_buffer
!= given_buffer
)
3497 #ifdef CLASH_DETECTION
3500 /* If we've locked this file for some other buffer,
3501 query before proceeding. */
3502 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3503 call2 (intern ("ask-user-about-lock"), fn
, Vuser_login_name
);
3505 lock_file (lockname
);
3507 #endif /* CLASH_DETECTION */
3509 fn
= XSTRING (filename
)->data
;
3513 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3514 #else /* not DOS_NT */
3515 desc
= open (fn
, O_WRONLY
);
3516 #endif /* not DOS_NT */
3520 if (auto_saving
) /* Overwrite any previous version of autosave file */
3522 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3523 desc
= open (fn
, O_RDWR
);
3525 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3526 ? XSTRING (current_buffer
->filename
)->data
: 0,
3529 else /* Write to temporary name and rename if no errors */
3531 Lisp_Object temp_name
;
3532 temp_name
= Ffile_name_directory (filename
);
3534 if (!NILP (temp_name
))
3536 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3537 build_string ("$$SAVE$$")));
3538 fname
= XSTRING (filename
)->data
;
3539 fn
= XSTRING (temp_name
)->data
;
3540 desc
= creat_copy_attrs (fname
, fn
);
3543 /* If we can't open the temporary file, try creating a new
3544 version of the original file. VMS "creat" creates a
3545 new version rather than truncating an existing file. */
3548 desc
= creat (fn
, 0666);
3549 #if 0 /* This can clobber an existing file and fail to replace it,
3550 if the user runs out of space. */
3553 /* We can't make a new version;
3554 try to truncate and rewrite existing version if any. */
3556 desc
= open (fn
, O_RDWR
);
3562 desc
= creat (fn
, 0666);
3567 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3568 S_IREAD
| S_IWRITE
);
3569 #else /* not DOS_NT */
3570 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3571 #endif /* not DOS_NT */
3572 #endif /* not VMS */
3578 #ifdef CLASH_DETECTION
3580 if (!auto_saving
) unlock_file (lockname
);
3582 #endif /* CLASH_DETECTION */
3583 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3586 record_unwind_protect (close_file_unwind
, make_number (desc
));
3589 if (lseek (desc
, 0, 2) < 0)
3591 #ifdef CLASH_DETECTION
3592 if (!auto_saving
) unlock_file (lockname
);
3593 #endif /* CLASH_DETECTION */
3594 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3599 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3600 * if we do writes that don't end with a carriage return. Furthermore
3601 * it cannot handle writes of more then 16K. The modified
3602 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3603 * this EXCEPT for the last record (iff it doesn't end with a carriage
3604 * return). This implies that if your buffer doesn't end with a carriage
3605 * return, you get one free... tough. However it also means that if
3606 * we make two calls to sys_write (a la the following code) you can
3607 * get one at the gap as well. The easiest way to fix this (honest)
3608 * is to move the gap to the next newline (or the end of the buffer).
3613 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3614 move_gap (find_next_newline (GPT
, 1));
3620 if (STRINGP (start
))
3622 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3623 XSTRING (start
)->size
, 0, &annotations
);
3626 else if (XINT (start
) != XINT (end
))
3629 if (XINT (start
) < GPT
)
3631 register int end1
= XINT (end
);
3633 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3634 min (GPT
, end1
) - tem
, tem
, &annotations
);
3635 nwritten
+= min (GPT
, end1
) - tem
;
3639 if (XINT (end
) > GPT
&& !failure
)
3642 tem
= max (tem
, GPT
);
3643 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3645 nwritten
+= XINT (end
) - tem
;
3651 /* If file was empty, still need to write the annotations */
3652 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3659 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3660 Disk full in NFS may be reported here. */
3661 /* mib says that closing the file will try to write as fast as NFS can do
3662 it, and that means the fsync here is not crucial for autosave files. */
3663 if (!auto_saving
&& fsync (desc
) < 0)
3665 /* If fsync fails with EINTR, don't treat that as serious. */
3667 failure
= 1, save_errno
= errno
;
3671 /* Spurious "file has changed on disk" warnings have been
3672 observed on Suns as well.
3673 It seems that `close' can change the modtime, under nfs.
3675 (This has supposedly been fixed in Sunos 4,
3676 but who knows about all the other machines with NFS?) */
3679 /* On VMS and APOLLO, must do the stat after the close
3680 since closing changes the modtime. */
3683 /* Recall that #if defined does not work on VMS. */
3690 /* NFS can report a write failure now. */
3691 if (close (desc
) < 0)
3692 failure
= 1, save_errno
= errno
;
3695 /* If we wrote to a temporary name and had no errors, rename to real name. */
3699 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3707 /* Discard the unwind protect for close_file_unwind. */
3708 specpdl_ptr
= specpdl
+ count1
;
3709 /* Restore the original current buffer. */
3710 visit_file
= unbind_to (count
, visit_file
);
3712 #ifdef CLASH_DETECTION
3714 unlock_file (lockname
);
3715 #endif /* CLASH_DETECTION */
3717 /* Do this before reporting IO error
3718 to avoid a "file has changed on disk" warning on
3719 next attempt to save. */
3721 current_buffer
->modtime
= st
.st_mtime
;
3724 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3728 SAVE_MODIFF
= MODIFF
;
3729 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3730 current_buffer
->filename
= visit_file
;
3731 update_mode_lines
++;
3737 message ("Wrote %s", XSTRING (visit_file
)->data
);
3742 Lisp_Object
merge ();
3744 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3745 "Return t if (car A) is numerically less than (car B).")
3749 return Flss (Fcar (a
), Fcar (b
));
3752 /* Build the complete list of annotations appropriate for writing out
3753 the text between START and END, by calling all the functions in
3754 write-region-annotate-functions and merging the lists they return.
3755 If one of these functions switches to a different buffer, we assume
3756 that buffer contains altered text. Therefore, the caller must
3757 make sure to restore the current buffer in all cases,
3758 as save-excursion would do. */
3761 build_annotations (start
, end
)
3762 Lisp_Object start
, end
;
3764 Lisp_Object annotations
;
3766 struct gcpro gcpro1
, gcpro2
;
3767 Lisp_Object original_buffer
;
3769 XSETBUFFER (original_buffer
, current_buffer
);
3772 p
= Vwrite_region_annotate_functions
;
3773 GCPRO2 (annotations
, p
);
3776 struct buffer
*given_buffer
= current_buffer
;
3777 Vwrite_region_annotations_so_far
= annotations
;
3778 res
= call2 (Fcar (p
), start
, end
);
3779 /* If the function makes a different buffer current,
3780 assume that means this buffer contains altered text to be output.
3781 Reset START and END from the buffer bounds
3782 and discard all previous annotations because they should have
3783 been dealt with by this function. */
3784 if (current_buffer
!= given_buffer
)
3790 Flength (res
); /* Check basic validity of return value */
3791 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3795 /* Now do the same for annotation functions implied by the file-format */
3796 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3797 p
= Vauto_save_file_format
;
3799 p
= current_buffer
->file_format
;
3802 struct buffer
*given_buffer
= current_buffer
;
3803 Vwrite_region_annotations_so_far
= annotations
;
3804 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
3806 if (current_buffer
!= given_buffer
)
3813 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3820 /* Write to descriptor DESC the LEN characters starting at ADDR,
3821 assuming they start at position POS in the buffer.
3822 Intersperse with them the annotations from *ANNOT
3823 (those which fall within the range of positions POS to POS + LEN),
3824 each at its appropriate position.
3826 Modify *ANNOT by discarding elements as we output them.
3827 The return value is negative in case of system call failure. */
3830 a_write (desc
, addr
, len
, pos
, annot
)
3832 register char *addr
;
3839 int lastpos
= pos
+ len
;
3841 while (NILP (*annot
) || CONSP (*annot
))
3843 tem
= Fcar_safe (Fcar (*annot
));
3844 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3845 nextpos
= XFASTINT (tem
);
3847 return e_write (desc
, addr
, lastpos
- pos
);
3850 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3852 addr
+= nextpos
- pos
;
3855 tem
= Fcdr (Fcar (*annot
));
3858 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3861 *annot
= Fcdr (*annot
);
3866 e_write (desc
, addr
, len
)
3868 register char *addr
;
3871 char buf
[16 * 1024];
3872 register char *p
, *end
;
3874 if (!EQ (current_buffer
->selective_display
, Qt
))
3875 return write (desc
, addr
, len
) - len
;
3879 end
= p
+ sizeof buf
;
3884 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3893 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3899 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3900 Sverify_visited_file_modtime
, 1, 1, 0,
3901 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3902 This means that the file has not been changed since it was visited or saved.")
3908 Lisp_Object handler
;
3910 CHECK_BUFFER (buf
, 0);
3913 if (!STRINGP (b
->filename
)) return Qt
;
3914 if (b
->modtime
== 0) return Qt
;
3916 /* If the file name has special constructs in it,
3917 call the corresponding file handler. */
3918 handler
= Ffind_file_name_handler (b
->filename
,
3919 Qverify_visited_file_modtime
);
3920 if (!NILP (handler
))
3921 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3923 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3925 /* If the file doesn't exist now and didn't exist before,
3926 we say that it isn't modified, provided the error is a tame one. */
3927 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3932 if (st
.st_mtime
== b
->modtime
3933 /* If both are positive, accept them if they are off by one second. */
3934 || (st
.st_mtime
> 0 && b
->modtime
> 0
3935 && (st
.st_mtime
== b
->modtime
+ 1
3936 || st
.st_mtime
== b
->modtime
- 1)))
3941 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3942 Sclear_visited_file_modtime
, 0, 0, 0,
3943 "Clear out records of last mod time of visited file.\n\
3944 Next attempt to save will certainly not complain of a discrepancy.")
3947 current_buffer
->modtime
= 0;
3951 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3952 Svisited_file_modtime
, 0, 0, 0,
3953 "Return the current buffer's recorded visited file modification time.\n\
3954 The value is a list of the form (HIGH . LOW), like the time values\n\
3955 that `file-attributes' returns.")
3958 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3961 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3962 Sset_visited_file_modtime
, 0, 1, 0,
3963 "Update buffer's recorded modification time from the visited file's time.\n\
3964 Useful if the buffer was not read from the file normally\n\
3965 or if the file itself has been changed for some known benign reason.\n\
3966 An argument specifies the modification time value to use\n\
3967 \(instead of that of the visited file), in the form of a list\n\
3968 \(HIGH . LOW) or (HIGH LOW).")
3970 Lisp_Object time_list
;
3972 if (!NILP (time_list
))
3973 current_buffer
->modtime
= cons_to_long (time_list
);
3976 register Lisp_Object filename
;
3978 Lisp_Object handler
;
3980 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3982 /* If the file name has special constructs in it,
3983 call the corresponding file handler. */
3984 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3985 if (!NILP (handler
))
3986 /* The handler can find the file name the same way we did. */
3987 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3988 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3989 current_buffer
->modtime
= st
.st_mtime
;
3999 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4000 Fsleep_for (make_number (1), Qnil
);
4001 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4002 Fsleep_for (make_number (1), Qnil
);
4003 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4004 Fsleep_for (make_number (1), Qnil
);
4014 /* Get visited file's mode to become the auto save file's mode. */
4015 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4016 /* But make sure we can overwrite it later! */
4017 auto_save_mode_bits
= st
.st_mode
| 0600;
4019 auto_save_mode_bits
= 0666;
4022 Fwrite_region (Qnil
, Qnil
,
4023 current_buffer
->auto_save_file_name
,
4024 Qnil
, Qlambda
, Qnil
);
4028 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4032 if (XINT (desc
) >= 0)
4033 close (XINT (desc
));
4037 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4038 "Auto-save all buffers that need it.\n\
4039 This is all buffers that have auto-saving enabled\n\
4040 and are changed since last auto-saved.\n\
4041 Auto-saving writes the buffer into a file\n\
4042 so that your editing is not lost if the system crashes.\n\
4043 This file is not the file you visited; that changes only when you save.\n\
4044 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4045 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4046 A non-nil CURRENT-ONLY argument means save only current buffer.")
4047 (no_message
, current_only
)
4048 Lisp_Object no_message
, current_only
;
4050 struct buffer
*old
= current_buffer
, *b
;
4051 Lisp_Object tail
, buf
;
4053 char *omessage
= echo_area_glyphs
;
4054 int omessage_length
= echo_area_glyphs_length
;
4055 int do_handled_files
;
4058 int count
= specpdl_ptr
- specpdl
;
4061 /* Ordinarily don't quit within this function,
4062 but don't make it impossible to quit (in case we get hung in I/O). */
4066 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4067 point to non-strings reached from Vbuffer_alist. */
4072 if (!NILP (Vrun_hooks
))
4073 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4075 if (STRINGP (Vauto_save_list_file_name
))
4077 Lisp_Object listfile
;
4078 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4080 listdesc
= open (XSTRING (listfile
)->data
,
4081 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4082 S_IREAD
| S_IWRITE
);
4083 #else /* not DOS_NT */
4084 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4085 #endif /* not DOS_NT */
4090 /* Arrange to close that file whether or not we get an error.
4091 Also reset auto_saving to 0. */
4092 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4096 /* First, save all files which don't have handlers. If Emacs is
4097 crashing, the handlers may tweak what is causing Emacs to crash
4098 in the first place, and it would be a shame if Emacs failed to
4099 autosave perfectly ordinary files because it couldn't handle some
4101 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4102 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4104 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4107 /* Record all the buffers that have auto save mode
4108 in the special file that lists them. For each of these buffers,
4109 Record visited name (if any) and auto save name. */
4110 if (STRINGP (b
->auto_save_file_name
)
4111 && listdesc
>= 0 && do_handled_files
== 0)
4113 if (!NILP (b
->filename
))
4115 write (listdesc
, XSTRING (b
->filename
)->data
,
4116 XSTRING (b
->filename
)->size
);
4118 write (listdesc
, "\n", 1);
4119 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4120 XSTRING (b
->auto_save_file_name
)->size
);
4121 write (listdesc
, "\n", 1);
4124 if (!NILP (current_only
)
4125 && b
!= current_buffer
)
4128 /* Don't auto-save indirect buffers.
4129 The base buffer takes care of it. */
4133 /* Check for auto save enabled
4134 and file changed since last auto save
4135 and file changed since last real save. */
4136 if (STRINGP (b
->auto_save_file_name
)
4137 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4138 && b
->auto_save_modified
< BUF_MODIFF (b
)
4139 /* -1 means we've turned off autosaving for a while--see below. */
4140 && XINT (b
->save_length
) >= 0
4141 && (do_handled_files
4142 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4145 EMACS_TIME before_time
, after_time
;
4147 EMACS_GET_TIME (before_time
);
4149 /* If we had a failure, don't try again for 20 minutes. */
4150 if (b
->auto_save_failure_time
>= 0
4151 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4154 if ((XFASTINT (b
->save_length
) * 10
4155 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4156 /* A short file is likely to change a large fraction;
4157 spare the user annoying messages. */
4158 && XFASTINT (b
->save_length
) > 5000
4159 /* These messages are frequent and annoying for `*mail*'. */
4160 && !EQ (b
->filename
, Qnil
)
4161 && NILP (no_message
))
4163 /* It has shrunk too much; turn off auto-saving here. */
4164 message ("Buffer %s has shrunk a lot; auto save turned off there",
4165 XSTRING (b
->name
)->data
);
4166 /* Turn off auto-saving until there's a real save,
4167 and prevent any more warnings. */
4168 XSETINT (b
->save_length
, -1);
4169 Fsleep_for (make_number (1), Qnil
);
4172 set_buffer_internal (b
);
4173 if (!auto_saved
&& NILP (no_message
))
4174 message1 ("Auto-saving...");
4175 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4177 b
->auto_save_modified
= BUF_MODIFF (b
);
4178 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4179 set_buffer_internal (old
);
4181 EMACS_GET_TIME (after_time
);
4183 /* If auto-save took more than 60 seconds,
4184 assume it was an NFS failure that got a timeout. */
4185 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4186 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4190 /* Prevent another auto save till enough input events come in. */
4191 record_auto_save ();
4193 if (auto_saved
&& NILP (no_message
))
4197 sit_for (1, 0, 0, 0);
4198 message2 (omessage
, omessage_length
);
4201 message1 ("Auto-saving...done");
4206 unbind_to (count
, Qnil
);
4210 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4211 Sset_buffer_auto_saved
, 0, 0, 0,
4212 "Mark current buffer as auto-saved with its current text.\n\
4213 No auto-save file will be written until the buffer changes again.")
4216 current_buffer
->auto_save_modified
= MODIFF
;
4217 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4218 current_buffer
->auto_save_failure_time
= -1;
4222 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4223 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4224 "Clear any record of a recent auto-save failure in the current buffer.")
4227 current_buffer
->auto_save_failure_time
= -1;
4231 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4233 "Return t if buffer has been auto-saved since last read in or saved.")
4236 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4239 /* Reading and completing file names */
4240 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4242 /* In the string VAL, change each $ to $$ and return the result. */
4245 double_dollars (val
)
4248 register unsigned char *old
, *new;
4252 osize
= XSTRING (val
)->size
;
4253 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4254 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4255 if (*old
++ == '$') count
++;
4258 old
= XSTRING (val
)->data
;
4259 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4260 new = XSTRING (val
)->data
;
4261 for (n
= osize
; n
> 0; n
--)
4274 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4276 "Internal subroutine for read-file-name. Do not call this.")
4277 (string
, dir
, action
)
4278 Lisp_Object string
, dir
, action
;
4279 /* action is nil for complete, t for return list of completions,
4280 lambda for verify final value */
4282 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4284 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4291 /* No need to protect ACTION--we only compare it with t and nil. */
4292 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4294 if (XSTRING (string
)->size
== 0)
4296 if (EQ (action
, Qlambda
))
4304 orig_string
= string
;
4305 string
= Fsubstitute_in_file_name (string
);
4306 changed
= NILP (Fstring_equal (string
, orig_string
));
4307 name
= Ffile_name_nondirectory (string
);
4308 val
= Ffile_name_directory (string
);
4310 realdir
= Fexpand_file_name (val
, realdir
);
4315 specdir
= Ffile_name_directory (string
);
4316 val
= Ffile_name_completion (name
, realdir
);
4321 return double_dollars (string
);
4325 if (!NILP (specdir
))
4326 val
= concat2 (specdir
, val
);
4328 return double_dollars (val
);
4331 #endif /* not VMS */
4335 if (EQ (action
, Qt
))
4336 return Ffile_name_all_completions (name
, realdir
);
4337 /* Only other case actually used is ACTION = lambda */
4339 /* Supposedly this helps commands such as `cd' that read directory names,
4340 but can someone explain how it helps them? -- RMS */
4341 if (XSTRING (name
)->size
== 0)
4344 return Ffile_exists_p (string
);
4347 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4348 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4349 Value is not expanded---you must call `expand-file-name' yourself.\n\
4350 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4351 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4352 except that if INITIAL is specified, that combined with DIR is used.)\n\
4353 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4354 Non-nil and non-t means also require confirmation after completion.\n\
4355 Fifth arg INITIAL specifies text to start with.\n\
4356 DIR defaults to current buffer's directory default.")
4357 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4358 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4360 Lisp_Object val
, insdef
, insdef1
, tem
;
4361 struct gcpro gcpro1
, gcpro2
;
4362 register char *homedir
;
4366 dir
= current_buffer
->directory
;
4367 if (NILP (default_filename
))
4369 if (! NILP (initial
))
4370 default_filename
= Fexpand_file_name (initial
, dir
);
4372 default_filename
= current_buffer
->filename
;
4375 /* If dir starts with user's homedir, change that to ~. */
4376 homedir
= (char *) egetenv ("HOME");
4378 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4379 CORRECT_DIR_SEPS (homedir
);
4383 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4384 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4386 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4387 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4388 XSTRING (dir
)->data
[0] = '~';
4391 if (insert_default_directory
)
4394 if (!NILP (initial
))
4396 Lisp_Object args
[2], pos
;
4400 insdef
= Fconcat (2, args
);
4401 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4402 insdef1
= Fcons (double_dollars (insdef
), pos
);
4405 insdef1
= double_dollars (insdef
);
4407 else if (!NILP (initial
))
4410 insdef1
= Fcons (double_dollars (insdef
), 0);
4413 insdef
= Qnil
, insdef1
= Qnil
;
4416 count
= specpdl_ptr
- specpdl
;
4417 specbind (intern ("completion-ignore-case"), Qt
);
4420 GCPRO2 (insdef
, default_filename
);
4421 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4422 dir
, mustmatch
, insdef1
,
4423 Qfile_name_history
);
4426 unbind_to (count
, Qnil
);
4431 error ("No file name specified");
4432 tem
= Fstring_equal (val
, insdef
);
4433 if (!NILP (tem
) && !NILP (default_filename
))
4434 return default_filename
;
4435 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4437 if (!NILP (default_filename
))
4438 return default_filename
;
4440 error ("No default file name");
4442 return Fsubstitute_in_file_name (val
);
4445 #if 0 /* Old version */
4446 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4447 /* Don't confuse make-docfile by having two doc strings for this function.
4448 make-docfile does not pay attention to #if, for good reason! */
4450 (prompt
, dir
, defalt
, mustmatch
, initial
)
4451 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4453 Lisp_Object val
, insdef
, tem
;
4454 struct gcpro gcpro1
, gcpro2
;
4455 register char *homedir
;
4459 dir
= current_buffer
->directory
;
4461 defalt
= current_buffer
->filename
;
4463 /* If dir starts with user's homedir, change that to ~. */
4464 homedir
= (char *) egetenv ("HOME");
4467 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4468 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4470 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4471 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4472 XSTRING (dir
)->data
[0] = '~';
4475 if (!NILP (initial
))
4477 else if (insert_default_directory
)
4480 insdef
= build_string ("");
4483 count
= specpdl_ptr
- specpdl
;
4484 specbind (intern ("completion-ignore-case"), Qt
);
4487 GCPRO2 (insdef
, defalt
);
4488 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4490 insert_default_directory
? insdef
: Qnil
,
4491 Qfile_name_history
);
4494 unbind_to (count
, Qnil
);
4499 error ("No file name specified");
4500 tem
= Fstring_equal (val
, insdef
);
4501 if (!NILP (tem
) && !NILP (defalt
))
4503 return Fsubstitute_in_file_name (val
);
4505 #endif /* Old version */
4509 Qexpand_file_name
= intern ("expand-file-name");
4510 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4511 Qdirectory_file_name
= intern ("directory-file-name");
4512 Qfile_name_directory
= intern ("file-name-directory");
4513 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4514 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4515 Qfile_name_as_directory
= intern ("file-name-as-directory");
4516 Qcopy_file
= intern ("copy-file");
4517 Qmake_directory_internal
= intern ("make-directory-internal");
4518 Qdelete_directory
= intern ("delete-directory");
4519 Qdelete_file
= intern ("delete-file");
4520 Qrename_file
= intern ("rename-file");
4521 Qadd_name_to_file
= intern ("add-name-to-file");
4522 Qmake_symbolic_link
= intern ("make-symbolic-link");
4523 Qfile_exists_p
= intern ("file-exists-p");
4524 Qfile_executable_p
= intern ("file-executable-p");
4525 Qfile_readable_p
= intern ("file-readable-p");
4526 Qfile_writable_p
= intern ("file-writable-p");
4527 Qfile_symlink_p
= intern ("file-symlink-p");
4528 Qaccess_file
= intern ("access-file");
4529 Qfile_directory_p
= intern ("file-directory-p");
4530 Qfile_regular_p
= intern ("file-regular-p");
4531 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4532 Qfile_modes
= intern ("file-modes");
4533 Qset_file_modes
= intern ("set-file-modes");
4534 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4535 Qinsert_file_contents
= intern ("insert-file-contents");
4536 Qwrite_region
= intern ("write-region");
4537 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4538 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4540 staticpro (&Qexpand_file_name
);
4541 staticpro (&Qsubstitute_in_file_name
);
4542 staticpro (&Qdirectory_file_name
);
4543 staticpro (&Qfile_name_directory
);
4544 staticpro (&Qfile_name_nondirectory
);
4545 staticpro (&Qunhandled_file_name_directory
);
4546 staticpro (&Qfile_name_as_directory
);
4547 staticpro (&Qcopy_file
);
4548 staticpro (&Qmake_directory_internal
);
4549 staticpro (&Qdelete_directory
);
4550 staticpro (&Qdelete_file
);
4551 staticpro (&Qrename_file
);
4552 staticpro (&Qadd_name_to_file
);
4553 staticpro (&Qmake_symbolic_link
);
4554 staticpro (&Qfile_exists_p
);
4555 staticpro (&Qfile_executable_p
);
4556 staticpro (&Qfile_readable_p
);
4557 staticpro (&Qfile_writable_p
);
4558 staticpro (&Qaccess_file
);
4559 staticpro (&Qfile_symlink_p
);
4560 staticpro (&Qfile_directory_p
);
4561 staticpro (&Qfile_regular_p
);
4562 staticpro (&Qfile_accessible_directory_p
);
4563 staticpro (&Qfile_modes
);
4564 staticpro (&Qset_file_modes
);
4565 staticpro (&Qfile_newer_than_file_p
);
4566 staticpro (&Qinsert_file_contents
);
4567 staticpro (&Qwrite_region
);
4568 staticpro (&Qverify_visited_file_modtime
);
4569 staticpro (&Qset_visited_file_modtime
);
4571 Qfile_name_history
= intern ("file-name-history");
4572 Fset (Qfile_name_history
, Qnil
);
4573 staticpro (&Qfile_name_history
);
4575 Qfile_error
= intern ("file-error");
4576 staticpro (&Qfile_error
);
4577 Qfile_already_exists
= intern ("file-already-exists");
4578 staticpro (&Qfile_already_exists
);
4581 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4582 staticpro (&Qfind_buffer_file_type
);
4585 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4586 "*Format in which to write auto-save files.\n\
4587 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4588 If it is t, which is the default, auto-save files are written in the\n\
4589 same format as a regular save would use.");
4590 Vauto_save_file_format
= Qt
;
4592 Qformat_decode
= intern ("format-decode");
4593 staticpro (&Qformat_decode
);
4594 Qformat_annotate_function
= intern ("format-annotate-function");
4595 staticpro (&Qformat_annotate_function
);
4597 Qcar_less_than_car
= intern ("car-less-than-car");
4598 staticpro (&Qcar_less_than_car
);
4600 Fput (Qfile_error
, Qerror_conditions
,
4601 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4602 Fput (Qfile_error
, Qerror_message
,
4603 build_string ("File error"));
4605 Fput (Qfile_already_exists
, Qerror_conditions
,
4606 Fcons (Qfile_already_exists
,
4607 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4608 Fput (Qfile_already_exists
, Qerror_message
,
4609 build_string ("File already exists"));
4611 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4612 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4613 insert_default_directory
= 1;
4615 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4616 "*Non-nil means write new files with record format `stmlf'.\n\
4617 nil means use format `var'. This variable is meaningful only on VMS.");
4618 vms_stmlf_recfm
= 0;
4620 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
4621 "Directory separator character for built-in functions that return file names.\n\
4622 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
4623 This variable affects the built-in functions only on Windows,\n\
4624 on other platforms, it is initialized so that Lisp code can find out\n\
4625 what the normal separator is.");
4626 Vdirectory_sep_char
= '/';
4628 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4629 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4630 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4633 The first argument given to HANDLER is the name of the I/O primitive\n\
4634 to be handled; the remaining arguments are the arguments that were\n\
4635 passed to that primitive. For example, if you do\n\
4636 (file-exists-p FILENAME)\n\
4637 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4638 (funcall HANDLER 'file-exists-p FILENAME)\n\
4639 The function `find-file-name-handler' checks this list for a handler\n\
4640 for its argument.");
4641 Vfile_name_handler_alist
= Qnil
;
4643 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4644 "A list of functions to be called at the end of `insert-file-contents'.\n\
4645 Each is passed one argument, the number of bytes inserted. It should return\n\
4646 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4647 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4648 responsible for calling the after-insert-file-functions if appropriate.");
4649 Vafter_insert_file_functions
= Qnil
;
4651 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4652 "A list of functions to be called at the start of `write-region'.\n\
4653 Each is passed two arguments, START and END as for `write-region'.\n\
4654 These are usually two numbers but not always; see the documentation\n\
4655 for `write-region'. The function should return a list of pairs\n\
4656 of the form (POSITION . STRING), consisting of strings to be effectively\n\
4657 inserted at the specified positions of the file being written (1 means to\n\
4658 insert before the first byte written). The POSITIONs must be sorted into\n\
4659 increasing order. If there are several functions in the list, the several\n\
4660 lists are merged destructively.");
4661 Vwrite_region_annotate_functions
= Qnil
;
4663 DEFVAR_LISP ("write-region-annotations-so-far",
4664 &Vwrite_region_annotations_so_far
,
4665 "When an annotation function is called, this holds the previous annotations.\n\
4666 These are the annotations made by other annotation functions\n\
4667 that were already called. See also `write-region-annotate-functions'.");
4668 Vwrite_region_annotations_so_far
= Qnil
;
4670 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4671 "A list of file name handlers that temporarily should not be used.\n\
4672 This applies only to the operation `inhibit-file-name-operation'.");
4673 Vinhibit_file_name_handlers
= Qnil
;
4675 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4676 "The operation for which `inhibit-file-name-handlers' is applicable.");
4677 Vinhibit_file_name_operation
= Qnil
;
4679 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4680 "File name in which we write a list of all auto save file names.\n\
4681 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4682 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4684 Vauto_save_list_file_name
= Qnil
;
4686 defsubr (&Sfind_file_name_handler
);
4687 defsubr (&Sfile_name_directory
);
4688 defsubr (&Sfile_name_nondirectory
);
4689 defsubr (&Sunhandled_file_name_directory
);
4690 defsubr (&Sfile_name_as_directory
);
4691 defsubr (&Sdirectory_file_name
);
4692 defsubr (&Smake_temp_name
);
4693 defsubr (&Sexpand_file_name
);
4694 defsubr (&Ssubstitute_in_file_name
);
4695 defsubr (&Scopy_file
);
4696 defsubr (&Smake_directory_internal
);
4697 defsubr (&Sdelete_directory
);
4698 defsubr (&Sdelete_file
);
4699 defsubr (&Srename_file
);
4700 defsubr (&Sadd_name_to_file
);
4702 defsubr (&Smake_symbolic_link
);
4703 #endif /* S_IFLNK */
4705 defsubr (&Sdefine_logical_name
);
4708 defsubr (&Ssysnetunam
);
4709 #endif /* HPUX_NET */
4710 defsubr (&Sfile_name_absolute_p
);
4711 defsubr (&Sfile_exists_p
);
4712 defsubr (&Sfile_executable_p
);
4713 defsubr (&Sfile_readable_p
);
4714 defsubr (&Sfile_writable_p
);
4715 defsubr (&Saccess_file
);
4716 defsubr (&Sfile_symlink_p
);
4717 defsubr (&Sfile_directory_p
);
4718 defsubr (&Sfile_accessible_directory_p
);
4719 defsubr (&Sfile_regular_p
);
4720 defsubr (&Sfile_modes
);
4721 defsubr (&Sset_file_modes
);
4722 defsubr (&Sset_default_file_modes
);
4723 defsubr (&Sdefault_file_modes
);
4724 defsubr (&Sfile_newer_than_file_p
);
4725 defsubr (&Sinsert_file_contents
);
4726 defsubr (&Swrite_region
);
4727 defsubr (&Scar_less_than_car
);
4728 defsubr (&Sverify_visited_file_modtime
);
4729 defsubr (&Sclear_visited_file_modtime
);
4730 defsubr (&Svisited_file_modtime
);
4731 defsubr (&Sset_visited_file_modtime
);
4732 defsubr (&Sdo_auto_save
);
4733 defsubr (&Sset_buffer_auto_saved
);
4734 defsubr (&Sclear_buffer_auto_save_failure
);
4735 defsubr (&Srecent_auto_save_p
);
4737 defsubr (&Sread_file_name_internal
);
4738 defsubr (&Sread_file_name
);
4741 defsubr (&Sunix_sync
);