19 |
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
20 |
Boston, MA 02111-1307, USA. */ |
Boston, MA 02111-1307, USA. */ |
21 |
|
|
|
#define _GNU_SOURCE /* for euidaccess */ |
|
|
|
|
22 |
#include <config.h> |
#include <config.h> |
23 |
|
|
24 |
#if defined (USG5) || defined (BSD_SYSTEM) || defined (GNU_LINUX) |
#ifdef HAVE_FCNTL_H |
25 |
#include <fcntl.h> |
#include <fcntl.h> |
26 |
#endif |
#endif |
27 |
|
|
72 |
#include <sys/time.h> |
#include <sys/time.h> |
73 |
#endif |
#endif |
74 |
|
|
|
#ifndef USG |
|
|
#ifndef VMS |
|
|
#ifndef BSD4_1 |
|
|
#ifndef WINDOWSNT |
|
|
#define HAVE_FSYNC |
|
|
#endif |
|
|
#endif |
|
|
#endif |
|
|
#endif |
|
|
|
|
75 |
#include "lisp.h" |
#include "lisp.h" |
76 |
#include "intervals.h" |
#include "intervals.h" |
77 |
#include "buffer.h" |
#include "buffer.h" |
188 |
Lisp_Object Vauto_save_list_file_name; |
Lisp_Object Vauto_save_list_file_name; |
189 |
|
|
190 |
/* Function to call to read a file name. */ |
/* Function to call to read a file name. */ |
191 |
Lisp_Object Vread_file_name_function; |
Lisp_Object Vread_file_name_function; |
192 |
|
|
193 |
/* Current predicate used by read_file_name_internal. */ |
/* Current predicate used by read_file_name_internal. */ |
194 |
Lisp_Object Vread_file_name_predicate; |
Lisp_Object Vread_file_name_predicate; |
238 |
|
|
239 |
void |
void |
240 |
report_file_error (string, data) |
report_file_error (string, data) |
241 |
char *string; |
const char *string; |
242 |
Lisp_Object data; |
Lisp_Object data; |
243 |
{ |
{ |
244 |
Lisp_Object errstring; |
Lisp_Object errstring; |
257 |
default: |
default: |
258 |
/* System error messages are capitalized. Downcase the initial |
/* System error messages are capitalized. Downcase the initial |
259 |
unless it is followed by a slash. */ |
unless it is followed by a slash. */ |
260 |
if (XSTRING (errstring)->data[1] != '/') |
if (SREF (errstring, 1) != '/') |
261 |
XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); |
SSET (errstring, 0, DOWNCASE (SREF (errstring, 0))); |
262 |
|
|
263 |
Fsignal (Qfile_error, |
Fsignal (Qfile_error, |
264 |
Fcons (build_string (string), Fcons (errstring, data))); |
Fcons (build_string (string), Fcons (errstring, data))); |
381 |
(filename) |
(filename) |
382 |
Lisp_Object filename; |
Lisp_Object filename; |
383 |
{ |
{ |
384 |
|
#ifndef DOS_NT |
385 |
|
register const unsigned char *beg; |
386 |
|
#else |
387 |
register unsigned char *beg; |
register unsigned char *beg; |
388 |
register unsigned char *p; |
#endif |
389 |
|
register const unsigned char *p; |
390 |
Lisp_Object handler; |
Lisp_Object handler; |
391 |
|
|
392 |
CHECK_STRING (filename); |
CHECK_STRING (filename); |
400 |
#ifdef FILE_SYSTEM_CASE |
#ifdef FILE_SYSTEM_CASE |
401 |
filename = FILE_SYSTEM_CASE (filename); |
filename = FILE_SYSTEM_CASE (filename); |
402 |
#endif |
#endif |
403 |
beg = XSTRING (filename)->data; |
beg = SDATA (filename); |
404 |
#ifdef DOS_NT |
#ifdef DOS_NT |
405 |
beg = strcpy (alloca (strlen (beg) + 1), beg); |
beg = strcpy (alloca (strlen (beg) + 1), beg); |
406 |
#endif |
#endif |
407 |
p = beg + STRING_BYTES (XSTRING (filename)); |
p = beg + SBYTES (filename); |
408 |
|
|
409 |
while (p != beg && !IS_DIRECTORY_SEP (p[-1]) |
while (p != beg && !IS_DIRECTORY_SEP (p[-1]) |
410 |
#ifdef VMS |
#ifdef VMS |
447 |
CORRECT_DIR_SEPS (beg); |
CORRECT_DIR_SEPS (beg); |
448 |
#endif /* DOS_NT */ |
#endif /* DOS_NT */ |
449 |
|
|
450 |
if (STRING_MULTIBYTE (filename)) |
return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); |
|
return make_string (beg, p - beg); |
|
|
return make_unibyte_string (beg, p - beg); |
|
451 |
} |
} |
452 |
|
|
453 |
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, |
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, |
459 |
(filename) |
(filename) |
460 |
Lisp_Object filename; |
Lisp_Object filename; |
461 |
{ |
{ |
462 |
register unsigned char *beg, *p, *end; |
register const unsigned char *beg, *p, *end; |
463 |
Lisp_Object handler; |
Lisp_Object handler; |
464 |
|
|
465 |
CHECK_STRING (filename); |
CHECK_STRING (filename); |
470 |
if (!NILP (handler)) |
if (!NILP (handler)) |
471 |
return call2 (handler, Qfile_name_nondirectory, filename); |
return call2 (handler, Qfile_name_nondirectory, filename); |
472 |
|
|
473 |
beg = XSTRING (filename)->data; |
beg = SDATA (filename); |
474 |
end = p = beg + STRING_BYTES (XSTRING (filename)); |
end = p = beg + SBYTES (filename); |
475 |
|
|
476 |
while (p != beg && !IS_DIRECTORY_SEP (p[-1]) |
while (p != beg && !IS_DIRECTORY_SEP (p[-1]) |
477 |
#ifdef VMS |
#ifdef VMS |
486 |
) |
) |
487 |
p--; |
p--; |
488 |
|
|
489 |
if (STRING_MULTIBYTE (filename)) |
return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename)); |
|
return make_string (p, end - p); |
|
|
return make_unibyte_string (p, end - p); |
|
490 |
} |
} |
491 |
|
|
492 |
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, |
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, |
590 |
/* For Unix syntax, Append a slash if necessary */ |
/* For Unix syntax, Append a slash if necessary */ |
591 |
if (!IS_DIRECTORY_SEP (out[size])) |
if (!IS_DIRECTORY_SEP (out[size])) |
592 |
{ |
{ |
593 |
out[size + 1] = DIRECTORY_SEP; |
/* Cannot use DIRECTORY_SEP, which could have any value */ |
594 |
|
out[size + 1] = '/'; |
595 |
out[size + 2] = '\0'; |
out[size + 2] = '\0'; |
596 |
} |
} |
597 |
#ifdef DOS_NT |
#ifdef DOS_NT |
603 |
|
|
604 |
DEFUN ("file-name-as-directory", Ffile_name_as_directory, |
DEFUN ("file-name-as-directory", Ffile_name_as_directory, |
605 |
Sfile_name_as_directory, 1, 1, 0, |
Sfile_name_as_directory, 1, 1, 0, |
606 |
doc: /* Return a string representing file FILENAME interpreted as a directory. |
doc: /* Return a string representing the file name FILE interpreted as a directory. |
607 |
This operation exists because a directory is also a file, but its name as |
This operation exists because a directory is also a file, but its name as |
608 |
a directory is different from its name as a file. |
a directory is different from its name as a file. |
609 |
The result can be used as the value of `default-directory' |
The result can be used as the value of `default-directory' |
626 |
if (!NILP (handler)) |
if (!NILP (handler)) |
627 |
return call2 (handler, Qfile_name_as_directory, file); |
return call2 (handler, Qfile_name_as_directory, file); |
628 |
|
|
629 |
buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10); |
buf = (char *) alloca (SBYTES (file) + 10); |
630 |
return build_string (file_name_as_directory (buf, XSTRING (file)->data)); |
file_name_as_directory (buf, SDATA (file)); |
631 |
|
return make_specified_string (buf, -1, strlen (buf), |
632 |
|
STRING_MULTIBYTE (file)); |
633 |
} |
} |
634 |
|
|
635 |
/* |
/* |
824 |
/* 20 extra chars is insufficient for VMS, since we might perform a |
/* 20 extra chars is insufficient for VMS, since we might perform a |
825 |
logical name translation. an equivalence string can be up to 255 |
logical name translation. an equivalence string can be up to 255 |
826 |
chars long, so grab that much extra space... - sss */ |
chars long, so grab that much extra space... - sss */ |
827 |
buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255); |
buf = (char *) alloca (SBYTES (directory) + 20 + 255); |
828 |
#else |
#else |
829 |
buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20); |
buf = (char *) alloca (SBYTES (directory) + 20); |
830 |
#endif |
#endif |
831 |
directory_file_name (XSTRING (directory)->data, buf); |
directory_file_name (SDATA (directory), buf); |
832 |
return build_string (buf); |
return make_specified_string (buf, -1, strlen (buf), |
833 |
|
STRING_MULTIBYTE (directory)); |
834 |
} |
} |
835 |
|
|
836 |
static char make_temp_name_tbl[64] = |
static char make_temp_name_tbl[64] = |
848 |
static unsigned make_temp_name_count, make_temp_name_count_initialized_p; |
static unsigned make_temp_name_count, make_temp_name_count_initialized_p; |
849 |
|
|
850 |
/* Value is a temporary file name starting with PREFIX, a string. |
/* Value is a temporary file name starting with PREFIX, a string. |
851 |
|
|
852 |
The Emacs process number forms part of the result, so there is |
The Emacs process number forms part of the result, so there is |
853 |
no danger of generating a name being used by another process. |
no danger of generating a name being used by another process. |
854 |
In addition, this function makes an attempt to choose a name |
In addition, this function makes an attempt to choose a name |
855 |
which has no existing file. To make this work, PREFIX should be |
which has no existing file. To make this work, PREFIX should be |
856 |
an absolute file name. |
an absolute file name. |
857 |
|
|
858 |
BASE64_P non-zero means add the pid as 3 characters in base64 |
BASE64_P non-zero means add the pid as 3 characters in base64 |
859 |
encoding. In this case, 6 characters will be added to PREFIX to |
encoding. In this case, 6 characters will be added to PREFIX to |
860 |
form the file name. Otherwise, if Emacs is running on a system |
form the file name. Otherwise, if Emacs is running on a system |
874 |
unsigned char *p, *data; |
unsigned char *p, *data; |
875 |
char pidbuf[20]; |
char pidbuf[20]; |
876 |
int pidlen; |
int pidlen; |
877 |
|
|
878 |
CHECK_STRING (prefix); |
CHECK_STRING (prefix); |
879 |
|
|
880 |
/* VAL is created by adding 6 characters to PREFIX. The first |
/* VAL is created by adding 6 characters to PREFIX. The first |
903 |
pidlen = 3; |
pidlen = 3; |
904 |
#endif |
#endif |
905 |
} |
} |
906 |
|
|
907 |
len = XSTRING (prefix)->size; |
len = SCHARS (prefix); |
908 |
val = make_uninit_string (len + 3 + pidlen); |
val = make_uninit_string (len + 3 + pidlen); |
909 |
data = XSTRING (val)->data; |
data = SDATA (val); |
910 |
bcopy(XSTRING (prefix)->data, data, len); |
bcopy(SDATA (prefix), data, len); |
911 |
p = data + len; |
p = data + len; |
912 |
|
|
913 |
bcopy (pidbuf, p, pidlen); |
bcopy (pidbuf, p, pidlen); |
962 |
} |
} |
963 |
|
|
964 |
error ("Cannot create temporary name for prefix `%s'", |
error ("Cannot create temporary name for prefix `%s'", |
965 |
XSTRING (prefix)->data); |
SDATA (prefix)); |
966 |
return Qnil; |
return Qnil; |
967 |
} |
} |
968 |
|
|
1026 |
int is_escaped = 0; |
int is_escaped = 0; |
1027 |
#endif /* DOS_NT */ |
#endif /* DOS_NT */ |
1028 |
int length; |
int length; |
1029 |
Lisp_Object handler; |
Lisp_Object handler, result; |
1030 |
|
|
1031 |
CHECK_STRING (name); |
CHECK_STRING (name); |
1032 |
|
|
1065 |
return call3 (handler, Qexpand_file_name, name, default_directory); |
return call3 (handler, Qexpand_file_name, name, default_directory); |
1066 |
} |
} |
1067 |
|
|
1068 |
o = XSTRING (default_directory)->data; |
o = SDATA (default_directory); |
1069 |
|
|
1070 |
/* Make sure DEFAULT_DIRECTORY is properly expanded. |
/* Make sure DEFAULT_DIRECTORY is properly expanded. |
1071 |
It would be better to do this down below where we actually use |
It would be better to do this down below where we actually use |
1110 |
name = FILE_SYSTEM_CASE (name); |
name = FILE_SYSTEM_CASE (name); |
1111 |
#endif |
#endif |
1112 |
|
|
1113 |
nm = XSTRING (name)->data; |
nm = SDATA (name); |
1114 |
|
|
1115 |
#ifdef DOS_NT |
#ifdef DOS_NT |
1116 |
/* We will force directory separators to be either all \ or /, so make |
/* We will force directory separators to be either all \ or /, so make |
1194 |
&& IS_DIRECTORY_SEP (p[0]) |
&& IS_DIRECTORY_SEP (p[0]) |
1195 |
&& IS_DIRECTORY_SEP (p[1])) |
&& IS_DIRECTORY_SEP (p[1])) |
1196 |
lose = 1; |
lose = 1; |
1197 |
|
|
1198 |
#ifdef VMS |
#ifdef VMS |
1199 |
if (p[0] == '\\') |
if (p[0] == '\\') |
1200 |
lose = 1; |
lose = 1; |
1274 |
{ |
{ |
1275 |
#ifdef VMS |
#ifdef VMS |
1276 |
if (index (nm, '/')) |
if (index (nm, '/')) |
1277 |
return build_string (sys_translate_unix (nm)); |
{ |
1278 |
|
nm = sys_translate_unix (nm); |
1279 |
|
return make_specified_string (nm, -1, strlen (nm), |
1280 |
|
STRING_MULTIBYTE (name)); |
1281 |
|
} |
1282 |
#endif /* VMS */ |
#endif /* VMS */ |
1283 |
#ifdef DOS_NT |
#ifdef DOS_NT |
1284 |
/* Make sure directories are all separated with / or \ as |
/* Make sure directories are all separated with / or \ as |
1288 |
#ifdef WINDOWSNT |
#ifdef WINDOWSNT |
1289 |
if (IS_DIRECTORY_SEP (nm[1])) |
if (IS_DIRECTORY_SEP (nm[1])) |
1290 |
{ |
{ |
1291 |
if (strcmp (nm, XSTRING (name)->data) != 0) |
if (strcmp (nm, SDATA (name)) != 0) |
1292 |
name = build_string (nm); |
name = make_specified_string (nm, -1, strlen (nm), |
1293 |
|
STRING_MULTIBYTE (name)); |
1294 |
} |
} |
1295 |
else |
else |
1296 |
#endif |
#endif |
1297 |
/* drive must be set, so this is okay */ |
/* drive must be set, so this is okay */ |
1298 |
if (strcmp (nm - 2, XSTRING (name)->data) != 0) |
if (strcmp (nm - 2, SDATA (name)) != 0) |
1299 |
{ |
{ |
1300 |
name = make_string (nm - 2, p - nm + 2); |
char temp[] = " :"; |
1301 |
XSTRING (name)->data[0] = DRIVE_LETTER (drive); |
|
1302 |
XSTRING (name)->data[1] = ':'; |
name = make_specified_string (nm, -1, p - nm, |
1303 |
|
STRING_MULTIBYTE (name)); |
1304 |
|
temp[0] = DRIVE_LETTER (drive); |
1305 |
|
name = concat2 (build_string (temp), name); |
1306 |
} |
} |
1307 |
return name; |
return name; |
1308 |
#else /* not DOS_NT */ |
#else /* not DOS_NT */ |
1309 |
if (nm == XSTRING (name)->data) |
if (nm == SDATA (name)) |
1310 |
return name; |
return name; |
1311 |
return build_string (nm); |
return make_specified_string (nm, -1, strlen (nm), |
1312 |
|
STRING_MULTIBYTE (name)); |
1313 |
#endif /* not DOS_NT */ |
#endif /* not DOS_NT */ |
1314 |
} |
} |
1315 |
} |
} |
1420 |
#endif |
#endif |
1421 |
&& !newdir) |
&& !newdir) |
1422 |
{ |
{ |
1423 |
newdir = XSTRING (default_directory)->data; |
newdir = SDATA (default_directory); |
1424 |
#ifdef DOS_NT |
#ifdef DOS_NT |
1425 |
/* Note if special escape prefix is present, but remove for now. */ |
/* Note if special escape prefix is present, but remove for now. */ |
1426 |
if (newdir[0] == '/' && newdir[1] == ':') |
if (newdir[0] == '/' && newdir[1] == ':') |
1546 |
absolute directory in nm produces "//", which will then be |
absolute directory in nm produces "//", which will then be |
1547 |
incorrectly treated as a network share. Ignore newdir in |
incorrectly treated as a network share. Ignore newdir in |
1548 |
this case (keeping the drive letter). */ |
this case (keeping the drive letter). */ |
1549 |
if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) |
if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) |
1550 |
&& newdir[1] == '\0')) |
&& newdir[1] == '\0')) |
1551 |
#endif |
#endif |
1552 |
strcpy (target, newdir); |
strcpy (target, newdir); |
1678 |
CORRECT_DIR_SEPS (target); |
CORRECT_DIR_SEPS (target); |
1679 |
#endif /* DOS_NT */ |
#endif /* DOS_NT */ |
1680 |
|
|
1681 |
return make_string (target, o - target); |
result = make_specified_string (target, -1, o - target, |
1682 |
|
STRING_MULTIBYTE (name)); |
1683 |
|
|
1684 |
|
/* Again look to see if the file name has special constructs in it |
1685 |
|
and perhaps call the corresponding file handler. This is needed |
1686 |
|
for filenames such as "/foo/../user@host:/bar/../baz". Expanding |
1687 |
|
the ".." component gives us "/user@host:/bar/../baz" which needs |
1688 |
|
to be expanded again. */ |
1689 |
|
handler = Ffind_file_name_handler (result, Qexpand_file_name); |
1690 |
|
if (!NILP (handler)) |
1691 |
|
return call3 (handler, Qexpand_file_name, result, default_directory); |
1692 |
|
|
1693 |
|
return result; |
1694 |
} |
} |
1695 |
|
|
1696 |
#if 0 |
#if 0 |
1739 |
name = Fupcase (name); |
name = Fupcase (name); |
1740 |
#endif |
#endif |
1741 |
|
|
1742 |
nm = XSTRING (name)->data; |
nm = SDATA (name); |
1743 |
|
|
1744 |
/* If nm is absolute, flush ...// and detect /./ and /../. |
/* If nm is absolute, flush ...// and detect /./ and /../. |
1745 |
If no /./ or /../ we can return right away. */ |
If no /./ or /../ we can return right away. */ |
1848 |
if (index (nm, '/')) |
if (index (nm, '/')) |
1849 |
return build_string (sys_translate_unix (nm)); |
return build_string (sys_translate_unix (nm)); |
1850 |
#endif /* VMS */ |
#endif /* VMS */ |
1851 |
if (nm == XSTRING (name)->data) |
if (nm == SDATA (name)) |
1852 |
return name; |
return name; |
1853 |
return build_string (nm); |
return build_string (nm); |
1854 |
} |
} |
1909 |
if (NILP (defalt)) |
if (NILP (defalt)) |
1910 |
defalt = current_buffer->directory; |
defalt = current_buffer->directory; |
1911 |
CHECK_STRING (defalt); |
CHECK_STRING (defalt); |
1912 |
newdir = XSTRING (defalt)->data; |
newdir = SDATA (defalt); |
1913 |
} |
} |
1914 |
|
|
1915 |
/* Now concatenate the directory and name to new space in the stack frame */ |
/* Now concatenate the directory and name to new space in the stack frame */ |
2059 |
if (!NILP (handler)) |
if (!NILP (handler)) |
2060 |
return call2 (handler, Qsubstitute_in_file_name, filename); |
return call2 (handler, Qsubstitute_in_file_name, filename); |
2061 |
|
|
2062 |
nm = XSTRING (filename)->data; |
nm = SDATA (filename); |
2063 |
#ifdef DOS_NT |
#ifdef DOS_NT |
2064 |
nm = strcpy (alloca (strlen (nm) + 1), nm); |
nm = strcpy (alloca (strlen (nm) + 1), nm); |
2065 |
CORRECT_DIR_SEPS (nm); |
CORRECT_DIR_SEPS (nm); |
2066 |
substituted = (strcmp (nm, XSTRING (filename)->data) != 0); |
substituted = (strcmp (nm, SDATA (filename)) != 0); |
2067 |
#endif |
#endif |
2068 |
endp = nm + STRING_BYTES (XSTRING (filename)); |
endp = nm + SBYTES (filename); |
2069 |
|
|
2070 |
/* If /~ or // appears, discard everything through first slash. */ |
/* If /~ or // appears, discard everything through first slash. */ |
2071 |
|
|
2072 |
for (p = nm; p != endp; p++) |
for (p = nm; p != endp; p++) |
2073 |
{ |
{ |
2074 |
if ((p[0] == '~' |
if ((p[0] == '~' |
2075 |
#if defined (APOLLO) || defined (WINDOWSNT) |
#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) |
2076 |
/* // at start of file name is meaningful in Apollo and |
/* // at start of file name is meaningful in Apollo, |
2077 |
WindowsNT systems. */ |
WindowsNT and Cygwin systems. */ |
2078 |
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) |
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) |
2079 |
#else /* not (APOLLO || WINDOWSNT) */ |
#else /* not (APOLLO || WINDOWSNT || CYGWIN) */ |
2080 |
|| IS_DIRECTORY_SEP (p[0]) |
|| IS_DIRECTORY_SEP (p[0]) |
2081 |
#endif /* not (APOLLO || WINDOWSNT) */ |
#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ |
2082 |
) |
) |
2083 |
&& p != nm |
&& p != nm |
2084 |
&& (0 |
&& (0 |
2121 |
} |
} |
2122 |
|
|
2123 |
#ifdef VMS |
#ifdef VMS |
2124 |
return build_string (nm); |
return make_specified_string (nm, -1, strlen (nm), |
2125 |
|
STRING_MULTIBYTE (filename)); |
2126 |
#else |
#else |
2127 |
|
|
2128 |
/* See if any variables are substituted into the string |
/* See if any variables are substituted into the string |
2182 |
|
|
2183 |
/* If substitution required, recopy the string and do it */ |
/* If substitution required, recopy the string and do it */ |
2184 |
/* Make space in stack frame for the new copy */ |
/* Make space in stack frame for the new copy */ |
2185 |
xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1); |
xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1); |
2186 |
x = xnm; |
x = xnm; |
2187 |
|
|
2188 |
/* Copy the rest of the name through, replacing $ constructs with values */ |
/* Copy the rest of the name through, replacing $ constructs with values */ |
2251 |
|
|
2252 |
for (p = xnm; p != x; p++) |
for (p = xnm; p != x; p++) |
2253 |
if ((p[0] == '~' |
if ((p[0] == '~' |
2254 |
#if defined (APOLLO) || defined (WINDOWSNT) |
#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) |
2255 |
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) |
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) |
2256 |
#else /* not (APOLLO || WINDOWSNT) */ |
#else /* not (APOLLO || WINDOWSNT || CYGWIN) */ |
2257 |
|| IS_DIRECTORY_SEP (p[0]) |
|| IS_DIRECTORY_SEP (p[0]) |
2258 |
#endif /* not (APOLLO || WINDOWSNT) */ |
#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ |
2259 |
) |
) |
2260 |
&& p != xnm && IS_DIRECTORY_SEP (p[-1])) |
&& p != xnm && IS_DIRECTORY_SEP (p[-1])) |
2261 |
xnm = p; |
xnm = p; |
2265 |
xnm = p; |
xnm = p; |
2266 |
#endif |
#endif |
2267 |
|
|
2268 |
if (STRING_MULTIBYTE (filename)) |
return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename)); |
|
return make_string (xnm, x - xnm); |
|
|
return make_unibyte_string (xnm, x - xnm); |
|
2269 |
|
|
2270 |
badsubst: |
badsubst: |
2271 |
error ("Bad format environment-variable substitution"); |
error ("Bad format environment-variable substitution"); |
2291 |
absname = Fexpand_file_name (filename, defdir); |
absname = Fexpand_file_name (filename, defdir); |
2292 |
#ifdef VMS |
#ifdef VMS |
2293 |
{ |
{ |
2294 |
register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1]; |
register int c = SREF (absname, SBYTES (absname) - 1); |
2295 |
if (c == ':' || c == ']' || c == '>') |
if (c == ':' || c == ']' || c == '>') |
2296 |
absname = Fdirectory_file_name (absname); |
absname = Fdirectory_file_name (absname); |
2297 |
} |
} |
2298 |
#else |
#else |
2299 |
/* Remove final slash, if any (unless this is the root dir). |
/* Remove final slash, if any (unless this is the root dir). |
2300 |
stat behaves differently depending! */ |
stat behaves differently depending! */ |
2301 |
if (XSTRING (absname)->size > 1 |
if (SCHARS (absname) > 1 |
2302 |
&& IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1]) |
&& IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1)) |
2303 |
&& !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2])) |
&& !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2))) |
2304 |
/* We cannot take shortcuts; they might be wrong for magic file names. */ |
/* We cannot take shortcuts; they might be wrong for magic file names. */ |
2305 |
absname = Fdirectory_file_name (absname); |
absname = Fdirectory_file_name (absname); |
2306 |
#endif |
#endif |
2335 |
|
|
2336 |
/* stat is a good way to tell whether the file exists, |
/* stat is a good way to tell whether the file exists, |
2337 |
regardless of what access permissions it has. */ |
regardless of what access permissions it has. */ |
2338 |
if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0) |
if (stat (SDATA (encoded_filename), &statbuf) >= 0) |
2339 |
{ |
{ |
2340 |
if (! interactive) |
if (! interactive) |
2341 |
Fsignal (Qfile_already_exists, |
Fsignal (Qfile_already_exists, |
2342 |
Fcons (build_string ("File already exists"), |
Fcons (build_string ("File already exists"), |
2343 |
Fcons (absname, Qnil))); |
Fcons (absname, Qnil))); |
2344 |
GCPRO1 (absname); |
GCPRO1 (absname); |
2345 |
tem = format1 ("File %s already exists; %s anyway? ", |
tem = format2 ("File %s already exists; %s anyway? ", |
2346 |
XSTRING (absname)->data, querystring); |
absname, build_string (querystring)); |
2347 |
if (quick) |
if (quick) |
2348 |
tem = Fy_or_n_p (tem); |
tem = Fy_or_n_p (tem); |
2349 |
else |
else |
2383 |
struct stat st, out_st; |
struct stat st, out_st; |
2384 |
Lisp_Object handler; |
Lisp_Object handler; |
2385 |
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
2386 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
2387 |
int input_file_statable_p; |
int input_file_statable_p; |
2388 |
Lisp_Object encoded_file, encoded_newname; |
Lisp_Object encoded_file, encoded_newname; |
2389 |
|
|
2416 |
|| INTEGERP (ok_if_already_exists)) |
|| INTEGERP (ok_if_already_exists)) |
2417 |
barf_or_query_if_file_exists (encoded_newname, "copy to it", |
barf_or_query_if_file_exists (encoded_newname, "copy to it", |
2418 |
INTEGERP (ok_if_already_exists), &out_st, 0); |
INTEGERP (ok_if_already_exists), &out_st, 0); |
2419 |
else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0) |
else if (stat (SDATA (encoded_newname), &out_st) < 0) |
2420 |
out_st.st_mode = 0; |
out_st.st_mode = 0; |
2421 |
|
|
2422 |
#ifdef WINDOWSNT |
#ifdef WINDOWSNT |
2423 |
if (!CopyFile (XSTRING (encoded_file)->data, |
if (!CopyFile (SDATA (encoded_file), |
2424 |
XSTRING (encoded_newname)->data, |
SDATA (encoded_newname), |
2425 |
FALSE)) |
FALSE)) |
2426 |
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); |
report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); |
2427 |
|
/* CopyFile retains the timestamp by default. */ |
2428 |
else if (NILP (keep_time)) |
else if (NILP (keep_time)) |
2429 |
{ |
{ |
2430 |
EMACS_TIME now; |
EMACS_TIME now; |
2432 |
char * filename; |
char * filename; |
2433 |
|
|
2434 |
EMACS_GET_TIME (now); |
EMACS_GET_TIME (now); |
2435 |
filename = XSTRING (encoded_newname)->data; |
filename = SDATA (encoded_newname); |
2436 |
|
|
2437 |
/* Ensure file is writable while its modified time is set. */ |
/* Ensure file is writable while its modified time is set. */ |
2438 |
attributes = GetFileAttributes (filename); |
attributes = GetFileAttributes (filename); |
2449 |
SetFileAttributes (filename, attributes); |
SetFileAttributes (filename, attributes); |
2450 |
} |
} |
2451 |
#else /* not WINDOWSNT */ |
#else /* not WINDOWSNT */ |
2452 |
ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0); |
immediate_quit = 1; |
2453 |
|
ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0); |
2454 |
|
immediate_quit = 0; |
2455 |
|
|
2456 |
if (ifd < 0) |
if (ifd < 0) |
2457 |
report_file_error ("Opening input file", Fcons (file, Qnil)); |
report_file_error ("Opening input file", Fcons (file, Qnil)); |
2458 |
|
|
2488 |
|
|
2489 |
#ifdef VMS |
#ifdef VMS |
2490 |
/* Create the copy file with the same record format as the input file */ |
/* Create the copy file with the same record format as the input file */ |
2491 |
ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd); |
ofd = sys_creat (SDATA (encoded_newname), 0666, ifd); |
2492 |
#else |
#else |
2493 |
#ifdef MSDOS |
#ifdef MSDOS |
2494 |
/* System's default file type was set to binary by _fmode in emacs.c. */ |
/* System's default file type was set to binary by _fmode in emacs.c. */ |
2495 |
ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE); |
ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE); |
2496 |
#else /* not MSDOS */ |
#else /* not MSDOS */ |
2497 |
ofd = creat (XSTRING (encoded_newname)->data, 0666); |
ofd = creat (SDATA (encoded_newname), 0666); |
2498 |
#endif /* not MSDOS */ |
#endif /* not MSDOS */ |
2499 |
#endif /* VMS */ |
#endif /* VMS */ |
2500 |
if (ofd < 0) |
if (ofd < 0) |
2520 |
EMACS_TIME atime, mtime; |
EMACS_TIME atime, mtime; |
2521 |
EMACS_SET_SECS_USECS (atime, st.st_atime, 0); |
EMACS_SET_SECS_USECS (atime, st.st_atime, 0); |
2522 |
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); |
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); |
2523 |
if (set_file_times (XSTRING (encoded_newname)->data, |
if (set_file_times (SDATA (encoded_newname), |
2524 |
atime, mtime)) |
atime, mtime)) |
2525 |
Fsignal (Qfile_date_error, |
Fsignal (Qfile_date_error, |
2526 |
Fcons (build_string ("Cannot set file date"), |
Fcons (build_string ("Cannot set file date"), |
2527 |
Fcons (newname, Qnil))); |
Fcons (newname, Qnil))); |
2528 |
} |
} |
2529 |
#ifndef MSDOS |
#ifndef MSDOS |
2530 |
chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777); |
chmod (SDATA (encoded_newname), st.st_mode & 07777); |
2531 |
#else /* MSDOS */ |
#else /* MSDOS */ |
2532 |
#if defined (__DJGPP__) && __DJGPP__ > 1 |
#if defined (__DJGPP__) && __DJGPP__ > 1 |
2533 |
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits, |
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits, |
2535 |
get only the READ bit, which will make the copied file read-only, |
get only the READ bit, which will make the copied file read-only, |
2536 |
so it's better not to chmod at all. */ |
so it's better not to chmod at all. */ |
2537 |
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0) |
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0) |
2538 |
chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777); |
chmod (SDATA (encoded_newname), st.st_mode & 07777); |
2539 |
#endif /* DJGPP version 2 or newer */ |
#endif /* DJGPP version 2 or newer */ |
2540 |
#endif /* MSDOS */ |
#endif /* MSDOS */ |
2541 |
} |
} |
2556 |
(directory) |
(directory) |
2557 |
Lisp_Object directory; |
Lisp_Object directory; |
2558 |
{ |
{ |
2559 |
unsigned char *dir; |
const unsigned char *dir; |
2560 |
Lisp_Object handler; |
Lisp_Object handler; |
2561 |
Lisp_Object encoded_dir; |
Lisp_Object encoded_dir; |
2562 |
|
|
2569 |
|
|
2570 |
encoded_dir = ENCODE_FILE (directory); |
encoded_dir = ENCODE_FILE (directory); |
2571 |
|
|
2572 |
dir = XSTRING (encoded_dir)->data; |
dir = SDATA (encoded_dir); |
2573 |
|
|
2574 |
#ifdef WINDOWSNT |
#ifdef WINDOWSNT |
2575 |
if (mkdir (dir) != 0) |
if (mkdir (dir) != 0) |
2582 |
} |
} |
2583 |
|
|
2584 |
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", |
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", |
2585 |
doc: /* Delete the directory named DIRECTORY. */) |
doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */) |
2586 |
(directory) |
(directory) |
2587 |
Lisp_Object directory; |
Lisp_Object directory; |
2588 |
{ |
{ |
2589 |
unsigned char *dir; |
const unsigned char *dir; |
2590 |
Lisp_Object handler; |
Lisp_Object handler; |
2591 |
Lisp_Object encoded_dir; |
Lisp_Object encoded_dir; |
2592 |
|
|
2599 |
|
|
2600 |
encoded_dir = ENCODE_FILE (directory); |
encoded_dir = ENCODE_FILE (directory); |
2601 |
|
|
2602 |
dir = XSTRING (encoded_dir)->data; |
dir = SDATA (encoded_dir); |
2603 |
|
|
2604 |
if (rmdir (dir) != 0) |
if (rmdir (dir) != 0) |
2605 |
report_file_error ("Removing directory", Flist (1, &directory)); |
report_file_error ("Removing directory", Flist (1, &directory)); |
2608 |
} |
} |
2609 |
|
|
2610 |
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", |
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", |
2611 |
doc: /* Delete file named FILENAME. |
doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink. |
2612 |
If file has multiple names, it continues to exist with the other names. */) |
If file has multiple names, it continues to exist with the other names. */) |
2613 |
(filename) |
(filename) |
2614 |
Lisp_Object filename; |
Lisp_Object filename; |
2615 |
{ |
{ |
2616 |
Lisp_Object handler; |
Lisp_Object handler; |
2617 |
Lisp_Object encoded_file; |
Lisp_Object encoded_file; |
2618 |
|
struct gcpro gcpro1; |
2619 |
|
|
2620 |
CHECK_STRING (filename); |
GCPRO1 (filename); |
2621 |
|
if (!NILP (Ffile_directory_p (filename))) |
2622 |
|
Fsignal (Qfile_error, |
2623 |
|
Fcons (build_string ("Removing old name: is a directory"), |
2624 |
|
Fcons (filename, Qnil))); |
2625 |
|
UNGCPRO; |
2626 |
filename = Fexpand_file_name (filename, Qnil); |
filename = Fexpand_file_name (filename, Qnil); |
2627 |
|
|
2628 |
handler = Ffind_file_name_handler (filename, Qdelete_file); |
handler = Ffind_file_name_handler (filename, Qdelete_file); |
2631 |
|
|
2632 |
encoded_file = ENCODE_FILE (filename); |
encoded_file = ENCODE_FILE (filename); |
2633 |
|
|
2634 |
if (0 > unlink (XSTRING (encoded_file)->data)) |
if (0 > unlink (SDATA (encoded_file))) |
2635 |
report_file_error ("Removing old name", Flist (1, &filename)); |
report_file_error ("Removing old name", Flist (1, &filename)); |
2636 |
return Qnil; |
return Qnil; |
2637 |
} |
} |
2701 |
barf_or_query_if_file_exists (encoded_newname, "rename to it", |
barf_or_query_if_file_exists (encoded_newname, "rename to it", |
2702 |
INTEGERP (ok_if_already_exists), 0, 0); |
INTEGERP (ok_if_already_exists), 0, 0); |
2703 |
#ifndef BSD4_1 |
#ifndef BSD4_1 |
2704 |
if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)) |
if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname))) |
2705 |
#else |
#else |
2706 |
if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data) |
if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)) |
2707 |
|| 0 > unlink (XSTRING (encoded_file)->data)) |
|| 0 > unlink (SDATA (encoded_file))) |
2708 |
#endif |
#endif |
2709 |
{ |
{ |
2710 |
if (errno == EXDEV) |
if (errno == EXDEV) |
2776 |
barf_or_query_if_file_exists (encoded_newname, "make it a new name", |
barf_or_query_if_file_exists (encoded_newname, "make it a new name", |
2777 |
INTEGERP (ok_if_already_exists), 0, 0); |
INTEGERP (ok_if_already_exists), 0, 0); |
2778 |
|
|
2779 |
unlink (XSTRING (newname)->data); |
unlink (SDATA (newname)); |
2780 |
if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)) |
if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))) |
2781 |
{ |
{ |
2782 |
#ifdef NO_ARG_ARRAY |
#ifdef NO_ARG_ARRAY |
2783 |
args[0] = file; |
args[0] = file; |
2817 |
/* If the link target has a ~, we must expand it to get |
/* If the link target has a ~, we must expand it to get |
2818 |
a truly valid file name. Otherwise, do not expand; |
a truly valid file name. Otherwise, do not expand; |
2819 |
we want to permit links to relative file names. */ |
we want to permit links to relative file names. */ |
2820 |
if (XSTRING (filename)->data[0] == '~') |
if (SREF (filename, 0) == '~') |
2821 |
filename = Fexpand_file_name (filename, Qnil); |
filename = Fexpand_file_name (filename, Qnil); |
2822 |
linkname = Fexpand_file_name (linkname, Qnil); |
linkname = Fexpand_file_name (linkname, Qnil); |
2823 |
|
|
2842 |
|| INTEGERP (ok_if_already_exists)) |
|| INTEGERP (ok_if_already_exists)) |
2843 |
barf_or_query_if_file_exists (encoded_linkname, "make it a link", |
barf_or_query_if_file_exists (encoded_linkname, "make it a link", |
2844 |
INTEGERP (ok_if_already_exists), 0, 0); |
INTEGERP (ok_if_already_exists), 0, 0); |
2845 |
if (0 > symlink (XSTRING (encoded_filename)->data, |
if (0 > symlink (SDATA (encoded_filename), |
2846 |
XSTRING (encoded_linkname)->data)) |
SDATA (encoded_linkname))) |
2847 |
{ |
{ |
2848 |
/* If we didn't complain already, silently delete existing file. */ |
/* If we didn't complain already, silently delete existing file. */ |
2849 |
if (errno == EEXIST) |
if (errno == EEXIST) |
2850 |
{ |
{ |
2851 |
unlink (XSTRING (encoded_linkname)->data); |
unlink (SDATA (encoded_linkname)); |
2852 |
if (0 <= symlink (XSTRING (encoded_filename)->data, |
if (0 <= symlink (SDATA (encoded_filename), |
2853 |
XSTRING (encoded_linkname)->data)) |
SDATA (encoded_linkname))) |
2854 |
{ |
{ |
2855 |
UNGCPRO; |
UNGCPRO; |
2856 |
return Qnil; |
return Qnil; |
2882 |
{ |
{ |
2883 |
CHECK_STRING (name); |
CHECK_STRING (name); |
2884 |
if (NILP (string)) |
if (NILP (string)) |
2885 |
delete_logical_name (XSTRING (name)->data); |
delete_logical_name (SDATA (name)); |
2886 |
else |
else |
2887 |
{ |
{ |
2888 |
CHECK_STRING (string); |
CHECK_STRING (string); |
2889 |
|
|
2890 |
if (XSTRING (string)->size == 0) |
if (SCHARS (string) == 0) |
2891 |
delete_logical_name (XSTRING (name)->data); |
delete_logical_name (SDATA (name)); |
2892 |
else |
else |
2893 |
define_logical_name (XSTRING (name)->data, XSTRING (string)->data); |
define_logical_name (SDATA (name), SDATA (string)); |
2894 |
} |
} |
2895 |
|
|
2896 |
return string; |
return string; |
2909 |
CHECK_STRING (path); |
CHECK_STRING (path); |
2910 |
CHECK_STRING (login); |
CHECK_STRING (login); |
2911 |
|
|
2912 |
netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); |
netresult = netunam (SDATA (path), SDATA (login)); |
2913 |
|
|
2914 |
if (netresult == -1) |
if (netresult == -1) |
2915 |
return Qnil; |
return Qnil; |
2925 |
(filename) |
(filename) |
2926 |
Lisp_Object filename; |
Lisp_Object filename; |
2927 |
{ |
{ |
2928 |
unsigned char *ptr; |
const unsigned char *ptr; |
2929 |
|
|
2930 |
CHECK_STRING (filename); |
CHECK_STRING (filename); |
2931 |
ptr = XSTRING (filename)->data; |
ptr = SDATA (filename); |
2932 |
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' |
if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' |
2933 |
#ifdef VMS |
#ifdef VMS |
2934 |
/* ??? This criterion is probably wrong for '<'. */ |
/* ??? This criterion is probably wrong for '<'. */ |
3025 |
|
|
3026 |
absname = ENCODE_FILE (absname); |
absname = ENCODE_FILE (absname); |
3027 |
|
|
3028 |
return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil; |
return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil; |
3029 |
} |
} |
3030 |
|
|
3031 |
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, |
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, |
3048 |
|
|
3049 |
absname = ENCODE_FILE (absname); |
absname = ENCODE_FILE (absname); |
3050 |
|
|
3051 |
return (check_executable (XSTRING (absname)->data) ? Qt : Qnil); |
return (check_executable (SDATA (absname)) ? Qt : Qnil); |
3052 |
} |
} |
3053 |
|
|
3054 |
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, |
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, |
3077 |
#if defined(DOS_NT) || defined(macintosh) |
#if defined(DOS_NT) || defined(macintosh) |
3078 |
/* Under MS-DOS, Windows, and Macintosh, open does not work for |
/* Under MS-DOS, Windows, and Macintosh, open does not work for |
3079 |
directories. */ |
directories. */ |
3080 |
if (access (XSTRING (absname)->data, 0) == 0) |
if (access (SDATA (absname), 0) == 0) |
3081 |
return Qt; |
return Qt; |
3082 |
return Qnil; |
return Qnil; |
3083 |
#else /* not DOS_NT and not macintosh */ |
#else /* not DOS_NT and not macintosh */ |
3086 |
/* Opening a fifo without O_NONBLOCK can wait. |
/* Opening a fifo without O_NONBLOCK can wait. |
3087 |
We don't want to wait. But we don't want to mess wth O_NONBLOCK |
We don't want to wait. But we don't want to mess wth O_NONBLOCK |
3088 |
except in the case of a fifo, on a system which handles it. */ |
except in the case of a fifo, on a system which handles it. */ |
3089 |
desc = stat (XSTRING (absname)->data, &statbuf); |
desc = stat (SDATA (absname), &statbuf); |
3090 |
if (desc < 0) |
if (desc < 0) |
3091 |
return Qnil; |
return Qnil; |
3092 |
if (S_ISFIFO (statbuf.st_mode)) |
if (S_ISFIFO (statbuf.st_mode)) |
3093 |
flags |= O_NONBLOCK; |
flags |= O_NONBLOCK; |
3094 |
#endif |
#endif |
3095 |
desc = emacs_open (XSTRING (absname)->data, flags, 0); |
desc = emacs_open (SDATA (absname), flags, 0); |
3096 |
if (desc < 0) |
if (desc < 0) |
3097 |
return Qnil; |
return Qnil; |
3098 |
emacs_close (desc); |
emacs_close (desc); |
3121 |
return call2 (handler, Qfile_writable_p, absname); |
return call2 (handler, Qfile_writable_p, absname); |
3122 |
|
|
3123 |
encoded = ENCODE_FILE (absname); |
encoded = ENCODE_FILE (absname); |
3124 |
if (stat (XSTRING (encoded)->data, &statbuf) >= 0) |
if (stat (SDATA (encoded), &statbuf) >= 0) |
3125 |
return (check_writable (XSTRING (encoded)->data) |
return (check_writable (SDATA (encoded)) |
3126 |
? Qt : Qnil); |
? Qt : Qnil); |
3127 |
|
|
3128 |
dir = Ffile_name_directory (absname); |
dir = Ffile_name_directory (absname); |
3140 |
/* The read-only attribute of the parent directory doesn't affect |
/* The read-only attribute of the parent directory doesn't affect |
3141 |
whether a file or directory can be created within it. Some day we |
whether a file or directory can be created within it. Some day we |
3142 |
should check ACLs though, which do affect this. */ |
should check ACLs though, which do affect this. */ |
3143 |
if (stat (XSTRING (dir)->data, &statbuf) < 0) |
if (stat (SDATA (dir), &statbuf) < 0) |
3144 |
return Qnil; |
return Qnil; |
3145 |
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; |
return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; |
3146 |
#else |
#else |
3147 |
return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "") |
return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "") |
3148 |
? Qt : Qnil); |
? Qt : Qnil); |
3149 |
#endif |
#endif |
3150 |
} |
} |
3172 |
|
|
3173 |
encoded_filename = ENCODE_FILE (absname); |
encoded_filename = ENCODE_FILE (absname); |
3174 |
|
|
3175 |
fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0); |
fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0); |
3176 |
if (fd < 0) |
if (fd < 0) |
3177 |
report_file_error (XSTRING (string)->data, Fcons (filename, Qnil)); |
report_file_error (SDATA (string), Fcons (filename, Qnil)); |
3178 |
emacs_close (fd); |
emacs_close (fd); |
3179 |
|
|
3180 |
return Qnil; |
return Qnil; |
3212 |
bufsize *= 2; |
bufsize *= 2; |
3213 |
buf = (char *) xrealloc (buf, bufsize); |
buf = (char *) xrealloc (buf, bufsize); |
3214 |
bzero (buf, bufsize); |
bzero (buf, bufsize); |
3215 |
|
|
3216 |
errno = 0; |
errno = 0; |
3217 |
valsize = readlink (XSTRING (filename)->data, buf, bufsize); |
valsize = readlink (SDATA (filename), buf, bufsize); |
3218 |
if (valsize == -1) |
if (valsize == -1) |
3219 |
{ |
{ |
3220 |
#ifdef ERANGE |
#ifdef ERANGE |
3230 |
} |
} |
3231 |
} |
} |
3232 |
while (valsize >= bufsize); |
while (valsize >= bufsize); |
3233 |
|
|
3234 |
val = make_string (buf, valsize); |
val = make_string (buf, valsize); |
3235 |
if (buf[0] == '/' && index (buf, ':')) |
if (buf[0] == '/' && index (buf, ':')) |
3236 |
val = concat2 (build_string ("/:"), val); |
val = concat2 (build_string ("/:"), val); |
3263 |
|
|
3264 |
absname = ENCODE_FILE (absname); |
absname = ENCODE_FILE (absname); |
3265 |
|
|
3266 |
if (stat (XSTRING (absname)->data, &st) < 0) |
if (stat (SDATA (absname), &st) < 0) |
3267 |
return Qnil; |
return Qnil; |
3268 |
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; |
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; |
3269 |
} |
} |
3289 |
if (!NILP (handler)) |
if (!NILP (handler)) |
3290 |
return call2 (handler, Qfile_accessible_directory_p, filename); |
return call2 (handler, Qfile_accessible_directory_p, filename); |
3291 |
|
|
|
/* It's an unlikely combination, but yes we really do need to gcpro: |
|
|
Suppose that file-accessible-directory-p has no handler, but |
|
|
file-directory-p does have a handler; this handler causes a GC which |
|
|
relocates the string in `filename'; and finally file-directory-p |
|
|
returns non-nil. Then we would end up passing a garbaged string |
|
|
to file-executable-p. */ |
|
3292 |
GCPRO1 (filename); |
GCPRO1 (filename); |
3293 |
tem = (NILP (Ffile_directory_p (filename)) |
tem = (NILP (Ffile_directory_p (filename)) |
3294 |
|| NILP (Ffile_executable_p (filename))); |
|| NILP (Ffile_executable_p (filename))); |
3323 |
|
|
3324 |
/* Tell stat to use expensive method to get accurate info. */ |
/* Tell stat to use expensive method to get accurate info. */ |
3325 |
Vw32_get_true_file_attributes = Qt; |
Vw32_get_true_file_attributes = Qt; |
3326 |
result = stat (XSTRING (absname)->data, &st); |
result = stat (SDATA (absname), &st); |
3327 |
Vw32_get_true_file_attributes = tem; |
Vw32_get_true_file_attributes = tem; |
3328 |
|
|
3329 |
if (result < 0) |
if (result < 0) |
3331 |
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; |
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; |
3332 |
} |
} |
3333 |
#else |
#else |
3334 |
if (stat (XSTRING (absname)->data, &st) < 0) |
if (stat (SDATA (absname), &st) < 0) |
3335 |
return Qnil; |
return Qnil; |
3336 |
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; |
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; |
3337 |
#endif |
#endif |
3356 |
|
|
3357 |
absname = ENCODE_FILE (absname); |
absname = ENCODE_FILE (absname); |
3358 |
|
|
3359 |
if (stat (XSTRING (absname)->data, &st) < 0) |
if (stat (SDATA (absname), &st) < 0) |
3360 |
return Qnil; |
return Qnil; |
3361 |
#if defined (MSDOS) && __DJGPP__ < 2 |
#if defined (MSDOS) && __DJGPP__ < 2 |
3362 |
if (check_executable (XSTRING (absname)->data)) |
if (check_executable (SDATA (absname))) |
3363 |
st.st_mode |= S_IEXEC; |
st.st_mode |= S_IEXEC; |
3364 |
#endif /* MSDOS && __DJGPP__ < 2 */ |
#endif /* MSDOS && __DJGPP__ < 2 */ |
3365 |
|
|
3386 |
|
|
3387 |
encoded_absname = ENCODE_FILE (absname); |
encoded_absname = ENCODE_FILE (absname); |
3388 |
|
|
3389 |
if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0) |
if (chmod (SDATA (encoded_absname), XINT (mode)) < 0) |
3390 |
report_file_error ("Doing chmod", Fcons (absname, Qnil)); |
report_file_error ("Doing chmod", Fcons (absname, Qnil)); |
3391 |
|
|
3392 |
return Qnil; |
return Qnil; |
3472 |
absname2 = ENCODE_FILE (absname2); |
absname2 = ENCODE_FILE (absname2); |
3473 |
UNGCPRO; |
UNGCPRO; |
3474 |
|
|
3475 |
if (stat (XSTRING (absname1)->data, &st) < 0) |
if (stat (SDATA (absname1), &st) < 0) |
3476 |
return Qnil; |
return Qnil; |
3477 |
|
|
3478 |
mtime1 = st.st_mtime; |
mtime1 = st.st_mtime; |
3479 |
|
|
3480 |
if (stat (XSTRING (absname2)->data, &st) < 0) |
if (stat (SDATA (absname2), &st) < 0) |
3481 |
return Qt; |
return Qt; |
3482 |
|
|
3483 |
return (mtime1 > st.st_mtime) ? Qt : Qnil; |
return (mtime1 > st.st_mtime) ? Qt : Qnil; |
3550 |
read_non_regular () |
read_non_regular () |
3551 |
{ |
{ |
3552 |
int nbytes; |
int nbytes; |
3553 |
|
|
3554 |
immediate_quit = 1; |
immediate_quit = 1; |
3555 |
QUIT; |
QUIT; |
3556 |
nbytes = emacs_read (non_regular_fd, |
nbytes = emacs_read (non_regular_fd, |
3604 |
int inserted = 0; |
int inserted = 0; |
3605 |
register int how_much; |
register int how_much; |
3606 |
register int unprocessed; |
register int unprocessed; |
3607 |
int count = BINDING_STACK_SIZE (); |
int count = SPECPDL_INDEX (); |
3608 |
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
3609 |
Lisp_Object handler, val, insval, orig_filename; |
Lisp_Object handler, val, insval, orig_filename; |
3610 |
Lisp_Object p; |
Lisp_Object p; |
3656 |
|
|
3657 |
/* Tell stat to use expensive method to get accurate info. */ |
/* Tell stat to use expensive method to get accurate info. */ |
3658 |
Vw32_get_true_file_attributes = Qt; |
Vw32_get_true_file_attributes = Qt; |
3659 |
total = stat (XSTRING (filename)->data, &st); |
total = stat (SDATA (filename), &st); |
3660 |
Vw32_get_true_file_attributes = tem; |
Vw32_get_true_file_attributes = tem; |
3661 |
} |
} |
3662 |
if (total < 0) |
if (total < 0) |
3663 |
#else |
#else |
3664 |
#ifndef APOLLO |
#ifndef APOLLO |
3665 |
if (stat (XSTRING (filename)->data, &st) < 0) |
if (stat (SDATA (filename), &st) < 0) |
3666 |
#else |
#else |
3667 |
if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0 |
if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0 |
3668 |
|| fstat (fd, &st) < 0) |
|| fstat (fd, &st) < 0) |
3669 |
#endif /* not APOLLO */ |
#endif /* not APOLLO */ |
3670 |
#endif /* WINDOWSNT */ |
#endif /* WINDOWSNT */ |
3699 |
#endif |
#endif |
3700 |
|
|
3701 |
if (fd < 0) |
if (fd < 0) |
3702 |
if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0) |
if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0) |
3703 |
goto badopen; |
goto badopen; |
3704 |
|
|
3705 |
/* Replacement should preserve point as it preserves markers. */ |
/* Replacement should preserve point as it preserves markers. */ |
3709 |
record_unwind_protect (close_file_unwind, make_number (fd)); |
record_unwind_protect (close_file_unwind, make_number (fd)); |
3710 |
|
|
3711 |
/* Supposedly happens on VMS. */ |
/* Supposedly happens on VMS. */ |
3712 |
|
/* Can happen on any platform that uses long as type of off_t, but allows |
3713 |
|
file sizes to exceed 2Gb. VMS is no longer officially supported, so |
3714 |
|
give a message suitable for the latter case. */ |
3715 |
if (! not_regular && st.st_size < 0) |
if (! not_regular && st.st_size < 0) |
3716 |
error ("File size is negative"); |
error ("Maximum buffer size exceeded"); |
3717 |
|
|
3718 |
/* Prevent redisplay optimizations. */ |
/* Prevent redisplay optimizations. */ |
3719 |
current_buffer->clip_changed = 1; |
current_buffer->clip_changed = 1; |
3798 |
|
|
3799 |
if (nread < 0) |
if (nread < 0) |
3800 |
error ("IO error reading %s: %s", |
error ("IO error reading %s: %s", |
3801 |
XSTRING (orig_filename)->data, emacs_strerror (errno)); |
SDATA (orig_filename), emacs_strerror (errno)); |
3802 |
else if (nread > 0) |
else if (nread > 0) |
3803 |
{ |
{ |
3804 |
struct buffer *prev = current_buffer; |
struct buffer *prev = current_buffer; |
3816 |
buf->undo_list = Qt; |
buf->undo_list = Qt; |
3817 |
buf->overlays_before = Qnil; |
buf->overlays_before = Qnil; |
3818 |
buf->overlays_after = Qnil; |
buf->overlays_after = Qnil; |
3819 |
|
|
3820 |
set_buffer_internal (buf); |
set_buffer_internal (buf); |
3821 |
Ferase_buffer (); |
Ferase_buffer (); |
3822 |
buf->enable_multibyte_characters = Qnil; |
buf->enable_multibyte_characters = Qnil; |
3826 |
val = call2 (Vset_auto_coding_function, |
val = call2 (Vset_auto_coding_function, |
3827 |
filename, make_number (nread)); |
filename, make_number (nread)); |
3828 |
set_buffer_internal (prev); |
set_buffer_internal (prev); |
3829 |
|
|
3830 |
/* Discard the unwind protect for recovering the |
/* Discard the unwind protect for recovering the |
3831 |
current buffer. */ |
current buffer. */ |
3832 |
specpdl_ptr--; |
specpdl_ptr--; |
3915 |
nread = emacs_read (fd, buffer, sizeof buffer); |
nread = emacs_read (fd, buffer, sizeof buffer); |
3916 |
if (nread < 0) |
if (nread < 0) |
3917 |
error ("IO error reading %s: %s", |
error ("IO error reading %s: %s", |
3918 |
XSTRING (orig_filename)->data, emacs_strerror (errno)); |
SDATA (orig_filename), emacs_strerror (errno)); |
3919 |
else if (nread == 0) |
else if (nread == 0) |
3920 |
break; |
break; |
3921 |
|
|
3986 |
nread = emacs_read (fd, buffer + total_read, trial - total_read); |
nread = emacs_read (fd, buffer + total_read, trial - total_read); |
3987 |
if (nread < 0) |
if (nread < 0) |
3988 |
error ("IO error reading %s: %s", |
error ("IO error reading %s: %s", |
3989 |
XSTRING (orig_filename)->data, emacs_strerror (errno)); |
SDATA (orig_filename), emacs_strerror (errno)); |
3990 |
else if (nread == 0) |
else if (nread == 0) |
3991 |
break; |
break; |
3992 |
total_read += nread; |
total_read += nread; |
3993 |
} |
} |
3994 |
|
|
3995 |
/* Scan this bufferful from the end, comparing with |
/* Scan this bufferful from the end, comparing with |
3996 |
the Emacs buffer. */ |
the Emacs buffer. */ |
3997 |
bufpos = total_read; |
bufpos = total_read; |
3998 |
|
|
3999 |
/* Compare with same_at_start to avoid counting some buffer text |
/* Compare with same_at_start to avoid counting some buffer text |
4000 |
as matching both at the file's beginning and at the end. */ |
as matching both at the file's beginning and at the end. */ |
4001 |
while (bufpos > 0 && same_at_end > same_at_start |
while (bufpos > 0 && same_at_end > same_at_start |
4169 |
|
|
4170 |
if (how_much == -1) |
if (how_much == -1) |
4171 |
error ("IO error reading %s: %s", |
error ("IO error reading %s: %s", |
4172 |
XSTRING (orig_filename)->data, emacs_strerror (errno)); |
SDATA (orig_filename), emacs_strerror (errno)); |
4173 |
else if (how_much == -2) |
else if (how_much == -2) |
4174 |
error ("maximum buffer size exceeded"); |
error ("maximum buffer size exceeded"); |
4175 |
} |
} |
4252 |
if (coding.cmp_data && coding.cmp_data->used) |
if (coding.cmp_data && coding.cmp_data->used) |
4253 |
coding_restore_composition (&coding, Fcurrent_buffer ()); |
coding_restore_composition (&coding, Fcurrent_buffer ()); |
4254 |
coding_free_composition_data (&coding); |
coding_free_composition_data (&coding); |
4255 |
|
|
4256 |
/* Set `inserted' to the number of inserted characters. */ |
/* Set `inserted' to the number of inserted characters. */ |
4257 |
inserted = PT - temp; |
inserted = PT - temp; |
4258 |
|
|
4297 |
before exiting the loop, it is set to a negative value if I/O |
before exiting the loop, it is set to a negative value if I/O |
4298 |
error occurs. */ |
error occurs. */ |
4299 |
how_much = 0; |
how_much = 0; |
4300 |
|
|
4301 |
/* Total bytes inserted. */ |
/* Total bytes inserted. */ |
4302 |
inserted = 0; |
inserted = 0; |
4303 |
|
|
4304 |
/* Here, we don't do code conversion in the loop. It is done by |
/* Here, we don't do code conversion in the loop. It is done by |
4305 |
code_convert_region after all data are read into the buffer. */ |
code_convert_region after all data are read into the buffer. */ |
4306 |
{ |
{ |
4307 |
int gap_size = GAP_SIZE; |
int gap_size = GAP_SIZE; |
4308 |
|
|
4309 |
while (how_much < total) |
while (how_much < total) |
4310 |
{ |
{ |
4311 |
/* try is reserved in some compilers (Microsoft C) */ |
/* try is reserved in some compilers (Microsoft C) */ |
4349 |
this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry); |
this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry); |
4350 |
immediate_quit = 0; |
immediate_quit = 0; |
4351 |
} |
} |
4352 |
|
|
4353 |
if (this <= 0) |
if (this <= 0) |
4354 |
{ |
{ |
4355 |
how_much = this; |
how_much = this; |
4389 |
|
|
4390 |
if (how_much < 0) |
if (how_much < 0) |
4391 |
error ("IO error reading %s: %s", |
error ("IO error reading %s: %s", |
4392 |
XSTRING (orig_filename)->data, emacs_strerror (errno)); |
SDATA (orig_filename), emacs_strerror (errno)); |
4393 |
|
|
4394 |
notfound: |
notfound: |
4395 |
|
|
4414 |
this way, we can run Lisp program safely before decoding |
this way, we can run Lisp program safely before decoding |
4415 |
the inserted text. */ |
the inserted text. */ |
4416 |
Lisp_Object unwind_data; |
Lisp_Object unwind_data; |
4417 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
4418 |
|
|
4419 |
unwind_data = Fcons (current_buffer->enable_multibyte_characters, |
unwind_data = Fcons (current_buffer->enable_multibyte_characters, |
4420 |
Fcons (current_buffer->undo_list, |
Fcons (current_buffer->undo_list, |
4497 |
/* Use the conversion type to determine buffer-file-type |
/* Use the conversion type to determine buffer-file-type |
4498 |
(find-buffer-file-type is now used to help determine the |
(find-buffer-file-type is now used to help determine the |
4499 |
conversion). */ |
conversion). */ |
4500 |
if ((coding.eol_type == CODING_EOL_UNDECIDED |
if ((coding.eol_type == CODING_EOL_UNDECIDED |
4501 |
|| coding.eol_type == CODING_EOL_LF) |
|| coding.eol_type == CODING_EOL_LF) |
4502 |
&& ! CODING_REQUIRE_DECODING (&coding)) |
&& ! CODING_REQUIRE_DECODING (&coding)) |
4503 |
current_buffer->buffer_file_type = Qt; |
current_buffer->buffer_file_type = Qt; |
4512 |
if (!EQ (current_buffer->undo_list, Qt)) |
if (!EQ (current_buffer->undo_list, Qt)) |
4513 |
current_buffer->undo_list = Qnil; |
current_buffer->undo_list = Qnil; |
4514 |
#ifdef APOLLO |
#ifdef APOLLO |
4515 |
stat (XSTRING (filename)->data, &st); |
stat (SDATA (filename), &st); |
4516 |
#endif |
#endif |
4517 |
|
|
4518 |
if (NILP (handler)) |
if (NILP (handler)) |
4542 |
if (inserted > 0) |
if (inserted > 0) |
4543 |
{ |
{ |
4544 |
int empty_undo_list_p = 0; |
int empty_undo_list_p = 0; |
4545 |
|
|
4546 |
/* If we're anyway going to discard undo information, don't |
/* If we're anyway going to discard undo information, don't |
4547 |
record it in the first place. The buffer's undo list at this |
record it in the first place. The buffer's undo list at this |
4548 |
point is either nil or t when visiting a file. */ |
point is either nil or t when visiting a file. */ |
4551 |
empty_undo_list_p = NILP (current_buffer->undo_list); |
empty_undo_list_p = NILP (current_buffer->undo_list); |
4552 |
current_buffer->undo_list = Qt; |
current_buffer->undo_list = Qt; |
4553 |
} |
} |
4554 |
|
|
4555 |
insval = call3 (Qformat_decode, |
insval = call3 (Qformat_decode, |
4556 |
Qnil, make_number (inserted), visit); |
Qnil, make_number (inserted), visit); |
4557 |
CHECK_NUMBER (insval); |
CHECK_NUMBER (insval); |
4558 |
inserted = XFASTINT (insval); |
inserted = XFASTINT (insval); |
4559 |
|
|
4560 |
if (!NILP (visit)) |
if (!NILP (visit)) |
4561 |
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt; |
current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt; |
4562 |
} |
} |
4644 |
if (auto_saving) |
if (auto_saving) |
4645 |
val = Qnil; |
val = Qnil; |
4646 |
else if (!NILP (Vcoding_system_for_write)) |
else if (!NILP (Vcoding_system_for_write)) |
4647 |
val = Vcoding_system_for_write; |
{ |
4648 |
|
val = Vcoding_system_for_write; |
4649 |
|
if (coding_system_require_warning |
4650 |
|
&& !NILP (Ffboundp (Vselect_safe_coding_system_function))) |
4651 |
|
/* Confirm that VAL can surely encode the current region. */ |
4652 |
|
val = call5 (Vselect_safe_coding_system_function, |
4653 |
|
start, end, Fcons (Qt, Fcons (val, Qnil)), |
4654 |
|
Qnil, filename); |
4655 |
|
} |
4656 |
else |
else |
4657 |
{ |
{ |
4658 |
/* If the variable `buffer-file-coding-system' is set locally, |
/* If the variable `buffer-file-coding-system' is set locally, |
4675 |
if (NILP (current_buffer->enable_multibyte_characters)) |
if (NILP (current_buffer->enable_multibyte_characters)) |
4676 |
force_raw_text = 1; |
force_raw_text = 1; |
4677 |
} |
} |
4678 |
|
|
4679 |
if (NILP (val)) |
if (NILP (val)) |
4680 |
{ |
{ |
4681 |
/* Check file-coding-system-alist. */ |
/* Check file-coding-system-alist. */ |
4697 |
val = current_buffer->buffer_file_coding_system; |
val = current_buffer->buffer_file_coding_system; |
4698 |
using_default_coding = 1; |
using_default_coding = 1; |
4699 |
} |
} |
4700 |
|
|
4701 |
if (!force_raw_text |
if (!force_raw_text |
4702 |
&& !NILP (Ffboundp (Vselect_safe_coding_system_function))) |
&& !NILP (Ffboundp (Vselect_safe_coding_system_function))) |
4703 |
/* Confirm that VAL can surely encode the current region. */ |
/* Confirm that VAL can surely encode the current region. */ |
4757 |
the output goes to FILENAME, but the buffer is marked as visiting VISIT. |
the output goes to FILENAME, but the buffer is marked as visiting VISIT. |
4758 |
VISIT is also the file name to lock and unlock for clash detection. |
VISIT is also the file name to lock and unlock for clash detection. |
4759 |
If VISIT is neither t nor nil nor a string, |
If VISIT is neither t nor nil nor a string, |
4760 |
that means do not print the \"Wrote file\" message. |
that means do not display the \"Wrote file\" message. |
4761 |
The optional sixth arg LOCKNAME, if non-nil, specifies the name to |
The optional sixth arg LOCKNAME, if non-nil, specifies the name to |
4762 |
use for locking and unlocking, overriding FILENAME and VISIT. |
use for locking and unlocking, overriding FILENAME and VISIT. |
4763 |
The optional seventh arg MUSTBENEW, if non-nil, insists on a check |
The optional seventh arg MUSTBENEW, if non-nil, insists on a check |
4777 |
register int desc; |
register int desc; |
4778 |
int failure; |
int failure; |
4779 |
int save_errno = 0; |
int save_errno = 0; |
4780 |
unsigned char *fn; |
const unsigned char *fn; |
4781 |
struct stat st; |
struct stat st; |
4782 |
int tem; |
int tem; |
4783 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
4784 |
int count1; |
int count1; |
4785 |
#ifdef VMS |
#ifdef VMS |
4786 |
unsigned char *fname = 0; /* If non-0, original filename (must rename) */ |
unsigned char *fname = 0; /* If non-0, original filename (must rename) */ |
4852 |
} |
} |
4853 |
|
|
4854 |
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); |
record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); |
4855 |
count1 = specpdl_ptr - specpdl; |
count1 = SPECPDL_INDEX (); |
4856 |
|
|
4857 |
given_buffer = current_buffer; |
given_buffer = current_buffer; |
4858 |
|
|
4907 |
|
|
4908 |
encoded_filename = ENCODE_FILE (filename); |
encoded_filename = ENCODE_FILE (filename); |
4909 |
|
|
4910 |
fn = XSTRING (encoded_filename)->data; |
fn = SDATA (encoded_filename); |
4911 |
desc = -1; |
desc = -1; |
4912 |
if (!NILP (append)) |
if (!NILP (append)) |
4913 |
#ifdef DOS_NT |
#ifdef DOS_NT |
4924 |
desc = emacs_open (fn, O_RDWR, 0); |
desc = emacs_open (fn, O_RDWR, 0); |
4925 |
if (desc < 0) |
if (desc < 0) |
4926 |
desc = creat_copy_attrs (STRINGP (current_buffer->filename) |
desc = creat_copy_attrs (STRINGP (current_buffer->filename) |
4927 |
? XSTRING (current_buffer->filename)->data : 0, |
? SDATA (current_buffer->filename) : 0, |
4928 |
fn); |
fn); |
4929 |
} |
} |
4930 |
else /* Write to temporary name and rename if no errors */ |
else /* Write to temporary name and rename if no errors */ |
4936 |
{ |
{ |
4937 |
temp_name = Fmake_temp_name (concat2 (temp_name, |
temp_name = Fmake_temp_name (concat2 (temp_name, |
4938 |
build_string ("$$SAVE$$"))); |
build_string ("$$SAVE$$"))); |
4939 |
fname = XSTRING (filename)->data; |
fname = SDATA (filename); |
4940 |
fn = XSTRING (temp_name)->data; |
fn = SDATA (temp_name); |
4941 |
desc = creat_copy_attrs (fname, fn); |
desc = creat_copy_attrs (fname, fn); |
4942 |
if (desc < 0) |
if (desc < 0) |
4943 |
{ |
{ |
4991 |
if (!NILP (append) && !NILP (Ffile_regular_p (filename))) |
if (!NILP (append) && !NILP (Ffile_regular_p (filename))) |
4992 |
{ |
{ |
4993 |
long ret; |
long ret; |
4994 |
|
|
4995 |
if (NUMBERP (append)) |
if (NUMBERP (append)) |
4996 |
ret = lseek (desc, XINT (append), 1); |
ret = lseek (desc, XINT (append), 1); |
4997 |
else |
else |
5005 |
report_file_error ("Lseek error", Fcons (filename, Qnil)); |
report_file_error ("Lseek error", Fcons (filename, Qnil)); |
5006 |
} |
} |
5007 |
} |
} |
5008 |
|
|
5009 |
UNGCPRO; |
UNGCPRO; |
5010 |
|
|
5011 |
#ifdef VMS |
#ifdef VMS |
5046 |
|
|
5047 |
if (STRINGP (start)) |
if (STRINGP (start)) |
5048 |
{ |
{ |
5049 |
failure = 0 > a_write (desc, start, 0, XSTRING (start)->size, |
failure = 0 > a_write (desc, start, 0, SCHARS (start), |
5050 |
&annotations, &coding); |
&annotations, &coding); |
5051 |
save_errno = errno; |
save_errno = errno; |
5052 |
} |
} |
5156 |
current_buffer->modtime = st.st_mtime; |
current_buffer->modtime = st.st_mtime; |
5157 |
|
|
5158 |
if (failure) |
if (failure) |
5159 |
error ("IO error writing %s: %s", XSTRING (filename)->data, |
error ("IO error writing %s: %s", SDATA (filename), |
5160 |
emacs_strerror (save_errno)); |
emacs_strerror (save_errno)); |
5161 |
|
|
5162 |
if (visiting) |
if (visiting) |
5237 |
for (i = 0; CONSP (p); p = XCDR (p), ++i) |
for (i = 0; CONSP (p); p = XCDR (p), ++i) |
5238 |
{ |
{ |
5239 |
struct buffer *given_buffer = current_buffer; |
struct buffer *given_buffer = current_buffer; |
5240 |
|
|
5241 |
Vwrite_region_annotations_so_far = annotations; |
Vwrite_region_annotations_so_far = annotations; |
5242 |
|
|
5243 |
/* Value is either a list of annotations or nil if the function |
/* Value is either a list of annotations or nil if the function |
5251 |
XSETFASTINT (end, ZV); |
XSETFASTINT (end, ZV); |
5252 |
annotations = Qnil; |
annotations = Qnil; |
5253 |
} |
} |
5254 |
|
|
5255 |
if (CONSP (res)) |
if (CONSP (res)) |
5256 |
annotations = merge (annotations, res, Qcar_less_than_car); |
annotations = merge (annotations, res, Qcar_less_than_car); |
5257 |
} |
} |
5331 |
tem = Fcdr (Fcar (*annot)); |
tem = Fcdr (Fcar (*annot)); |
5332 |
if (STRINGP (tem)) |
if (STRINGP (tem)) |
5333 |
{ |
{ |
5334 |
if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding)) |
if (0 > e_write (desc, tem, 0, SCHARS (tem), coding)) |
5335 |
return -1; |
return -1; |
5336 |
} |
} |
5337 |
*annot = Fcdr (*annot); |
*annot = Fcdr (*annot); |
5367 |
|
|
5368 |
if (STRINGP (string)) |
if (STRINGP (string)) |
5369 |
{ |
{ |
5370 |
addr = XSTRING (string)->data; |
addr = SDATA (string); |
5371 |
nbytes = STRING_BYTES (XSTRING (string)); |
nbytes = SBYTES (string); |
5372 |
coding->src_multibyte = STRING_MULTIBYTE (string); |
coding->src_multibyte = STRING_MULTIBYTE (string); |
5373 |
} |
} |
5374 |
else if (start < end) |
else if (start < end) |
5456 |
|
|
5457 |
filename = ENCODE_FILE (b->filename); |
filename = ENCODE_FILE (b->filename); |
5458 |
|
|
5459 |
if (stat (XSTRING (filename)->data, &st) < 0) |
if (stat (SDATA (filename), &st) < 0) |
5460 |
{ |
{ |
5461 |
/* If the file doesn't exist now and didn't exist before, |
/* If the file doesn't exist now and didn't exist before, |
5462 |
we say that it isn't modified, provided the error is a tame one. */ |
we say that it isn't modified, provided the error is a tame one. */ |
5524 |
|
|
5525 |
filename = ENCODE_FILE (filename); |
filename = ENCODE_FILE (filename); |
5526 |
|
|
5527 |
if (stat (XSTRING (filename)->data, &st) >= 0) |
if (stat (SDATA (filename), &st) >= 0) |
5528 |
current_buffer->modtime = st.st_mtime; |
current_buffer->modtime = st.st_mtime; |
5529 |
} |
} |
5530 |
|
|
5538 |
Lisp_Object args[3], msg; |
Lisp_Object args[3], msg; |
5539 |
int i, nbytes; |
int i, nbytes; |
5540 |
struct gcpro gcpro1; |
struct gcpro gcpro1; |
5541 |
|
|
5542 |
ring_bell (); |
ring_bell (); |
5543 |
|
|
5544 |
args[0] = build_string ("Auto-saving %s: %s"); |
args[0] = build_string ("Auto-saving %s: %s"); |
5545 |
args[1] = current_buffer->name; |
args[1] = current_buffer->name; |
5546 |
args[2] = Ferror_message_string (error); |
args[2] = Ferror_message_string (error); |
5547 |
msg = Fformat (3, args); |
msg = Fformat (3, args); |
5548 |
GCPRO1 (msg); |
GCPRO1 (msg); |
5549 |
nbytes = STRING_BYTES (XSTRING (msg)); |
nbytes = SBYTES (msg); |
5550 |
|
|
5551 |
for (i = 0; i < 3; ++i) |
for (i = 0; i < 3; ++i) |
5552 |
{ |
{ |
5553 |
if (i == 0) |
if (i == 0) |
5554 |
message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg)); |
message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); |
5555 |
else |
else |
5556 |
message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg)); |
message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); |
5557 |
Fsleep_for (make_number (1), Qnil); |
Fsleep_for (make_number (1), Qnil); |
5558 |
} |
} |
5559 |
|
|
5568 |
|
|
5569 |
/* Get visited file's mode to become the auto save file's mode. */ |
/* Get visited file's mode to become the auto save file's mode. */ |
5570 |
if (! NILP (current_buffer->filename) |
if (! NILP (current_buffer->filename) |
5571 |
&& stat (XSTRING (current_buffer->filename)->data, &st) >= 0) |
&& stat (SDATA (current_buffer->filename), &st) >= 0) |
5572 |
/* But make sure we can overwrite it later! */ |
/* But make sure we can overwrite it later! */ |
5573 |
auto_save_mode_bits = st.st_mode | 0600; |
auto_save_mode_bits = st.st_mode | 0600; |
5574 |
else |
else |
5588 |
if (!NILP (stream)) |
if (!NILP (stream)) |
5589 |
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 |
fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 |
5590 |
| XFASTINT (XCDR (stream)))); |
| XFASTINT (XCDR (stream)))); |
|
pop_message (); |
|
5591 |
return Qnil; |
return Qnil; |
5592 |
} |
} |
5593 |
|
|
5599 |
return Qnil; |
return Qnil; |
5600 |
} |
} |
5601 |
|
|
5602 |
|
static Lisp_Object |
5603 |
|
do_auto_save_make_dir (dir) |
5604 |
|
Lisp_Object dir; |
5605 |
|
{ |
5606 |
|
return call2 (Qmake_directory, dir, Qt); |
5607 |
|
} |
5608 |
|
|
5609 |
|
static Lisp_Object |
5610 |
|
do_auto_save_eh (ignore) |
5611 |
|
Lisp_Object ignore; |
5612 |
|
{ |
5613 |
|
return Qnil; |
5614 |
|
} |
5615 |
|
|
5616 |
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", |
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", |
5617 |
doc: /* Auto-save all buffers that need it. |
doc: /* Auto-save all buffers that need it. |
5618 |
This is all buffers that have auto-saving enabled |
This is all buffers that have auto-saving enabled |
5634 |
Lisp_Object oquit; |
Lisp_Object oquit; |
5635 |
FILE *stream; |
FILE *stream; |
5636 |
Lisp_Object lispstream; |
Lisp_Object lispstream; |
5637 |
int count = specpdl_ptr - specpdl; |
int count = SPECPDL_INDEX (); |
5638 |
int orig_minibuffer_auto_raise = minibuffer_auto_raise; |
int orig_minibuffer_auto_raise = minibuffer_auto_raise; |
5639 |
int message_p = 0; |
int old_message_p = 0; |
5640 |
|
struct gcpro gcpro1, gcpro2; |
5641 |
|
|
5642 |
if (max_specpdl_size < specpdl_size + 40) |
if (max_specpdl_size < specpdl_size + 40) |
5643 |
max_specpdl_size = specpdl_size + 40; |
max_specpdl_size = specpdl_size + 40; |
5645 |
if (minibuf_level) |
if (minibuf_level) |
5646 |
no_message = Qt; |
no_message = Qt; |
5647 |
|
|
5648 |
if (NILP (no_message)); |
if (NILP (no_message)) |
5649 |
message_p = push_message (); |
{ |
5650 |
|
old_message_p = push_message (); |
5651 |
|
record_unwind_protect (pop_message_unwind, Qnil); |
5652 |
|
} |
5653 |
|
|
5654 |
/* Ordinarily don't quit within this function, |
/* Ordinarily don't quit within this function, |
5655 |
but don't make it impossible to quit (in case we get hung in I/O). */ |
but don't make it impossible to quit (in case we get hung in I/O). */ |
5656 |
oquit = Vquit_flag; |
oquit = Vquit_flag; |
5665 |
if (STRINGP (Vauto_save_list_file_name)) |
if (STRINGP (Vauto_save_list_file_name)) |
5666 |
{ |
{ |
5667 |
Lisp_Object listfile; |
Lisp_Object listfile; |
5668 |
|
|
5669 |
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); |
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); |
5670 |
|
|
5671 |
/* Don't try to create the directory when shutting down Emacs, |
/* Don't try to create the directory when shutting down Emacs, |
5674 |
if (!NILP (Vrun_hooks)) |
if (!NILP (Vrun_hooks)) |
5675 |
{ |
{ |
5676 |
Lisp_Object dir; |
Lisp_Object dir; |
5677 |
|
dir = Qnil; |
5678 |
|
GCPRO2 (dir, listfile); |
5679 |
dir = Ffile_name_directory (listfile); |
dir = Ffile_name_directory (listfile); |
5680 |
if (NILP (Ffile_directory_p (dir))) |
if (NILP (Ffile_directory_p (dir))) |
5681 |
call2 (Qmake_directory, dir, Qt); |
internal_condition_case_1 (do_auto_save_make_dir, |
5682 |
|
dir, Fcons (Fcons (Qfile_error, Qnil), Qnil), |
5683 |
|
do_auto_save_eh); |
5684 |
|
UNGCPRO; |
5685 |
} |
} |
5686 |
|
|
5687 |
stream = fopen (XSTRING (listfile)->data, "w"); |
stream = fopen (SDATA (listfile), "w"); |
5688 |
if (stream != NULL) |
if (stream != NULL) |
5689 |
{ |
{ |
5690 |
/* Arrange to close that file whether or not we get an error. |
/* Arrange to close that file whether or not we get an error. |
5727 |
{ |
{ |
5728 |
if (!NILP (b->filename)) |
if (!NILP (b->filename)) |
5729 |
{ |
{ |
5730 |
fwrite (XSTRING (b->filename)->data, 1, |
fwrite (SDATA (b->filename), 1, |
5731 |
STRING_BYTES (XSTRING (b->filename)), stream); |
SBYTES (b->filename), stream); |
5732 |
} |
} |
5733 |
putc ('\n', stream); |
putc ('\n', stream); |
5734 |
fwrite (XSTRING (b->auto_save_file_name)->data, 1, |
fwrite (SDATA (b->auto_save_file_name), 1, |
5735 |
STRING_BYTES (XSTRING (b->auto_save_file_name)), stream); |
SBYTES (b->auto_save_file_name), stream); |
5736 |
putc ('\n', stream); |
putc ('\n', stream); |
5737 |
} |
} |
5738 |
|
|
5809 |
|
|
5810 |
if (auto_saved && NILP (no_message)) |
if (auto_saved && NILP (no_message)) |
5811 |
{ |
{ |
5812 |
if (message_p) |
if (old_message_p) |
5813 |
{ |
{ |
5814 |
|
/* If we are going to restore an old message, |
5815 |
|
give time to read ours. */ |
5816 |
sit_for (1, 0, 0, 0, 0); |
sit_for (1, 0, 0, 0, 0); |
5817 |
restore_message (); |
restore_message (); |
5818 |
} |
} |
5819 |
else |
else |
5820 |
|
/* If we displayed a message and then restored a state |
5821 |
|
with no message, leave a "done" message on the screen. */ |
5822 |
message1 ("Auto-saving...done"); |
message1 ("Auto-saving...done"); |
5823 |
} |
} |
5824 |
|
|
5825 |
Vquit_flag = oquit; |
Vquit_flag = oquit; |
5826 |
|
|
5827 |
|
/* This restores the message-stack status. */ |
5828 |
unbind_to (count, Qnil); |
unbind_to (count, Qnil); |
5829 |
return Qnil; |
return Qnil; |
5830 |
} |
} |
5867 |
double_dollars (val) |
double_dollars (val) |
5868 |
Lisp_Object val; |
Lisp_Object val; |
5869 |
{ |
{ |
5870 |
register unsigned char *old, *new; |
register const unsigned char *old; |
5871 |
|
register unsigned char *new; |
5872 |
register int n; |
register int n; |
5873 |
int osize, count; |
int osize, count; |
5874 |
|
|
5875 |
osize = STRING_BYTES (XSTRING (val)); |
osize = SBYTES (val); |
5876 |
|
|
5877 |
/* Count the number of $ characters. */ |
/* Count the number of $ characters. */ |
5878 |
for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) |
for (n = osize, count = 0, old = SDATA (val); n > 0; n--) |
5879 |
if (*old++ == '$') count++; |
if (*old++ == '$') count++; |
5880 |
if (count > 0) |
if (count > 0) |
5881 |
{ |
{ |
5882 |
old = XSTRING (val)->data; |
old = SDATA (val); |
5883 |
val = make_uninit_multibyte_string (XSTRING (val)->size + count, |
val = make_uninit_multibyte_string (SCHARS (val) + count, |
5884 |
osize + count); |
osize + count); |
5885 |
new = XSTRING (val)->data; |
new = SDATA (val); |
5886 |
for (n = osize; n > 0; n--) |
for (n = osize; n > 0; n--) |
5887 |
if (*old != '$') |
if (*old != '$') |
5888 |
*new++ = *old++; |
*new++ = *old++; |
5900 |
read_file_name_cleanup (arg) |
read_file_name_cleanup (arg) |
5901 |
Lisp_Object arg; |
Lisp_Object arg; |
5902 |
{ |
{ |
5903 |
current_buffer->directory = arg; |
return (current_buffer->directory = arg); |
5904 |
} |
} |
5905 |
|
|
5906 |
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, |
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, |
5925 |
/* No need to protect ACTION--we only compare it with t and nil. */ |
/* No need to protect ACTION--we only compare it with t and nil. */ |
5926 |
GCPRO5 (string, realdir, name, specdir, orig_string); |
GCPRO5 (string, realdir, name, specdir, orig_string); |
5927 |
|
|
5928 |
if (XSTRING (string)->size == 0) |
if (SCHARS (string) == 0) |
5929 |
{ |
{ |
5930 |
if (EQ (action, Qlambda)) |
if (EQ (action, Qlambda)) |
5931 |
{ |
{ |
5979 |
#ifndef VMS |
#ifndef VMS |
5980 |
if (EQ (Vread_file_name_predicate, Qfile_directory_p)) |
if (EQ (Vread_file_name_predicate, Qfile_directory_p)) |
5981 |
{ |
{ |
5982 |
/* Brute-force speed up for directory checking: |
/* Brute-force speed up for directory checking: |
5983 |
Discard strings which don't end in a slash. */ |
Discard strings which don't end in a slash. */ |
5984 |
for (comp = Qnil; CONSP (all); all = XCDR (all)) |
for (comp = Qnil; CONSP (all); all = XCDR (all)) |
5985 |
{ |
{ |
5986 |
Lisp_Object tem = XCAR (all); |
Lisp_Object tem = XCAR (all); |
5987 |
int len; |
int len; |
5988 |
if (STRINGP (tem) && |
if (STRINGP (tem) && |
5989 |
(len = XSTRING (tem)->size, len > 0) && |
(len = SCHARS (tem), len > 0) && |
5990 |
IS_DIRECTORY_SEP (XSTRING (tem)->data[len-1])) |
IS_DIRECTORY_SEP (SREF (tem, len-1))) |
5991 |
comp = Fcons (tem, comp); |
comp = Fcons (tem, comp); |
5992 |
} |
} |
5993 |
} |
} |
5996 |
{ |
{ |
5997 |
/* Must do it the hard (and slow) way. */ |
/* Must do it the hard (and slow) way. */ |
5998 |
GCPRO3 (all, comp, specdir); |
GCPRO3 (all, comp, specdir); |
5999 |
count = specpdl_ptr - specpdl; |
count = SPECPDL_INDEX (); |
6000 |
record_unwind_protect (read_file_name_cleanup, current_buffer->directory); |
record_unwind_protect (read_file_name_cleanup, current_buffer->directory); |
6001 |
current_buffer->directory = realdir; |
current_buffer->directory = realdir; |
6002 |
for (comp = Qnil; CONSP (all); all = XCDR (all)) |
for (comp = Qnil; CONSP (all); all = XCDR (all)) |
6012 |
#ifdef VMS |
#ifdef VMS |
6013 |
/* Supposedly this helps commands such as `cd' that read directory names, |
/* Supposedly this helps commands such as `cd' that read directory names, |
6014 |
but can someone explain how it helps them? -- RMS */ |
but can someone explain how it helps them? -- RMS */ |
6015 |
if (XSTRING (name)->size == 0) |
if (SCHARS (name) == 0) |
6016 |
return Qt; |
return Qt; |
6017 |
#endif /* VMS */ |
#endif /* VMS */ |
6018 |
if (!NILP (Vread_file_name_predicate)) |
if (!NILP (Vread_file_name_predicate)) |
6029 |
Fourth arg MUSTMATCH non-nil means require existing file's name. |
Fourth arg MUSTMATCH non-nil means require existing file's name. |
6030 |
Non-nil and non-t means also require confirmation after completion. |
Non-nil and non-t means also require confirmation after completion. |
6031 |
Fifth arg INITIAL specifies text to start with. |
Fifth arg INITIAL specifies text to start with. |
6032 |
If optional sixth arg PREDICATE is non-nil, possible completions and the |
If optional sixth arg PREDICATE is non-nil, possible completions and the |
6033 |
resulting file name must satisfy (funcall PREDICATE NAME). |
resulting file name must satisfy (funcall PREDICATE NAME). |
6034 |
DIR defaults to current buffer's directory default. |
DIR defaults to current buffer's directory default. |
6035 |
|
|
6042 |
Lisp_Object val, insdef, tem; |
Lisp_Object val, insdef, tem; |
6043 |
struct gcpro gcpro1, gcpro2; |
struct gcpro gcpro1, gcpro2; |
6044 |
register char *homedir; |
register char *homedir; |
6045 |
|
Lisp_Object decoded_homedir; |
6046 |
int replace_in_history = 0; |
int replace_in_history = 0; |
6047 |
int add_to_history = 0; |
int add_to_history = 0; |
6048 |
int count; |
int count; |
6050 |
if (NILP (dir)) |
if (NILP (dir)) |
6051 |
dir = current_buffer->directory; |
dir = current_buffer->directory; |
6052 |
if (NILP (default_filename)) |
if (NILP (default_filename)) |
6053 |
{ |
default_filename = !NILP (initial) |
6054 |
if (! NILP (initial)) |
? Fexpand_file_name (initial, dir) |
6055 |
default_filename = Fexpand_file_name (initial, dir); |
: current_buffer->filename; |
|
else |
|
|
default_filename = current_buffer->filename; |
|
|
} |
|
6056 |
|
|
6057 |
/* If dir starts with user's homedir, change that to ~. */ |
/* If dir starts with user's homedir, change that to ~. */ |
6058 |
homedir = (char *) egetenv ("HOME"); |
homedir = (char *) egetenv ("HOME"); |
6065 |
CORRECT_DIR_SEPS (homedir); |
CORRECT_DIR_SEPS (homedir); |
6066 |
} |
} |
6067 |
#endif |
#endif |
6068 |
|
if (homedir != 0) |
6069 |
|
decoded_homedir |
6070 |
|
= DECODE_FILE (make_unibyte_string (homedir, strlen (homedir))); |
6071 |
if (homedir != 0 |
if (homedir != 0 |
6072 |
&& STRINGP (dir) |
&& STRINGP (dir) |
6073 |
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) |
&& !strncmp (SDATA (decoded_homedir), SDATA (dir), |
6074 |
&& IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)])) |
SBYTES (decoded_homedir)) |
6075 |
|
&& IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir)))) |
6076 |
{ |
{ |
6077 |
dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, |
dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil); |
6078 |
STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1); |
dir = concat2 (build_string ("~"), dir); |
|
XSTRING (dir)->data[0] = '~'; |
|
6079 |
} |
} |
6080 |
/* Likewise for default_filename. */ |
/* Likewise for default_filename. */ |
6081 |
if (homedir != 0 |
if (homedir != 0 |
6082 |
&& STRINGP (default_filename) |
&& STRINGP (default_filename) |
6083 |
&& !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir)) |
&& !strncmp (SDATA (decoded_homedir), SDATA (default_filename), |
6084 |
&& IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)])) |
SBYTES (decoded_homedir)) |
6085 |
|
&& IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir)))) |
6086 |
{ |
{ |
6087 |
default_filename |
default_filename |
6088 |
= make_string (XSTRING (default_filename)->data + strlen (homedir) - 1, |
= Fsubstring (default_filename, |
6089 |
STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1); |
make_number (SCHARS (decoded_homedir)), Qnil); |
6090 |
XSTRING (default_filename)->data[0] = '~'; |
default_filename = concat2 (build_string ("~"), default_filename); |
6091 |
} |
} |
6092 |
if (!NILP (default_filename)) |
if (!NILP (default_filename)) |
6093 |
{ |
{ |
6105 |
args[0] = insdef; |
args[0] = insdef; |
6106 |
args[1] = initial; |
args[1] = initial; |
6107 |
insdef = Fconcat (2, args); |
insdef = Fconcat (2, args); |
6108 |
pos = make_number (XSTRING (double_dollars (dir))->size); |
pos = make_number (SCHARS (double_dollars (dir))); |
6109 |
insdef = Fcons (double_dollars (insdef), pos); |
insdef = Fcons (double_dollars (insdef), pos); |
6110 |
} |
} |
6111 |
else |
else |
6131 |
RETURN_UNGCPRO (Ffuncall (7, args)); |
RETURN_UNGCPRO (Ffuncall (7, args)); |
6132 |
} |
} |
6133 |
|
|
6134 |
count = specpdl_ptr - specpdl; |
count = SPECPDL_INDEX (); |
6135 |
#ifdef VMS |
#ifdef VMS |
6136 |
specbind (intern ("completion-ignore-case"), Qt); |
specbind (intern ("completion-ignore-case"), Qt); |
6137 |
#endif |
#endif |
6138 |
|
|
6139 |
specbind (intern ("minibuffer-completing-file-name"), Qt); |
specbind (intern ("minibuffer-completing-file-name"), Qt); |
6140 |
specbind (intern ("read-file-name-predicate"), |
specbind (intern ("read-file-name-predicate"), |
6141 |
(NILP (predicate) ? Qfile_exists_p : predicate)); |
(NILP (predicate) ? Qfile_exists_p : predicate)); |
6142 |
|
|
6143 |
GCPRO2 (insdef, default_filename); |
GCPRO2 (insdef, default_filename); |
6144 |
|
|
6145 |
#if defined (USE_MOTIF) || defined (HAVE_NTGUI) |
#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) |
6146 |
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) |
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) |
6147 |
&& use_dialog_box |
&& use_dialog_box |
6148 |
&& have_menus_p ()) |
&& have_menus_p ()) |
6150 |
/* If DIR contains a file name, split it. */ |
/* If DIR contains a file name, split it. */ |
6151 |
Lisp_Object file; |
Lisp_Object file; |
6152 |
file = Ffile_name_nondirectory (dir); |
file = Ffile_name_nondirectory (dir); |
6153 |
if (XSTRING (file)->size && NILP (default_filename)) |
if (SCHARS (file) && NILP (default_filename)) |
6154 |
{ |
{ |
6155 |
default_filename = file; |
default_filename = file; |
6156 |
dir = Ffile_name_directory (dir); |
dir = Ffile_name_directory (dir); |
6182 |
if (! replace_in_history) |
if (! replace_in_history) |
6183 |
add_to_history = 1; |
add_to_history = 1; |
6184 |
|
|
6185 |
val = build_string (""); |
val = empty_string; |
6186 |
} |
} |
6187 |
|
|
6188 |
unbind_to (count, Qnil); |
unbind_to (count, Qnil); |
6194 |
|
|
6195 |
if (!NILP (tem) && !NILP (default_filename)) |
if (!NILP (tem) && !NILP (default_filename)) |
6196 |
val = default_filename; |
val = default_filename; |
6197 |
else if (XSTRING (val)->size == 0 && NILP (insdef)) |
else if (SCHARS (val) == 0 && NILP (insdef)) |
6198 |
{ |
{ |
6199 |
if (!NILP (default_filename)) |
if (!NILP (default_filename)) |
6200 |
val = default_filename; |
val = default_filename; |
6217 |
Fset (Qfile_name_history, |
Fset (Qfile_name_history, |
6218 |
Fcons (val1, tem)); |
Fcons (val1, tem)); |
6219 |
} |
} |
6220 |
|
|
6221 |
return val; |
return val; |
6222 |
} |
} |
6223 |
|
|
6342 |
staticpro (&Qformat_decode); |
staticpro (&Qformat_decode); |
6343 |
Qformat_annotate_function = intern ("format-annotate-function"); |
Qformat_annotate_function = intern ("format-annotate-function"); |
6344 |
staticpro (&Qformat_annotate_function); |
staticpro (&Qformat_annotate_function); |
6345 |
|
|
6346 |
Qcar_less_than_car = intern ("car-less-than-car"); |
Qcar_less_than_car = intern ("car-less-than-car"); |
6347 |
staticpro (&Qcar_less_than_car); |
staticpro (&Qcar_less_than_car); |
6348 |
|
|
6382 |
|
|
6383 |
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char, |
DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char, |
6384 |
doc: /* Directory separator character for built-in functions that return file names. |
doc: /* Directory separator character for built-in functions that return file names. |
6385 |
The value should be either ?/ or ?\\ (any other value is treated as ?\\). |
The value is always ?/. Don't use this variable, just use `/'. */); |
|
This variable affects the built-in functions only on Windows, |
|
|
on other platforms, it is initialized so that Lisp code can find out |
|
|
what the normal separator is. |
|
|
|
|
|
WARNING: This variable is deprecated and will be removed in the near |
|
|
future. DO NOT USE IT. */); |
|
6386 |
|
|
6387 |
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, |
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, |
6388 |
doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially. |
doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially. |
6514 |
defsubr (&Sunix_sync); |
defsubr (&Sunix_sync); |
6515 |
#endif |
#endif |
6516 |
} |
} |
|
|
|