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 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
27 #include <sys/types.h>
34 #if !defined (S_ISLNK) && defined (S_IFLNK)
35 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
38 #if !defined (S_ISFIFO) && defined (S_IFIFO)
39 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
42 #if !defined (S_ISREG) && defined (S_IFREG)
43 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
54 #include <sys/param.h>
76 extern char *strerror ();
93 #include "intervals.h"
102 #endif /* not WINDOWSNT */
105 #define CORRECT_DIR_SEPS(s) \
106 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
107 else unixtodos_filename (s); \
109 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
110 redirector allows the six letters between 'Z' and 'a' as well. */
112 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
115 #define IS_DRIVE(x) isalpha (x)
117 /* Need to lower-case the drive letter, or else expanded
118 filenames will sometimes compare inequal, because
119 `expand-file-name' doesn't always down-case the drive letter. */
120 #define DRIVE_LETTER(x) (tolower (x))
149 #define min(a, b) ((a) < (b) ? (a) : (b))
150 #define max(a, b) ((a) > (b) ? (a) : (b))
152 /* Nonzero during writing of auto-save files */
155 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
156 a new file with the same mode as the original */
157 int auto_save_mode_bits
;
159 /* Alist of elements (REGEXP . HANDLER) for file names
160 whose I/O is done with a special handler. */
161 Lisp_Object Vfile_name_handler_alist
;
163 /* Format for auto-save files */
164 Lisp_Object Vauto_save_file_format
;
166 /* Lisp functions for translating file formats */
167 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
169 /* Functions to be called to process text properties in inserted file. */
170 Lisp_Object Vafter_insert_file_functions
;
172 /* Functions to be called to create text property annotations for file. */
173 Lisp_Object Vwrite_region_annotate_functions
;
175 /* During build_annotations, each time an annotation function is called,
176 this holds the annotations made by the previous functions. */
177 Lisp_Object Vwrite_region_annotations_so_far
;
179 /* File name in which we write a list of all our auto save files. */
180 Lisp_Object Vauto_save_list_file_name
;
182 /* Nonzero means, when reading a filename in the minibuffer,
183 start out by inserting the default directory into the minibuffer. */
184 int insert_default_directory
;
186 /* On VMS, nonzero means write new files with record format stmlf.
187 Zero means use var format. */
190 /* On NT, specifies the directory separator character, used (eg.) when
191 expanding file names. This can be bound to / or \. */
192 Lisp_Object Vdirectory_sep_char
;
194 extern Lisp_Object Vuser_login_name
;
196 extern int minibuf_level
;
198 /* These variables describe handlers that have "already" had a chance
199 to handle the current operation.
201 Vinhibit_file_name_handlers is a list of file name handlers.
202 Vinhibit_file_name_operation is the operation being handled.
203 If we try to handle that operation, we ignore those handlers. */
205 static Lisp_Object Vinhibit_file_name_handlers
;
206 static Lisp_Object Vinhibit_file_name_operation
;
208 Lisp_Object Qfile_error
, Qfile_already_exists
;
210 Lisp_Object Qfile_name_history
;
212 Lisp_Object Qcar_less_than_car
;
214 report_file_error (string
, data
)
218 Lisp_Object errstring
;
220 errstring
= build_string (strerror (errno
));
222 /* System error messages are capitalized. Downcase the initial
223 unless it is followed by a slash. */
224 if (XSTRING (errstring
)->data
[1] != '/')
225 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
228 Fsignal (Qfile_error
,
229 Fcons (build_string (string
), Fcons (errstring
, data
)));
232 close_file_unwind (fd
)
235 close (XFASTINT (fd
));
238 /* Restore point, having saved it as a marker. */
240 restore_point_unwind (location
)
241 Lisp_Object location
;
243 SET_PT (marker_position (location
));
244 Fset_marker (location
, Qnil
, Qnil
);
247 Lisp_Object Qexpand_file_name
;
248 Lisp_Object Qsubstitute_in_file_name
;
249 Lisp_Object Qdirectory_file_name
;
250 Lisp_Object Qfile_name_directory
;
251 Lisp_Object Qfile_name_nondirectory
;
252 Lisp_Object Qunhandled_file_name_directory
;
253 Lisp_Object Qfile_name_as_directory
;
254 Lisp_Object Qcopy_file
;
255 Lisp_Object Qmake_directory_internal
;
256 Lisp_Object Qdelete_directory
;
257 Lisp_Object Qdelete_file
;
258 Lisp_Object Qrename_file
;
259 Lisp_Object Qadd_name_to_file
;
260 Lisp_Object Qmake_symbolic_link
;
261 Lisp_Object Qfile_exists_p
;
262 Lisp_Object Qfile_executable_p
;
263 Lisp_Object Qfile_readable_p
;
264 Lisp_Object Qfile_writable_p
;
265 Lisp_Object Qfile_symlink_p
;
266 Lisp_Object Qaccess_file
;
267 Lisp_Object Qfile_directory_p
;
268 Lisp_Object Qfile_regular_p
;
269 Lisp_Object Qfile_accessible_directory_p
;
270 Lisp_Object Qfile_modes
;
271 Lisp_Object Qset_file_modes
;
272 Lisp_Object Qfile_newer_than_file_p
;
273 Lisp_Object Qinsert_file_contents
;
274 Lisp_Object Qwrite_region
;
275 Lisp_Object Qverify_visited_file_modtime
;
276 Lisp_Object Qset_visited_file_modtime
;
278 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
279 "Return FILENAME's handler function for OPERATION, if it has one.\n\
280 Otherwise, return nil.\n\
281 A file name is handled if one of the regular expressions in\n\
282 `file-name-handler-alist' matches it.\n\n\
283 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
284 any handlers that are members of `inhibit-file-name-handlers',\n\
285 but we still do run any other handlers. This lets handlers\n\
286 use the standard functions without calling themselves recursively.")
287 (filename
, operation
)
288 Lisp_Object filename
, operation
;
290 /* This function must not munge the match data. */
291 Lisp_Object chain
, inhibited_handlers
;
293 CHECK_STRING (filename
, 0);
295 if (EQ (operation
, Vinhibit_file_name_operation
))
296 inhibited_handlers
= Vinhibit_file_name_handlers
;
298 inhibited_handlers
= Qnil
;
300 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
301 chain
= XCONS (chain
)->cdr
)
304 elt
= XCONS (chain
)->car
;
308 string
= XCONS (elt
)->car
;
309 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
311 Lisp_Object handler
, tem
;
313 handler
= XCONS (elt
)->cdr
;
314 tem
= Fmemq (handler
, inhibited_handlers
);
325 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
327 "Return the directory component in file name FILENAME.\n\
328 Return nil if FILENAME does not include a directory.\n\
329 Otherwise return a directory spec.\n\
330 Given a Unix syntax file name, returns a string ending in slash;\n\
331 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
333 Lisp_Object filename
;
335 register unsigned char *beg
;
336 register unsigned char *p
;
339 CHECK_STRING (filename
, 0);
341 /* If the file name has special constructs in it,
342 call the corresponding file handler. */
343 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
345 return call2 (handler
, Qfile_name_directory
, filename
);
347 #ifdef FILE_SYSTEM_CASE
348 filename
= FILE_SYSTEM_CASE (filename
);
350 beg
= XSTRING (filename
)->data
;
352 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
354 p
= beg
+ XSTRING (filename
)->size
;
356 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
358 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
361 /* only recognise drive specifier at beginning */
362 && !(p
[-1] == ':' && p
== beg
+ 2)
369 /* Expansion of "c:" to drive and default directory. */
370 if (p
== beg
+ 2 && beg
[1] == ':')
372 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
373 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
374 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
376 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
379 p
= beg
+ strlen (beg
);
382 CORRECT_DIR_SEPS (beg
);
384 return make_string (beg
, p
- beg
);
387 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
389 "Return file name FILENAME sans its directory.\n\
390 For example, in a Unix-syntax file name,\n\
391 this is everything after the last slash,\n\
392 or the entire name if it contains no slash.")
394 Lisp_Object filename
;
396 register unsigned char *beg
, *p
, *end
;
399 CHECK_STRING (filename
, 0);
401 /* If the file name has special constructs in it,
402 call the corresponding file handler. */
403 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
405 return call2 (handler
, Qfile_name_nondirectory
, filename
);
407 beg
= XSTRING (filename
)->data
;
408 end
= p
= beg
+ XSTRING (filename
)->size
;
410 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
412 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
415 /* only recognise drive specifier at beginning */
416 && !(p
[-1] == ':' && p
== beg
+ 2)
420 return make_string (p
, end
- p
);
423 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
424 "Return a directly usable directory name somehow associated with FILENAME.\n\
425 A `directly usable' directory name is one that may be used without the\n\
426 intervention of any file handler.\n\
427 If FILENAME is a directly usable file itself, return\n\
428 (file-name-directory FILENAME).\n\
429 The `call-process' and `start-process' functions use this function to\n\
430 get a current directory to run processes in.")
432 Lisp_Object filename
;
436 /* If the file name has special constructs in it,
437 call the corresponding file handler. */
438 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
440 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
442 return Ffile_name_directory (filename
);
447 file_name_as_directory (out
, in
)
450 int size
= strlen (in
) - 1;
455 /* Is it already a directory string? */
456 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
458 /* Is it a VMS directory file name? If so, hack VMS syntax. */
459 else if (! index (in
, '/')
460 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
461 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
462 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
463 || ! strncmp (&in
[size
- 5], ".dir", 4))
464 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
465 && in
[size
] == '1')))
467 register char *p
, *dot
;
471 dir:x.dir --> dir:[x]
472 dir:[x]y.dir --> dir:[x.y] */
474 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
477 strncpy (out
, in
, p
- in
);
496 dot
= index (p
, '.');
499 /* blindly remove any extension */
500 size
= strlen (out
) + (dot
- p
);
501 strncat (out
, p
, dot
- p
);
512 /* For Unix syntax, Append a slash if necessary */
513 if (!IS_DIRECTORY_SEP (out
[size
]))
515 out
[size
+ 1] = DIRECTORY_SEP
;
516 out
[size
+ 2] = '\0';
519 CORRECT_DIR_SEPS (out
);
525 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
526 Sfile_name_as_directory
, 1, 1, 0,
527 "Return a string representing file FILENAME interpreted as a directory.\n\
528 This operation exists because a directory is also a file, but its name as\n\
529 a directory is different from its name as a file.\n\
530 The result can be used as the value of `default-directory'\n\
531 or passed as second argument to `expand-file-name'.\n\
532 For a Unix-syntax file name, just appends a slash.\n\
533 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
540 CHECK_STRING (file
, 0);
544 /* If the file name has special constructs in it,
545 call the corresponding file handler. */
546 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
548 return call2 (handler
, Qfile_name_as_directory
, file
);
550 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
551 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
555 * Convert from directory name to filename.
557 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
558 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
559 * On UNIX, it's simple: just make sure there isn't a terminating /
561 * Value is nonzero if the string output is different from the input.
564 directory_file_name (src
, dst
)
572 struct FAB fab
= cc$rms_fab
;
573 struct NAM nam
= cc$rms_nam
;
574 char esa
[NAM$C_MAXRSS
];
579 if (! index (src
, '/')
580 && (src
[slen
- 1] == ']'
581 || src
[slen
- 1] == ':'
582 || src
[slen
- 1] == '>'))
584 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
586 fab
.fab$b_fns
= slen
;
587 fab
.fab$l_nam
= &nam
;
588 fab
.fab$l_fop
= FAB$M_NAM
;
591 nam
.nam$b_ess
= sizeof esa
;
592 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
594 /* We call SYS$PARSE to handle such things as [--] for us. */
595 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
597 slen
= nam
.nam$b_esl
;
598 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
603 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
605 /* what about when we have logical_name:???? */
606 if (src
[slen
- 1] == ':')
607 { /* Xlate logical name and see what we get */
608 ptr
= strcpy (dst
, src
); /* upper case for getenv */
611 if ('a' <= *ptr
&& *ptr
<= 'z')
615 dst
[slen
- 1] = 0; /* remove colon */
616 if (!(src
= egetenv (dst
)))
618 /* should we jump to the beginning of this procedure?
619 Good points: allows us to use logical names that xlate
621 Bad points: can be a problem if we just translated to a device
623 For now, I'll punt and always expect VMS names, and hope for
626 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
627 { /* no recursion here! */
633 { /* not a directory spec */
638 bracket
= src
[slen
- 1];
640 /* If bracket is ']' or '>', bracket - 2 is the corresponding
642 ptr
= index (src
, bracket
- 2);
644 { /* no opening bracket */
648 if (!(rptr
= rindex (src
, '.')))
651 strncpy (dst
, src
, slen
);
655 dst
[slen
++] = bracket
;
660 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
661 then translate the device and recurse. */
662 if (dst
[slen
- 1] == ':'
663 && dst
[slen
- 2] != ':' /* skip decnet nodes */
664 && strcmp (src
+ slen
, "[000000]") == 0)
666 dst
[slen
- 1] = '\0';
667 if ((ptr
= egetenv (dst
))
668 && (rlen
= strlen (ptr
) - 1) > 0
669 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
670 && ptr
[rlen
- 1] == '.')
672 char * buf
= (char *) alloca (strlen (ptr
) + 1);
676 return directory_file_name (buf
, dst
);
681 strcat (dst
, "[000000]");
685 rlen
= strlen (rptr
) - 1;
686 strncat (dst
, rptr
, rlen
);
687 dst
[slen
+ rlen
] = '\0';
688 strcat (dst
, ".DIR.1");
692 /* Process as Unix format: just remove any final slash.
693 But leave "/" unchanged; do not change it to "". */
696 /* Handle // as root for apollo's. */
697 if ((slen
> 2 && dst
[slen
- 1] == '/')
698 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
702 && IS_DIRECTORY_SEP (dst
[slen
- 1])
704 && !IS_ANY_SEP (dst
[slen
- 2])
710 CORRECT_DIR_SEPS (dst
);
715 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
717 "Returns the file name of the directory named DIRECTORY.\n\
718 This is the name of the file that holds the data for the directory DIRECTORY.\n\
719 This operation exists because a directory is also a file, but its name as\n\
720 a directory is different from its name as a file.\n\
721 In Unix-syntax, this function just removes the final slash.\n\
722 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
723 it returns a file name such as \"[X]Y.DIR.1\".")
725 Lisp_Object directory
;
730 CHECK_STRING (directory
, 0);
732 if (NILP (directory
))
735 /* If the file name has special constructs in it,
736 call the corresponding file handler. */
737 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
739 return call2 (handler
, Qdirectory_file_name
, directory
);
742 /* 20 extra chars is insufficient for VMS, since we might perform a
743 logical name translation. an equivalence string can be up to 255
744 chars long, so grab that much extra space... - sss */
745 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
747 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
749 directory_file_name (XSTRING (directory
)->data
, buf
);
750 return build_string (buf
);
753 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
754 "Generate temporary file name (string) starting with PREFIX (a string).\n\
755 The Emacs process number forms part of the result,\n\
756 so there is no danger of generating a name being used by another process.")
762 /* Don't use too many characters of the restricted 8+3 DOS
764 val
= concat2 (prefix
, build_string ("a.XXX"));
766 val
= concat2 (prefix
, build_string ("XXXXXX"));
768 mktemp (XSTRING (val
)->data
);
770 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
775 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
776 "Convert filename NAME to absolute, and canonicalize it.\n\
777 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
778 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
779 the current buffer's value of default-directory is used.\n\
780 File name components that are `.' are removed, and \n\
781 so are file name components followed by `..', along with the `..' itself;\n\
782 note that these simplifications are done without checking the resulting\n\
783 file names in the file system.\n\
784 An initial `~/' expands to your home directory.\n\
785 An initial `~USER/' expands to USER's home directory.\n\
786 See also the function `substitute-in-file-name'.")
787 (name
, default_directory
)
788 Lisp_Object name
, default_directory
;
792 register unsigned char *newdir
, *p
, *o
;
794 unsigned char *target
;
797 unsigned char * colon
= 0;
798 unsigned char * close
= 0;
799 unsigned char * slash
= 0;
800 unsigned char * brack
= 0;
801 int lbrack
= 0, rbrack
= 0;
806 int collapse_newdir
= 1;
811 CHECK_STRING (name
, 0);
813 /* If the file name has special constructs in it,
814 call the corresponding file handler. */
815 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
817 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
819 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
820 if (NILP (default_directory
))
821 default_directory
= current_buffer
->directory
;
822 CHECK_STRING (default_directory
, 1);
824 if (!NILP (default_directory
))
826 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
828 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
831 o
= XSTRING (default_directory
)->data
;
833 /* Make sure DEFAULT_DIRECTORY is properly expanded.
834 It would be better to do this down below where we actually use
835 default_directory. Unfortunately, calling Fexpand_file_name recursively
836 could invoke GC, and the strings might be relocated. This would
837 be annoying because we have pointers into strings lying around
838 that would need adjusting, and people would add new pointers to
839 the code and forget to adjust them, resulting in intermittent bugs.
840 Putting this call here avoids all that crud.
842 The EQ test avoids infinite recursion. */
843 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
844 /* Save time in some common cases - as long as default_directory
845 is not relative, it can be canonicalized with name below (if it
846 is needed at all) without requiring it to be expanded now. */
848 /* Detect MSDOS file names with drive specifiers. */
849 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
851 /* Detect Windows file names in UNC format. */
852 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
854 #else /* not DOS_NT */
855 /* Detect Unix absolute file names (/... alone is not absolute on
857 && ! (IS_DIRECTORY_SEP (o
[0]))
858 #endif /* not DOS_NT */
864 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
869 /* Filenames on VMS are always upper case. */
870 name
= Fupcase (name
);
872 #ifdef FILE_SYSTEM_CASE
873 name
= FILE_SYSTEM_CASE (name
);
876 nm
= XSTRING (name
)->data
;
879 /* We will force directory separators to be either all \ or /, so make
880 a local copy to modify, even if there ends up being no change. */
881 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
883 /* Find and remove drive specifier if present; this makes nm absolute
884 even if the rest of the name appears to be relative. */
886 unsigned char *colon
= rindex (nm
, ':');
889 /* Only recognize colon as part of drive specifier if there is a
890 single alphabetic character preceeding the colon (and if the
891 character before the drive letter, if present, is a directory
892 separator); this is to support the remote system syntax used by
893 ange-ftp, and the "po:username" syntax for POP mailboxes. */
897 else if (IS_DRIVE (colon
[-1])
898 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
905 while (--colon
>= nm
)
913 /* Discard any previous drive specifier if nm is now in UNC format. */
914 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
920 /* If nm is absolute, look for /./ or /../ sequences; if none are
921 found, we can probably return right away. We will avoid allocating
922 a new string if name is already fully expanded. */
924 IS_DIRECTORY_SEP (nm
[0])
929 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
936 /* If it turns out that the filename we want to return is just a
937 suffix of FILENAME, we don't need to go through and edit
938 things; we just need to construct a new string using data
939 starting at the middle of FILENAME. If we set lose to a
940 non-zero value, that means we've discovered that we can't do
947 /* Since we know the name is absolute, we can assume that each
948 element starts with a "/". */
950 /* "." and ".." are hairy. */
951 if (IS_DIRECTORY_SEP (p
[0])
953 && (IS_DIRECTORY_SEP (p
[2])
955 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
962 /* if dev:[dir]/, move nm to / */
963 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
964 nm
= (brack
? brack
+ 1 : colon
+ 1);
973 /* VMS pre V4.4,convert '-'s in filenames. */
974 if (lbrack
== rbrack
)
976 if (dots
< 2) /* this is to allow negative version numbers */
981 if (lbrack
> rbrack
&&
982 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
983 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
989 /* count open brackets, reset close bracket pointer */
990 if (p
[0] == '[' || p
[0] == '<')
992 /* count close brackets, set close bracket pointer */
993 if (p
[0] == ']' || p
[0] == '>')
995 /* detect ][ or >< */
996 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
998 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
999 nm
= p
+ 1, lose
= 1;
1000 if (p
[0] == ':' && (colon
|| slash
))
1001 /* if dev1:[dir]dev2:, move nm to dev2: */
1007 /* if /name/dev:, move nm to dev: */
1010 /* if node::dev:, move colon following dev */
1011 else if (colon
&& colon
[-1] == ':')
1013 /* if dev1:dev2:, move nm to dev2: */
1014 else if (colon
&& colon
[-1] != ':')
1019 if (p
[0] == ':' && !colon
)
1025 if (lbrack
== rbrack
)
1028 else if (p
[0] == '.')
1036 if (index (nm
, '/'))
1037 return build_string (sys_translate_unix (nm
));
1040 /* Make sure directories are all separated with / or \ as
1041 desired, but avoid allocation of a new string when not
1043 CORRECT_DIR_SEPS (nm
);
1045 if (IS_DIRECTORY_SEP (nm
[1]))
1047 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1048 name
= build_string (nm
);
1052 /* drive must be set, so this is okay */
1053 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1055 name
= make_string (nm
- 2, p
- nm
+ 2);
1056 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1057 XSTRING (name
)->data
[1] = ':';
1060 #else /* not DOS_NT */
1061 if (nm
== XSTRING (name
)->data
)
1063 return build_string (nm
);
1064 #endif /* not DOS_NT */
1068 /* At this point, nm might or might not be an absolute file name. We
1069 need to expand ~ or ~user if present, otherwise prefix nm with
1070 default_directory if nm is not absolute, and finally collapse /./
1071 and /foo/../ sequences.
1073 We set newdir to be the appropriate prefix if one is needed:
1074 - the relevant user directory if nm starts with ~ or ~user
1075 - the specified drive's working dir (DOS/NT only) if nm does not
1077 - the value of default_directory.
1079 Note that these prefixes are not guaranteed to be absolute (except
1080 for the working dir of a drive). Therefore, to ensure we always
1081 return an absolute name, if the final prefix is not absolute we
1082 append it to the current working directory. */
1086 if (nm
[0] == '~') /* prefix ~ */
1088 if (IS_DIRECTORY_SEP (nm
[1])
1092 || nm
[1] == 0) /* ~ by itself */
1094 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1095 newdir
= (unsigned char *) "";
1098 collapse_newdir
= 0;
1101 nm
++; /* Don't leave the slash in nm. */
1104 else /* ~user/filename */
1106 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1111 o
= (unsigned char *) alloca (p
- nm
+ 1);
1112 bcopy ((char *) nm
, o
, p
- nm
);
1115 pw
= (struct passwd
*) getpwnam (o
+ 1);
1118 newdir
= (unsigned char *) pw
-> pw_dir
;
1120 nm
= p
+ 1; /* skip the terminator */
1124 collapse_newdir
= 0;
1129 /* If we don't find a user of that name, leave the name
1130 unchanged; don't move nm forward to p. */
1135 /* On DOS and Windows, nm is absolute if a drive name was specified;
1136 use the drive's current directory as the prefix if needed. */
1137 if (!newdir
&& drive
)
1139 /* Get default directory if needed to make nm absolute. */
1140 if (!IS_DIRECTORY_SEP (nm
[0]))
1142 newdir
= alloca (MAXPATHLEN
+ 1);
1143 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1148 /* Either nm starts with /, or drive isn't mounted. */
1149 newdir
= alloca (4);
1150 newdir
[0] = DRIVE_LETTER (drive
);
1158 /* Finally, if no prefix has been specified and nm is not absolute,
1159 then it must be expanded relative to default_directory. */
1163 /* /... alone is not absolute on DOS and Windows. */
1164 && !IS_DIRECTORY_SEP (nm
[0])
1167 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1174 newdir
= XSTRING (default_directory
)->data
;
1180 /* First ensure newdir is an absolute name. */
1182 /* Detect MSDOS file names with drive specifiers. */
1183 ! (IS_DRIVE (newdir
[0])
1184 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1186 /* Detect Windows file names in UNC format. */
1187 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1191 /* Effectively, let newdir be (expand-file-name newdir cwd).
1192 Because of the admonition against calling expand-file-name
1193 when we have pointers into lisp strings, we accomplish this
1194 indirectly by prepending newdir to nm if necessary, and using
1195 cwd (or the wd of newdir's drive) as the new newdir. */
1197 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1202 if (!IS_DIRECTORY_SEP (nm
[0]))
1204 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1205 file_name_as_directory (tmp
, newdir
);
1209 newdir
= alloca (MAXPATHLEN
+ 1);
1212 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1219 /* Strip off drive name from prefix, if present. */
1220 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1226 /* Keep only a prefix from newdir if nm starts with slash
1227 (//server/share for UNC, nothing otherwise). */
1228 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1231 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1233 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1235 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1237 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1249 /* Get rid of any slash at the end of newdir, unless newdir is
1250 just // (an incomplete UNC name). */
1251 length
= strlen (newdir
);
1252 if (IS_DIRECTORY_SEP (newdir
[length
- 1])
1254 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1258 unsigned char *temp
= (unsigned char *) alloca (length
);
1259 bcopy (newdir
, temp
, length
- 1);
1260 temp
[length
- 1] = 0;
1268 /* Now concatenate the directory and name to new space in the stack frame */
1269 tlen
+= strlen (nm
) + 1;
1271 /* Add reserved space for drive name. (The Microsoft x86 compiler
1272 produces incorrect code if the following two lines are combined.) */
1273 target
= (unsigned char *) alloca (tlen
+ 2);
1275 #else /* not DOS_NT */
1276 target
= (unsigned char *) alloca (tlen
);
1277 #endif /* not DOS_NT */
1283 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1284 strcpy (target
, newdir
);
1287 file_name_as_directory (target
, newdir
);
1290 strcat (target
, nm
);
1292 if (index (target
, '/'))
1293 strcpy (target
, sys_translate_unix (target
));
1296 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1298 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1306 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1312 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1313 /* brackets are offset from each other by 2 */
1316 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1317 /* convert [foo][bar] to [bar] */
1318 while (o
[-1] != '[' && o
[-1] != '<')
1320 else if (*p
== '-' && *o
!= '.')
1323 else if (p
[0] == '-' && o
[-1] == '.' &&
1324 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1325 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1329 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1330 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1332 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1334 /* else [foo.-] ==> [-] */
1340 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1341 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1347 if (!IS_DIRECTORY_SEP (*p
))
1351 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1352 #if defined (APOLLO) || defined (WINDOWSNT)
1353 /* // at start of filename is meaningful in Apollo
1354 and WindowsNT systems */
1356 #endif /* APOLLO || WINDOWSNT */
1362 else if (IS_DIRECTORY_SEP (p
[0])
1364 && (IS_DIRECTORY_SEP (p
[2])
1367 /* If "/." is the entire filename, keep the "/". Otherwise,
1368 just delete the whole "/.". */
1369 if (o
== target
&& p
[2] == '\0')
1373 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1374 /* `/../' is the "superroot" on certain file systems. */
1376 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1378 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1380 if (o
== target
&& IS_ANY_SEP (*o
))
1388 #endif /* not VMS */
1392 /* At last, set drive name. */
1394 /* Except for network file name. */
1395 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1396 #endif /* WINDOWSNT */
1398 if (!drive
) abort ();
1400 target
[0] = DRIVE_LETTER (drive
);
1403 CORRECT_DIR_SEPS (target
);
1406 return make_string (target
, o
- target
);
1410 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1411 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1412 "Convert FILENAME to absolute, and canonicalize it.\n\
1413 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1414 (does not start with slash); if DEFAULT is nil or missing,\n\
1415 the current buffer's value of default-directory is used.\n\
1416 Filenames containing `.' or `..' as components are simplified;\n\
1417 initial `~/' expands to your home directory.\n\
1418 See also the function `substitute-in-file-name'.")
1420 Lisp_Object name
, defalt
;
1424 register unsigned char *newdir
, *p
, *o
;
1426 unsigned char *target
;
1430 unsigned char * colon
= 0;
1431 unsigned char * close
= 0;
1432 unsigned char * slash
= 0;
1433 unsigned char * brack
= 0;
1434 int lbrack
= 0, rbrack
= 0;
1438 CHECK_STRING (name
, 0);
1441 /* Filenames on VMS are always upper case. */
1442 name
= Fupcase (name
);
1445 nm
= XSTRING (name
)->data
;
1447 /* If nm is absolute, flush ...// and detect /./ and /../.
1448 If no /./ or /../ we can return right away. */
1460 if (p
[0] == '/' && p
[1] == '/'
1462 /* // at start of filename is meaningful on Apollo system */
1467 if (p
[0] == '/' && p
[1] == '~')
1468 nm
= p
+ 1, lose
= 1;
1469 if (p
[0] == '/' && p
[1] == '.'
1470 && (p
[2] == '/' || p
[2] == 0
1471 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1477 /* if dev:[dir]/, move nm to / */
1478 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1479 nm
= (brack
? brack
+ 1 : colon
+ 1);
1480 lbrack
= rbrack
= 0;
1488 /* VMS pre V4.4,convert '-'s in filenames. */
1489 if (lbrack
== rbrack
)
1491 if (dots
< 2) /* this is to allow negative version numbers */
1496 if (lbrack
> rbrack
&&
1497 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1498 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1504 /* count open brackets, reset close bracket pointer */
1505 if (p
[0] == '[' || p
[0] == '<')
1506 lbrack
++, brack
= 0;
1507 /* count close brackets, set close bracket pointer */
1508 if (p
[0] == ']' || p
[0] == '>')
1509 rbrack
++, brack
= p
;
1510 /* detect ][ or >< */
1511 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1513 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1514 nm
= p
+ 1, lose
= 1;
1515 if (p
[0] == ':' && (colon
|| slash
))
1516 /* if dev1:[dir]dev2:, move nm to dev2: */
1522 /* If /name/dev:, move nm to dev: */
1525 /* If node::dev:, move colon following dev */
1526 else if (colon
&& colon
[-1] == ':')
1528 /* If dev1:dev2:, move nm to dev2: */
1529 else if (colon
&& colon
[-1] != ':')
1534 if (p
[0] == ':' && !colon
)
1540 if (lbrack
== rbrack
)
1543 else if (p
[0] == '.')
1551 if (index (nm
, '/'))
1552 return build_string (sys_translate_unix (nm
));
1554 if (nm
== XSTRING (name
)->data
)
1556 return build_string (nm
);
1560 /* Now determine directory to start with and put it in NEWDIR */
1564 if (nm
[0] == '~') /* prefix ~ */
1569 || nm
[1] == 0)/* ~/filename */
1571 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1572 newdir
= (unsigned char *) "";
1575 nm
++; /* Don't leave the slash in nm. */
1578 else /* ~user/filename */
1580 /* Get past ~ to user */
1581 unsigned char *user
= nm
+ 1;
1582 /* Find end of name. */
1583 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1584 int len
= ptr
? ptr
- user
: strlen (user
);
1586 unsigned char *ptr1
= index (user
, ':');
1587 if (ptr1
!= 0 && ptr1
- user
< len
)
1590 /* Copy the user name into temp storage. */
1591 o
= (unsigned char *) alloca (len
+ 1);
1592 bcopy ((char *) user
, o
, len
);
1595 /* Look up the user name. */
1596 pw
= (struct passwd
*) getpwnam (o
+ 1);
1598 error ("\"%s\" isn't a registered user", o
+ 1);
1600 newdir
= (unsigned char *) pw
->pw_dir
;
1602 /* Discard the user name from NM. */
1609 #endif /* not VMS */
1613 defalt
= current_buffer
->directory
;
1614 CHECK_STRING (defalt
, 1);
1615 newdir
= XSTRING (defalt
)->data
;
1618 /* Now concatenate the directory and name to new space in the stack frame */
1620 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1621 target
= (unsigned char *) alloca (tlen
);
1627 if (nm
[0] == 0 || nm
[0] == '/')
1628 strcpy (target
, newdir
);
1631 file_name_as_directory (target
, newdir
);
1634 strcat (target
, nm
);
1636 if (index (target
, '/'))
1637 strcpy (target
, sys_translate_unix (target
));
1640 /* Now canonicalize by removing /. and /foo/.. if they appear */
1648 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1654 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1655 /* brackets are offset from each other by 2 */
1658 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1659 /* convert [foo][bar] to [bar] */
1660 while (o
[-1] != '[' && o
[-1] != '<')
1662 else if (*p
== '-' && *o
!= '.')
1665 else if (p
[0] == '-' && o
[-1] == '.' &&
1666 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1667 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1671 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1672 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1674 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1676 /* else [foo.-] ==> [-] */
1682 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1683 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1693 else if (!strncmp (p
, "//", 2)
1695 /* // at start of filename is meaningful in Apollo system */
1703 else if (p
[0] == '/' && p
[1] == '.' &&
1704 (p
[2] == '/' || p
[2] == 0))
1706 else if (!strncmp (p
, "/..", 3)
1707 /* `/../' is the "superroot" on certain file systems. */
1709 && (p
[3] == '/' || p
[3] == 0))
1711 while (o
!= target
&& *--o
!= '/')
1714 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1718 if (o
== target
&& *o
== '/')
1726 #endif /* not VMS */
1729 return make_string (target
, o
- target
);
1733 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1734 Ssubstitute_in_file_name
, 1, 1, 0,
1735 "Substitute environment variables referred to in FILENAME.\n\
1736 `$FOO' where FOO is an environment variable name means to substitute\n\
1737 the value of that variable. The variable name should be terminated\n\
1738 with a character not a letter, digit or underscore; otherwise, enclose\n\
1739 the entire variable name in braces.\n\
1740 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1741 On VMS, `$' substitution is not done; this function does little and only\n\
1742 duplicates what `expand-file-name' does.")
1744 Lisp_Object filename
;
1748 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1749 unsigned char *target
;
1751 int substituted
= 0;
1753 Lisp_Object handler
;
1755 CHECK_STRING (filename
, 0);
1757 /* If the file name has special constructs in it,
1758 call the corresponding file handler. */
1759 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1760 if (!NILP (handler
))
1761 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1763 nm
= XSTRING (filename
)->data
;
1765 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1766 CORRECT_DIR_SEPS (nm
);
1767 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1769 endp
= nm
+ XSTRING (filename
)->size
;
1771 /* If /~ or // appears, discard everything through first slash. */
1773 for (p
= nm
; p
!= endp
; p
++)
1776 #if defined (APOLLO) || defined (WINDOWSNT)
1777 /* // at start of file name is meaningful in Apollo and
1778 WindowsNT systems */
1779 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1780 #else /* not (APOLLO || WINDOWSNT) */
1781 || IS_DIRECTORY_SEP (p
[0])
1782 #endif /* not (APOLLO || WINDOWSNT) */
1787 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1789 || IS_DIRECTORY_SEP (p
[-1])))
1795 /* see comment in expand-file-name about drive specifiers */
1796 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1797 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1806 return build_string (nm
);
1809 /* See if any variables are substituted into the string
1810 and find the total length of their values in `total' */
1812 for (p
= nm
; p
!= endp
;)
1822 /* "$$" means a single "$" */
1831 while (p
!= endp
&& *p
!= '}') p
++;
1832 if (*p
!= '}') goto missingclose
;
1838 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1842 /* Copy out the variable name */
1843 target
= (unsigned char *) alloca (s
- o
+ 1);
1844 strncpy (target
, o
, s
- o
);
1847 strupr (target
); /* $home == $HOME etc. */
1850 /* Get variable value */
1851 o
= (unsigned char *) egetenv (target
);
1852 if (!o
) goto badvar
;
1853 total
+= strlen (o
);
1860 /* If substitution required, recopy the string and do it */
1861 /* Make space in stack frame for the new copy */
1862 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1865 /* Copy the rest of the name through, replacing $ constructs with values */
1882 while (p
!= endp
&& *p
!= '}') p
++;
1883 if (*p
!= '}') goto missingclose
;
1889 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1893 /* Copy out the variable name */
1894 target
= (unsigned char *) alloca (s
- o
+ 1);
1895 strncpy (target
, o
, s
- o
);
1898 strupr (target
); /* $home == $HOME etc. */
1901 /* Get variable value */
1902 o
= (unsigned char *) egetenv (target
);
1912 /* If /~ or // appears, discard everything through first slash. */
1914 for (p
= xnm
; p
!= x
; p
++)
1916 #if defined (APOLLO) || defined (WINDOWSNT)
1917 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1918 #else /* not (APOLLO || WINDOWSNT) */
1919 || IS_DIRECTORY_SEP (p
[0])
1920 #endif /* not (APOLLO || WINDOWSNT) */
1922 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1925 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1926 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1930 return make_string (xnm
, x
- xnm
);
1933 error ("Bad format environment-variable substitution");
1935 error ("Missing \"}\" in environment-variable substitution");
1937 error ("Substituting nonexistent environment variable \"%s\"", target
);
1940 #endif /* not VMS */
1943 /* A slightly faster and more convenient way to get
1944 (directory-file-name (expand-file-name FOO)). */
1947 expand_and_dir_to_file (filename
, defdir
)
1948 Lisp_Object filename
, defdir
;
1950 register Lisp_Object absname
;
1952 absname
= Fexpand_file_name (filename
, defdir
);
1955 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1956 if (c
== ':' || c
== ']' || c
== '>')
1957 absname
= Fdirectory_file_name (absname
);
1960 /* Remove final slash, if any (unless this is the root dir).
1961 stat behaves differently depending! */
1962 if (XSTRING (absname
)->size
> 1
1963 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1964 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1965 /* We cannot take shortcuts; they might be wrong for magic file names. */
1966 absname
= Fdirectory_file_name (absname
);
1971 /* Signal an error if the file ABSNAME already exists.
1972 If INTERACTIVE is nonzero, ask the user whether to proceed,
1973 and bypass the error if the user says to go ahead.
1974 QUERYSTRING is a name for the action that is being considered
1976 *STATPTR is used to store the stat information if the file exists.
1977 If the file does not exist, STATPTR->st_mode is set to 0. */
1980 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1981 Lisp_Object absname
;
1982 unsigned char *querystring
;
1984 struct stat
*statptr
;
1986 register Lisp_Object tem
;
1987 struct stat statbuf
;
1988 struct gcpro gcpro1
;
1990 /* stat is a good way to tell whether the file exists,
1991 regardless of what access permissions it has. */
1992 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1995 Fsignal (Qfile_already_exists
,
1996 Fcons (build_string ("File already exists"),
1997 Fcons (absname
, Qnil
)));
1999 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2000 XSTRING (absname
)->data
, querystring
));
2003 Fsignal (Qfile_already_exists
,
2004 Fcons (build_string ("File already exists"),
2005 Fcons (absname
, Qnil
)));
2012 statptr
->st_mode
= 0;
2017 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2018 "fCopy file: \nFCopy %s to file: \np\nP",
2019 "Copy FILE to NEWNAME. Both args must be strings.\n\
2020 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2021 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2022 A number as third arg means request confirmation if NEWNAME already exists.\n\
2023 This is what happens in interactive use with M-x.\n\
2024 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2025 last-modified time as the old one. (This works on only some systems.)\n\
2026 A prefix arg makes KEEP-TIME non-nil.")
2027 (file
, newname
, ok_if_already_exists
, keep_date
)
2028 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2031 char buf
[16 * 1024];
2032 struct stat st
, out_st
;
2033 Lisp_Object handler
;
2034 struct gcpro gcpro1
, gcpro2
;
2035 int count
= specpdl_ptr
- specpdl
;
2036 int input_file_statable_p
;
2038 GCPRO2 (file
, newname
);
2039 CHECK_STRING (file
, 0);
2040 CHECK_STRING (newname
, 1);
2041 file
= Fexpand_file_name (file
, Qnil
);
2042 newname
= Fexpand_file_name (newname
, Qnil
);
2044 /* If the input file name has special constructs in it,
2045 call the corresponding file handler. */
2046 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2047 /* Likewise for output file name. */
2049 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2050 if (!NILP (handler
))
2051 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2052 ok_if_already_exists
, keep_date
));
2054 if (NILP (ok_if_already_exists
)
2055 || INTEGERP (ok_if_already_exists
))
2056 barf_or_query_if_file_exists (newname
, "copy to it",
2057 INTEGERP (ok_if_already_exists
), &out_st
);
2058 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2061 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2063 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2065 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2067 /* We can only copy regular files and symbolic links. Other files are not
2069 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2071 #if !defined (MSDOS) || __DJGPP__ > 1
2072 if (out_st
.st_mode
!= 0
2073 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2076 report_file_error ("Input and output files are the same",
2077 Fcons (file
, Fcons (newname
, Qnil
)));
2081 #if defined (S_ISREG) && defined (S_ISLNK)
2082 if (input_file_statable_p
)
2084 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2086 #if defined (EISDIR)
2087 /* Get a better looking error message. */
2090 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2093 #endif /* S_ISREG && S_ISLNK */
2096 /* Create the copy file with the same record format as the input file */
2097 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2100 /* System's default file type was set to binary by _fmode in emacs.c. */
2101 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2102 #else /* not MSDOS */
2103 ofd
= creat (XSTRING (newname
)->data
, 0666);
2104 #endif /* not MSDOS */
2107 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2109 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2113 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2114 if (write (ofd
, buf
, n
) != n
)
2115 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2118 /* Closing the output clobbers the file times on some systems. */
2119 if (close (ofd
) < 0)
2120 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2122 if (input_file_statable_p
)
2124 if (!NILP (keep_date
))
2126 EMACS_TIME atime
, mtime
;
2127 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2128 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2129 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2130 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2133 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2135 #if defined (__DJGPP__) && __DJGPP__ > 1
2136 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2137 and if it can't, it tells so. Otherwise, under MSDOS we usually
2138 get only the READ bit, which will make the copied file read-only,
2139 so it's better not to chmod at all. */
2140 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2141 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2142 #endif /* DJGPP version 2 or newer */
2148 /* Discard the unwind protects. */
2149 specpdl_ptr
= specpdl
+ count
;
2155 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2156 Smake_directory_internal
, 1, 1, 0,
2157 "Create a new directory named DIRECTORY.")
2159 Lisp_Object directory
;
2162 Lisp_Object handler
;
2164 CHECK_STRING (directory
, 0);
2165 directory
= Fexpand_file_name (directory
, Qnil
);
2167 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2168 if (!NILP (handler
))
2169 return call2 (handler
, Qmake_directory_internal
, directory
);
2171 dir
= XSTRING (directory
)->data
;
2174 if (mkdir (dir
) != 0)
2176 if (mkdir (dir
, 0777) != 0)
2178 report_file_error ("Creating directory", Flist (1, &directory
));
2183 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2184 "Delete the directory named DIRECTORY.")
2186 Lisp_Object directory
;
2189 Lisp_Object handler
;
2191 CHECK_STRING (directory
, 0);
2192 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2193 dir
= XSTRING (directory
)->data
;
2195 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2196 if (!NILP (handler
))
2197 return call2 (handler
, Qdelete_directory
, directory
);
2199 if (rmdir (dir
) != 0)
2200 report_file_error ("Removing directory", Flist (1, &directory
));
2205 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2206 "Delete file named FILENAME.\n\
2207 If file has multiple names, it continues to exist with the other names.")
2209 Lisp_Object filename
;
2211 Lisp_Object handler
;
2212 CHECK_STRING (filename
, 0);
2213 filename
= Fexpand_file_name (filename
, Qnil
);
2215 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2216 if (!NILP (handler
))
2217 return call2 (handler
, Qdelete_file
, filename
);
2219 if (0 > unlink (XSTRING (filename
)->data
))
2220 report_file_error ("Removing old name", Flist (1, &filename
));
2225 internal_delete_file_1 (ignore
)
2231 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2234 internal_delete_file (filename
)
2235 Lisp_Object filename
;
2237 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2238 Qt
, internal_delete_file_1
));
2241 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2242 "fRename file: \nFRename %s to file: \np",
2243 "Rename FILE as NEWNAME. Both args strings.\n\
2244 If file has names other than FILE, it continues to have those names.\n\
2245 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2246 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2247 A number as third arg means request confirmation if NEWNAME already exists.\n\
2248 This is what happens in interactive use with M-x.")
2249 (file
, newname
, ok_if_already_exists
)
2250 Lisp_Object file
, newname
, ok_if_already_exists
;
2253 Lisp_Object args
[2];
2255 Lisp_Object handler
;
2256 struct gcpro gcpro1
, gcpro2
;
2258 GCPRO2 (file
, newname
);
2259 CHECK_STRING (file
, 0);
2260 CHECK_STRING (newname
, 1);
2261 file
= Fexpand_file_name (file
, Qnil
);
2262 newname
= Fexpand_file_name (newname
, Qnil
);
2264 /* If the file name has special constructs in it,
2265 call the corresponding file handler. */
2266 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2268 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2269 if (!NILP (handler
))
2270 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2271 file
, newname
, ok_if_already_exists
));
2273 if (NILP (ok_if_already_exists
)
2274 || INTEGERP (ok_if_already_exists
))
2275 barf_or_query_if_file_exists (newname
, "rename to it",
2276 INTEGERP (ok_if_already_exists
), 0);
2278 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2280 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2281 || 0 > unlink (XSTRING (file
)->data
))
2286 Fcopy_file (file
, newname
,
2287 /* We have already prompted if it was an integer,
2288 so don't have copy-file prompt again. */
2289 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2290 Fdelete_file (file
);
2297 report_file_error ("Renaming", Flist (2, args
));
2300 report_file_error ("Renaming", Flist (2, &file
));
2307 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2308 "fAdd name to file: \nFName to add to %s: \np",
2309 "Give FILE additional name NEWNAME. Both args strings.\n\
2310 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2311 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2312 A number as third arg means request confirmation if NEWNAME already exists.\n\
2313 This is what happens in interactive use with M-x.")
2314 (file
, newname
, ok_if_already_exists
)
2315 Lisp_Object file
, newname
, ok_if_already_exists
;
2318 Lisp_Object args
[2];
2320 Lisp_Object handler
;
2321 struct gcpro gcpro1
, gcpro2
;
2323 GCPRO2 (file
, newname
);
2324 CHECK_STRING (file
, 0);
2325 CHECK_STRING (newname
, 1);
2326 file
= Fexpand_file_name (file
, Qnil
);
2327 newname
= Fexpand_file_name (newname
, Qnil
);
2329 /* If the file name has special constructs in it,
2330 call the corresponding file handler. */
2331 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2332 if (!NILP (handler
))
2333 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2334 newname
, ok_if_already_exists
));
2336 /* If the new name has special constructs in it,
2337 call the corresponding file handler. */
2338 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2339 if (!NILP (handler
))
2340 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2341 newname
, ok_if_already_exists
));
2343 if (NILP (ok_if_already_exists
)
2344 || INTEGERP (ok_if_already_exists
))
2345 barf_or_query_if_file_exists (newname
, "make it a new name",
2346 INTEGERP (ok_if_already_exists
), 0);
2348 /* Windows does not support this operation. */
2349 report_file_error ("Adding new name", Flist (2, &file
));
2350 #else /* not WINDOWSNT */
2352 unlink (XSTRING (newname
)->data
);
2353 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2358 report_file_error ("Adding new name", Flist (2, args
));
2360 report_file_error ("Adding new name", Flist (2, &file
));
2363 #endif /* not WINDOWSNT */
2370 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2371 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2372 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2373 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2374 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2375 A number as third arg means request confirmation if LINKNAME already exists.\n\
2376 This happens for interactive use with M-x.")
2377 (filename
, linkname
, ok_if_already_exists
)
2378 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2381 Lisp_Object args
[2];
2383 Lisp_Object handler
;
2384 struct gcpro gcpro1
, gcpro2
;
2386 GCPRO2 (filename
, linkname
);
2387 CHECK_STRING (filename
, 0);
2388 CHECK_STRING (linkname
, 1);
2389 /* If the link target has a ~, we must expand it to get
2390 a truly valid file name. Otherwise, do not expand;
2391 we want to permit links to relative file names. */
2392 if (XSTRING (filename
)->data
[0] == '~')
2393 filename
= Fexpand_file_name (filename
, Qnil
);
2394 linkname
= Fexpand_file_name (linkname
, Qnil
);
2396 /* If the file name has special constructs in it,
2397 call the corresponding file handler. */
2398 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2399 if (!NILP (handler
))
2400 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2401 linkname
, ok_if_already_exists
));
2403 /* If the new link name has special constructs in it,
2404 call the corresponding file handler. */
2405 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2406 if (!NILP (handler
))
2407 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2408 linkname
, ok_if_already_exists
));
2410 if (NILP (ok_if_already_exists
)
2411 || INTEGERP (ok_if_already_exists
))
2412 barf_or_query_if_file_exists (linkname
, "make it a link",
2413 INTEGERP (ok_if_already_exists
), 0);
2414 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2416 /* If we didn't complain already, silently delete existing file. */
2417 if (errno
== EEXIST
)
2419 unlink (XSTRING (linkname
)->data
);
2420 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2430 report_file_error ("Making symbolic link", Flist (2, args
));
2432 report_file_error ("Making symbolic link", Flist (2, &filename
));
2438 #endif /* S_IFLNK */
2442 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2443 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2444 "Define the job-wide logical name NAME to have the value STRING.\n\
2445 If STRING is nil or a null string, the logical name NAME is deleted.")
2450 CHECK_STRING (name
, 0);
2452 delete_logical_name (XSTRING (name
)->data
);
2455 CHECK_STRING (string
, 1);
2457 if (XSTRING (string
)->size
== 0)
2458 delete_logical_name (XSTRING (name
)->data
);
2460 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2469 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2470 "Open a network connection to PATH using LOGIN as the login string.")
2472 Lisp_Object path
, login
;
2476 CHECK_STRING (path
, 0);
2477 CHECK_STRING (login
, 0);
2479 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2481 if (netresult
== -1)
2486 #endif /* HPUX_NET */
2488 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2490 "Return t if file FILENAME specifies an absolute file name.\n\
2491 On Unix, this is a name starting with a `/' or a `~'.")
2493 Lisp_Object filename
;
2497 CHECK_STRING (filename
, 0);
2498 ptr
= XSTRING (filename
)->data
;
2499 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2501 /* ??? This criterion is probably wrong for '<'. */
2502 || index (ptr
, ':') || index (ptr
, '<')
2503 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2507 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2515 /* Return nonzero if file FILENAME exists and can be executed. */
2518 check_executable (filename
)
2522 int len
= strlen (filename
);
2525 if (stat (filename
, &st
) < 0)
2527 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2528 return ((st
.st_mode
& S_IEXEC
) != 0);
2530 return (S_ISREG (st
.st_mode
)
2532 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2533 || stricmp (suffix
, ".exe") == 0
2534 || stricmp (suffix
, ".bat") == 0)
2535 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2536 #endif /* not WINDOWSNT */
2537 #else /* not DOS_NT */
2538 #ifdef HAVE_EUIDACCESS
2539 return (euidaccess (filename
, 1) >= 0);
2541 /* Access isn't quite right because it uses the real uid
2542 and we really want to test with the effective uid.
2543 But Unix doesn't give us a right way to do it. */
2544 return (access (filename
, 1) >= 0);
2546 #endif /* not DOS_NT */
2549 /* Return nonzero if file FILENAME exists and can be written. */
2552 check_writable (filename
)
2557 if (stat (filename
, &st
) < 0)
2559 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2560 #else /* not MSDOS */
2561 #ifdef HAVE_EUIDACCESS
2562 return (euidaccess (filename
, 2) >= 0);
2564 /* Access isn't quite right because it uses the real uid
2565 and we really want to test with the effective uid.
2566 But Unix doesn't give us a right way to do it.
2567 Opening with O_WRONLY could work for an ordinary file,
2568 but would lose for directories. */
2569 return (access (filename
, 2) >= 0);
2571 #endif /* not MSDOS */
2574 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2575 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2576 See also `file-readable-p' and `file-attributes'.")
2578 Lisp_Object filename
;
2580 Lisp_Object absname
;
2581 Lisp_Object handler
;
2582 struct stat statbuf
;
2584 CHECK_STRING (filename
, 0);
2585 absname
= Fexpand_file_name (filename
, Qnil
);
2587 /* If the file name has special constructs in it,
2588 call the corresponding file handler. */
2589 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2590 if (!NILP (handler
))
2591 return call2 (handler
, Qfile_exists_p
, absname
);
2593 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2596 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2597 "Return t if FILENAME can be executed by you.\n\
2598 For a directory, this means you can access files in that directory.")
2600 Lisp_Object filename
;
2603 Lisp_Object absname
;
2604 Lisp_Object handler
;
2606 CHECK_STRING (filename
, 0);
2607 absname
= Fexpand_file_name (filename
, Qnil
);
2609 /* If the file name has special constructs in it,
2610 call the corresponding file handler. */
2611 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2612 if (!NILP (handler
))
2613 return call2 (handler
, Qfile_executable_p
, absname
);
2615 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2618 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2619 "Return t if file FILENAME exists and you can read it.\n\
2620 See also `file-exists-p' and `file-attributes'.")
2622 Lisp_Object filename
;
2624 Lisp_Object absname
;
2625 Lisp_Object handler
;
2628 struct stat statbuf
;
2630 CHECK_STRING (filename
, 0);
2631 absname
= Fexpand_file_name (filename
, Qnil
);
2633 /* If the file name has special constructs in it,
2634 call the corresponding file handler. */
2635 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2636 if (!NILP (handler
))
2637 return call2 (handler
, Qfile_readable_p
, absname
);
2640 /* Under MS-DOS and Windows, open does not work for directories. */
2641 if (access (XSTRING (absname
)->data
, 0) == 0)
2644 #else /* not DOS_NT */
2646 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2647 /* Opening a fifo without O_NONBLOCK can wait.
2648 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2649 except in the case of a fifo, on a system which handles it. */
2650 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2653 if (S_ISFIFO (statbuf
.st_mode
))
2654 flags
|= O_NONBLOCK
;
2656 desc
= open (XSTRING (absname
)->data
, flags
);
2661 #endif /* not DOS_NT */
2664 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2666 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2667 "Return t if file FILENAME can be written or created by you.")
2669 Lisp_Object filename
;
2671 Lisp_Object absname
, dir
;
2672 Lisp_Object handler
;
2673 struct stat statbuf
;
2675 CHECK_STRING (filename
, 0);
2676 absname
= Fexpand_file_name (filename
, Qnil
);
2678 /* If the file name has special constructs in it,
2679 call the corresponding file handler. */
2680 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2681 if (!NILP (handler
))
2682 return call2 (handler
, Qfile_writable_p
, absname
);
2684 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2685 return (check_writable (XSTRING (absname
)->data
)
2687 dir
= Ffile_name_directory (absname
);
2690 dir
= Fdirectory_file_name (dir
);
2694 dir
= Fdirectory_file_name (dir
);
2696 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2700 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2701 "Access file FILENAME, and get an error if that does not work.\n\
2702 The second argument STRING is used in the error message.\n\
2703 If there is no error, we return nil.")
2705 Lisp_Object filename
, string
;
2707 Lisp_Object handler
;
2710 CHECK_STRING (filename
, 0);
2712 /* If the file name has special constructs in it,
2713 call the corresponding file handler. */
2714 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2715 if (!NILP (handler
))
2716 return call3 (handler
, Qaccess_file
, filename
, string
);
2718 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2720 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2726 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2727 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2728 The value is the name of the file to which it is linked.\n\
2729 Otherwise returns nil.")
2731 Lisp_Object filename
;
2738 Lisp_Object handler
;
2740 CHECK_STRING (filename
, 0);
2741 filename
= Fexpand_file_name (filename
, Qnil
);
2743 /* If the file name has special constructs in it,
2744 call the corresponding file handler. */
2745 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2746 if (!NILP (handler
))
2747 return call2 (handler
, Qfile_symlink_p
, filename
);
2752 buf
= (char *) xmalloc (bufsize
);
2753 bzero (buf
, bufsize
);
2754 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2755 if (valsize
< bufsize
) break;
2756 /* Buffer was not long enough */
2765 val
= make_string (buf
, valsize
);
2768 #else /* not S_IFLNK */
2770 #endif /* not S_IFLNK */
2773 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2774 "Return t if file FILENAME is the name of a directory as a file.\n\
2775 A directory name spec may be given instead; then the value is t\n\
2776 if the directory so specified exists and really is a directory.")
2778 Lisp_Object filename
;
2780 register Lisp_Object absname
;
2782 Lisp_Object handler
;
2784 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2786 /* If the file name has special constructs in it,
2787 call the corresponding file handler. */
2788 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2789 if (!NILP (handler
))
2790 return call2 (handler
, Qfile_directory_p
, absname
);
2792 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2794 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2797 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2798 "Return t if file FILENAME is the name of a directory as a file,\n\
2799 and files in that directory can be opened by you. In order to use a\n\
2800 directory as a buffer's current directory, this predicate must return true.\n\
2801 A directory name spec may be given instead; then the value is t\n\
2802 if the directory so specified exists and really is a readable and\n\
2803 searchable directory.")
2805 Lisp_Object filename
;
2807 Lisp_Object handler
;
2809 struct gcpro gcpro1
;
2811 /* If the file name has special constructs in it,
2812 call the corresponding file handler. */
2813 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2814 if (!NILP (handler
))
2815 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2817 /* It's an unlikely combination, but yes we really do need to gcpro:
2818 Suppose that file-accessible-directory-p has no handler, but
2819 file-directory-p does have a handler; this handler causes a GC which
2820 relocates the string in `filename'; and finally file-directory-p
2821 returns non-nil. Then we would end up passing a garbaged string
2822 to file-executable-p. */
2824 tem
= (NILP (Ffile_directory_p (filename
))
2825 || NILP (Ffile_executable_p (filename
)));
2827 return tem
? Qnil
: Qt
;
2830 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2831 "Return t if file FILENAME is the name of a regular file.\n\
2832 This is the sort of file that holds an ordinary stream of data bytes.")
2834 Lisp_Object filename
;
2836 register Lisp_Object absname
;
2838 Lisp_Object handler
;
2840 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2842 /* If the file name has special constructs in it,
2843 call the corresponding file handler. */
2844 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2845 if (!NILP (handler
))
2846 return call2 (handler
, Qfile_regular_p
, absname
);
2848 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2850 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2853 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2854 "Return mode bits of file named FILENAME, as an integer.")
2856 Lisp_Object filename
;
2858 Lisp_Object absname
;
2860 Lisp_Object handler
;
2862 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2864 /* If the file name has special constructs in it,
2865 call the corresponding file handler. */
2866 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2867 if (!NILP (handler
))
2868 return call2 (handler
, Qfile_modes
, absname
);
2870 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2872 #if defined (MSDOS) && __DJGPP__ < 2
2873 if (check_executable (XSTRING (absname
)->data
))
2874 st
.st_mode
|= S_IEXEC
;
2875 #endif /* MSDOS && __DJGPP__ < 2 */
2877 return make_number (st
.st_mode
& 07777);
2880 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2881 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2882 Only the 12 low bits of MODE are used.")
2884 Lisp_Object filename
, mode
;
2886 Lisp_Object absname
;
2887 Lisp_Object handler
;
2889 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2890 CHECK_NUMBER (mode
, 1);
2892 /* If the file name has special constructs in it,
2893 call the corresponding file handler. */
2894 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2895 if (!NILP (handler
))
2896 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2898 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2899 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2904 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2905 "Set the file permission bits for newly created files.\n\
2906 The argument MODE should be an integer; only the low 9 bits are used.\n\
2907 This setting is inherited by subprocesses.")
2911 CHECK_NUMBER (mode
, 0);
2913 umask ((~ XINT (mode
)) & 0777);
2918 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2919 "Return the default file protection for created files.\n\
2920 The value is an integer.")
2926 realmask
= umask (0);
2929 XSETINT (value
, (~ realmask
) & 0777);
2935 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2936 "Tell Unix to finish all pending disk updates.")
2945 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2946 "Return t if file FILE1 is newer than file FILE2.\n\
2947 If FILE1 does not exist, the answer is nil;\n\
2948 otherwise, if FILE2 does not exist, the answer is t.")
2950 Lisp_Object file1
, file2
;
2952 Lisp_Object absname1
, absname2
;
2955 Lisp_Object handler
;
2956 struct gcpro gcpro1
, gcpro2
;
2958 CHECK_STRING (file1
, 0);
2959 CHECK_STRING (file2
, 0);
2962 GCPRO2 (absname1
, file2
);
2963 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2964 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2967 /* If the file name has special constructs in it,
2968 call the corresponding file handler. */
2969 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2971 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2972 if (!NILP (handler
))
2973 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2975 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2978 mtime1
= st
.st_mtime
;
2980 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2983 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2987 Lisp_Object Qfind_buffer_file_type
;
2990 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2992 "Insert contents of file FILENAME after point.\n\
2993 Returns list of absolute file name and length of data inserted.\n\
2994 If second argument VISIT is non-nil, the buffer's visited filename\n\
2995 and last save file modtime are set, and it is marked unmodified.\n\
2996 If visiting and the file does not exist, visiting is completed\n\
2997 before the error is signaled.\n\n\
2998 The optional third and fourth arguments BEG and END\n\
2999 specify what portion of the file to insert.\n\
3000 If VISIT is non-nil, BEG and END must be nil.\n\
3002 If optional fifth argument REPLACE is non-nil,\n\
3003 it means replace the current buffer contents (in the accessible portion)\n\
3004 with the file contents. This is better than simply deleting and inserting\n\
3005 the whole thing because (1) it preserves some marker positions\n\
3006 and (2) it puts less data in the undo list.\n\
3007 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3008 which is often less than the number of characters to be read.")
3009 (filename
, visit
, beg
, end
, replace
)
3010 Lisp_Object filename
, visit
, beg
, end
, replace
;
3014 register int inserted
= 0;
3015 register int how_much
;
3016 int count
= specpdl_ptr
- specpdl
;
3017 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3018 Lisp_Object handler
, val
, insval
;
3021 int not_regular
= 0;
3023 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3024 error ("Cannot do file visiting in an indirect buffer");
3026 if (!NILP (current_buffer
->read_only
))
3027 Fbarf_if_buffer_read_only ();
3032 GCPRO3 (filename
, val
, p
);
3034 CHECK_STRING (filename
, 0);
3035 filename
= Fexpand_file_name (filename
, Qnil
);
3037 /* If the file name has special constructs in it,
3038 call the corresponding file handler. */
3039 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3040 if (!NILP (handler
))
3042 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3043 visit
, beg
, end
, replace
);
3050 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3052 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3053 || fstat (fd
, &st
) < 0)
3054 #endif /* not APOLLO */
3056 if (fd
>= 0) close (fd
);
3059 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3066 /* This code will need to be changed in order to work on named
3067 pipes, and it's probably just not worth it. So we should at
3068 least signal an error. */
3069 if (!S_ISREG (st
.st_mode
))
3072 Fsignal (Qfile_error
,
3073 Fcons (build_string ("not a regular file"),
3074 Fcons (filename
, Qnil
)));
3082 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3085 /* Replacement should preserve point as it preserves markers. */
3086 if (!NILP (replace
))
3087 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3089 record_unwind_protect (close_file_unwind
, make_number (fd
));
3091 /* Supposedly happens on VMS. */
3093 error ("File size is negative");
3095 if (!NILP (beg
) || !NILP (end
))
3097 error ("Attempt to visit less than an entire file");
3100 CHECK_NUMBER (beg
, 0);
3102 XSETFASTINT (beg
, 0);
3105 CHECK_NUMBER (end
, 0);
3108 XSETINT (end
, st
.st_size
);
3109 if (XINT (end
) != st
.st_size
)
3110 error ("maximum buffer size exceeded");
3113 /* If requested, replace the accessible part of the buffer
3114 with the file contents. Avoid replacing text at the
3115 beginning or end of the buffer that matches the file contents;
3116 that preserves markers pointing to the unchanged parts. */
3118 /* On MSDOS, replace mode doesn't really work, except for binary files,
3119 and it's not worth supporting just for them. */
3120 if (!NILP (replace
))
3123 del_range_1 (BEGV
, ZV
, 0);
3125 #else /* not DOS_NT */
3126 if (!NILP (replace
))
3128 unsigned char buffer
[1 << 14];
3129 int same_at_start
= BEGV
;
3130 int same_at_end
= ZV
;
3133 if (XINT (beg
) != 0)
3135 if (lseek (fd
, XINT (beg
), 0) < 0)
3136 report_file_error ("Setting file position",
3137 Fcons (filename
, Qnil
));
3142 /* Count how many chars at the start of the file
3143 match the text at the beginning of the buffer. */
3148 nread
= read (fd
, buffer
, sizeof buffer
);
3150 error ("IO error reading %s: %s",
3151 XSTRING (filename
)->data
, strerror (errno
));
3152 else if (nread
== 0)
3155 while (bufpos
< nread
&& same_at_start
< ZV
3156 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
3157 same_at_start
++, bufpos
++;
3158 /* If we found a discrepancy, stop the scan.
3159 Otherwise loop around and scan the next bufferful. */
3160 if (bufpos
!= nread
)
3164 /* If the file matches the buffer completely,
3165 there's no need to replace anything. */
3166 if (same_at_start
- BEGV
== XINT (end
))
3170 /* Truncate the buffer to the size of the file. */
3171 del_range_1 (same_at_start
, same_at_end
, 0);
3176 /* Count how many chars at the end of the file
3177 match the text at the end of the buffer. */
3180 int total_read
, nread
, bufpos
, curpos
, trial
;
3182 /* At what file position are we now scanning? */
3183 curpos
= XINT (end
) - (ZV
- same_at_end
);
3184 /* If the entire file matches the buffer tail, stop the scan. */
3187 /* How much can we scan in the next step? */
3188 trial
= min (curpos
, sizeof buffer
);
3189 if (lseek (fd
, curpos
- trial
, 0) < 0)
3190 report_file_error ("Setting file position",
3191 Fcons (filename
, Qnil
));
3194 while (total_read
< trial
)
3196 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3198 error ("IO error reading %s: %s",
3199 XSTRING (filename
)->data
, strerror (errno
));
3200 total_read
+= nread
;
3202 /* Scan this bufferful from the end, comparing with
3203 the Emacs buffer. */
3204 bufpos
= total_read
;
3205 /* Compare with same_at_start to avoid counting some buffer text
3206 as matching both at the file's beginning and at the end. */
3207 while (bufpos
> 0 && same_at_end
> same_at_start
3208 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
3209 same_at_end
--, bufpos
--;
3210 /* If we found a discrepancy, stop the scan.
3211 Otherwise loop around and scan the preceding bufferful. */
3214 /* If display current starts at beginning of line,
3215 keep it that way. */
3216 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3217 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3221 /* Don't try to reuse the same piece of text twice. */
3222 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3224 same_at_end
+= overlap
;
3226 /* Arrange to read only the nonmatching middle part of the file. */
3227 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3228 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3230 del_range_1 (same_at_start
, same_at_end
, 0);
3231 /* Insert from the file at the proper position. */
3232 SET_PT (same_at_start
);
3234 #endif /* not DOS_NT */
3236 total
= XINT (end
) - XINT (beg
);
3239 register Lisp_Object temp
;
3241 /* Make sure point-max won't overflow after this insertion. */
3242 XSETINT (temp
, total
);
3243 if (total
!= XINT (temp
))
3244 error ("maximum buffer size exceeded");
3247 if (NILP (visit
) && total
> 0)
3248 prepare_to_modify_buffer (PT
, PT
);
3251 if (GAP_SIZE
< total
)
3252 make_gap (total
- GAP_SIZE
);
3254 if (XINT (beg
) != 0 || !NILP (replace
))
3256 if (lseek (fd
, XINT (beg
), 0) < 0)
3257 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3261 while (inserted
< total
)
3263 /* try is reserved in some compilers (Microsoft C) */
3264 int trytry
= min (total
- inserted
, 64 << 10);
3267 /* Allow quitting out of the actual I/O. */
3270 this = read (fd
, &FETCH_CHAR (PT
+ inserted
- 1) + 1, trytry
);
3287 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3288 /* Determine file type from name and remove LFs from CR-LFs if the file
3289 is deemed to be a text file. */
3291 current_buffer
->buffer_file_type
3292 = call1 (Qfind_buffer_file_type
, filename
);
3293 if (NILP (current_buffer
->buffer_file_type
))
3296 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (PT
- 1) + 1);
3299 GPT
-= reduced_size
;
3300 GAP_SIZE
+= reduced_size
;
3301 inserted
-= reduced_size
;
3308 record_insert (PT
, inserted
);
3310 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3311 offset_intervals (current_buffer
, PT
, inserted
);
3317 /* Discard the unwind protect for closing the file. */
3321 error ("IO error reading %s: %s",
3322 XSTRING (filename
)->data
, strerror (errno
));
3329 if (!EQ (current_buffer
->undo_list
, Qt
))
3330 current_buffer
->undo_list
= Qnil
;
3332 stat (XSTRING (filename
)->data
, &st
);
3337 current_buffer
->modtime
= st
.st_mtime
;
3338 current_buffer
->filename
= filename
;
3341 SAVE_MODIFF
= MODIFF
;
3342 current_buffer
->auto_save_modified
= MODIFF
;
3343 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3344 #ifdef CLASH_DETECTION
3347 if (!NILP (current_buffer
->file_truename
))
3348 unlock_file (current_buffer
->file_truename
);
3349 unlock_file (filename
);
3351 #endif /* CLASH_DETECTION */
3353 Fsignal (Qfile_error
,
3354 Fcons (build_string ("not a regular file"),
3355 Fcons (filename
, Qnil
)));
3357 /* If visiting nonexistent file, return nil. */
3358 if (current_buffer
->modtime
== -1)
3359 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3362 /* Decode file format */
3365 insval
= call3 (Qformat_decode
,
3366 Qnil
, make_number (inserted
), visit
);
3367 CHECK_NUMBER (insval
, 0);
3368 inserted
= XFASTINT (insval
);
3371 if (inserted
> 0 && NILP (visit
) && total
> 0)
3372 signal_after_change (PT
, 0, inserted
);
3376 p
= Vafter_insert_file_functions
;
3379 insval
= call1 (Fcar (p
), make_number (inserted
));
3382 CHECK_NUMBER (insval
, 0);
3383 inserted
= XFASTINT (insval
);
3391 val
= Fcons (filename
,
3392 Fcons (make_number (inserted
),
3395 RETURN_UNGCPRO (unbind_to (count
, val
));
3398 static Lisp_Object
build_annotations ();
3400 /* If build_annotations switched buffers, switch back to BUF.
3401 Kill the temporary buffer that was selected in the meantime. */
3404 build_annotations_unwind (buf
)
3409 if (XBUFFER (buf
) == current_buffer
)
3411 tembuf
= Fcurrent_buffer ();
3413 Fkill_buffer (tembuf
);
3417 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3418 "r\nFWrite region to file: ",
3419 "Write current region into specified file.\n\
3420 When called from a program, takes three arguments:\n\
3421 START, END and FILENAME. START and END are buffer positions.\n\
3422 Optional fourth argument APPEND if non-nil means\n\
3423 append to existing file contents (if any).\n\
3424 Optional fifth argument VISIT if t means\n\
3425 set the last-save-file-modtime of buffer to this file's modtime\n\
3426 and mark buffer not modified.\n\
3427 If VISIT is a string, it is a second file name;\n\
3428 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3429 VISIT is also the file name to lock and unlock for clash detection.\n\
3430 If VISIT is neither t nor nil nor a string,\n\
3431 that means do not print the \"Wrote file\" message.\n\
3432 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3433 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3434 Kludgy feature: if START is a string, then that string is written\n\
3435 to the file, instead of any buffer contents, and END is ignored.")
3436 (start
, end
, filename
, append
, visit
, lockname
)
3437 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3445 int count
= specpdl_ptr
- specpdl
;
3448 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3450 Lisp_Object handler
;
3451 Lisp_Object visit_file
;
3452 Lisp_Object annotations
;
3453 int visiting
, quietly
;
3454 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3455 struct buffer
*given_buffer
;
3457 int buffer_file_type
3458 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3461 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3462 error ("Cannot do file visiting in an indirect buffer");
3464 if (!NILP (start
) && !STRINGP (start
))
3465 validate_region (&start
, &end
);
3467 GCPRO3 (filename
, visit
, lockname
);
3468 filename
= Fexpand_file_name (filename
, Qnil
);
3469 if (STRINGP (visit
))
3470 visit_file
= Fexpand_file_name (visit
, Qnil
);
3472 visit_file
= filename
;
3475 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3476 quietly
= !NILP (visit
);
3480 if (NILP (lockname
))
3481 lockname
= visit_file
;
3483 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3485 /* If the file name has special constructs in it,
3486 call the corresponding file handler. */
3487 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3488 /* If FILENAME has no handler, see if VISIT has one. */
3489 if (NILP (handler
) && STRINGP (visit
))
3490 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3492 if (!NILP (handler
))
3495 val
= call6 (handler
, Qwrite_region
, start
, end
,
3496 filename
, append
, visit
);
3500 SAVE_MODIFF
= MODIFF
;
3501 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3502 current_buffer
->filename
= visit_file
;
3508 /* Special kludge to simplify auto-saving. */
3511 XSETFASTINT (start
, BEG
);
3512 XSETFASTINT (end
, Z
);
3515 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3516 count1
= specpdl_ptr
- specpdl
;
3518 given_buffer
= current_buffer
;
3519 annotations
= build_annotations (start
, end
);
3520 if (current_buffer
!= given_buffer
)
3526 #ifdef CLASH_DETECTION
3529 /* If we've locked this file for some other buffer,
3530 query before proceeding. */
3531 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3532 call2 (intern ("ask-user-about-lock"), fn
, Vuser_login_name
);
3534 lock_file (lockname
);
3536 #endif /* CLASH_DETECTION */
3538 fn
= XSTRING (filename
)->data
;
3542 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3543 #else /* not DOS_NT */
3544 desc
= open (fn
, O_WRONLY
);
3545 #endif /* not DOS_NT */
3547 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
3549 if (auto_saving
) /* Overwrite any previous version of autosave file */
3551 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3552 desc
= open (fn
, O_RDWR
);
3554 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3555 ? XSTRING (current_buffer
->filename
)->data
: 0,
3558 else /* Write to temporary name and rename if no errors */
3560 Lisp_Object temp_name
;
3561 temp_name
= Ffile_name_directory (filename
);
3563 if (!NILP (temp_name
))
3565 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3566 build_string ("$$SAVE$$")));
3567 fname
= XSTRING (filename
)->data
;
3568 fn
= XSTRING (temp_name
)->data
;
3569 desc
= creat_copy_attrs (fname
, fn
);
3572 /* If we can't open the temporary file, try creating a new
3573 version of the original file. VMS "creat" creates a
3574 new version rather than truncating an existing file. */
3577 desc
= creat (fn
, 0666);
3578 #if 0 /* This can clobber an existing file and fail to replace it,
3579 if the user runs out of space. */
3582 /* We can't make a new version;
3583 try to truncate and rewrite existing version if any. */
3585 desc
= open (fn
, O_RDWR
);
3591 desc
= creat (fn
, 0666);
3596 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3597 S_IREAD
| S_IWRITE
);
3598 #else /* not DOS_NT */
3599 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3600 #endif /* not DOS_NT */
3601 #endif /* not VMS */
3607 #ifdef CLASH_DETECTION
3609 if (!auto_saving
) unlock_file (lockname
);
3611 #endif /* CLASH_DETECTION */
3612 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3615 record_unwind_protect (close_file_unwind
, make_number (desc
));
3618 if (lseek (desc
, 0, 2) < 0)
3620 #ifdef CLASH_DETECTION
3621 if (!auto_saving
) unlock_file (lockname
);
3622 #endif /* CLASH_DETECTION */
3623 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3628 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3629 * if we do writes that don't end with a carriage return. Furthermore
3630 * it cannot handle writes of more then 16K. The modified
3631 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3632 * this EXCEPT for the last record (iff it doesn't end with a carriage
3633 * return). This implies that if your buffer doesn't end with a carriage
3634 * return, you get one free... tough. However it also means that if
3635 * we make two calls to sys_write (a la the following code) you can
3636 * get one at the gap as well. The easiest way to fix this (honest)
3637 * is to move the gap to the next newline (or the end of the buffer).
3642 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3643 move_gap (find_next_newline (GPT
, 1));
3649 if (STRINGP (start
))
3651 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3652 XSTRING (start
)->size
, 0, &annotations
);
3655 else if (XINT (start
) != XINT (end
))
3658 if (XINT (start
) < GPT
)
3660 register int end1
= XINT (end
);
3662 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3663 min (GPT
, end1
) - tem
, tem
, &annotations
);
3664 nwritten
+= min (GPT
, end1
) - tem
;
3668 if (XINT (end
) > GPT
&& !failure
)
3671 tem
= max (tem
, GPT
);
3672 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3674 nwritten
+= XINT (end
) - tem
;
3680 /* If file was empty, still need to write the annotations */
3681 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3688 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3689 Disk full in NFS may be reported here. */
3690 /* mib says that closing the file will try to write as fast as NFS can do
3691 it, and that means the fsync here is not crucial for autosave files. */
3692 if (!auto_saving
&& fsync (desc
) < 0)
3694 /* If fsync fails with EINTR, don't treat that as serious. */
3696 failure
= 1, save_errno
= errno
;
3700 /* Spurious "file has changed on disk" warnings have been
3701 observed on Suns as well.
3702 It seems that `close' can change the modtime, under nfs.
3704 (This has supposedly been fixed in Sunos 4,
3705 but who knows about all the other machines with NFS?) */
3708 /* On VMS and APOLLO, must do the stat after the close
3709 since closing changes the modtime. */
3712 /* Recall that #if defined does not work on VMS. */
3719 /* NFS can report a write failure now. */
3720 if (close (desc
) < 0)
3721 failure
= 1, save_errno
= errno
;
3724 /* If we wrote to a temporary name and had no errors, rename to real name. */
3728 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3736 /* Discard the unwind protect for close_file_unwind. */
3737 specpdl_ptr
= specpdl
+ count1
;
3738 /* Restore the original current buffer. */
3739 visit_file
= unbind_to (count
, visit_file
);
3741 #ifdef CLASH_DETECTION
3743 unlock_file (lockname
);
3744 #endif /* CLASH_DETECTION */
3746 /* Do this before reporting IO error
3747 to avoid a "file has changed on disk" warning on
3748 next attempt to save. */
3750 current_buffer
->modtime
= st
.st_mtime
;
3753 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3757 SAVE_MODIFF
= MODIFF
;
3758 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3759 current_buffer
->filename
= visit_file
;
3760 update_mode_lines
++;
3766 message ("Wrote %s", XSTRING (visit_file
)->data
);
3771 Lisp_Object
merge ();
3773 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3774 "Return t if (car A) is numerically less than (car B).")
3778 return Flss (Fcar (a
), Fcar (b
));
3781 /* Build the complete list of annotations appropriate for writing out
3782 the text between START and END, by calling all the functions in
3783 write-region-annotate-functions and merging the lists they return.
3784 If one of these functions switches to a different buffer, we assume
3785 that buffer contains altered text. Therefore, the caller must
3786 make sure to restore the current buffer in all cases,
3787 as save-excursion would do. */
3790 build_annotations (start
, end
)
3791 Lisp_Object start
, end
;
3793 Lisp_Object annotations
;
3795 struct gcpro gcpro1
, gcpro2
;
3796 Lisp_Object original_buffer
;
3798 XSETBUFFER (original_buffer
, current_buffer
);
3801 p
= Vwrite_region_annotate_functions
;
3802 GCPRO2 (annotations
, p
);
3805 struct buffer
*given_buffer
= current_buffer
;
3806 Vwrite_region_annotations_so_far
= annotations
;
3807 res
= call2 (Fcar (p
), start
, end
);
3808 /* If the function makes a different buffer current,
3809 assume that means this buffer contains altered text to be output.
3810 Reset START and END from the buffer bounds
3811 and discard all previous annotations because they should have
3812 been dealt with by this function. */
3813 if (current_buffer
!= given_buffer
)
3819 Flength (res
); /* Check basic validity of return value */
3820 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3824 /* Now do the same for annotation functions implied by the file-format */
3825 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3826 p
= Vauto_save_file_format
;
3828 p
= current_buffer
->file_format
;
3831 struct buffer
*given_buffer
= current_buffer
;
3832 Vwrite_region_annotations_so_far
= annotations
;
3833 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
3835 if (current_buffer
!= given_buffer
)
3842 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3849 /* Write to descriptor DESC the LEN characters starting at ADDR,
3850 assuming they start at position POS in the buffer.
3851 Intersperse with them the annotations from *ANNOT
3852 (those which fall within the range of positions POS to POS + LEN),
3853 each at its appropriate position.
3855 Modify *ANNOT by discarding elements as we output them.
3856 The return value is negative in case of system call failure. */
3859 a_write (desc
, addr
, len
, pos
, annot
)
3861 register char *addr
;
3868 int lastpos
= pos
+ len
;
3870 while (NILP (*annot
) || CONSP (*annot
))
3872 tem
= Fcar_safe (Fcar (*annot
));
3873 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3874 nextpos
= XFASTINT (tem
);
3876 return e_write (desc
, addr
, lastpos
- pos
);
3879 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3881 addr
+= nextpos
- pos
;
3884 tem
= Fcdr (Fcar (*annot
));
3887 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3890 *annot
= Fcdr (*annot
);
3895 e_write (desc
, addr
, len
)
3897 register char *addr
;
3900 char buf
[16 * 1024];
3901 register char *p
, *end
;
3903 if (!EQ (current_buffer
->selective_display
, Qt
))
3904 return write (desc
, addr
, len
) - len
;
3908 end
= p
+ sizeof buf
;
3913 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3922 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3928 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3929 Sverify_visited_file_modtime
, 1, 1, 0,
3930 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3931 This means that the file has not been changed since it was visited or saved.")
3937 Lisp_Object handler
;
3939 CHECK_BUFFER (buf
, 0);
3942 if (!STRINGP (b
->filename
)) return Qt
;
3943 if (b
->modtime
== 0) return Qt
;
3945 /* If the file name has special constructs in it,
3946 call the corresponding file handler. */
3947 handler
= Ffind_file_name_handler (b
->filename
,
3948 Qverify_visited_file_modtime
);
3949 if (!NILP (handler
))
3950 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3952 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3954 /* If the file doesn't exist now and didn't exist before,
3955 we say that it isn't modified, provided the error is a tame one. */
3956 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3961 if (st
.st_mtime
== b
->modtime
3962 /* If both are positive, accept them if they are off by one second. */
3963 || (st
.st_mtime
> 0 && b
->modtime
> 0
3964 && (st
.st_mtime
== b
->modtime
+ 1
3965 || st
.st_mtime
== b
->modtime
- 1)))
3970 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3971 Sclear_visited_file_modtime
, 0, 0, 0,
3972 "Clear out records of last mod time of visited file.\n\
3973 Next attempt to save will certainly not complain of a discrepancy.")
3976 current_buffer
->modtime
= 0;
3980 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3981 Svisited_file_modtime
, 0, 0, 0,
3982 "Return the current buffer's recorded visited file modification time.\n\
3983 The value is a list of the form (HIGH . LOW), like the time values\n\
3984 that `file-attributes' returns.")
3987 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3990 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3991 Sset_visited_file_modtime
, 0, 1, 0,
3992 "Update buffer's recorded modification time from the visited file's time.\n\
3993 Useful if the buffer was not read from the file normally\n\
3994 or if the file itself has been changed for some known benign reason.\n\
3995 An argument specifies the modification time value to use\n\
3996 \(instead of that of the visited file), in the form of a list\n\
3997 \(HIGH . LOW) or (HIGH LOW).")
3999 Lisp_Object time_list
;
4001 if (!NILP (time_list
))
4002 current_buffer
->modtime
= cons_to_long (time_list
);
4005 register Lisp_Object filename
;
4007 Lisp_Object handler
;
4009 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4011 /* If the file name has special constructs in it,
4012 call the corresponding file handler. */
4013 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4014 if (!NILP (handler
))
4015 /* The handler can find the file name the same way we did. */
4016 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4017 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4018 current_buffer
->modtime
= st
.st_mtime
;
4028 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4029 Fsleep_for (make_number (1), Qnil
);
4030 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4031 Fsleep_for (make_number (1), Qnil
);
4032 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4033 Fsleep_for (make_number (1), Qnil
);
4043 /* Get visited file's mode to become the auto save file's mode. */
4044 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4045 /* But make sure we can overwrite it later! */
4046 auto_save_mode_bits
= st
.st_mode
| 0600;
4048 auto_save_mode_bits
= 0666;
4051 Fwrite_region (Qnil
, Qnil
,
4052 current_buffer
->auto_save_file_name
,
4053 Qnil
, Qlambda
, Qnil
);
4057 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4061 if (XINT (desc
) >= 0)
4062 close (XINT (desc
));
4066 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4067 "Auto-save all buffers that need it.\n\
4068 This is all buffers that have auto-saving enabled\n\
4069 and are changed since last auto-saved.\n\
4070 Auto-saving writes the buffer into a file\n\
4071 so that your editing is not lost if the system crashes.\n\
4072 This file is not the file you visited; that changes only when you save.\n\
4073 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4074 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4075 A non-nil CURRENT-ONLY argument means save only current buffer.")
4076 (no_message
, current_only
)
4077 Lisp_Object no_message
, current_only
;
4079 struct buffer
*old
= current_buffer
, *b
;
4080 Lisp_Object tail
, buf
;
4082 char *omessage
= echo_area_glyphs
;
4083 int omessage_length
= echo_area_glyphs_length
;
4084 int do_handled_files
;
4087 int count
= specpdl_ptr
- specpdl
;
4090 /* Ordinarily don't quit within this function,
4091 but don't make it impossible to quit (in case we get hung in I/O). */
4095 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4096 point to non-strings reached from Vbuffer_alist. */
4101 if (!NILP (Vrun_hooks
))
4102 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4104 if (STRINGP (Vauto_save_list_file_name
))
4106 Lisp_Object listfile
;
4107 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4109 listdesc
= open (XSTRING (listfile
)->data
,
4110 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4111 S_IREAD
| S_IWRITE
);
4112 #else /* not DOS_NT */
4113 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4114 #endif /* not DOS_NT */
4119 /* Arrange to close that file whether or not we get an error.
4120 Also reset auto_saving to 0. */
4121 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4125 /* First, save all files which don't have handlers. If Emacs is
4126 crashing, the handlers may tweak what is causing Emacs to crash
4127 in the first place, and it would be a shame if Emacs failed to
4128 autosave perfectly ordinary files because it couldn't handle some
4130 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4131 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4133 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4136 /* Record all the buffers that have auto save mode
4137 in the special file that lists them. For each of these buffers,
4138 Record visited name (if any) and auto save name. */
4139 if (STRINGP (b
->auto_save_file_name
)
4140 && listdesc
>= 0 && do_handled_files
== 0)
4142 if (!NILP (b
->filename
))
4144 write (listdesc
, XSTRING (b
->filename
)->data
,
4145 XSTRING (b
->filename
)->size
);
4147 write (listdesc
, "\n", 1);
4148 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4149 XSTRING (b
->auto_save_file_name
)->size
);
4150 write (listdesc
, "\n", 1);
4153 if (!NILP (current_only
)
4154 && b
!= current_buffer
)
4157 /* Don't auto-save indirect buffers.
4158 The base buffer takes care of it. */
4162 /* Check for auto save enabled
4163 and file changed since last auto save
4164 and file changed since last real save. */
4165 if (STRINGP (b
->auto_save_file_name
)
4166 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4167 && b
->auto_save_modified
< BUF_MODIFF (b
)
4168 /* -1 means we've turned off autosaving for a while--see below. */
4169 && XINT (b
->save_length
) >= 0
4170 && (do_handled_files
4171 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4174 EMACS_TIME before_time
, after_time
;
4176 EMACS_GET_TIME (before_time
);
4178 /* If we had a failure, don't try again for 20 minutes. */
4179 if (b
->auto_save_failure_time
>= 0
4180 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4183 if ((XFASTINT (b
->save_length
) * 10
4184 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4185 /* A short file is likely to change a large fraction;
4186 spare the user annoying messages. */
4187 && XFASTINT (b
->save_length
) > 5000
4188 /* These messages are frequent and annoying for `*mail*'. */
4189 && !EQ (b
->filename
, Qnil
)
4190 && NILP (no_message
))
4192 /* It has shrunk too much; turn off auto-saving here. */
4193 message ("Buffer %s has shrunk a lot; auto save turned off there",
4194 XSTRING (b
->name
)->data
);
4195 /* Turn off auto-saving until there's a real save,
4196 and prevent any more warnings. */
4197 XSETINT (b
->save_length
, -1);
4198 Fsleep_for (make_number (1), Qnil
);
4201 set_buffer_internal (b
);
4202 if (!auto_saved
&& NILP (no_message
))
4203 message1 ("Auto-saving...");
4204 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4206 b
->auto_save_modified
= BUF_MODIFF (b
);
4207 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4208 set_buffer_internal (old
);
4210 EMACS_GET_TIME (after_time
);
4212 /* If auto-save took more than 60 seconds,
4213 assume it was an NFS failure that got a timeout. */
4214 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4215 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4219 /* Prevent another auto save till enough input events come in. */
4220 record_auto_save ();
4222 if (auto_saved
&& NILP (no_message
))
4226 sit_for (1, 0, 0, 0);
4227 message2 (omessage
, omessage_length
);
4230 message1 ("Auto-saving...done");
4235 unbind_to (count
, Qnil
);
4239 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4240 Sset_buffer_auto_saved
, 0, 0, 0,
4241 "Mark current buffer as auto-saved with its current text.\n\
4242 No auto-save file will be written until the buffer changes again.")
4245 current_buffer
->auto_save_modified
= MODIFF
;
4246 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4247 current_buffer
->auto_save_failure_time
= -1;
4251 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4252 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4253 "Clear any record of a recent auto-save failure in the current buffer.")
4256 current_buffer
->auto_save_failure_time
= -1;
4260 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4262 "Return t if buffer has been auto-saved since last read in or saved.")
4265 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4268 /* Reading and completing file names */
4269 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4271 /* In the string VAL, change each $ to $$ and return the result. */
4274 double_dollars (val
)
4277 register unsigned char *old
, *new;
4281 osize
= XSTRING (val
)->size
;
4282 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4283 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4284 if (*old
++ == '$') count
++;
4287 old
= XSTRING (val
)->data
;
4288 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4289 new = XSTRING (val
)->data
;
4290 for (n
= osize
; n
> 0; n
--)
4303 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4305 "Internal subroutine for read-file-name. Do not call this.")
4306 (string
, dir
, action
)
4307 Lisp_Object string
, dir
, action
;
4308 /* action is nil for complete, t for return list of completions,
4309 lambda for verify final value */
4311 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4313 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4315 CHECK_STRING (string
, 0);
4322 /* No need to protect ACTION--we only compare it with t and nil. */
4323 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4325 if (XSTRING (string
)->size
== 0)
4327 if (EQ (action
, Qlambda
))
4335 orig_string
= string
;
4336 string
= Fsubstitute_in_file_name (string
);
4337 changed
= NILP (Fstring_equal (string
, orig_string
));
4338 name
= Ffile_name_nondirectory (string
);
4339 val
= Ffile_name_directory (string
);
4341 realdir
= Fexpand_file_name (val
, realdir
);
4346 specdir
= Ffile_name_directory (string
);
4347 val
= Ffile_name_completion (name
, realdir
);
4352 return double_dollars (string
);
4356 if (!NILP (specdir
))
4357 val
= concat2 (specdir
, val
);
4359 return double_dollars (val
);
4362 #endif /* not VMS */
4366 if (EQ (action
, Qt
))
4367 return Ffile_name_all_completions (name
, realdir
);
4368 /* Only other case actually used is ACTION = lambda */
4370 /* Supposedly this helps commands such as `cd' that read directory names,
4371 but can someone explain how it helps them? -- RMS */
4372 if (XSTRING (name
)->size
== 0)
4375 return Ffile_exists_p (string
);
4378 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4379 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4380 Value is not expanded---you must call `expand-file-name' yourself.\n\
4381 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4382 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4383 except that if INITIAL is specified, that combined with DIR is used.)\n\
4384 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4385 Non-nil and non-t means also require confirmation after completion.\n\
4386 Fifth arg INITIAL specifies text to start with.\n\
4387 DIR defaults to current buffer's directory default.")
4388 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4389 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4391 Lisp_Object val
, insdef
, insdef1
, tem
;
4392 struct gcpro gcpro1
, gcpro2
;
4393 register char *homedir
;
4397 dir
= current_buffer
->directory
;
4398 if (NILP (default_filename
))
4400 if (! NILP (initial
))
4401 default_filename
= Fexpand_file_name (initial
, dir
);
4403 default_filename
= current_buffer
->filename
;
4406 /* If dir starts with user's homedir, change that to ~. */
4407 homedir
= (char *) egetenv ("HOME");
4409 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4410 CORRECT_DIR_SEPS (homedir
);
4414 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4415 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4417 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4418 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4419 XSTRING (dir
)->data
[0] = '~';
4422 if (insert_default_directory
&& STRINGP (dir
))
4425 if (!NILP (initial
))
4427 Lisp_Object args
[2], pos
;
4431 insdef
= Fconcat (2, args
);
4432 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4433 insdef1
= Fcons (double_dollars (insdef
), pos
);
4436 insdef1
= double_dollars (insdef
);
4438 else if (STRINGP (initial
))
4441 insdef1
= Fcons (double_dollars (insdef
), 0);
4444 insdef
= Qnil
, insdef1
= Qnil
;
4447 count
= specpdl_ptr
- specpdl
;
4448 specbind (intern ("completion-ignore-case"), Qt
);
4451 GCPRO2 (insdef
, default_filename
);
4452 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4453 dir
, mustmatch
, insdef1
,
4454 Qfile_name_history
);
4457 unbind_to (count
, Qnil
);
4462 error ("No file name specified");
4463 tem
= Fstring_equal (val
, insdef
);
4464 if (!NILP (tem
) && !NILP (default_filename
))
4465 return default_filename
;
4466 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4468 if (!NILP (default_filename
))
4469 return default_filename
;
4471 error ("No default file name");
4473 return Fsubstitute_in_file_name (val
);
4476 #if 0 /* Old version */
4477 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4478 /* Don't confuse make-docfile by having two doc strings for this function.
4479 make-docfile does not pay attention to #if, for good reason! */
4481 (prompt
, dir
, defalt
, mustmatch
, initial
)
4482 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4484 Lisp_Object val
, insdef
, tem
;
4485 struct gcpro gcpro1
, gcpro2
;
4486 register char *homedir
;
4490 dir
= current_buffer
->directory
;
4492 defalt
= current_buffer
->filename
;
4494 /* If dir starts with user's homedir, change that to ~. */
4495 homedir
= (char *) egetenv ("HOME");
4498 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4499 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4501 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4502 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4503 XSTRING (dir
)->data
[0] = '~';
4506 if (!NILP (initial
))
4508 else if (insert_default_directory
)
4511 insdef
= build_string ("");
4514 count
= specpdl_ptr
- specpdl
;
4515 specbind (intern ("completion-ignore-case"), Qt
);
4518 GCPRO2 (insdef
, defalt
);
4519 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4521 insert_default_directory
? insdef
: Qnil
,
4522 Qfile_name_history
);
4525 unbind_to (count
, Qnil
);
4530 error ("No file name specified");
4531 tem
= Fstring_equal (val
, insdef
);
4532 if (!NILP (tem
) && !NILP (defalt
))
4534 return Fsubstitute_in_file_name (val
);
4536 #endif /* Old version */
4540 Qexpand_file_name
= intern ("expand-file-name");
4541 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4542 Qdirectory_file_name
= intern ("directory-file-name");
4543 Qfile_name_directory
= intern ("file-name-directory");
4544 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4545 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4546 Qfile_name_as_directory
= intern ("file-name-as-directory");
4547 Qcopy_file
= intern ("copy-file");
4548 Qmake_directory_internal
= intern ("make-directory-internal");
4549 Qdelete_directory
= intern ("delete-directory");
4550 Qdelete_file
= intern ("delete-file");
4551 Qrename_file
= intern ("rename-file");
4552 Qadd_name_to_file
= intern ("add-name-to-file");
4553 Qmake_symbolic_link
= intern ("make-symbolic-link");
4554 Qfile_exists_p
= intern ("file-exists-p");
4555 Qfile_executable_p
= intern ("file-executable-p");
4556 Qfile_readable_p
= intern ("file-readable-p");
4557 Qfile_writable_p
= intern ("file-writable-p");
4558 Qfile_symlink_p
= intern ("file-symlink-p");
4559 Qaccess_file
= intern ("access-file");
4560 Qfile_directory_p
= intern ("file-directory-p");
4561 Qfile_regular_p
= intern ("file-regular-p");
4562 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4563 Qfile_modes
= intern ("file-modes");
4564 Qset_file_modes
= intern ("set-file-modes");
4565 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4566 Qinsert_file_contents
= intern ("insert-file-contents");
4567 Qwrite_region
= intern ("write-region");
4568 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4569 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4571 staticpro (&Qexpand_file_name
);
4572 staticpro (&Qsubstitute_in_file_name
);
4573 staticpro (&Qdirectory_file_name
);
4574 staticpro (&Qfile_name_directory
);
4575 staticpro (&Qfile_name_nondirectory
);
4576 staticpro (&Qunhandled_file_name_directory
);
4577 staticpro (&Qfile_name_as_directory
);
4578 staticpro (&Qcopy_file
);
4579 staticpro (&Qmake_directory_internal
);
4580 staticpro (&Qdelete_directory
);
4581 staticpro (&Qdelete_file
);
4582 staticpro (&Qrename_file
);
4583 staticpro (&Qadd_name_to_file
);
4584 staticpro (&Qmake_symbolic_link
);
4585 staticpro (&Qfile_exists_p
);
4586 staticpro (&Qfile_executable_p
);
4587 staticpro (&Qfile_readable_p
);
4588 staticpro (&Qfile_writable_p
);
4589 staticpro (&Qaccess_file
);
4590 staticpro (&Qfile_symlink_p
);
4591 staticpro (&Qfile_directory_p
);
4592 staticpro (&Qfile_regular_p
);
4593 staticpro (&Qfile_accessible_directory_p
);
4594 staticpro (&Qfile_modes
);
4595 staticpro (&Qset_file_modes
);
4596 staticpro (&Qfile_newer_than_file_p
);
4597 staticpro (&Qinsert_file_contents
);
4598 staticpro (&Qwrite_region
);
4599 staticpro (&Qverify_visited_file_modtime
);
4600 staticpro (&Qset_visited_file_modtime
);
4602 Qfile_name_history
= intern ("file-name-history");
4603 Fset (Qfile_name_history
, Qnil
);
4604 staticpro (&Qfile_name_history
);
4606 Qfile_error
= intern ("file-error");
4607 staticpro (&Qfile_error
);
4608 Qfile_already_exists
= intern ("file-already-exists");
4609 staticpro (&Qfile_already_exists
);
4612 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4613 staticpro (&Qfind_buffer_file_type
);
4616 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4617 "*Format in which to write auto-save files.\n\
4618 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4619 If it is t, which is the default, auto-save files are written in the\n\
4620 same format as a regular save would use.");
4621 Vauto_save_file_format
= Qt
;
4623 Qformat_decode
= intern ("format-decode");
4624 staticpro (&Qformat_decode
);
4625 Qformat_annotate_function
= intern ("format-annotate-function");
4626 staticpro (&Qformat_annotate_function
);
4628 Qcar_less_than_car
= intern ("car-less-than-car");
4629 staticpro (&Qcar_less_than_car
);
4631 Fput (Qfile_error
, Qerror_conditions
,
4632 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4633 Fput (Qfile_error
, Qerror_message
,
4634 build_string ("File error"));
4636 Fput (Qfile_already_exists
, Qerror_conditions
,
4637 Fcons (Qfile_already_exists
,
4638 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4639 Fput (Qfile_already_exists
, Qerror_message
,
4640 build_string ("File already exists"));
4642 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4643 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4644 insert_default_directory
= 1;
4646 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4647 "*Non-nil means write new files with record format `stmlf'.\n\
4648 nil means use format `var'. This variable is meaningful only on VMS.");
4649 vms_stmlf_recfm
= 0;
4651 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
4652 "Directory separator character for built-in functions that return file names.\n\
4653 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
4654 This variable affects the built-in functions only on Windows,\n\
4655 on other platforms, it is initialized so that Lisp code can find out\n\
4656 what the normal separator is.");
4657 Vdirectory_sep_char
= '/';
4659 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4660 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4661 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4664 The first argument given to HANDLER is the name of the I/O primitive\n\
4665 to be handled; the remaining arguments are the arguments that were\n\
4666 passed to that primitive. For example, if you do\n\
4667 (file-exists-p FILENAME)\n\
4668 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4669 (funcall HANDLER 'file-exists-p FILENAME)\n\
4670 The function `find-file-name-handler' checks this list for a handler\n\
4671 for its argument.");
4672 Vfile_name_handler_alist
= Qnil
;
4674 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4675 "A list of functions to be called at the end of `insert-file-contents'.\n\
4676 Each is passed one argument, the number of bytes inserted. It should return\n\
4677 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4678 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4679 responsible for calling the after-insert-file-functions if appropriate.");
4680 Vafter_insert_file_functions
= Qnil
;
4682 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4683 "A list of functions to be called at the start of `write-region'.\n\
4684 Each is passed two arguments, START and END as for `write-region'.\n\
4685 These are usually two numbers but not always; see the documentation\n\
4686 for `write-region'. The function should return a list of pairs\n\
4687 of the form (POSITION . STRING), consisting of strings to be effectively\n\
4688 inserted at the specified positions of the file being written (1 means to\n\
4689 insert before the first byte written). The POSITIONs must be sorted into\n\
4690 increasing order. If there are several functions in the list, the several\n\
4691 lists are merged destructively.");
4692 Vwrite_region_annotate_functions
= Qnil
;
4694 DEFVAR_LISP ("write-region-annotations-so-far",
4695 &Vwrite_region_annotations_so_far
,
4696 "When an annotation function is called, this holds the previous annotations.\n\
4697 These are the annotations made by other annotation functions\n\
4698 that were already called. See also `write-region-annotate-functions'.");
4699 Vwrite_region_annotations_so_far
= Qnil
;
4701 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4702 "A list of file name handlers that temporarily should not be used.\n\
4703 This applies only to the operation `inhibit-file-name-operation'.");
4704 Vinhibit_file_name_handlers
= Qnil
;
4706 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4707 "The operation for which `inhibit-file-name-handlers' is applicable.");
4708 Vinhibit_file_name_operation
= Qnil
;
4710 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4711 "File name in which we write a list of all auto save file names.\n\
4712 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4713 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4715 Vauto_save_list_file_name
= Qnil
;
4717 defsubr (&Sfind_file_name_handler
);
4718 defsubr (&Sfile_name_directory
);
4719 defsubr (&Sfile_name_nondirectory
);
4720 defsubr (&Sunhandled_file_name_directory
);
4721 defsubr (&Sfile_name_as_directory
);
4722 defsubr (&Sdirectory_file_name
);
4723 defsubr (&Smake_temp_name
);
4724 defsubr (&Sexpand_file_name
);
4725 defsubr (&Ssubstitute_in_file_name
);
4726 defsubr (&Scopy_file
);
4727 defsubr (&Smake_directory_internal
);
4728 defsubr (&Sdelete_directory
);
4729 defsubr (&Sdelete_file
);
4730 defsubr (&Srename_file
);
4731 defsubr (&Sadd_name_to_file
);
4733 defsubr (&Smake_symbolic_link
);
4734 #endif /* S_IFLNK */
4736 defsubr (&Sdefine_logical_name
);
4739 defsubr (&Ssysnetunam
);
4740 #endif /* HPUX_NET */
4741 defsubr (&Sfile_name_absolute_p
);
4742 defsubr (&Sfile_exists_p
);
4743 defsubr (&Sfile_executable_p
);
4744 defsubr (&Sfile_readable_p
);
4745 defsubr (&Sfile_writable_p
);
4746 defsubr (&Saccess_file
);
4747 defsubr (&Sfile_symlink_p
);
4748 defsubr (&Sfile_directory_p
);
4749 defsubr (&Sfile_accessible_directory_p
);
4750 defsubr (&Sfile_regular_p
);
4751 defsubr (&Sfile_modes
);
4752 defsubr (&Sset_file_modes
);
4753 defsubr (&Sset_default_file_modes
);
4754 defsubr (&Sdefault_file_modes
);
4755 defsubr (&Sfile_newer_than_file_p
);
4756 defsubr (&Sinsert_file_contents
);
4757 defsubr (&Swrite_region
);
4758 defsubr (&Scar_less_than_car
);
4759 defsubr (&Sverify_visited_file_modtime
);
4760 defsubr (&Sclear_visited_file_modtime
);
4761 defsubr (&Svisited_file_modtime
);
4762 defsubr (&Sset_visited_file_modtime
);
4763 defsubr (&Sdo_auto_save
);
4764 defsubr (&Sset_buffer_auto_saved
);
4765 defsubr (&Sclear_buffer_auto_save_failure
);
4766 defsubr (&Srecent_auto_save_p
);
4768 defsubr (&Sread_file_name_internal
);
4769 defsubr (&Sread_file_name
);
4772 defsubr (&Sunix_sync
);