Mercurial > emacs
annotate src/fileio.c @ 11392:81c0a8b9ec55
Fix typo in previous change.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 12 Apr 1995 02:50:23 +0000 |
parents | e5591c7b9e17 |
children | 6502c07121b7 |
rev | line source |
---|---|
230 | 1 /* File IO for GNU Emacs. |
11235 | 2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc. |
230 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
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 | |
621 | 8 the Free Software Foundation; either version 2, or (at your option) |
230 | 9 any later version. |
10 | |
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. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4483
diff
changeset
|
20 #include <config.h> |
230 | 21 |
22 #include <sys/types.h> | |
23 #include <sys/stat.h> | |
372 | 24 |
6862
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
25 #ifdef HAVE_UNISTD_H |
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
26 #include <unistd.h> |
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
27 #endif |
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
28 |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
29 #if !defined (S_ISLNK) && defined (S_IFLNK) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
31 #endif |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
32 |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
33 #if !defined (S_ISREG) && defined (S_IFREG) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
35 #endif |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
36 |
372 | 37 #ifdef VMS |
564 | 38 #include "vms-pwd.h" |
372 | 39 #else |
230 | 40 #include <pwd.h> |
372 | 41 #endif |
42 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
43 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
44 #include "msdos.h" |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
45 #include <sys/param.h> |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
46 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
47 |
230 | 48 #include <ctype.h> |
372 | 49 |
50 #ifdef VMS | |
5877 | 51 #include "vmsdir.h" |
372 | 52 #include <perror.h> |
53 #include <stddef.h> | |
54 #include <string.h> | |
55 #endif | |
56 | |
230 | 57 #include <errno.h> |
58 | |
372 | 59 #ifndef vax11c |
230 | 60 extern int errno; |
61 #endif | |
62 | |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
63 extern char *strerror (); |
230 | 64 |
65 #ifdef APOLLO | |
66 #include <sys/time.h> | |
67 #endif | |
68 | |
2280
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
69 #ifndef USG |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
70 #ifndef VMS |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
71 #ifndef BSD4_1 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
72 #ifndef WINDOWSNT |
2280
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
73 #define HAVE_FSYNC |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
74 #endif |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
75 #endif |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
76 #endif |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
77 #endif |
2280
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
78 |
230 | 79 #include "lisp.h" |
1299
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
80 #include "intervals.h" |
230 | 81 #include "buffer.h" |
82 #include "window.h" | |
83 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
84 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
85 #define NOMINMAX 1 |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
86 #include <windows.h> |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
87 #include <stdlib.h> |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
88 #include <fcntl.h> |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
89 #endif /* not WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
90 |
230 | 91 #ifdef VMS |
92 #include <file.h> | |
93 #include <rmsdef.h> | |
94 #include <fab.h> | |
95 #include <nam.h> | |
96 #endif | |
97 | |
564 | 98 #include "systime.h" |
230 | 99 |
100 #ifdef HPUX | |
101 #include <netio.h> | |
350 | 102 #ifndef HPUX8 |
3410
47b51faf6c4e
[HPUX9]: Don't include errnet.h.
Richard M. Stallman <rms@gnu.org>
parents:
3032
diff
changeset
|
103 #ifndef HPUX9 |
230 | 104 #include <errnet.h> |
105 #endif | |
350 | 106 #endif |
3410
47b51faf6c4e
[HPUX9]: Don't include errnet.h.
Richard M. Stallman <rms@gnu.org>
parents:
3032
diff
changeset
|
107 #endif |
230 | 108 |
109 #ifndef O_WRONLY | |
110 #define O_WRONLY 1 | |
111 #endif | |
112 | |
8597 | 113 #ifndef O_RDONLY |
114 #define O_RDONLY 0 | |
115 #endif | |
116 | |
230 | 117 #define min(a, b) ((a) < (b) ? (a) : (b)) |
118 #define max(a, b) ((a) > (b) ? (a) : (b)) | |
119 | |
120 /* Nonzero during writing of auto-save files */ | |
121 int auto_saving; | |
122 | |
123 /* Set by auto_save_1 to mode of original file so Fwrite_region will create | |
124 a new file with the same mode as the original */ | |
125 int auto_save_mode_bits; | |
126 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
127 /* Alist of elements (REGEXP . HANDLER) for file names |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
128 whose I/O is done with a special handler. */ |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
129 Lisp_Object Vfile_name_handler_alist; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
130 |
11053
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
131 /* Format for auto-save files */ |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
132 Lisp_Object Vauto_save_file_format; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
133 |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
134 /* Lisp functions for translating file formats */ |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
135 Lisp_Object Qformat_decode, Qformat_annotate_function; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
136 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
137 /* Functions to be called to process text properties in inserted file. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
138 Lisp_Object Vafter_insert_file_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
139 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
140 /* Functions to be called to create text property annotations for file. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
141 Lisp_Object Vwrite_region_annotate_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
142 |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
143 /* During build_annotations, each time an annotation function is called, |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
144 this holds the annotations made by the previous functions. */ |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
145 Lisp_Object Vwrite_region_annotations_so_far; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
146 |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
147 /* File name in which we write a list of all our auto save files. */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
148 Lisp_Object Vauto_save_list_file_name; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
149 |
230 | 150 /* Nonzero means, when reading a filename in the minibuffer, |
151 start out by inserting the default directory into the minibuffer. */ | |
152 int insert_default_directory; | |
153 | |
154 /* On VMS, nonzero means write new files with record format stmlf. | |
155 Zero means use var format. */ | |
156 int vms_stmlf_recfm; | |
157 | |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
158 /* These variables describe handlers that have "already" had a chance |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
159 to handle the current operation. |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
160 |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
161 Vinhibit_file_name_handlers is a list of file name handlers. |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
162 Vinhibit_file_name_operation is the operation being handled. |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
163 If we try to handle that operation, we ignore those handlers. */ |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
164 |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
165 static Lisp_Object Vinhibit_file_name_handlers; |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
166 static Lisp_Object Vinhibit_file_name_operation; |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
167 |
230 | 168 Lisp_Object Qfile_error, Qfile_already_exists; |
169 | |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
170 Lisp_Object Qfile_name_history; |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
171 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
172 Lisp_Object Qcar_less_than_car; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
173 |
230 | 174 report_file_error (string, data) |
175 char *string; | |
176 Lisp_Object data; | |
177 { | |
178 Lisp_Object errstring; | |
179 | |
5529
708b422cf8df
(report_file_error): Use strerror instead of sys_errlist.
Roland McGrath <roland@gnu.org>
parents:
5517
diff
changeset
|
180 errstring = build_string (strerror (errno)); |
230 | 181 |
182 /* System error messages are capitalized. Downcase the initial | |
183 unless it is followed by a slash. */ | |
184 if (XSTRING (errstring)->data[1] != '/') | |
185 XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); | |
186 | |
187 while (1) | |
188 Fsignal (Qfile_error, | |
189 Fcons (build_string (string), Fcons (errstring, data))); | |
190 } | |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
191 |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
192 close_file_unwind (fd) |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
193 Lisp_Object fd; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
194 { |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
195 close (XFASTINT (fd)); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
196 } |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
197 |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
198 /* Restore point, having saved it as a marker. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
199 |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
200 restore_point_unwind (location) |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
201 Lisp_Object location; |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
202 { |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
203 SET_PT (marker_position (location)); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
204 Fset_marker (location, Qnil, Qnil); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
205 } |
230 | 206 |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
207 Lisp_Object Qexpand_file_name; |
10719
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
208 Lisp_Object Qsubstitute_in_file_name; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
209 Lisp_Object Qdirectory_file_name; |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
210 Lisp_Object Qfile_name_directory; |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
211 Lisp_Object Qfile_name_nondirectory; |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
212 Lisp_Object Qunhandled_file_name_directory; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
213 Lisp_Object Qfile_name_as_directory; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
214 Lisp_Object Qcopy_file; |
8227
0e6b7eeedc3b
(Fmake_directory_internal): Use Qmake_directory_internal.
Richard M. Stallman <rms@gnu.org>
parents:
8185
diff
changeset
|
215 Lisp_Object Qmake_directory_internal; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
216 Lisp_Object Qdelete_directory; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
217 Lisp_Object Qdelete_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
218 Lisp_Object Qrename_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
219 Lisp_Object Qadd_name_to_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
220 Lisp_Object Qmake_symbolic_link; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
221 Lisp_Object Qfile_exists_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
222 Lisp_Object Qfile_executable_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
223 Lisp_Object Qfile_readable_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
224 Lisp_Object Qfile_symlink_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
225 Lisp_Object Qfile_writable_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
226 Lisp_Object Qfile_directory_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
227 Lisp_Object Qfile_accessible_directory_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
228 Lisp_Object Qfile_modes; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
229 Lisp_Object Qset_file_modes; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
230 Lisp_Object Qfile_newer_than_file_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
231 Lisp_Object Qinsert_file_contents; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
232 Lisp_Object Qwrite_region; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
233 Lisp_Object Qverify_visited_file_modtime; |
3560
95021dcb923b
(syms_of_fileio): Set up Qset_visited_file_modtime.
Richard M. Stallman <rms@gnu.org>
parents:
3415
diff
changeset
|
234 Lisp_Object Qset_visited_file_modtime; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
235 |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
236 DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0, |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
237 "Return FILENAME's handler function for OPERATION, if it has one.\n\ |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
238 Otherwise, return nil.\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
239 A file name is handled if one of the regular expressions in\n\ |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
240 `file-name-handler-alist' matches it.\n\n\ |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
241 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\ |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
242 any handlers that are members of `inhibit-file-name-handlers',\n\ |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
243 but we still do run any other handlers. This lets handlers\n\ |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
244 use the standard functions without calling themselves recursively.") |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
245 (filename, operation) |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
246 Lisp_Object filename, operation; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
247 { |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
248 /* This function must not munge the match data. */ |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
249 Lisp_Object chain, inhibited_handlers; |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
250 |
2895
1ed91566882a
* fileio.c (Ffind_file_name_handler): Check that FILENAME is a
Jim Blandy <jimb@redhat.com>
parents:
2741
diff
changeset
|
251 CHECK_STRING (filename, 0); |
1ed91566882a
* fileio.c (Ffind_file_name_handler): Check that FILENAME is a
Jim Blandy <jimb@redhat.com>
parents:
2741
diff
changeset
|
252 |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
253 if (EQ (operation, Vinhibit_file_name_operation)) |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
254 inhibited_handlers = Vinhibit_file_name_handlers; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
255 else |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
256 inhibited_handlers = Qnil; |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
257 |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
258 for (chain = Vfile_name_handler_alist; CONSP (chain); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
259 chain = XCONS (chain)->cdr) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
260 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
261 Lisp_Object elt; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
262 elt = XCONS (chain)->car; |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
263 if (CONSP (elt)) |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
264 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
265 Lisp_Object string; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
266 string = XCONS (elt)->car; |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
267 if (STRINGP (string) && fast_string_match (string, filename) >= 0) |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
268 { |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
269 Lisp_Object handler, tem; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
270 |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
271 handler = XCONS (elt)->cdr; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
272 tem = Fmemq (handler, inhibited_handlers); |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
273 if (NILP (tem)) |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
274 return handler; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
275 } |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
276 } |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
277 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
278 QUIT; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
279 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
280 return Qnil; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
281 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
282 |
230 | 283 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, |
284 1, 1, 0, | |
285 "Return the directory component in file name NAME.\n\ | |
286 Return nil if NAME does not include a directory.\n\ | |
287 Otherwise return a directory spec.\n\ | |
288 Given a Unix syntax file name, returns a string ending in slash;\n\ | |
289 on VMS, perhaps instead a string ending in `:', `]' or `>'.") | |
290 (file) | |
291 Lisp_Object file; | |
292 { | |
293 register unsigned char *beg; | |
294 register unsigned char *p; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
295 Lisp_Object handler; |
230 | 296 |
297 CHECK_STRING (file, 0); | |
298 | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
299 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
300 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
301 handler = Ffind_file_name_handler (file, Qfile_name_directory); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
302 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
303 return call2 (handler, Qfile_name_directory, file); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
304 |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
305 #ifdef FILE_SYSTEM_CASE |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
306 file = FILE_SYSTEM_CASE (file); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
307 #endif |
230 | 308 beg = XSTRING (file)->data; |
309 p = beg + XSTRING (file)->size; | |
310 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
311 while (p != beg && !IS_ANY_SEP (p[-1]) |
230 | 312 #ifdef VMS |
313 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' | |
314 #endif /* VMS */ | |
315 ) p--; | |
316 | |
317 if (p == beg) | |
318 return Qnil; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
319 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
320 /* Expansion of "c:" to drive and default directory. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
321 /* (NT does the right thing.) */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
322 if (p == beg + 2 && beg[1] == ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
323 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
324 int drive = (*beg) - 'a'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
325 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
326 unsigned char *res = alloca (MAXPATHLEN + 5); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
327 unsigned char *res1; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
328 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
329 res1 = res; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
330 /* The NT version places the drive letter at the beginning already. */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
331 #else /* not WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
332 /* On MSDOG we must put the drive letter in by hand. */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
333 res1 = res + 2; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
334 #endif /* not WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
335 if (getdefdir (drive + 1, res)) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
336 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
337 #ifdef MSDOS |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
338 res[0] = drive + 'a'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
339 res[1] = ':'; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
340 #endif /* MSDOS */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
341 if (IS_DIRECTORY_SEP (res[strlen (res) - 1])) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
342 strcat (res, "/"); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
343 beg = res; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
344 p = beg + strlen (beg); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
345 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
346 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
347 #endif /* DOS_NT */ |
230 | 348 return make_string (beg, p - beg); |
349 } | |
350 | |
351 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory, | |
352 1, 1, 0, | |
353 "Return file name NAME sans its directory.\n\ | |
354 For example, in a Unix-syntax file name,\n\ | |
355 this is everything after the last slash,\n\ | |
356 or the entire name if it contains no slash.") | |
357 (file) | |
358 Lisp_Object file; | |
359 { | |
360 register unsigned char *beg, *p, *end; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
361 Lisp_Object handler; |
230 | 362 |
363 CHECK_STRING (file, 0); | |
364 | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
365 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
366 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
367 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
368 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
369 return call2 (handler, Qfile_name_nondirectory, file); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
370 |
230 | 371 beg = XSTRING (file)->data; |
372 end = p = beg + XSTRING (file)->size; | |
373 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
374 while (p != beg && !IS_ANY_SEP (p[-1]) |
230 | 375 #ifdef VMS |
376 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' | |
377 #endif /* VMS */ | |
378 ) p--; | |
379 | |
380 return make_string (p, end - p); | |
381 } | |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
382 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
383 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0, |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
384 "Return a directly usable directory name somehow associated with FILENAME.\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
385 A `directly usable' directory name is one that may be used without the\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
386 intervention of any file handler.\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
387 If FILENAME is a directly usable file itself, return\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
388 (file-name-directory FILENAME).\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
389 The `call-process' and `start-process' functions use this function to\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
390 get a current directory to run processes in.") |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
391 (filename) |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
392 Lisp_Object filename; |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
393 { |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
394 Lisp_Object handler; |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
395 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
396 /* If the file name has special constructs in it, |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
397 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
398 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
399 if (!NILP (handler)) |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
400 return call2 (handler, Qunhandled_file_name_directory, filename); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
401 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
402 return Ffile_name_directory (filename); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
403 } |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
404 |
230 | 405 |
406 char * | |
407 file_name_as_directory (out, in) | |
408 char *out, *in; | |
409 { | |
410 int size = strlen (in) - 1; | |
411 | |
412 strcpy (out, in); | |
413 | |
414 #ifdef VMS | |
415 /* Is it already a directory string? */ | |
416 if (in[size] == ':' || in[size] == ']' || in[size] == '>') | |
417 return out; | |
418 /* Is it a VMS directory file name? If so, hack VMS syntax. */ | |
419 else if (! index (in, '/') | |
420 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR")) | |
421 || (size > 3 && ! strcmp (&in[size - 3], ".dir")) | |
422 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4) | |
423 || ! strncmp (&in[size - 5], ".dir", 4)) | |
424 && (in[size - 1] == '.' || in[size - 1] == ';') | |
425 && in[size] == '1'))) | |
426 { | |
427 register char *p, *dot; | |
428 char brack; | |
429 | |
430 /* x.dir -> [.x] | |
431 dir:x.dir --> dir:[x] | |
432 dir:[x]y.dir --> dir:[x.y] */ | |
433 p = in + size; | |
434 while (p != in && *p != ':' && *p != '>' && *p != ']') p--; | |
435 if (p != in) | |
436 { | |
437 strncpy (out, in, p - in); | |
438 out[p - in] = '\0'; | |
439 if (*p == ':') | |
440 { | |
441 brack = ']'; | |
442 strcat (out, ":["); | |
443 } | |
444 else | |
445 { | |
446 brack = *p; | |
447 strcat (out, "."); | |
448 } | |
449 p++; | |
450 } | |
451 else | |
452 { | |
453 brack = ']'; | |
454 strcpy (out, "[."); | |
455 } | |
372 | 456 dot = index (p, '.'); |
457 if (dot) | |
230 | 458 { |
459 /* blindly remove any extension */ | |
460 size = strlen (out) + (dot - p); | |
461 strncat (out, p, dot - p); | |
462 } | |
463 else | |
464 { | |
465 strcat (out, p); | |
466 size = strlen (out); | |
467 } | |
468 out[size++] = brack; | |
469 out[size] = '\0'; | |
470 } | |
471 #else /* not VMS */ | |
472 /* For Unix syntax, Append a slash if necessary */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
473 if (!IS_ANY_SEP (out[size])) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
474 { |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
475 out[size + 1] = DIRECTORY_SEP; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
476 out[size + 2] = '\0'; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
477 } |
230 | 478 #endif /* not VMS */ |
479 return out; | |
480 } | |
481 | |
482 DEFUN ("file-name-as-directory", Ffile_name_as_directory, | |
483 Sfile_name_as_directory, 1, 1, 0, | |
484 "Return a string representing file FILENAME interpreted as a directory.\n\ | |
485 This operation exists because a directory is also a file, but its name as\n\ | |
486 a directory is different from its name as a file.\n\ | |
487 The result can be used as the value of `default-directory'\n\ | |
488 or passed as second argument to `expand-file-name'.\n\ | |
489 For a Unix-syntax file name, just appends a slash.\n\ | |
490 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") | |
491 (file) | |
492 Lisp_Object file; | |
493 { | |
494 char *buf; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
495 Lisp_Object handler; |
230 | 496 |
497 CHECK_STRING (file, 0); | |
485 | 498 if (NILP (file)) |
230 | 499 return Qnil; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
500 |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
501 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
502 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
503 handler = Ffind_file_name_handler (file, Qfile_name_as_directory); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
504 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
505 return call2 (handler, Qfile_name_as_directory, file); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
506 |
230 | 507 buf = (char *) alloca (XSTRING (file)->size + 10); |
508 return build_string (file_name_as_directory (buf, XSTRING (file)->data)); | |
509 } | |
510 | |
511 /* | |
512 * Convert from directory name to filename. | |
513 * On VMS: | |
514 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1 | |
515 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1 | |
516 * On UNIX, it's simple: just make sure there is a terminating / | |
517 | |
518 * Value is nonzero if the string output is different from the input. | |
519 */ | |
520 | |
521 directory_file_name (src, dst) | |
522 char *src, *dst; | |
523 { | |
524 long slen; | |
525 #ifdef VMS | |
526 long rlen; | |
527 char * ptr, * rptr; | |
528 char bracket; | |
529 struct FAB fab = cc$rms_fab; | |
530 struct NAM nam = cc$rms_nam; | |
531 char esa[NAM$C_MAXRSS]; | |
532 #endif /* VMS */ | |
533 | |
534 slen = strlen (src); | |
535 #ifdef VMS | |
536 if (! index (src, '/') | |
537 && (src[slen - 1] == ']' | |
538 || src[slen - 1] == ':' | |
539 || src[slen - 1] == '>')) | |
540 { | |
541 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */ | |
542 fab.fab$l_fna = src; | |
543 fab.fab$b_fns = slen; | |
544 fab.fab$l_nam = &nam; | |
545 fab.fab$l_fop = FAB$M_NAM; | |
546 | |
547 nam.nam$l_esa = esa; | |
548 nam.nam$b_ess = sizeof esa; | |
549 nam.nam$b_nop |= NAM$M_SYNCHK; | |
550 | |
551 /* We call SYS$PARSE to handle such things as [--] for us. */ | |
552 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL) | |
553 { | |
554 slen = nam.nam$b_esl; | |
555 if (esa[slen - 1] == ';' && esa[slen - 2] == '.') | |
556 slen -= 2; | |
557 esa[slen] = '\0'; | |
558 src = esa; | |
559 } | |
560 if (src[slen - 1] != ']' && src[slen - 1] != '>') | |
561 { | |
562 /* what about when we have logical_name:???? */ | |
563 if (src[slen - 1] == ':') | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
564 { /* Xlate logical name and see what we get */ |
230 | 565 ptr = strcpy (dst, src); /* upper case for getenv */ |
566 while (*ptr) | |
567 { | |
568 if ('a' <= *ptr && *ptr <= 'z') | |
569 *ptr -= 040; | |
570 ptr++; | |
571 } | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
572 dst[slen - 1] = 0; /* remove colon */ |
230 | 573 if (!(src = egetenv (dst))) |
574 return 0; | |
575 /* should we jump to the beginning of this procedure? | |
576 Good points: allows us to use logical names that xlate | |
577 to Unix names, | |
578 Bad points: can be a problem if we just translated to a device | |
579 name... | |
580 For now, I'll punt and always expect VMS names, and hope for | |
581 the best! */ | |
582 slen = strlen (src); | |
583 if (src[slen - 1] != ']' && src[slen - 1] != '>') | |
584 { /* no recursion here! */ | |
585 strcpy (dst, src); | |
586 return 0; | |
587 } | |
588 } | |
589 else | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
590 { /* not a directory spec */ |
230 | 591 strcpy (dst, src); |
592 return 0; | |
593 } | |
594 } | |
595 bracket = src[slen - 1]; | |
596 | |
597 /* If bracket is ']' or '>', bracket - 2 is the corresponding | |
598 opening bracket. */ | |
372 | 599 ptr = index (src, bracket - 2); |
600 if (ptr == 0) | |
230 | 601 { /* no opening bracket */ |
602 strcpy (dst, src); | |
603 return 0; | |
604 } | |
605 if (!(rptr = rindex (src, '.'))) | |
606 rptr = ptr; | |
607 slen = rptr - src; | |
608 strncpy (dst, src, slen); | |
609 dst[slen] = '\0'; | |
610 if (*rptr == '.') | |
611 { | |
612 dst[slen++] = bracket; | |
613 dst[slen] = '\0'; | |
614 } | |
615 else | |
616 { | |
617 /* If we have the top-level of a rooted directory (i.e. xx:[000000]), | |
618 then translate the device and recurse. */ | |
619 if (dst[slen - 1] == ':' | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
620 && dst[slen - 2] != ':' /* skip decnet nodes */ |
230 | 621 && strcmp(src + slen, "[000000]") == 0) |
622 { | |
623 dst[slen - 1] = '\0'; | |
624 if ((ptr = egetenv (dst)) | |
625 && (rlen = strlen (ptr) - 1) > 0 | |
626 && (ptr[rlen] == ']' || ptr[rlen] == '>') | |
627 && ptr[rlen - 1] == '.') | |
628 { | |
1358
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
629 char * buf = (char *) alloca (strlen (ptr) + 1); |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
630 strcpy (buf, ptr); |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
631 buf[rlen - 1] = ']'; |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
632 buf[rlen] = '\0'; |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
633 return directory_file_name (buf, dst); |
230 | 634 } |
635 else | |
636 dst[slen - 1] = ':'; | |
637 } | |
638 strcat (dst, "[000000]"); | |
639 slen += 8; | |
640 } | |
641 rptr++; | |
642 rlen = strlen (rptr) - 1; | |
643 strncat (dst, rptr, rlen); | |
644 dst[slen + rlen] = '\0'; | |
645 strcat (dst, ".DIR.1"); | |
646 return 1; | |
647 } | |
648 #endif /* VMS */ | |
649 /* Process as Unix format: just remove any final slash. | |
650 But leave "/" unchanged; do not change it to "". */ | |
651 strcpy (dst, src); | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
652 if (slen > 1 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
653 && IS_DIRECTORY_SEP (dst[slen - 1]) |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
654 && !IS_ANY_SEP (dst[slen - 2])) |
230 | 655 dst[slen - 1] = 0; |
656 return 1; | |
657 } | |
658 | |
659 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, | |
660 1, 1, 0, | |
661 "Returns the file name of the directory named DIR.\n\ | |
662 This is the name of the file that holds the data for the directory DIR.\n\ | |
663 This operation exists because a directory is also a file, but its name as\n\ | |
664 a directory is different from its name as a file.\n\ | |
665 In Unix-syntax, this function just removes the final slash.\n\ | |
666 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\ | |
667 it returns a file name such as \"[X]Y.DIR.1\".") | |
668 (directory) | |
669 Lisp_Object directory; | |
670 { | |
671 char *buf; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
672 Lisp_Object handler; |
230 | 673 |
674 CHECK_STRING (directory, 0); | |
675 | |
485 | 676 if (NILP (directory)) |
230 | 677 return Qnil; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
678 |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
679 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
680 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
681 handler = Ffind_file_name_handler (directory, Qdirectory_file_name); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
682 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
683 return call2 (handler, Qdirectory_file_name, directory); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
684 |
230 | 685 #ifdef VMS |
686 /* 20 extra chars is insufficient for VMS, since we might perform a | |
687 logical name translation. an equivalence string can be up to 255 | |
688 chars long, so grab that much extra space... - sss */ | |
689 buf = (char *) alloca (XSTRING (directory)->size + 20 + 255); | |
690 #else | |
691 buf = (char *) alloca (XSTRING (directory)->size + 20); | |
692 #endif | |
693 directory_file_name (XSTRING (directory)->data, buf); | |
694 return build_string (buf); | |
695 } | |
696 | |
697 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, | |
698 "Generate temporary file name (string) starting with PREFIX (a string).\n\ | |
699 The Emacs process number forms part of the result,\n\ | |
700 so there is no danger of generating a name being used by another process.") | |
701 (prefix) | |
702 Lisp_Object prefix; | |
703 { | |
704 Lisp_Object val; | |
705 val = concat2 (prefix, build_string ("XXXXXX")); | |
706 mktemp (XSTRING (val)->data); | |
707 return val; | |
708 } | |
709 | |
710 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, | |
711 "Convert FILENAME to absolute, and canonicalize it.\n\ | |
712 Second arg DEFAULT is directory to start with if FILENAME is relative\n\ | |
713 (does not start with slash); if DEFAULT is nil or missing,\n\ | |
714 the current buffer's value of default-directory is used.\n\ | |
536 | 715 Path components that are `.' are removed, and \n\ |
716 path components followed by `..' are removed, along with the `..' itself;\n\ | |
717 note that these simplifications are done without checking the resulting\n\ | |
718 paths in the file system.\n\ | |
719 An initial `~/' expands to your home directory.\n\ | |
720 An initial `~USER/' expands to USER's home directory.\n\ | |
230 | 721 See also the function `substitute-in-file-name'.") |
722 (name, defalt) | |
723 Lisp_Object name, defalt; | |
724 { | |
725 unsigned char *nm; | |
726 | |
727 register unsigned char *newdir, *p, *o; | |
728 int tlen; | |
729 unsigned char *target; | |
730 struct passwd *pw; | |
731 #ifdef VMS | |
732 unsigned char * colon = 0; | |
733 unsigned char * close = 0; | |
734 unsigned char * slash = 0; | |
735 unsigned char * brack = 0; | |
736 int lbrack = 0, rbrack = 0; | |
737 int dots = 0; | |
738 #endif /* VMS */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
739 #ifdef DOS_NT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
740 /* Demacs 1.1.2 91/10/20 Manabu Higashida */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
741 int drive = -1; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
742 int relpath = 0; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
743 unsigned char *tmp, *defdir; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
744 #endif /* DOS_NT */ |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
745 Lisp_Object handler; |
230 | 746 |
747 CHECK_STRING (name, 0); | |
748 | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
749 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
750 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
751 handler = Ffind_file_name_handler (name, Qexpand_file_name); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
752 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
753 return call3 (handler, Qexpand_file_name, name, defalt); |
10734
634120aac320
(Fexpand_file_name): Copy default-directory
Richard M. Stallman <rms@gnu.org>
parents:
10719
diff
changeset
|
754 |
634120aac320
(Fexpand_file_name): Copy default-directory
Richard M. Stallman <rms@gnu.org>
parents:
10719
diff
changeset
|
755 /* Use the buffer's default-directory if DEFALT is omitted. */ |
634120aac320
(Fexpand_file_name): Copy default-directory
Richard M. Stallman <rms@gnu.org>
parents:
10719
diff
changeset
|
756 if (NILP (defalt)) |
634120aac320
(Fexpand_file_name): Copy default-directory
Richard M. Stallman <rms@gnu.org>
parents:
10719
diff
changeset
|
757 defalt = current_buffer->directory; |
634120aac320
(Fexpand_file_name): Copy default-directory
Richard M. Stallman <rms@gnu.org>
parents:
10719
diff
changeset
|
758 CHECK_STRING (defalt, 1); |
634120aac320
(Fexpand_file_name): Copy default-directory
Richard M. Stallman <rms@gnu.org>
parents:
10719
diff
changeset
|
759 |
10719
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
760 if (!NILP (defalt)) |
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
761 { |
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
762 handler = Ffind_file_name_handler (defalt, Qexpand_file_name); |
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
763 if (!NILP (handler)) |
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
764 return call3 (handler, Qexpand_file_name, name, defalt); |
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
765 } |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
766 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
767 o = XSTRING (defalt)->data; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
768 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
769 /* Make sure DEFALT is properly expanded. |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
770 It would be better to do this down below where we actually use |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
771 defalt. Unfortunately, calling Fexpand_file_name recursively |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
772 could invoke GC, and the strings might be relocated. This would |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
773 be annoying because we have pointers into strings lying around |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
774 that would need adjusting, and people would add new pointers to |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
775 the code and forget to adjust them, resulting in intermittent bugs. |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
776 Putting this call here avoids all that crud. |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
777 |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
778 The EQ test avoids infinite recursion. */ |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
779 if (! NILP (defalt) && !EQ (defalt, name) |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
780 /* This saves time in a common case. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
781 && ! (XSTRING (defalt)->size >= 3 |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
782 && IS_DIRECTORY_SEP (XSTRING (defalt)->data[0]) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
783 && IS_DEVICE_SEP (XSTRING (defalt)->data[1]))) |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
784 { |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
785 struct gcpro gcpro1; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
786 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
787 GCPRO1 (name); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
788 defalt = Fexpand_file_name (defalt, Qnil); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
789 UNGCPRO; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
790 } |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
791 |
230 | 792 #ifdef VMS |
793 /* Filenames on VMS are always upper case. */ | |
794 name = Fupcase (name); | |
795 #endif | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
796 #ifdef FILE_SYSTEM_CASE |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
797 name = FILE_SYSTEM_CASE (name); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
798 #endif |
230 | 799 |
800 nm = XSTRING (name)->data; | |
801 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
802 #ifdef MSDOS |
8185
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
803 /* First map all backslashes to slashes. */ |
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
804 dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
805 #endif |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
806 |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
807 #ifdef DOS_NT |
8185
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
808 /* Now strip drive name. */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
809 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
810 unsigned char *colon = rindex (nm, ':'); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
811 if (colon) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
812 if (nm == colon) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
813 nm++; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
814 else |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
815 { |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
816 drive = colon[-1]; |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
817 nm = colon + 1; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
818 if (!IS_DIRECTORY_SEP (*nm)) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
819 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
820 defdir = alloca (MAXPATHLEN + 1); |
11392 | 821 relpath = getdefdir (tolower (drive) - 'a' + 1, defdir); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
822 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
823 } |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
824 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
825 #endif /* DOS_NT */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
826 |
230 | 827 /* If nm is absolute, flush ...// and detect /./ and /../. |
828 If no /./ or /../ we can return right away. */ | |
829 if ( | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
830 IS_DIRECTORY_SEP (nm[0]) |
230 | 831 #ifdef VMS |
832 || index (nm, ':') | |
833 #endif /* VMS */ | |
834 ) | |
835 { | |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
836 /* If it turns out that the filename we want to return is just a |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
837 suffix of FILENAME, we don't need to go through and edit |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
838 things; we just need to construct a new string using data |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
839 starting at the middle of FILENAME. If we set lose to a |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
840 non-zero value, that means we've discovered that we can't do |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
841 that cool trick. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
842 int lose = 0; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
843 |
230 | 844 p = nm; |
845 while (*p) | |
846 { | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
847 /* Since we know the path is absolute, we can assume that each |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
848 element starts with a "/". */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
849 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
850 /* "//" anywhere isn't necessarily hairy; we just start afresh |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
851 with the second slash. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
852 if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]) |
230 | 853 #ifdef APOLLO |
854 /* // at start of filename is meaningful on Apollo system */ | |
855 && nm != p | |
856 #endif /* APOLLO */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
857 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
858 /* \\ or // at the start of a pathname is meaningful on NT. */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
859 && nm != p |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
860 #endif /* WINDOWSNT */ |
230 | 861 ) |
862 nm = p + 1; | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
863 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
864 /* "~" is hairy as the start of any path element. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
865 if (IS_DIRECTORY_SEP (p[0]) && p[1] == '~') |
230 | 866 nm = p + 1, lose = 1; |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
867 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
868 /* "." and ".." are hairy. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
869 if (IS_DIRECTORY_SEP (p[0]) |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
870 && p[1] == '.' |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
871 && (IS_DIRECTORY_SEP (p[2]) |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
872 || p[2] == 0 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
873 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
874 || p[3] == 0)))) |
230 | 875 lose = 1; |
876 #ifdef VMS | |
877 if (p[0] == '\\') | |
878 lose = 1; | |
879 if (p[0] == '/') { | |
880 /* if dev:[dir]/, move nm to / */ | |
881 if (!slash && p > nm && (brack || colon)) { | |
882 nm = (brack ? brack + 1 : colon + 1); | |
883 lbrack = rbrack = 0; | |
884 brack = 0; | |
885 colon = 0; | |
886 } | |
887 slash = p; | |
888 } | |
889 if (p[0] == '-') | |
890 #ifndef VMS4_4 | |
891 /* VMS pre V4.4,convert '-'s in filenames. */ | |
892 if (lbrack == rbrack) | |
893 { | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
894 if (dots < 2) /* this is to allow negative version numbers */ |
230 | 895 p[0] = '_'; |
896 } | |
897 else | |
898 #endif /* VMS4_4 */ | |
899 if (lbrack > rbrack && | |
900 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && | |
901 (p[1] == '.' || p[1] == ']' || p[1] == '>'))) | |
902 lose = 1; | |
903 #ifndef VMS4_4 | |
904 else | |
905 p[0] = '_'; | |
906 #endif /* VMS4_4 */ | |
907 /* count open brackets, reset close bracket pointer */ | |
908 if (p[0] == '[' || p[0] == '<') | |
909 lbrack++, brack = 0; | |
910 /* count close brackets, set close bracket pointer */ | |
911 if (p[0] == ']' || p[0] == '>') | |
912 rbrack++, brack = p; | |
913 /* detect ][ or >< */ | |
914 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) | |
915 lose = 1; | |
916 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') | |
917 nm = p + 1, lose = 1; | |
918 if (p[0] == ':' && (colon || slash)) | |
919 /* if dev1:[dir]dev2:, move nm to dev2: */ | |
920 if (brack) | |
921 { | |
922 nm = brack + 1; | |
923 brack = 0; | |
924 } | |
925 /* if /pathname/dev:, move nm to dev: */ | |
926 else if (slash) | |
927 nm = slash + 1; | |
928 /* if node::dev:, move colon following dev */ | |
929 else if (colon && colon[-1] == ':') | |
930 colon = p; | |
931 /* if dev1:dev2:, move nm to dev2: */ | |
932 else if (colon && colon[-1] != ':') | |
933 { | |
934 nm = colon + 1; | |
935 colon = 0; | |
936 } | |
937 if (p[0] == ':' && !colon) | |
938 { | |
939 if (p[1] == ':') | |
940 p++; | |
941 colon = p; | |
942 } | |
943 if (lbrack == rbrack) | |
944 if (p[0] == ';') | |
945 dots = 2; | |
946 else if (p[0] == '.') | |
947 dots++; | |
948 #endif /* VMS */ | |
949 p++; | |
950 } | |
951 if (!lose) | |
952 { | |
953 #ifdef VMS | |
954 if (index (nm, '/')) | |
955 return build_string (sys_translate_unix (nm)); | |
956 #endif /* VMS */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
957 #ifndef DOS_NT |
230 | 958 if (nm == XSTRING (name)->data) |
959 return name; | |
960 return build_string (nm); | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
961 #endif /* not DOS_NT */ |
230 | 962 } |
963 } | |
964 | |
965 /* Now determine directory to start with and put it in newdir */ | |
966 | |
967 newdir = 0; | |
968 | |
969 if (nm[0] == '~') /* prefix ~ */ | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
970 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
971 if (IS_DIRECTORY_SEP (nm[1]) |
230 | 972 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
973 || nm[1] == ':' |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
974 #endif /* VMS */ |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
975 || nm[1] == 0) /* ~ by itself */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
976 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
977 if (!(newdir = (unsigned char *) egetenv ("HOME"))) |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
978 newdir = (unsigned char *) ""; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
979 #ifdef DOS_NT |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
980 /* Problem when expanding "~\" if HOME is not on current drive. |
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
981 Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */ |
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
982 if (newdir[1] == ':') |
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
983 drive = newdir[0]; |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
984 dostounix_filename (newdir); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
985 #endif |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
986 nm++; |
230 | 987 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
988 nm++; /* Don't leave the slash in nm. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
989 #endif /* VMS */ |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
990 } |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
991 else /* ~user/filename */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
992 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
993 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p) |
230 | 994 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
995 && *p != ':' |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
996 #endif /* VMS */ |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
997 ); p++); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
998 o = (unsigned char *) alloca (p - nm + 1); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
999 bcopy ((char *) nm, o, p - nm); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1000 o [p - nm] = 0; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1001 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1002 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1003 newdir = (unsigned char *) egetenv ("HOME"); |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1004 dostounix_filename (newdir); |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1005 #else /* not WINDOWSNT */ |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1006 pw = (struct passwd *) getpwnam (o + 1); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1007 if (pw) |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1008 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1009 newdir = (unsigned char *) pw -> pw_dir; |
230 | 1010 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1011 nm = p + 1; /* skip the terminator */ |
230 | 1012 #else |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1013 nm = p; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1014 #endif /* VMS */ |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1015 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1016 #endif /* not WINDOWSNT */ |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1017 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1018 /* If we don't find a user of that name, leave the name |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1019 unchanged; don't move nm forward to p. */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1020 } |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1021 } |
230 | 1022 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1023 if (!IS_ANY_SEP (nm[0]) |
230 | 1024 #ifdef VMS |
1025 && !index (nm, ':') | |
1026 #endif /* not VMS */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1027 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1028 && drive == -1 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1029 #endif /* DOS_NT */ |
230 | 1030 && !newdir) |
1031 { | |
1032 newdir = XSTRING (defalt)->data; | |
1033 } | |
1034 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1035 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1036 if (newdir == 0 && relpath) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1037 newdir = defdir; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1038 #endif /* DOS_NT */ |
372 | 1039 if (newdir != 0) |
1040 { | |
1041 /* Get rid of any slash at the end of newdir. */ | |
1042 int length = strlen (newdir); | |
2607
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
1043 /* Adding `length > 1 &&' makes ~ expand into / when homedir |
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
1044 is the root dir. People disagree about whether that is right. |
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
1045 Anyway, we can't take the risk of this change now. */ |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1046 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1047 if (newdir[1] != ':' && length > 1) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1048 #endif |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1049 if (IS_DIRECTORY_SEP (newdir[length - 1])) |
372 | 1050 { |
1051 unsigned char *temp = (unsigned char *) alloca (length); | |
1052 bcopy (newdir, temp, length - 1); | |
1053 temp[length - 1] = 0; | |
1054 newdir = temp; | |
1055 } | |
1056 tlen = length + 1; | |
1057 } | |
1058 else | |
1059 tlen = 0; | |
230 | 1060 |
372 | 1061 /* Now concatenate the directory and name to new space in the stack frame */ |
1062 tlen += strlen (nm) + 1; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1063 #ifdef DOS_NT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1064 /* Add reserved space for drive name. (The Microsoft x86 compiler |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1065 produces incorrect code if the following two lines are combined.) */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1066 target = (unsigned char *) alloca (tlen + 2); |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1067 target += 2; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1068 #else /* not DOS_NT */ |
230 | 1069 target = (unsigned char *) alloca (tlen); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1070 #endif /* not DOS_NT */ |
230 | 1071 *target = 0; |
1072 | |
1073 if (newdir) | |
1074 { | |
1075 #ifndef VMS | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1076 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) |
230 | 1077 strcpy (target, newdir); |
1078 else | |
1079 #endif | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1080 file_name_as_directory (target, newdir); |
230 | 1081 } |
1082 | |
1083 strcat (target, nm); | |
1084 #ifdef VMS | |
1085 if (index (target, '/')) | |
1086 strcpy (target, sys_translate_unix (target)); | |
1087 #endif /* VMS */ | |
1088 | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1089 /* Now canonicalize by removing /. and /foo/.. if they appear. */ |
230 | 1090 |
1091 p = target; | |
1092 o = target; | |
1093 | |
1094 while (*p) | |
1095 { | |
1096 #ifdef VMS | |
1097 if (*p != ']' && *p != '>' && *p != '-') | |
1098 { | |
1099 if (*p == '\\') | |
1100 p++; | |
1101 *o++ = *p++; | |
1102 } | |
1103 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) | |
1104 /* brackets are offset from each other by 2 */ | |
1105 { | |
1106 p += 2; | |
1107 if (*p != '.' && *p != '-' && o[-1] != '.') | |
1108 /* convert [foo][bar] to [bar] */ | |
1109 while (o[-1] != '[' && o[-1] != '<') | |
1110 o--; | |
1111 else if (*p == '-' && *o != '.') | |
1112 *--p = '.'; | |
1113 } | |
1114 else if (p[0] == '-' && o[-1] == '.' && | |
1115 (p[1] == '.' || p[1] == ']' || p[1] == '>')) | |
1116 /* flush .foo.- ; leave - if stopped by '[' or '<' */ | |
1117 { | |
1118 do | |
1119 o--; | |
1120 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1121 if (p[1] == '.') /* foo.-.bar ==> bar. */ |
230 | 1122 p += 2; |
1123 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ | |
1124 p++, o--; | |
1125 /* else [foo.-] ==> [-] */ | |
1126 } | |
1127 else | |
1128 { | |
1129 #ifndef VMS4_4 | |
1130 if (*p == '-' && | |
1131 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && | |
1132 p[1] != ']' && p[1] != '>' && p[1] != '.') | |
1133 *p = '_'; | |
1134 #endif /* VMS4_4 */ | |
1135 *o++ = *p++; | |
1136 } | |
1137 #else /* not VMS */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1138 if (!IS_DIRECTORY_SEP (*p)) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1139 { |
230 | 1140 *o++ = *p++; |
1141 } | |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1142 else if ( |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1143 #ifdef WINDOWSNT |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1144 (!strncmp (p, "\\\\", 2) || !strncmp (p, "//", 2)) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1145 #else /* not WINDOWSNT */ |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1146 !strncmp (p, "//", 2) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1147 #endif /* not WINDOWSNT */ |
230 | 1148 #ifdef APOLLO |
1149 /* // at start of filename is meaningful in Apollo system */ | |
1150 && o != target | |
1151 #endif /* APOLLO */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1152 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1153 /* \\ at start of filename is meaningful in Windows-NT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1154 && o != target |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1155 #endif /* WINDOWSNT */ |
230 | 1156 ) |
1157 { | |
1158 o = target; | |
1159 p++; | |
1160 } | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1161 else if (IS_DIRECTORY_SEP (p[0]) |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1162 && p[1] == '.' |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1163 && (IS_DIRECTORY_SEP (p[2]) |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1164 || p[2] == 0)) |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1165 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1166 /* If "/." is the entire filename, keep the "/". Otherwise, |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1167 just delete the whole "/.". */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1168 if (o == target && p[2] == '\0') |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1169 *o++ = *p; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1170 p += 2; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1171 } |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1172 else if ( |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1173 #ifdef WINDOWSNT |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1174 (!strncmp (p, "\\..", 3) || !strncmp (p, "/..", 3)) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1175 #else /* not WINDOWSNT */ |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1176 !strncmp (p, "/..", 3) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1177 #endif /* not WINDOWSNT */ |
230 | 1178 /* `/../' is the "superroot" on certain file systems. */ |
1179 && o != target | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1180 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) |
230 | 1181 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1182 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) |
230 | 1183 ; |
1184 #ifdef APOLLO | |
1185 if (o == target + 1 && o[-1] == '/' && o[0] == '/') | |
1186 ++o; | |
1187 else | |
1188 #endif /* APOLLO */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1189 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1190 if (o == target + 1 && (o[-1] == '/' && o[0] == '/') |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1191 || (o[-1] == '\\' && o[0] == '\\')) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1192 ++o; |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1193 else |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1194 #endif /* WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1195 if (o == target && IS_ANY_SEP (*o)) |
230 | 1196 ++o; |
1197 p += 3; | |
1198 } | |
1199 else | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1200 { |
230 | 1201 *o++ = *p++; |
1202 } | |
1203 #endif /* not VMS */ | |
1204 } | |
1205 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1206 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1207 /* at last, set drive name. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1208 if (target[1] != ':' |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1209 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1210 /* Allow network paths that look like "\\foo" */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1211 && !(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1212 #endif /* WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1213 ) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1214 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1215 target -= 2; |
11381
e5591c7b9e17
(directory_file_name) [WINDOWSNT]: Handle UNC format.
Karl Heuer <kwzh@gnu.org>
parents:
11235
diff
changeset
|
1216 target[0] = (drive < 0 ? getdisk () + 'A' : drive); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1217 target[1] = ':'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1218 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1219 #endif /* DOS_NT */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1220 |
230 | 1221 return make_string (target, o - target); |
1222 } | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1223 |
230 | 1224 #if 0 |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1225 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */ |
732 | 1226 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, |
230 | 1227 "Convert FILENAME to absolute, and canonicalize it.\n\ |
1228 Second arg DEFAULT is directory to start with if FILENAME is relative\n\ | |
1229 (does not start with slash); if DEFAULT is nil or missing,\n\ | |
1230 the current buffer's value of default-directory is used.\n\ | |
1231 Filenames containing `.' or `..' as components are simplified;\n\ | |
1232 initial `~/' expands to your home directory.\n\ | |
1233 See also the function `substitute-in-file-name'.") | |
1234 (name, defalt) | |
1235 Lisp_Object name, defalt; | |
1236 { | |
1237 unsigned char *nm; | |
1238 | |
1239 register unsigned char *newdir, *p, *o; | |
1240 int tlen; | |
1241 unsigned char *target; | |
1242 struct passwd *pw; | |
1243 int lose; | |
1244 #ifdef VMS | |
1245 unsigned char * colon = 0; | |
1246 unsigned char * close = 0; | |
1247 unsigned char * slash = 0; | |
1248 unsigned char * brack = 0; | |
1249 int lbrack = 0, rbrack = 0; | |
1250 int dots = 0; | |
1251 #endif /* VMS */ | |
1252 | |
1253 CHECK_STRING (name, 0); | |
1254 | |
1255 #ifdef VMS | |
1256 /* Filenames on VMS are always upper case. */ | |
1257 name = Fupcase (name); | |
1258 #endif | |
1259 | |
1260 nm = XSTRING (name)->data; | |
1261 | |
1262 /* If nm is absolute, flush ...// and detect /./ and /../. | |
1263 If no /./ or /../ we can return right away. */ | |
1264 if ( | |
1265 nm[0] == '/' | |
1266 #ifdef VMS | |
1267 || index (nm, ':') | |
1268 #endif /* VMS */ | |
1269 ) | |
1270 { | |
1271 p = nm; | |
1272 lose = 0; | |
1273 while (*p) | |
1274 { | |
1275 if (p[0] == '/' && p[1] == '/' | |
1276 #ifdef APOLLO | |
1277 /* // at start of filename is meaningful on Apollo system */ | |
1278 && nm != p | |
1279 #endif /* APOLLO */ | |
1280 ) | |
1281 nm = p + 1; | |
1282 if (p[0] == '/' && p[1] == '~') | |
1283 nm = p + 1, lose = 1; | |
1284 if (p[0] == '/' && p[1] == '.' | |
1285 && (p[2] == '/' || p[2] == 0 | |
1286 || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) | |
1287 lose = 1; | |
1288 #ifdef VMS | |
1289 if (p[0] == '\\') | |
1290 lose = 1; | |
1291 if (p[0] == '/') { | |
1292 /* if dev:[dir]/, move nm to / */ | |
1293 if (!slash && p > nm && (brack || colon)) { | |
1294 nm = (brack ? brack + 1 : colon + 1); | |
1295 lbrack = rbrack = 0; | |
1296 brack = 0; | |
1297 colon = 0; | |
1298 } | |
1299 slash = p; | |
1300 } | |
1301 if (p[0] == '-') | |
1302 #ifndef VMS4_4 | |
1303 /* VMS pre V4.4,convert '-'s in filenames. */ | |
1304 if (lbrack == rbrack) | |
1305 { | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1306 if (dots < 2) /* this is to allow negative version numbers */ |
230 | 1307 p[0] = '_'; |
1308 } | |
1309 else | |
1310 #endif /* VMS4_4 */ | |
1311 if (lbrack > rbrack && | |
1312 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && | |
1313 (p[1] == '.' || p[1] == ']' || p[1] == '>'))) | |
1314 lose = 1; | |
1315 #ifndef VMS4_4 | |
1316 else | |
1317 p[0] = '_'; | |
1318 #endif /* VMS4_4 */ | |
1319 /* count open brackets, reset close bracket pointer */ | |
1320 if (p[0] == '[' || p[0] == '<') | |
1321 lbrack++, brack = 0; | |
1322 /* count close brackets, set close bracket pointer */ | |
1323 if (p[0] == ']' || p[0] == '>') | |
1324 rbrack++, brack = p; | |
1325 /* detect ][ or >< */ | |
1326 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) | |
1327 lose = 1; | |
1328 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') | |
1329 nm = p + 1, lose = 1; | |
1330 if (p[0] == ':' && (colon || slash)) | |
1331 /* if dev1:[dir]dev2:, move nm to dev2: */ | |
1332 if (brack) | |
1333 { | |
1334 nm = brack + 1; | |
1335 brack = 0; | |
1336 } | |
1337 /* if /pathname/dev:, move nm to dev: */ | |
1338 else if (slash) | |
1339 nm = slash + 1; | |
1340 /* if node::dev:, move colon following dev */ | |
1341 else if (colon && colon[-1] == ':') | |
1342 colon = p; | |
1343 /* if dev1:dev2:, move nm to dev2: */ | |
1344 else if (colon && colon[-1] != ':') | |
1345 { | |
1346 nm = colon + 1; | |
1347 colon = 0; | |
1348 } | |
1349 if (p[0] == ':' && !colon) | |
1350 { | |
1351 if (p[1] == ':') | |
1352 p++; | |
1353 colon = p; | |
1354 } | |
1355 if (lbrack == rbrack) | |
1356 if (p[0] == ';') | |
1357 dots = 2; | |
1358 else if (p[0] == '.') | |
1359 dots++; | |
1360 #endif /* VMS */ | |
1361 p++; | |
1362 } | |
1363 if (!lose) | |
1364 { | |
1365 #ifdef VMS | |
1366 if (index (nm, '/')) | |
1367 return build_string (sys_translate_unix (nm)); | |
1368 #endif /* VMS */ | |
1369 if (nm == XSTRING (name)->data) | |
1370 return name; | |
1371 return build_string (nm); | |
1372 } | |
1373 } | |
1374 | |
1375 /* Now determine directory to start with and put it in NEWDIR */ | |
1376 | |
1377 newdir = 0; | |
1378 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1379 if (nm[0] == '~') /* prefix ~ */ |
230 | 1380 if (nm[1] == '/' |
1381 #ifdef VMS | |
1382 || nm[1] == ':' | |
1383 #endif /* VMS */ | |
1384 || nm[1] == 0)/* ~/filename */ | |
1385 { | |
1386 if (!(newdir = (unsigned char *) egetenv ("HOME"))) | |
1387 newdir = (unsigned char *) ""; | |
1388 nm++; | |
1389 #ifdef VMS | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1390 nm++; /* Don't leave the slash in nm. */ |
230 | 1391 #endif /* VMS */ |
1392 } | |
1393 else /* ~user/filename */ | |
1394 { | |
1395 /* Get past ~ to user */ | |
1396 unsigned char *user = nm + 1; | |
1397 /* Find end of name. */ | |
1398 unsigned char *ptr = (unsigned char *) index (user, '/'); | |
1399 int len = ptr ? ptr - user : strlen (user); | |
1400 #ifdef VMS | |
1401 unsigned char *ptr1 = index (user, ':'); | |
1402 if (ptr1 != 0 && ptr1 - user < len) | |
1403 len = ptr1 - user; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1404 #endif /* VMS */ |
230 | 1405 /* Copy the user name into temp storage. */ |
1406 o = (unsigned char *) alloca (len + 1); | |
1407 bcopy ((char *) user, o, len); | |
1408 o[len] = 0; | |
1409 | |
1410 /* Look up the user name. */ | |
1411 pw = (struct passwd *) getpwnam (o + 1); | |
1412 if (!pw) | |
1413 error ("\"%s\" isn't a registered user", o + 1); | |
1414 | |
1415 newdir = (unsigned char *) pw->pw_dir; | |
1416 | |
1417 /* Discard the user name from NM. */ | |
1418 nm += len; | |
1419 } | |
1420 | |
1421 if (nm[0] != '/' | |
1422 #ifdef VMS | |
1423 && !index (nm, ':') | |
1424 #endif /* not VMS */ | |
1425 && !newdir) | |
1426 { | |
485 | 1427 if (NILP (defalt)) |
230 | 1428 defalt = current_buffer->directory; |
1429 CHECK_STRING (defalt, 1); | |
1430 newdir = XSTRING (defalt)->data; | |
1431 } | |
1432 | |
1433 /* Now concatenate the directory and name to new space in the stack frame */ | |
1434 | |
1435 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1; | |
1436 target = (unsigned char *) alloca (tlen); | |
1437 *target = 0; | |
1438 | |
1439 if (newdir) | |
1440 { | |
1441 #ifndef VMS | |
1442 if (nm[0] == 0 || nm[0] == '/') | |
1443 strcpy (target, newdir); | |
1444 else | |
1445 #endif | |
1446 file_name_as_directory (target, newdir); | |
1447 } | |
1448 | |
1449 strcat (target, nm); | |
1450 #ifdef VMS | |
1451 if (index (target, '/')) | |
1452 strcpy (target, sys_translate_unix (target)); | |
1453 #endif /* VMS */ | |
1454 | |
1455 /* Now canonicalize by removing /. and /foo/.. if they appear */ | |
1456 | |
1457 p = target; | |
1458 o = target; | |
1459 | |
1460 while (*p) | |
1461 { | |
1462 #ifdef VMS | |
1463 if (*p != ']' && *p != '>' && *p != '-') | |
1464 { | |
1465 if (*p == '\\') | |
1466 p++; | |
1467 *o++ = *p++; | |
1468 } | |
1469 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) | |
1470 /* brackets are offset from each other by 2 */ | |
1471 { | |
1472 p += 2; | |
1473 if (*p != '.' && *p != '-' && o[-1] != '.') | |
1474 /* convert [foo][bar] to [bar] */ | |
1475 while (o[-1] != '[' && o[-1] != '<') | |
1476 o--; | |
1477 else if (*p == '-' && *o != '.') | |
1478 *--p = '.'; | |
1479 } | |
1480 else if (p[0] == '-' && o[-1] == '.' && | |
1481 (p[1] == '.' || p[1] == ']' || p[1] == '>')) | |
1482 /* flush .foo.- ; leave - if stopped by '[' or '<' */ | |
1483 { | |
1484 do | |
1485 o--; | |
1486 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1487 if (p[1] == '.') /* foo.-.bar ==> bar. */ |
230 | 1488 p += 2; |
1489 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ | |
1490 p++, o--; | |
1491 /* else [foo.-] ==> [-] */ | |
1492 } | |
1493 else | |
1494 { | |
1495 #ifndef VMS4_4 | |
1496 if (*p == '-' && | |
1497 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && | |
1498 p[1] != ']' && p[1] != '>' && p[1] != '.') | |
1499 *p = '_'; | |
1500 #endif /* VMS4_4 */ | |
1501 *o++ = *p++; | |
1502 } | |
1503 #else /* not VMS */ | |
1504 if (*p != '/') | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1505 { |
230 | 1506 *o++ = *p++; |
1507 } | |
1508 else if (!strncmp (p, "//", 2) | |
1509 #ifdef APOLLO | |
1510 /* // at start of filename is meaningful in Apollo system */ | |
1511 && o != target | |
1512 #endif /* APOLLO */ | |
1513 ) | |
1514 { | |
1515 o = target; | |
1516 p++; | |
1517 } | |
1518 else if (p[0] == '/' && p[1] == '.' && | |
1519 (p[2] == '/' || p[2] == 0)) | |
1520 p += 2; | |
1521 else if (!strncmp (p, "/..", 3) | |
1522 /* `/../' is the "superroot" on certain file systems. */ | |
1523 && o != target | |
1524 && (p[3] == '/' || p[3] == 0)) | |
1525 { | |
1526 while (o != target && *--o != '/') | |
1527 ; | |
1528 #ifdef APOLLO | |
1529 if (o == target + 1 && o[-1] == '/' && o[0] == '/') | |
1530 ++o; | |
1531 else | |
1532 #endif /* APOLLO */ | |
1533 if (o == target && *o == '/') | |
1534 ++o; | |
1535 p += 3; | |
1536 } | |
1537 else | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1538 { |
230 | 1539 *o++ = *p++; |
1540 } | |
1541 #endif /* not VMS */ | |
1542 } | |
1543 | |
1544 return make_string (target, o - target); | |
1545 } | |
1546 #endif | |
1547 | |
1548 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, | |
1549 Ssubstitute_in_file_name, 1, 1, 0, | |
1550 "Substitute environment variables referred to in FILENAME.\n\ | |
1551 `$FOO' where FOO is an environment variable name means to substitute\n\ | |
1552 the value of that variable. The variable name should be terminated\n\ | |
1553 with a character not a letter, digit or underscore; otherwise, enclose\n\ | |
1554 the entire variable name in braces.\n\ | |
1555 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\ | |
1556 On VMS, `$' substitution is not done; this function does little and only\n\ | |
1557 duplicates what `expand-file-name' does.") | |
1558 (string) | |
1559 Lisp_Object string; | |
1560 { | |
1561 unsigned char *nm; | |
1562 | |
1563 register unsigned char *s, *p, *o, *x, *endp; | |
1564 unsigned char *target; | |
1565 int total = 0; | |
1566 int substituted = 0; | |
1567 unsigned char *xnm; | |
9955
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1568 Lisp_Object handler; |
230 | 1569 |
1570 CHECK_STRING (string, 0); | |
1571 | |
9955
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1572 /* If the file name has special constructs in it, |
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1573 call the corresponding file handler. */ |
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1574 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name); |
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1575 if (!NILP (handler)) |
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1576 return call2 (handler, Qsubstitute_in_file_name, string); |
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
1577 |
230 | 1578 nm = XSTRING (string)->data; |
8185
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
1579 #ifdef MSDOS |
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
1580 dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); |
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
1581 substituted = !strcmp (nm, XSTRING (string)->data); |
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
1582 #endif |
230 | 1583 endp = nm + XSTRING (string)->size; |
1584 | |
1585 /* If /~ or // appears, discard everything through first slash. */ | |
1586 | |
1587 for (p = nm; p != endp; p++) | |
1588 { | |
1589 if ((p[0] == '~' || | |
1590 #ifdef APOLLO | |
1591 /* // at start of file name is meaningful in Apollo system */ | |
1592 (p[0] == '/' && p - 1 != nm) | |
1593 #else /* not APOLLO */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1594 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1595 (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1596 #else /* not WINDOWSNT */ |
230 | 1597 p[0] == '/' |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1598 #endif /* not WINDOWSNT */ |
230 | 1599 #endif /* not APOLLO */ |
1600 ) | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1601 && p != nm |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1602 && (0 |
230 | 1603 #ifdef VMS |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1604 || p[-1] == ':' || p[-1] == ']' || p[-1] == '>' |
230 | 1605 #endif /* VMS */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1606 || IS_DIRECTORY_SEP (p[-1]))) |
230 | 1607 { |
1608 nm = p; | |
1609 substituted = 1; | |
1610 } | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1611 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1612 if (p[0] && p[1] == ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1613 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1614 nm = p; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1615 substituted = 1; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1616 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1617 #endif /* DOS_NT */ |
230 | 1618 } |
1619 | |
1620 #ifdef VMS | |
1621 return build_string (nm); | |
1622 #else | |
1623 | |
1624 /* See if any variables are substituted into the string | |
1625 and find the total length of their values in `total' */ | |
1626 | |
1627 for (p = nm; p != endp;) | |
1628 if (*p != '$') | |
1629 p++; | |
1630 else | |
1631 { | |
1632 p++; | |
1633 if (p == endp) | |
1634 goto badsubst; | |
1635 else if (*p == '$') | |
1636 { | |
1637 /* "$$" means a single "$" */ | |
1638 p++; | |
1639 total -= 1; | |
1640 substituted = 1; | |
1641 continue; | |
1642 } | |
1643 else if (*p == '{') | |
1644 { | |
1645 o = ++p; | |
1646 while (p != endp && *p != '}') p++; | |
1647 if (*p != '}') goto missingclose; | |
1648 s = p; | |
1649 } | |
1650 else | |
1651 { | |
1652 o = p; | |
1653 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
1654 s = p; | |
1655 } | |
1656 | |
1657 /* Copy out the variable name */ | |
1658 target = (unsigned char *) alloca (s - o + 1); | |
1659 strncpy (target, o, s - o); | |
1660 target[s - o] = 0; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1661 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1662 strupr (target); /* $home == $HOME etc. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1663 #endif /* DOS_NT */ |
230 | 1664 |
1665 /* Get variable value */ | |
1666 o = (unsigned char *) egetenv (target); | |
1667 if (!o) goto badvar; | |
1668 total += strlen (o); | |
1669 substituted = 1; | |
1670 } | |
1671 | |
1672 if (!substituted) | |
1673 return string; | |
1674 | |
1675 /* If substitution required, recopy the string and do it */ | |
1676 /* Make space in stack frame for the new copy */ | |
1677 xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1); | |
1678 x = xnm; | |
1679 | |
1680 /* Copy the rest of the name through, replacing $ constructs with values */ | |
1681 for (p = nm; *p;) | |
1682 if (*p != '$') | |
1683 *x++ = *p++; | |
1684 else | |
1685 { | |
1686 p++; | |
1687 if (p == endp) | |
1688 goto badsubst; | |
1689 else if (*p == '$') | |
1690 { | |
1691 *x++ = *p++; | |
1692 continue; | |
1693 } | |
1694 else if (*p == '{') | |
1695 { | |
1696 o = ++p; | |
1697 while (p != endp && *p != '}') p++; | |
1698 if (*p != '}') goto missingclose; | |
1699 s = p++; | |
1700 } | |
1701 else | |
1702 { | |
1703 o = p; | |
1704 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
1705 s = p; | |
1706 } | |
1707 | |
1708 /* Copy out the variable name */ | |
1709 target = (unsigned char *) alloca (s - o + 1); | |
1710 strncpy (target, o, s - o); | |
1711 target[s - o] = 0; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1712 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1713 strupr (target); /* $home == $HOME etc. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1714 #endif /* DOS_NT */ |
230 | 1715 |
1716 /* Get variable value */ | |
1717 o = (unsigned char *) egetenv (target); | |
1718 if (!o) | |
1719 goto badvar; | |
1720 | |
1721 strcpy (x, o); | |
1722 x += strlen (o); | |
1723 } | |
1724 | |
1725 *x = 0; | |
1726 | |
1727 /* If /~ or // appears, discard everything through first slash. */ | |
1728 | |
1729 for (p = xnm; p != x; p++) | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1730 if ((p[0] == '~' |
230 | 1731 #ifdef APOLLO |
1732 /* // at start of file name is meaningful in Apollo system */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1733 || (p[0] == '/' && p - 1 != xnm) |
230 | 1734 #else /* not APOLLO */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1735 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1736 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1737 #else /* not WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1738 || p[0] == '/' |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1739 #endif /* not WINDOWSNT */ |
9872
3f52395fcef9
(Fsubstitute_in_file_name): Add missing #endif.
Richard M. Stallman <rms@gnu.org>
parents:
9789
diff
changeset
|
1740 #endif /* not APOLLO */ |
230 | 1741 ) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1742 && p != nm && IS_DIRECTORY_SEP (p[-1])) |
230 | 1743 xnm = p; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1744 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1745 else if (p[0] && p[1] == ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1746 xnm = p; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1747 #endif |
230 | 1748 |
1749 return make_string (xnm, x - xnm); | |
1750 | |
1751 badsubst: | |
1752 error ("Bad format environment-variable substitution"); | |
1753 missingclose: | |
1754 error ("Missing \"}\" in environment-variable substitution"); | |
1755 badvar: | |
1756 error ("Substituting nonexistent environment variable \"%s\"", target); | |
1757 | |
1758 /* NOTREACHED */ | |
1759 #endif /* not VMS */ | |
1760 } | |
1761 | |
853 | 1762 /* A slightly faster and more convenient way to get |
4451
73b91cd2c55e
(expand_and_dir_to_file): Remove final / by copying abspath.
Richard M. Stallman <rms@gnu.org>
parents:
4395
diff
changeset
|
1763 (directory-file-name (expand-file-name FOO)). */ |
853 | 1764 |
230 | 1765 Lisp_Object |
1766 expand_and_dir_to_file (filename, defdir) | |
1767 Lisp_Object filename, defdir; | |
1768 { | |
1769 register Lisp_Object abspath; | |
1770 | |
1771 abspath = Fexpand_file_name (filename, defdir); | |
1772 #ifdef VMS | |
1773 { | |
1774 register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1]; | |
1775 if (c == ':' || c == ']' || c == '>') | |
1776 abspath = Fdirectory_file_name (abspath); | |
1777 } | |
1778 #else | |
1779 /* Remove final slash, if any (unless path is root). | |
1780 stat behaves differently depending! */ | |
1781 if (XSTRING (abspath)->size > 1 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1782 && IS_DIRECTORY_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size - 1]) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1783 && !IS_DEVICE_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size-2])) |
4483
6894dd27c9ec
(expand_and_dir_to_file): Use Fdirectory_file_name.
Richard M. Stallman <rms@gnu.org>
parents:
4451
diff
changeset
|
1784 /* We cannot take shortcuts; they might be wrong for magic file names. */ |
6894dd27c9ec
(expand_and_dir_to_file): Use Fdirectory_file_name.
Richard M. Stallman <rms@gnu.org>
parents:
4451
diff
changeset
|
1785 abspath = Fdirectory_file_name (abspath); |
230 | 1786 #endif |
1787 return abspath; | |
1788 } | |
1789 | |
8846
6bf0ce964319
(barf_or_query_if_file_exists): Fix declaration.
Karl Heuer <kwzh@gnu.org>
parents:
8808
diff
changeset
|
1790 void |
230 | 1791 barf_or_query_if_file_exists (absname, querystring, interactive) |
1792 Lisp_Object absname; | |
1793 unsigned char *querystring; | |
1794 int interactive; | |
1795 { | |
1796 register Lisp_Object tem; | |
8597 | 1797 struct stat statbuf; |
230 | 1798 struct gcpro gcpro1; |
1799 | |
8597 | 1800 /* stat is a good way to tell whether the file exists, |
1801 regardless of what access permissions it has. */ | |
1802 if (stat (XSTRING (absname)->data, &statbuf) >= 0) | |
230 | 1803 { |
1804 if (! interactive) | |
1805 Fsignal (Qfile_already_exists, | |
1806 Fcons (build_string ("File already exists"), | |
1807 Fcons (absname, Qnil))); | |
1808 GCPRO1 (absname); | |
1809 tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ", | |
1810 XSTRING (absname)->data, querystring)); | |
1811 UNGCPRO; | |
485 | 1812 if (NILP (tem)) |
230 | 1813 Fsignal (Qfile_already_exists, |
1814 Fcons (build_string ("File already exists"), | |
1815 Fcons (absname, Qnil))); | |
1816 } | |
1817 return; | |
1818 } | |
1819 | |
1820 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, | |
410 | 1821 "fCopy file: \nFCopy %s to file: \np\nP", |
230 | 1822 "Copy FILE to NEWNAME. Both args must be strings.\n\ |
1823 Signals a `file-already-exists' error if file NEWNAME already exists,\n\ | |
1824 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\ | |
1825 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
1826 This is what happens in interactive use with M-x.\n\ | |
410 | 1827 Fourth arg KEEP-TIME non-nil means give the new file the same\n\ |
1828 last-modified time as the old one. (This works on only some systems.)\n\ | |
1829 A prefix arg makes KEEP-TIME non-nil.") | |
230 | 1830 (filename, newname, ok_if_already_exists, keep_date) |
1831 Lisp_Object filename, newname, ok_if_already_exists, keep_date; | |
1832 { | |
1833 int ifd, ofd, n; | |
1834 char buf[16 * 1024]; | |
1835 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1836 Lisp_Object handler; |
230 | 1837 struct gcpro gcpro1, gcpro2; |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1838 int count = specpdl_ptr - specpdl; |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1839 int input_file_statable_p; |
230 | 1840 |
1841 GCPRO2 (filename, newname); | |
1842 CHECK_STRING (filename, 0); | |
1843 CHECK_STRING (newname, 1); | |
1844 filename = Fexpand_file_name (filename, Qnil); | |
1845 newname = Fexpand_file_name (newname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1846 |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
1847 /* If the input file name has special constructs in it, |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1848 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1849 handler = Ffind_file_name_handler (filename, Qcopy_file); |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
1850 /* Likewise for output file name. */ |
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
1851 if (NILP (handler)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1852 handler = Ffind_file_name_handler (newname, Qcopy_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1853 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1854 RETURN_UNGCPRO (call5 (handler, Qcopy_file, filename, newname, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1855 ok_if_already_exists, keep_date)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1856 |
485 | 1857 if (NILP (ok_if_already_exists) |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
1858 || INTEGERP (ok_if_already_exists)) |
230 | 1859 barf_or_query_if_file_exists (newname, "copy to it", |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
1860 INTEGERP (ok_if_already_exists)); |
230 | 1861 |
8597 | 1862 ifd = open (XSTRING (filename)->data, O_RDONLY); |
230 | 1863 if (ifd < 0) |
1864 report_file_error ("Opening input file", Fcons (filename, Qnil)); | |
1865 | |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1866 record_unwind_protect (close_file_unwind, make_number (ifd)); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1867 |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1868 /* We can only copy regular files and symbolic links. Other files are not |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1869 copyable by us. */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1870 input_file_statable_p = (fstat (ifd, &st) >= 0); |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1871 |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1872 #if defined (S_ISREG) && defined (S_ISLNK) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1873 if (input_file_statable_p) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1874 { |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1875 if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode))) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1876 { |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1877 #if defined (EISDIR) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1878 /* Get a better looking error message. */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1879 errno = EISDIR; |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1880 #endif /* EISDIR */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1881 report_file_error ("Non-regular file", Fcons (filename, Qnil)); |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1882 } |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1883 } |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1884 #endif /* S_ISREG && S_ISLNK */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1885 |
230 | 1886 #ifdef VMS |
1887 /* Create the copy file with the same record format as the input file */ | |
1888 ofd = sys_creat (XSTRING (newname)->data, 0666, ifd); | |
1889 #else | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1890 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1891 /* System's default file type was set to binary by _fmode in emacs.c. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1892 ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1893 #else /* not MSDOS */ |
230 | 1894 ofd = creat (XSTRING (newname)->data, 0666); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1895 #endif /* not MSDOS */ |
230 | 1896 #endif /* VMS */ |
1897 if (ofd < 0) | |
595 | 1898 report_file_error ("Opening output file", Fcons (newname, Qnil)); |
230 | 1899 |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1900 record_unwind_protect (close_file_unwind, make_number (ofd)); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1901 |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1902 immediate_quit = 1; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1903 QUIT; |
230 | 1904 while ((n = read (ifd, buf, sizeof buf)) > 0) |
1905 if (write (ofd, buf, n) != n) | |
595 | 1906 report_file_error ("I/O error", Fcons (newname, Qnil)); |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1907 immediate_quit = 0; |
230 | 1908 |
7493
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1909 /* Closing the output clobbers the file times on some systems. */ |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1910 if (close (ofd) < 0) |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1911 report_file_error ("I/O error", Fcons (newname, Qnil)); |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1912 |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1913 if (input_file_statable_p) |
230 | 1914 { |
485 | 1915 if (!NILP (keep_date)) |
230 | 1916 { |
564 | 1917 EMACS_TIME atime, mtime; |
1918 EMACS_SET_SECS_USECS (atime, st.st_atime, 0); | |
1919 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); | |
8883
24993c71127a
(Fcopy_file): Use set_file_times, and check for the error return.
Karl Heuer <kwzh@gnu.org>
parents:
8846
diff
changeset
|
1920 if (set_file_times (XSTRING (newname)->data, atime, mtime)) |
24993c71127a
(Fcopy_file): Use set_file_times, and check for the error return.
Karl Heuer <kwzh@gnu.org>
parents:
8846
diff
changeset
|
1921 report_file_error ("I/O error", Fcons (newname, Qnil)); |
230 | 1922 } |
1923 #ifdef APOLLO | |
1924 if (!egetenv ("USE_DOMAIN_ACLS")) | |
1925 #endif | |
564 | 1926 chmod (XSTRING (newname)->data, st.st_mode & 07777); |
230 | 1927 } |
1928 | |
7493
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1929 close (ifd); |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1930 |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1931 /* Discard the unwind protects. */ |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1932 specpdl_ptr = specpdl + count; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1933 |
230 | 1934 UNGCPRO; |
1935 return Qnil; | |
1936 } | |
10084
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
1937 |
1533
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
1938 DEFUN ("make-directory-internal", Fmake_directory_internal, |
1536
0877009e6324
* fileio.c (Fmake_directory_internal): Remove extra paren before the
Jim Blandy <jimb@redhat.com>
parents:
1533
diff
changeset
|
1939 Smake_directory_internal, 1, 1, 0, |
230 | 1940 "Create a directory. One argument, a file name string.") |
1941 (dirname) | |
1942 Lisp_Object dirname; | |
1943 { | |
1944 unsigned char *dir; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1945 Lisp_Object handler; |
230 | 1946 |
1947 CHECK_STRING (dirname, 0); | |
1948 dirname = Fexpand_file_name (dirname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1949 |
8227
0e6b7eeedc3b
(Fmake_directory_internal): Use Qmake_directory_internal.
Richard M. Stallman <rms@gnu.org>
parents:
8185
diff
changeset
|
1950 handler = Ffind_file_name_handler (dirname, Qmake_directory_internal); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1951 if (!NILP (handler)) |
8587
792839acdc92
(Fmake_directory_internal): Pass just 2 args to handler.
Richard M. Stallman <rms@gnu.org>
parents:
8454
diff
changeset
|
1952 return call2 (handler, Qmake_directory_internal, dirname); |
1533
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
1953 |
230 | 1954 dir = XSTRING (dirname)->data; |
1955 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1956 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1957 if (mkdir (dir) != 0) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1958 #else |
230 | 1959 if (mkdir (dir, 0777) != 0) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
1960 #endif |
230 | 1961 report_file_error ("Creating directory", Flist (1, &dirname)); |
1962 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1963 return Qnil; |
230 | 1964 } |
1965 | |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
648
diff
changeset
|
1966 DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", |
7611
f93e2ddcf8c2
(Fdelete_directory): Allow dir names as well as file names.
Richard M. Stallman <rms@gnu.org>
parents:
7595
diff
changeset
|
1967 "Delete a directory. One argument, a file name or directory name string.") |
230 | 1968 (dirname) |
1969 Lisp_Object dirname; | |
1970 { | |
1971 unsigned char *dir; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1972 Lisp_Object handler; |
230 | 1973 |
1974 CHECK_STRING (dirname, 0); | |
7611
f93e2ddcf8c2
(Fdelete_directory): Allow dir names as well as file names.
Richard M. Stallman <rms@gnu.org>
parents:
7595
diff
changeset
|
1975 dirname = Fdirectory_file_name (Fexpand_file_name (dirname, Qnil)); |
230 | 1976 dir = XSTRING (dirname)->data; |
1977 | |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1978 handler = Ffind_file_name_handler (dirname, Qdelete_directory); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1979 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1980 return call2 (handler, Qdelete_directory, dirname); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1981 |
230 | 1982 if (rmdir (dir) != 0) |
1983 report_file_error ("Removing directory", Flist (1, &dirname)); | |
1984 | |
1985 return Qnil; | |
1986 } | |
1987 | |
1988 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", | |
1989 "Delete specified file. One argument, a file name string.\n\ | |
1990 If file has multiple names, it continues to exist with the other names.") | |
1991 (filename) | |
1992 Lisp_Object filename; | |
1993 { | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1994 Lisp_Object handler; |
230 | 1995 CHECK_STRING (filename, 0); |
1996 filename = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1997 |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1998 handler = Ffind_file_name_handler (filename, Qdelete_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1999 if (!NILP (handler)) |
9170
1d95c81487a3
(Fdelete_file): Undo Sep 16 change.
Karl Heuer <kwzh@gnu.org>
parents:
9131
diff
changeset
|
2000 return call2 (handler, Qdelete_file, filename); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2001 |
230 | 2002 if (0 > unlink (XSTRING (filename)->data)) |
2003 report_file_error ("Removing old name", Flist (1, &filename)); | |
9170
1d95c81487a3
(Fdelete_file): Undo Sep 16 change.
Karl Heuer <kwzh@gnu.org>
parents:
9131
diff
changeset
|
2004 return Qnil; |
230 | 2005 } |
2006 | |
10084
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2007 static Lisp_Object |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2008 internal_delete_file_1 (ignore) |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2009 Lisp_Object ignore; |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2010 { |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2011 return Qt; |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2012 } |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2013 |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2014 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */ |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2015 |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2016 int |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2017 internal_delete_file (filename) |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2018 Lisp_Object filename; |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2019 { |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2020 return NILP (internal_condition_case_1 (Fdelete_file, filename, |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2021 Qt, internal_delete_file_1)); |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2022 } |
e930bf84753c
(internal_delete_file, internal_delete_file_1): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
9962
diff
changeset
|
2023 |
230 | 2024 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, |
2025 "fRename file: \nFRename %s to file: \np", | |
2026 "Rename FILE as NEWNAME. Both args strings.\n\ | |
2027 If file has names other than FILE, it continues to have those names.\n\ | |
2028 Signals a `file-already-exists' error if a file NEWNAME already exists\n\ | |
2029 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ | |
2030 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
2031 This is what happens in interactive use with M-x.") | |
2032 (filename, newname, ok_if_already_exists) | |
2033 Lisp_Object filename, newname, ok_if_already_exists; | |
2034 { | |
2035 #ifdef NO_ARG_ARRAY | |
2036 Lisp_Object args[2]; | |
2037 #endif | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2038 Lisp_Object handler; |
230 | 2039 struct gcpro gcpro1, gcpro2; |
2040 | |
2041 GCPRO2 (filename, newname); | |
2042 CHECK_STRING (filename, 0); | |
2043 CHECK_STRING (newname, 1); | |
2044 filename = Fexpand_file_name (filename, Qnil); | |
2045 newname = Fexpand_file_name (newname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2046 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2047 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2048 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2049 handler = Ffind_file_name_handler (filename, Qrename_file); |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
2050 if (NILP (handler)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2051 handler = Ffind_file_name_handler (newname, Qrename_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2052 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2053 RETURN_UNGCPRO (call4 (handler, Qrename_file, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2054 filename, newname, ok_if_already_exists)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2055 |
485 | 2056 if (NILP (ok_if_already_exists) |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
2057 || INTEGERP (ok_if_already_exists)) |
230 | 2058 barf_or_query_if_file_exists (newname, "rename to it", |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
2059 INTEGERP (ok_if_already_exists)); |
230 | 2060 #ifndef BSD4_1 |
2061 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data)) | |
2062 #else | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2063 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2064 if (!MoveFile (XSTRING (filename)->data, XSTRING (newname)->data)) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2065 #else /* not WINDOWSNT */ |
230 | 2066 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data) |
2067 || 0 > unlink (XSTRING (filename)->data)) | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2068 #endif /* not WINDOWSNT */ |
230 | 2069 #endif |
2070 { | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2071 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2072 /* Why two? And why doesn't MS document what MoveFile will return? */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2073 if (GetLastError () == ERROR_FILE_EXISTS |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2074 || GetLastError () == ERROR_ALREADY_EXISTS) |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2075 #else /* not WINDOWSNT */ |
230 | 2076 if (errno == EXDEV) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2077 #endif /* not WINDOWSNT */ |
230 | 2078 { |
3963
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
2079 Fcopy_file (filename, newname, |
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
2080 /* We have already prompted if it was an integer, |
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
2081 so don't have copy-file prompt again. */ |
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
2082 NILP (ok_if_already_exists) ? Qnil : Qt, Qt); |
230 | 2083 Fdelete_file (filename); |
2084 } | |
2085 else | |
2086 #ifdef NO_ARG_ARRAY | |
2087 { | |
2088 args[0] = filename; | |
2089 args[1] = newname; | |
2090 report_file_error ("Renaming", Flist (2, args)); | |
2091 } | |
2092 #else | |
2093 report_file_error ("Renaming", Flist (2, &filename)); | |
2094 #endif | |
2095 } | |
2096 UNGCPRO; | |
2097 return Qnil; | |
2098 } | |
2099 | |
2100 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, | |
2101 "fAdd name to file: \nFName to add to %s: \np", | |
2102 "Give FILE additional name NEWNAME. Both args strings.\n\ | |
2103 Signals a `file-already-exists' error if a file NEWNAME already exists\n\ | |
2104 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ | |
2105 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
2106 This is what happens in interactive use with M-x.") | |
2107 (filename, newname, ok_if_already_exists) | |
2108 Lisp_Object filename, newname, ok_if_already_exists; | |
2109 { | |
2110 #ifdef NO_ARG_ARRAY | |
2111 Lisp_Object args[2]; | |
2112 #endif | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2113 Lisp_Object handler; |
230 | 2114 struct gcpro gcpro1, gcpro2; |
2115 | |
2116 GCPRO2 (filename, newname); | |
2117 CHECK_STRING (filename, 0); | |
2118 CHECK_STRING (newname, 1); | |
2119 filename = Fexpand_file_name (filename, Qnil); | |
2120 newname = Fexpand_file_name (newname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2121 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2122 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2123 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2124 handler = Ffind_file_name_handler (filename, Qadd_name_to_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2125 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2126 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2127 newname, ok_if_already_exists)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2128 |
485 | 2129 if (NILP (ok_if_already_exists) |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
2130 || INTEGERP (ok_if_already_exists)) |
230 | 2131 barf_or_query_if_file_exists (newname, "make it a new name", |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
2132 INTEGERP (ok_if_already_exists)); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2133 #ifdef WINDOWSNT |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2134 /* Windows does not support this operation. */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2135 report_file_error ("Adding new name", Flist (2, &filename)); |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2136 #else /* not WINDOWSNT */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2137 |
230 | 2138 unlink (XSTRING (newname)->data); |
2139 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)) | |
2140 { | |
2141 #ifdef NO_ARG_ARRAY | |
2142 args[0] = filename; | |
2143 args[1] = newname; | |
2144 report_file_error ("Adding new name", Flist (2, args)); | |
2145 #else | |
2146 report_file_error ("Adding new name", Flist (2, &filename)); | |
2147 #endif | |
2148 } | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2149 #endif /* not WINDOWSNT */ |
230 | 2150 |
2151 UNGCPRO; | |
2152 return Qnil; | |
2153 } | |
2154 | |
2155 #ifdef S_IFLNK | |
2156 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, | |
2157 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", | |
2158 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\ | |
8738
56c445a92c4c
(Fset_default_file_modes): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
8703
diff
changeset
|
2159 Signals a `file-already-exists' error if a file LINKNAME already exists\n\ |
230 | 2160 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ |
8738
56c445a92c4c
(Fset_default_file_modes): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
8703
diff
changeset
|
2161 A number as third arg means request confirmation if LINKNAME already exists.\n\ |
230 | 2162 This happens for interactive use with M-x.") |
732 | 2163 (filename, linkname, ok_if_already_exists) |
2164 Lisp_Object filename, linkname, ok_if_already_exists; | |
230 | 2165 { |
2166 #ifdef NO_ARG_ARRAY | |
2167 Lisp_Object args[2]; | |
2168 #endif | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2169 Lisp_Object handler; |
230 | 2170 struct gcpro gcpro1, gcpro2; |
2171 | |
732 | 2172 GCPRO2 (filename, linkname); |
230 | 2173 CHECK_STRING (filename, 0); |
732 | 2174 CHECK_STRING (linkname, 1); |
5245
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2175 /* If the link target has a ~, we must expand it to get |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2176 a truly valid file name. Otherwise, do not expand; |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2177 we want to permit links to relative file names. */ |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2178 if (XSTRING (filename)->data[0] == '~') |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2179 filename = Fexpand_file_name (filename, Qnil); |
732 | 2180 linkname = Fexpand_file_name (linkname, Qnil); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2181 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2182 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2183 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2184 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2185 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2186 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2187 linkname, ok_if_already_exists)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2188 |
485 | 2189 if (NILP (ok_if_already_exists) |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
2190 || INTEGERP (ok_if_already_exists)) |
732 | 2191 barf_or_query_if_file_exists (linkname, "make it a link", |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
2192 INTEGERP (ok_if_already_exists)); |
732 | 2193 if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) |
230 | 2194 { |
2195 /* If we didn't complain already, silently delete existing file. */ | |
2196 if (errno == EEXIST) | |
2197 { | |
2650
f378d89945e1
* fileio.c (Fmake_symbolic_link): If a file already exists under
Jim Blandy <jimb@redhat.com>
parents:
2607
diff
changeset
|
2198 unlink (XSTRING (linkname)->data); |
732 | 2199 if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2200 { |
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2201 UNGCPRO; |
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2202 return Qnil; |
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2203 } |
230 | 2204 } |
2205 | |
2206 #ifdef NO_ARG_ARRAY | |
2207 args[0] = filename; | |
732 | 2208 args[1] = linkname; |
230 | 2209 report_file_error ("Making symbolic link", Flist (2, args)); |
2210 #else | |
2211 report_file_error ("Making symbolic link", Flist (2, &filename)); | |
2212 #endif | |
2213 } | |
2214 UNGCPRO; | |
2215 return Qnil; | |
2216 } | |
2217 #endif /* S_IFLNK */ | |
2218 | |
2219 #ifdef VMS | |
2220 | |
2221 DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, | |
2222 2, 2, "sDefine logical name: \nsDefine logical name %s as: ", | |
2223 "Define the job-wide logical name NAME to have the value STRING.\n\ | |
2224 If STRING is nil or a null string, the logical name NAME is deleted.") | |
2225 (varname, string) | |
2226 Lisp_Object varname; | |
2227 Lisp_Object string; | |
2228 { | |
2229 CHECK_STRING (varname, 0); | |
485 | 2230 if (NILP (string)) |
230 | 2231 delete_logical_name (XSTRING (varname)->data); |
2232 else | |
2233 { | |
2234 CHECK_STRING (string, 1); | |
2235 | |
2236 if (XSTRING (string)->size == 0) | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2237 delete_logical_name (XSTRING (varname)->data); |
230 | 2238 else |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2239 define_logical_name (XSTRING (varname)->data, XSTRING (string)->data); |
230 | 2240 } |
2241 | |
2242 return string; | |
2243 } | |
2244 #endif /* VMS */ | |
2245 | |
2246 #ifdef HPUX_NET | |
2247 | |
2248 DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, | |
2249 "Open a network connection to PATH using LOGIN as the login string.") | |
2250 (path, login) | |
2251 Lisp_Object path, login; | |
2252 { | |
2253 int netresult; | |
2254 | |
2255 CHECK_STRING (path, 0); | |
2256 CHECK_STRING (login, 0); | |
2257 | |
2258 netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); | |
2259 | |
2260 if (netresult == -1) | |
2261 return Qnil; | |
2262 else | |
2263 return Qt; | |
2264 } | |
2265 #endif /* HPUX_NET */ | |
2266 | |
2267 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, | |
2268 1, 1, 0, | |
2269 "Return t if file FILENAME specifies an absolute path name.\n\ | |
2270 On Unix, this is a name starting with a `/' or a `~'.") | |
2271 (filename) | |
2272 Lisp_Object filename; | |
2273 { | |
2274 unsigned char *ptr; | |
2275 | |
2276 CHECK_STRING (filename, 0); | |
2277 ptr = XSTRING (filename)->data; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2278 if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' |
230 | 2279 #ifdef VMS |
2280 /* ??? This criterion is probably wrong for '<'. */ | |
2281 || index (ptr, ':') || index (ptr, '<') | |
2282 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']')) | |
2283 && ptr[1] != '.') | |
2284 #endif /* VMS */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2285 #ifdef DOS_NT |
8185
b5cc015a3698
(Ffile_name_directory, Ffile_name_nondirectory,
Richard M. Stallman <rms@gnu.org>
parents:
8079
diff
changeset
|
2286 || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\')) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2287 #endif |
230 | 2288 ) |
2289 return Qt; | |
2290 else | |
2291 return Qnil; | |
2292 } | |
9078
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2293 |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2294 /* Return nonzero if file FILENAME exists and can be executed. */ |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2295 |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2296 static int |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2297 check_executable (filename) |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2298 char *filename; |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2299 { |
9374
347f919eea4a
(check_writable, check_executable): Test HAVE_EACCESS.
Richard M. Stallman <rms@gnu.org>
parents:
9346
diff
changeset
|
2300 #ifdef HAVE_EACCESS |
9188
c17b2a49b6ec
(check_writable, check_executable) [__HURD__]: Use eaccess.
Richard M. Stallman <rms@gnu.org>
parents:
9170
diff
changeset
|
2301 return (eaccess (filename, 1) >= 0); |
9078
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2302 #else |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2303 /* Access isn't quite right because it uses the real uid |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2304 and we really want to test with the effective uid. |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2305 But Unix doesn't give us a right way to do it. */ |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2306 return (access (filename, 1) >= 0); |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2307 #endif |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2308 } |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2309 |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2310 /* Return nonzero if file FILENAME exists and can be written. */ |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2311 |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2312 static int |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2313 check_writable (filename) |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2314 char *filename; |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2315 { |
9374
347f919eea4a
(check_writable, check_executable): Test HAVE_EACCESS.
Richard M. Stallman <rms@gnu.org>
parents:
9346
diff
changeset
|
2316 #ifdef HAVE_EACCESS |
9188
c17b2a49b6ec
(check_writable, check_executable) [__HURD__]: Use eaccess.
Richard M. Stallman <rms@gnu.org>
parents:
9170
diff
changeset
|
2317 return (eaccess (filename, 2) >= 0); |
9078
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2318 #else |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2319 /* Access isn't quite right because it uses the real uid |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2320 and we really want to test with the effective uid. |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2321 But Unix doesn't give us a right way to do it. |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2322 Opening with O_WRONLY could work for an ordinary file, |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2323 but would lose for directories. */ |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2324 return (access (filename, 2) >= 0); |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2325 #endif |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2326 } |
230 | 2327 |
2328 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, | |
2329 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\ | |
2330 See also `file-readable-p' and `file-attributes'.") | |
2331 (filename) | |
2332 Lisp_Object filename; | |
2333 { | |
2334 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2335 Lisp_Object handler; |
8597 | 2336 struct stat statbuf; |
230 | 2337 |
2338 CHECK_STRING (filename, 0); | |
2339 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2340 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2341 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2342 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2343 handler = Ffind_file_name_handler (abspath, Qfile_exists_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2344 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2345 return call2 (handler, Qfile_exists_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2346 |
8597 | 2347 return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil; |
230 | 2348 } |
2349 | |
2350 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, | |
2351 "Return t if FILENAME can be executed by you.\n\ | |
2236 | 2352 For a directory, this means you can access files in that directory.") |
230 | 2353 (filename) |
2354 Lisp_Object filename; | |
2355 | |
2356 { | |
2357 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2358 Lisp_Object handler; |
230 | 2359 |
2360 CHECK_STRING (filename, 0); | |
2361 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2362 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2363 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2364 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2365 handler = Ffind_file_name_handler (abspath, Qfile_executable_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2366 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2367 return call2 (handler, Qfile_executable_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2368 |
9078
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
2369 return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil); |
230 | 2370 } |
2371 | |
2372 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, | |
2373 "Return t if file FILENAME exists and you can read it.\n\ | |
2374 See also `file-exists-p' and `file-attributes'.") | |
2375 (filename) | |
2376 Lisp_Object filename; | |
2377 { | |
2378 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2379 Lisp_Object handler; |
8597 | 2380 int desc; |
230 | 2381 |
2382 CHECK_STRING (filename, 0); | |
2383 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2384 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2385 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2386 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2387 handler = Ffind_file_name_handler (abspath, Qfile_readable_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2388 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2389 return call2 (handler, Qfile_readable_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2390 |
8597 | 2391 desc = open (XSTRING (abspath)->data, O_RDONLY); |
2392 if (desc < 0) | |
2393 return Qnil; | |
2394 close (desc); | |
2395 return Qt; | |
230 | 2396 } |
2397 | |
9346
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2398 /* Having this before file-symlink-p mysteriously caused it to be forgotten |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2399 on the RT/PC. */ |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2400 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2401 "Return t if file FILENAME can be written or created by you.") |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2402 (filename) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2403 Lisp_Object filename; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2404 { |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2405 Lisp_Object abspath, dir; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2406 Lisp_Object handler; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2407 struct stat statbuf; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2408 |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2409 CHECK_STRING (filename, 0); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2410 abspath = Fexpand_file_name (filename, Qnil); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2411 |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2412 /* If the file name has special constructs in it, |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2413 call the corresponding file handler. */ |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2414 handler = Ffind_file_name_handler (abspath, Qfile_writable_p); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2415 if (!NILP (handler)) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2416 return call2 (handler, Qfile_writable_p, abspath); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2417 |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2418 if (stat (XSTRING (abspath)->data, &statbuf) >= 0) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2419 return (check_writable (XSTRING (abspath)->data) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2420 ? Qt : Qnil); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2421 dir = Ffile_name_directory (abspath); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2422 #ifdef VMS |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2423 if (!NILP (dir)) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2424 dir = Fdirectory_file_name (dir); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2425 #endif /* VMS */ |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2426 #ifdef MSDOS |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2427 if (!NILP (dir)) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2428 dir = Fdirectory_file_name (dir); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2429 #endif /* MSDOS */ |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2430 return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "") |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2431 ? Qt : Qnil); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2432 } |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2433 |
230 | 2434 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, |
5616
67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5553
diff
changeset
|
2435 "Return non-nil if file FILENAME is the name of a symbolic link.\n\ |
67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5553
diff
changeset
|
2436 The value is the name of the file to which it is linked.\n\ |
67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5553
diff
changeset
|
2437 Otherwise returns nil.") |
230 | 2438 (filename) |
2439 Lisp_Object filename; | |
2440 { | |
2441 #ifdef S_IFLNK | |
2442 char *buf; | |
2443 int bufsize; | |
2444 int valsize; | |
2445 Lisp_Object val; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2446 Lisp_Object handler; |
230 | 2447 |
2448 CHECK_STRING (filename, 0); | |
2449 filename = Fexpand_file_name (filename, Qnil); | |
2450 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2451 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2452 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2453 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2454 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2455 return call2 (handler, Qfile_symlink_p, filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2456 |
230 | 2457 bufsize = 100; |
2458 while (1) | |
2459 { | |
2460 buf = (char *) xmalloc (bufsize); | |
2461 bzero (buf, bufsize); | |
2462 valsize = readlink (XSTRING (filename)->data, buf, bufsize); | |
2463 if (valsize < bufsize) break; | |
2464 /* Buffer was not long enough */ | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2435
diff
changeset
|
2465 xfree (buf); |
230 | 2466 bufsize *= 2; |
2467 } | |
2468 if (valsize == -1) | |
2469 { | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2435
diff
changeset
|
2470 xfree (buf); |
230 | 2471 return Qnil; |
2472 } | |
2473 val = make_string (buf, valsize); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2435
diff
changeset
|
2474 xfree (buf); |
230 | 2475 return val; |
2476 #else /* not S_IFLNK */ | |
2477 return Qnil; | |
2478 #endif /* not S_IFLNK */ | |
2479 } | |
2480 | |
2481 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, | |
2482 "Return t if file FILENAME is the name of a directory as a file.\n\ | |
2483 A directory name spec may be given instead; then the value is t\n\ | |
2484 if the directory so specified exists and really is a directory.") | |
2485 (filename) | |
2486 Lisp_Object filename; | |
2487 { | |
2488 register Lisp_Object abspath; | |
2489 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2490 Lisp_Object handler; |
230 | 2491 |
2492 abspath = expand_and_dir_to_file (filename, current_buffer->directory); | |
2493 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2494 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2495 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2496 handler = Ffind_file_name_handler (abspath, Qfile_directory_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2497 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2498 return call2 (handler, Qfile_directory_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2499 |
230 | 2500 if (stat (XSTRING (abspath)->data, &st) < 0) |
2501 return Qnil; | |
2502 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; | |
2503 } | |
2504 | |
536 | 2505 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, |
2506 "Return t if file FILENAME is the name of a directory as a file,\n\ | |
2507 and files in that directory can be opened by you. In order to use a\n\ | |
2508 directory as a buffer's current directory, this predicate must return true.\n\ | |
2509 A directory name spec may be given instead; then the value is t\n\ | |
2510 if the directory so specified exists and really is a readable and\n\ | |
2511 searchable directory.") | |
2512 (filename) | |
2513 Lisp_Object filename; | |
2514 { | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2515 Lisp_Object handler; |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2516 int tem; |
8703
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2517 struct gcpro gcpro1; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2518 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2519 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2520 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2521 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2522 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2523 return call2 (handler, Qfile_accessible_directory_p, filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2524 |
8703
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2525 /* It's an unlikely combination, but yes we really do need to gcpro: |
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2526 Suppose that file-accessible-directory-p has no handler, but |
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2527 file-directory-p does have a handler; this handler causes a GC which |
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2528 relocates the string in `filename'; and finally file-directory-p |
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2529 returns non-nil. Then we would end up passing a garbaged string |
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2530 to file-executable-p. */ |
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2531 GCPRO1 (filename); |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2532 tem = (NILP (Ffile_directory_p (filename)) |
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2533 || NILP (Ffile_executable_p (filename))); |
8703
aaa0730f8b1e
(Ffile_accessible_directory_p): Put back the gcpro.
Karl Heuer <kwzh@gnu.org>
parents:
8662
diff
changeset
|
2534 UNGCPRO; |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2535 return tem ? Qnil : Qt; |
536 | 2536 } |
2537 | |
9346
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2538 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2539 "Return t if file FILENAME is the name of a regular file.\n\ |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2540 This is the sort of file that holds an ordinary stream of data bytes.") |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2541 (filename) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2542 Lisp_Object filename; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2543 { |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2544 register Lisp_Object abspath; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2545 struct stat st; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2546 Lisp_Object handler; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2547 |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2548 abspath = expand_and_dir_to_file (filename, current_buffer->directory); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2549 |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2550 /* If the file name has special constructs in it, |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2551 call the corresponding file handler. */ |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2552 handler = Ffind_file_name_handler (abspath, Qfile_directory_p); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2553 if (!NILP (handler)) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2554 return call2 (handler, Qfile_directory_p, abspath); |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2555 |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2556 if (stat (XSTRING (abspath)->data, &st) < 0) |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2557 return Qnil; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2558 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2559 } |
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2560 |
230 | 2561 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, |
2562 "Return mode bits of FILE, as an integer.") | |
2563 (filename) | |
2564 Lisp_Object filename; | |
2565 { | |
2566 Lisp_Object abspath; | |
2567 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2568 Lisp_Object handler; |
230 | 2569 |
2570 abspath = expand_and_dir_to_file (filename, current_buffer->directory); | |
2571 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2572 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2573 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2574 handler = Ffind_file_name_handler (abspath, Qfile_modes); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2575 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2576 return call2 (handler, Qfile_modes, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2577 |
230 | 2578 if (stat (XSTRING (abspath)->data, &st) < 0) |
2579 return Qnil; | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2580 #ifdef DOS_NT |
6383
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2581 { |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2582 int len; |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2583 char *suffix; |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2584 if (S_ISREG (st.st_mode) |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2585 && (len = XSTRING (abspath)->size) >= 5 |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2586 && (stricmp ((suffix = XSTRING (abspath)->data + len-4), ".com") == 0 |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2587 || stricmp (suffix, ".exe") == 0 |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2588 || stricmp (suffix, ".bat") == 0)) |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2589 st.st_mode |= S_IEXEC; |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2590 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2591 #endif /* DOS_NT */ |
6383
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2592 |
230 | 2593 return make_number (st.st_mode & 07777); |
2594 } | |
2595 | |
2596 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, | |
2597 "Set mode bits of FILE to MODE (an integer).\n\ | |
2598 Only the 12 low bits of MODE are used.") | |
2599 (filename, mode) | |
2600 Lisp_Object filename, mode; | |
2601 { | |
2602 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2603 Lisp_Object handler; |
230 | 2604 |
2605 abspath = Fexpand_file_name (filename, current_buffer->directory); | |
2606 CHECK_NUMBER (mode, 1); | |
2607 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2608 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2609 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2610 handler = Ffind_file_name_handler (abspath, Qset_file_modes); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2611 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2612 return call3 (handler, Qset_file_modes, abspath, mode); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2613 |
230 | 2614 #ifndef APOLLO |
2615 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) | |
2616 report_file_error ("Doing chmod", Fcons (abspath, Qnil)); | |
2617 #else /* APOLLO */ | |
2618 if (!egetenv ("USE_DOMAIN_ACLS")) | |
2619 { | |
2620 struct stat st; | |
2621 struct timeval tvp[2]; | |
2622 | |
2623 /* chmod on apollo also change the file's modtime; need to save the | |
2624 modtime and then restore it. */ | |
2625 if (stat (XSTRING (abspath)->data, &st) < 0) | |
2626 { | |
2627 report_file_error ("Doing chmod", Fcons (abspath, Qnil)); | |
2628 return (Qnil); | |
2629 } | |
2630 | |
2631 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2632 report_file_error ("Doing chmod", Fcons (abspath, Qnil)); |
230 | 2633 |
2634 /* reset the old accessed and modified times. */ | |
2635 tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */ | |
2636 tvp[0].tv_usec = 0; | |
2637 tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */ | |
2638 tvp[1].tv_usec = 0; | |
2639 | |
2640 if (utimes (XSTRING (abspath)->data, tvp) < 0) | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2641 report_file_error ("Doing utimes", Fcons (abspath, Qnil)); |
230 | 2642 } |
2643 #endif /* APOLLO */ | |
2644 | |
2645 return Qnil; | |
2646 } | |
2647 | |
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
2648 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2649 "Set the file permission bits for newly created files.\n\ |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2650 The argument MODE should be an integer; only the low 9 bits are used.\n\ |
550 | 2651 This setting is inherited by subprocesses.") |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2652 (mode) |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2653 Lisp_Object mode; |
550 | 2654 { |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2655 CHECK_NUMBER (mode, 0); |
550 | 2656 |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2657 umask ((~ XINT (mode)) & 0777); |
550 | 2658 |
2659 return Qnil; | |
2660 } | |
2661 | |
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
2662 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2663 "Return the default file protection for created files.\n\ |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2664 The value is an integer.") |
550 | 2665 () |
2666 { | |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2667 int realmask; |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2668 Lisp_Object value; |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2669 |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2670 realmask = umask (0); |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2671 umask (realmask); |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2672 |
9266
811ad893828b
(Fdefault_file_modes, Finsert_file_contents, Fdo_auto_save): Use new accessor
Karl Heuer <kwzh@gnu.org>
parents:
9241
diff
changeset
|
2673 XSETINT (value, (~ realmask) & 0777); |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2674 return value; |
550 | 2675 } |
9346
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
2676 |
689
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2677 #ifdef unix |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2678 |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2679 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2680 "Tell Unix to finish all pending disk updates.") |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2681 () |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2682 { |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2683 sync (); |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2684 return Qnil; |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2685 } |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2686 |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2687 #endif /* unix */ |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2688 |
230 | 2689 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, |
2690 "Return t if file FILE1 is newer than file FILE2.\n\ | |
2691 If FILE1 does not exist, the answer is nil;\n\ | |
2692 otherwise, if FILE2 does not exist, the answer is t.") | |
2693 (file1, file2) | |
2694 Lisp_Object file1, file2; | |
2695 { | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2696 Lisp_Object abspath1, abspath2; |
230 | 2697 struct stat st; |
2698 int mtime1; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2699 Lisp_Object handler; |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2700 struct gcpro gcpro1, gcpro2; |
230 | 2701 |
2702 CHECK_STRING (file1, 0); | |
2703 CHECK_STRING (file2, 0); | |
2704 | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2705 abspath1 = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2706 GCPRO2 (abspath1, file2); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2707 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2708 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2709 UNGCPRO; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2710 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2711 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2712 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2713 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
2714 if (NILP (handler)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2715 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2716 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2717 return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2718 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2719 if (stat (XSTRING (abspath1)->data, &st) < 0) |
230 | 2720 return Qnil; |
2721 | |
2722 mtime1 = st.st_mtime; | |
2723 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2724 if (stat (XSTRING (abspath2)->data, &st) < 0) |
230 | 2725 return Qt; |
2726 | |
2727 return (mtime1 > st.st_mtime) ? Qt : Qnil; | |
2728 } | |
2729 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2730 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2731 Lisp_Object Qfind_buffer_file_type; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2732 #endif /* DOS_NT */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2733 |
230 | 2734 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2735 1, 5, 0, |
230 | 2736 "Insert contents of file FILENAME after point.\n\ |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2737 Returns list of absolute file name and length of data inserted.\n\ |
230 | 2738 If second argument VISIT is non-nil, the buffer's visited filename\n\ |
2739 and last save file modtime are set, and it is marked unmodified.\n\ | |
2740 If visiting and the file does not exist, visiting is completed\n\ | |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2741 before the error is signaled.\n\n\ |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2742 The optional third and fourth arguments BEG and END\n\ |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2743 specify what portion of the file to insert.\n\ |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2744 If VISIT is non-nil, BEG and END must be nil.\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2745 If optional fifth argument REPLACE is non-nil,\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2746 it means replace the current buffer contents (in the accessible portion)\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2747 with the file contents. This is better than simply deleting and inserting\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2748 the whole thing because (1) it preserves some marker positions\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2749 and (2) it puts less data in the undo list.") |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2750 (filename, visit, beg, end, replace) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2751 Lisp_Object filename, visit, beg, end, replace; |
230 | 2752 { |
2753 struct stat st; | |
2754 register int fd; | |
2755 register int inserted = 0; | |
2756 register int how_much; | |
2757 int count = specpdl_ptr - specpdl; | |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2758 struct gcpro gcpro1, gcpro2, gcpro3; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2759 Lisp_Object handler, val, insval; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2760 Lisp_Object p; |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2761 int total; |
9921
62392796a691
(Finsert_file_contents): Init not_regular at the beginning.
Richard M. Stallman <rms@gnu.org>
parents:
9915
diff
changeset
|
2762 int not_regular = 0; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2763 |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
2764 if (current_buffer->base_buffer && ! NILP (visit)) |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
2765 error ("Cannot do file visiting in an indirect buffer"); |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
2766 |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
2767 if (!NILP (current_buffer->read_only)) |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
2768 Fbarf_if_buffer_read_only (); |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
2769 |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2770 val = Qnil; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2771 p = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2772 |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
2773 GCPRO3 (filename, val, p); |
230 | 2774 |
2775 CHECK_STRING (filename, 0); | |
2776 filename = Fexpand_file_name (filename, Qnil); | |
2777 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2778 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2779 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2780 handler = Ffind_file_name_handler (filename, Qinsert_file_contents); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2781 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2782 { |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2783 val = call6 (handler, Qinsert_file_contents, filename, |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2784 visit, beg, end, replace); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2785 goto handled; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2786 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2787 |
230 | 2788 fd = -1; |
2789 | |
2790 #ifndef APOLLO | |
8047
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2791 if (stat (XSTRING (filename)->data, &st) < 0) |
230 | 2792 #else |
8597 | 2793 if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0 |
230 | 2794 || fstat (fd, &st) < 0) |
2795 #endif /* not APOLLO */ | |
2796 { | |
2797 if (fd >= 0) close (fd); | |
8047
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2798 badopen: |
485 | 2799 if (NILP (visit)) |
230 | 2800 report_file_error ("Opening input file", Fcons (filename, Qnil)); |
2801 st.st_mtime = -1; | |
2802 how_much = 0; | |
2803 goto notfound; | |
2804 } | |
2805 | |
8047
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2806 #ifdef S_IFREG |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2807 /* This code will need to be changed in order to work on named |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2808 pipes, and it's probably just not worth it. So we should at |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2809 least signal an error. */ |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2810 if (!S_ISREG (st.st_mode)) |
9915
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2811 { |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2812 if (NILP (visit)) |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2813 Fsignal (Qfile_error, |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2814 Fcons (build_string ("not a regular file"), |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2815 Fcons (filename, Qnil))); |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2816 |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2817 not_regular = 1; |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2818 goto notfound; |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
2819 } |
8047
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2820 #endif |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2821 |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2822 if (fd < 0) |
8597 | 2823 if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0) |
8047
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2824 goto badopen; |
fb950b66d754
(Finsert_file_contents): Fix check for non-regular files.
Karl Heuer <kwzh@gnu.org>
parents:
7695
diff
changeset
|
2825 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2826 /* Replacement should preserve point as it preserves markers. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2827 if (!NILP (replace)) |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2828 record_unwind_protect (restore_point_unwind, Fpoint_marker ()); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2829 |
230 | 2830 record_unwind_protect (close_file_unwind, make_number (fd)); |
2831 | |
2832 /* Supposedly happens on VMS. */ | |
2833 if (st.st_size < 0) | |
2834 error ("File size is negative"); | |
752 | 2835 |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2836 if (!NILP (beg) || !NILP (end)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2837 if (!NILP (visit)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2838 error ("Attempt to visit less than an entire file"); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2839 |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2840 if (!NILP (beg)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2841 CHECK_NUMBER (beg, 0); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2842 else |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
2843 XSETFASTINT (beg, 0); |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2844 |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2845 if (!NILP (end)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2846 CHECK_NUMBER (end, 0); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2847 else |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2848 { |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2849 XSETINT (end, st.st_size); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2850 if (XINT (end) != st.st_size) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2851 error ("maximum buffer size exceeded"); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2852 } |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2853 |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2854 /* If requested, replace the accessible part of the buffer |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2855 with the file contents. Avoid replacing text at the |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2856 beginning or end of the buffer that matches the file contents; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2857 that preserves markers pointing to the unchanged parts. */ |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2858 #ifdef DOS_NT |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2859 /* On MSDOS, replace mode doesn't really work, except for binary files, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2860 and it's not worth supporting just for them. */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2861 if (!NILP (replace)) |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2862 { |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2863 replace = Qnil; |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
2864 XSETFASTINT (beg, 0); |
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
2865 XSETFASTINT (end, st.st_size); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2866 del_range_1 (BEGV, ZV, 0); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2867 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2868 #else /* not DOS_NT */ |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2869 if (!NILP (replace)) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2870 { |
7549
ccb8b7f8dce7
(syms_of_fileio): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
7526
diff
changeset
|
2871 unsigned char buffer[1 << 14]; |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2872 int same_at_start = BEGV; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2873 int same_at_end = ZV; |
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2874 int overlap; |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2875 |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2876 immediate_quit = 1; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2877 QUIT; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2878 /* Count how many chars at the start of the file |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2879 match the text at the beginning of the buffer. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2880 while (1) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2881 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2882 int nread, bufpos; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2883 |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2884 nread = read (fd, buffer, sizeof buffer); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2885 if (nread < 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2886 error ("IO error reading %s: %s", |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2887 XSTRING (filename)->data, strerror (errno)); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2888 else if (nread == 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2889 break; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2890 bufpos = 0; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2891 while (bufpos < nread && same_at_start < ZV |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2892 && FETCH_CHAR (same_at_start) == buffer[bufpos]) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2893 same_at_start++, bufpos++; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2894 /* If we found a discrepancy, stop the scan. |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2895 Otherwise loop around and scan the next bufferfull. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2896 if (bufpos != nread) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2897 break; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2898 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2899 immediate_quit = 0; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2900 /* If the file matches the buffer completely, |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2901 there's no need to replace anything. */ |
7595
9f0893928a4d
(Finsert_file_contents): Declare buffer as unsigned
Richard M. Stallman <rms@gnu.org>
parents:
7551
diff
changeset
|
2902 if (same_at_start - BEGV == st.st_size) |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2903 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2904 close (fd); |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2905 specpdl_ptr--; |
7595
9f0893928a4d
(Finsert_file_contents): Declare buffer as unsigned
Richard M. Stallman <rms@gnu.org>
parents:
7551
diff
changeset
|
2906 /* Truncate the buffer to the size of the file. */ |
9f0893928a4d
(Finsert_file_contents): Declare buffer as unsigned
Richard M. Stallman <rms@gnu.org>
parents:
7551
diff
changeset
|
2907 del_range_1 (same_at_start, same_at_end, 0); |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2908 goto handled; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2909 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2910 immediate_quit = 1; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2911 QUIT; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2912 /* Count how many chars at the end of the file |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2913 match the text at the end of the buffer. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2914 while (1) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2915 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2916 int total_read, nread, bufpos, curpos, trial; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2917 |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2918 /* At what file position are we now scanning? */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2919 curpos = st.st_size - (ZV - same_at_end); |
7695
aba3ffcc8f51
(Finsert_file_contents): Check for beginning of file.
Karl Heuer <kwzh@gnu.org>
parents:
7611
diff
changeset
|
2920 /* If the entire file matches the buffer tail, stop the scan. */ |
aba3ffcc8f51
(Finsert_file_contents): Check for beginning of file.
Karl Heuer <kwzh@gnu.org>
parents:
7611
diff
changeset
|
2921 if (curpos == 0) |
aba3ffcc8f51
(Finsert_file_contents): Check for beginning of file.
Karl Heuer <kwzh@gnu.org>
parents:
7611
diff
changeset
|
2922 break; |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2923 /* How much can we scan in the next step? */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2924 trial = min (curpos, sizeof buffer); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2925 if (lseek (fd, curpos - trial, 0) < 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2926 report_file_error ("Setting file position", |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2927 Fcons (filename, Qnil)); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2928 |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2929 total_read = 0; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2930 while (total_read < trial) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2931 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2932 nread = read (fd, buffer + total_read, trial - total_read); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2933 if (nread <= 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2934 error ("IO error reading %s: %s", |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2935 XSTRING (filename)->data, strerror (errno)); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2936 total_read += nread; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2937 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2938 /* Scan this bufferfull from the end, comparing with |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2939 the Emacs buffer. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2940 bufpos = total_read; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2941 /* Compare with same_at_start to avoid counting some buffer text |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2942 as matching both at the file's beginning and at the end. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2943 while (bufpos > 0 && same_at_end > same_at_start |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2944 && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1]) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2945 same_at_end--, bufpos--; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2946 /* If we found a discrepancy, stop the scan. |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2947 Otherwise loop around and scan the preceding bufferfull. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2948 if (bufpos != 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2949 break; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2950 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2951 immediate_quit = 0; |
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2952 |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2953 /* Don't try to reuse the same piece of text twice. */ |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2954 overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV); |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2955 if (overlap > 0) |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2956 same_at_end += overlap; |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2957 |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2958 /* Arrange to read only the nonmatching middle part of the file. */ |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
2959 XSETFASTINT (beg, same_at_start - BEGV); |
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
2960 XSETFASTINT (end, st.st_size - (ZV - same_at_end)); |
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2961 |
6194
b094b321b4a6
(Finsert_file_contents): Pass del_range_1 two ends, not a length.
Richard M. Stallman <rms@gnu.org>
parents:
6181
diff
changeset
|
2962 del_range_1 (same_at_start, same_at_end, 0); |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2963 /* Insert from the file at the proper position. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2964 SET_PT (same_at_start); |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2965 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2966 #endif /* not DOS_NT */ |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2967 |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2968 total = XINT (end) - XINT (beg); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2969 |
230 | 2970 { |
2971 register Lisp_Object temp; | |
2972 | |
2973 /* Make sure point-max won't overflow after this insertion. */ | |
9266
811ad893828b
(Fdefault_file_modes, Finsert_file_contents, Fdo_auto_save): Use new accessor
Karl Heuer <kwzh@gnu.org>
parents:
9241
diff
changeset
|
2974 XSETINT (temp, total); |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2975 if (total != XINT (temp)) |
230 | 2976 error ("maximum buffer size exceeded"); |
2977 } | |
2978 | |
4395
76b24be40a57
(Finsert_file_contents): Don't call prepare_to_modify_buffer
Richard M. Stallman <rms@gnu.org>
parents:
4270
diff
changeset
|
2979 if (NILP (visit) && total > 0) |
230 | 2980 prepare_to_modify_buffer (point, point); |
2981 | |
2982 move_gap (point); | |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2983 if (GAP_SIZE < total) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2984 make_gap (total - GAP_SIZE); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2985 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2986 if (XINT (beg) != 0 || !NILP (replace)) |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2987 { |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2988 if (lseek (fd, XINT (beg), 0) < 0) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2989 report_file_error ("Setting file position", Fcons (filename, Qnil)); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2990 } |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2991 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2992 how_much = 0; |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2993 while (inserted < total) |
230 | 2994 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2995 /* try is reserved in some compilers (Microsoft C) */ |
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
2996 int trytry = min (total - inserted, 64 << 10); |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2997 int this; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2998 |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2999 /* Allow quitting out of the actual I/O. */ |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
3000 immediate_quit = 1; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
3001 QUIT; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3002 this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, trytry); |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
3003 immediate_quit = 0; |
230 | 3004 |
3005 if (this <= 0) | |
3006 { | |
3007 how_much = this; | |
3008 break; | |
3009 } | |
3010 | |
3011 GPT += this; | |
3012 GAP_SIZE -= this; | |
3013 ZV += this; | |
3014 Z += this; | |
3015 inserted += this; | |
3016 } | |
3017 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3018 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3019 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3020 /* Determine file type from name and remove LFs from CR-LFs if the file |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3021 is deemed to be a text file. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3022 { |
7130
b3e9a76134d2
(Finsert_file_contents): Fix accessing buffer_file_type
Richard M. Stallman <rms@gnu.org>
parents:
7041
diff
changeset
|
3023 current_buffer->buffer_file_type |
b3e9a76134d2
(Finsert_file_contents): Fix accessing buffer_file_type
Richard M. Stallman <rms@gnu.org>
parents:
7041
diff
changeset
|
3024 = call1 (Qfind_buffer_file_type, filename); |
b3e9a76134d2
(Finsert_file_contents): Fix accessing buffer_file_type
Richard M. Stallman <rms@gnu.org>
parents:
7041
diff
changeset
|
3025 if (NILP (current_buffer->buffer_file_type)) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3026 { |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3027 int reduced_size |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3028 = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3029 ZV -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3030 Z -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3031 GPT -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3032 GAP_SIZE += reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3033 inserted -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3034 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3035 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3036 #endif /* DOS_NT */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3037 |
230 | 3038 if (inserted > 0) |
1240
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
3039 { |
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
3040 record_insert (point, inserted); |
1299
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
3041 |
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
3042 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ |
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
3043 offset_intervals (current_buffer, point, inserted); |
1240
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
3044 MODIFF++; |
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
3045 } |
230 | 3046 |
3047 close (fd); | |
3048 | |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3049 /* Discard the unwind protect for closing the file. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3050 specpdl_ptr--; |
230 | 3051 |
3052 if (how_much < 0) | |
3053 error ("IO error reading %s: %s", | |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
3054 XSTRING (filename)->data, strerror (errno)); |
230 | 3055 |
3056 notfound: | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3057 handled: |
230 | 3058 |
485 | 3059 if (!NILP (visit)) |
230 | 3060 { |
6177
ac2ef13dca1b
(Finsert_file_contents): If undo_list was t, leave it t.
Richard M. Stallman <rms@gnu.org>
parents:
6036
diff
changeset
|
3061 if (!EQ (current_buffer->undo_list, Qt)) |
ac2ef13dca1b
(Finsert_file_contents): If undo_list was t, leave it t.
Richard M. Stallman <rms@gnu.org>
parents:
6036
diff
changeset
|
3062 current_buffer->undo_list = Qnil; |
230 | 3063 #ifdef APOLLO |
3064 stat (XSTRING (filename)->data, &st); | |
3065 #endif | |
5390
d9c81d7079f3
(Finsert_file_contents): Don't run after change hook
Richard M. Stallman <rms@gnu.org>
parents:
5351
diff
changeset
|
3066 |
5395
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
3067 if (NILP (handler)) |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
3068 { |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
3069 current_buffer->modtime = st.st_mtime; |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
3070 current_buffer->filename = filename; |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
3071 } |
5390
d9c81d7079f3
(Finsert_file_contents): Don't run after change hook
Richard M. Stallman <rms@gnu.org>
parents:
5351
diff
changeset
|
3072 |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3073 SAVE_MODIFF = MODIFF; |
230 | 3074 current_buffer->auto_save_modified = MODIFF; |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3075 XSETFASTINT (current_buffer->save_length, Z - BEG); |
230 | 3076 #ifdef CLASH_DETECTION |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3077 if (NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3078 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3079 if (!NILP (current_buffer->filename)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3080 unlock_file (current_buffer->filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3081 unlock_file (filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3082 } |
230 | 3083 #endif /* CLASH_DETECTION */ |
9915
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
3084 if (not_regular) |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
3085 Fsignal (Qfile_error, |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
3086 Fcons (build_string ("not a regular file"), |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
3087 Fcons (filename, Qnil))); |
ec185bc66071
(Finsert_file_contents): If VISIT, set the buffer components
Richard M. Stallman <rms@gnu.org>
parents:
9872
diff
changeset
|
3088 |
230 | 3089 /* If visiting nonexistent file, return nil. */ |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3090 if (current_buffer->modtime == -1) |
230 | 3091 report_file_error ("Opening input file", Fcons (filename, Qnil)); |
3092 } | |
3093 | |
11053
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3094 /* Decode file format */ |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3095 if (inserted > 0) |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3096 { |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3097 insval = call3 (Qformat_decode, |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3098 Qnil, make_number (inserted), visit); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3099 CHECK_NUMBER (insval, 0); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3100 inserted = XFASTINT (insval); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3101 } |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3102 |
5390
d9c81d7079f3
(Finsert_file_contents): Don't run after change hook
Richard M. Stallman <rms@gnu.org>
parents:
5351
diff
changeset
|
3103 if (inserted > 0 && NILP (visit) && total > 0) |
5129
d48d18e20316
(Finsert_file_contents): Don't call signal_after_change
Richard M. Stallman <rms@gnu.org>
parents:
4989
diff
changeset
|
3104 signal_after_change (point, 0, inserted); |
230 | 3105 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3106 if (inserted > 0) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3107 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3108 p = Vafter_insert_file_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3109 while (!NILP (p)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3110 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3111 insval = call1 (Fcar (p), make_number (inserted)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3112 if (!NILP (insval)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3113 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3114 CHECK_NUMBER (insval, 0); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3115 inserted = XFASTINT (insval); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3116 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3117 QUIT; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3118 p = Fcdr (p); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3119 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3120 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3121 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3122 if (NILP (val)) |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3123 val = Fcons (filename, |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3124 Fcons (make_number (inserted), |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3125 Qnil)); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3126 |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
3127 RETURN_UNGCPRO (unbind_to (count, val)); |
230 | 3128 } |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
3129 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3130 static Lisp_Object build_annotations (); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3131 |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3132 /* If build_annotations switched buffers, switch back to BUF. |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3133 Kill the temporary buffer that was selected in the meantime. */ |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3134 |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3135 static Lisp_Object |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3136 build_annotations_unwind (buf) |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3137 Lisp_Object buf; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3138 { |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3139 Lisp_Object tembuf; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3140 |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3141 if (XBUFFER (buf) == current_buffer) |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3142 return Qnil; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3143 tembuf = Fcurrent_buffer (); |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3144 Fset_buffer (buf); |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3145 Fkill_buffer (tembuf); |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3146 return Qnil; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3147 } |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3148 |
230 | 3149 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, |
3150 "r\nFWrite region to file: ", | |
3151 "Write current region into specified file.\n\ | |
3152 When called from a program, takes three arguments:\n\ | |
3153 START, END and FILENAME. START and END are buffer positions.\n\ | |
3154 Optional fourth argument APPEND if non-nil means\n\ | |
3155 append to existing file contents (if any).\n\ | |
3156 Optional fifth argument VISIT if t means\n\ | |
3157 set the last-save-file-modtime of buffer to this file's modtime\n\ | |
3158 and mark buffer not modified.\n\ | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3159 If VISIT is a string, it is a second file name;\n\ |
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3160 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\ |
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3161 VISIT is also the file name to lock and unlock for clash detection.\n\ |
1761
b9ef55b0df4a
(Fwrite_region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
1679
diff
changeset
|
3162 If VISIT is neither t nor nil nor a string,\n\ |
b9ef55b0df4a
(Fwrite_region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
1679
diff
changeset
|
3163 that means do not print the \"Wrote file\" message.\n\ |
230 | 3164 Kludgy feature: if START is a string, then that string is written\n\ |
3165 to the file, instead of any buffer contents, and END is ignored.") | |
3166 (start, end, filename, append, visit) | |
3167 Lisp_Object start, end, filename, append, visit; | |
3168 { | |
3169 register int desc; | |
3170 int failure; | |
3171 int save_errno; | |
3172 unsigned char *fn; | |
3173 struct stat st; | |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3174 int tem; |
230 | 3175 int count = specpdl_ptr - specpdl; |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3176 int count1; |
230 | 3177 #ifdef VMS |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3178 unsigned char *fname = 0; /* If non-0, original filename (must rename) */ |
230 | 3179 #endif /* VMS */ |
848 | 3180 Lisp_Object handler; |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
3181 Lisp_Object visit_file; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3182 Lisp_Object annotations; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3183 int visiting, quietly; |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3184 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3185 struct buffer *given_buffer; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3186 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3187 int buffer_file_type |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3188 = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3189 #endif /* DOS_NT */ |
230 | 3190 |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3191 if (current_buffer->base_buffer && ! NILP (visit)) |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3192 error ("Cannot do file visiting in an indirect buffer"); |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3193 |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3194 if (!NILP (start) && !STRINGP (start)) |
230 | 3195 validate_region (&start, &end); |
3196 | |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
3197 GCPRO2 (filename, visit); |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
3198 filename = Fexpand_file_name (filename, Qnil); |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3199 if (STRINGP (visit)) |
2435
b72453ad92ae
(Fwrite_region): Don't fail to set visit_file.
Richard M. Stallman <rms@gnu.org>
parents:
2407
diff
changeset
|
3200 visit_file = Fexpand_file_name (visit, Qnil); |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
3201 else |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
3202 visit_file = filename; |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
3203 UNGCPRO; |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
3204 |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3205 visiting = (EQ (visit, Qt) || STRINGP (visit)); |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3206 quietly = !NILP (visit); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3207 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3208 annotations = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3209 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3210 GCPRO4 (start, filename, annotations, visit_file); |
230 | 3211 |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3212 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3213 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3214 handler = Ffind_file_name_handler (filename, Qwrite_region); |
5758
23821c197271
(Fwrite_region): If FILENAME has no handler, see if VISIT has one.
Richard M. Stallman <rms@gnu.org>
parents:
5647
diff
changeset
|
3215 /* If FILENAME has no handler, see if VISIT has one. */ |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
3216 if (NILP (handler) && STRINGP (visit)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3217 handler = Ffind_file_name_handler (visit, Qwrite_region); |
848 | 3218 |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3219 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3220 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3221 Lisp_Object val; |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
3222 val = call6 (handler, Qwrite_region, start, end, |
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
3223 filename, append, visit); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3224 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3225 if (visiting) |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3226 { |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3227 SAVE_MODIFF = MODIFF; |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3228 XSETFASTINT (current_buffer->save_length, Z - BEG); |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3229 current_buffer->filename = visit_file; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3230 } |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3231 UNGCPRO; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3232 return val; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3233 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3234 |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3235 /* Special kludge to simplify auto-saving. */ |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3236 if (NILP (start)) |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3237 { |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3238 XSETFASTINT (start, BEG); |
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3239 XSETFASTINT (end, Z); |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3240 } |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3241 |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3242 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3243 count1 = specpdl_ptr - specpdl; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3244 |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3245 given_buffer = current_buffer; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3246 annotations = build_annotations (start, end); |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3247 if (current_buffer != given_buffer) |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3248 { |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3249 start = BEGV; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3250 end = ZV; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3251 } |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3252 |
230 | 3253 #ifdef CLASH_DETECTION |
3254 if (!auto_saving) | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3255 lock_file (visit_file); |
230 | 3256 #endif /* CLASH_DETECTION */ |
3257 | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3258 fn = XSTRING (filename)->data; |
230 | 3259 desc = -1; |
485 | 3260 if (!NILP (append)) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3261 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3262 desc = open (fn, O_WRONLY | buffer_file_type); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3263 #else /* not DOS_NT */ |
230 | 3264 desc = open (fn, O_WRONLY); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3265 #endif /* not DOS_NT */ |
230 | 3266 |
3267 if (desc < 0) | |
3268 #ifdef VMS | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3269 if (auto_saving) /* Overwrite any previous version of autosave file */ |
230 | 3270 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3271 vms_truncate (fn); /* if fn exists, truncate to zero length */ |
230 | 3272 desc = open (fn, O_RDWR); |
3273 if (desc < 0) | |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3274 desc = creat_copy_attrs (STRINGP (current_buffer->filename) |
536 | 3275 ? XSTRING (current_buffer->filename)->data : 0, |
3276 fn); | |
230 | 3277 } |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3278 else /* Write to temporary name and rename if no errors */ |
230 | 3279 { |
3280 Lisp_Object temp_name; | |
3281 temp_name = Ffile_name_directory (filename); | |
3282 | |
485 | 3283 if (!NILP (temp_name)) |
230 | 3284 { |
3285 temp_name = Fmake_temp_name (concat2 (temp_name, | |
3286 build_string ("$$SAVE$$"))); | |
3287 fname = XSTRING (filename)->data; | |
3288 fn = XSTRING (temp_name)->data; | |
3289 desc = creat_copy_attrs (fname, fn); | |
3290 if (desc < 0) | |
3291 { | |
3292 /* If we can't open the temporary file, try creating a new | |
3293 version of the original file. VMS "creat" creates a | |
3294 new version rather than truncating an existing file. */ | |
3295 fn = fname; | |
3296 fname = 0; | |
3297 desc = creat (fn, 0666); | |
3298 #if 0 /* This can clobber an existing file and fail to replace it, | |
3299 if the user runs out of space. */ | |
3300 if (desc < 0) | |
3301 { | |
3302 /* We can't make a new version; | |
3303 try to truncate and rewrite existing version if any. */ | |
3304 vms_truncate (fn); | |
3305 desc = open (fn, O_RDWR); | |
3306 } | |
3307 #endif | |
3308 } | |
3309 } | |
3310 else | |
3311 desc = creat (fn, 0666); | |
3312 } | |
3313 #else /* not VMS */ | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3314 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3315 desc = open (fn, |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3316 O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3317 S_IREAD | S_IWRITE); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3318 #else /* not DOS_NT */ |
230 | 3319 desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3320 #endif /* not DOS_NT */ |
230 | 3321 #endif /* not VMS */ |
3322 | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3323 UNGCPRO; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3324 |
230 | 3325 if (desc < 0) |
3326 { | |
3327 #ifdef CLASH_DETECTION | |
3328 save_errno = errno; | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3329 if (!auto_saving) unlock_file (visit_file); |
230 | 3330 errno = save_errno; |
3331 #endif /* CLASH_DETECTION */ | |
3332 report_file_error ("Opening output file", Fcons (filename, Qnil)); | |
3333 } | |
3334 | |
3335 record_unwind_protect (close_file_unwind, make_number (desc)); | |
3336 | |
485 | 3337 if (!NILP (append)) |
230 | 3338 if (lseek (desc, 0, 2) < 0) |
3339 { | |
3340 #ifdef CLASH_DETECTION | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3341 if (!auto_saving) unlock_file (visit_file); |
230 | 3342 #endif /* CLASH_DETECTION */ |
3343 report_file_error ("Lseek error", Fcons (filename, Qnil)); | |
3344 } | |
3345 | |
3346 #ifdef VMS | |
3347 /* | |
3348 * Kludge Warning: The VMS C RTL likes to insert carriage returns | |
3349 * if we do writes that don't end with a carriage return. Furthermore | |
3350 * it cannot handle writes of more then 16K. The modified | |
3351 * version of "sys_write" in SYSDEP.C (see comment there) copes with | |
3352 * this EXCEPT for the last record (iff it doesn't end with a carriage | |
3353 * return). This implies that if your buffer doesn't end with a carriage | |
3354 * return, you get one free... tough. However it also means that if | |
3355 * we make two calls to sys_write (a la the following code) you can | |
3356 * get one at the gap as well. The easiest way to fix this (honest) | |
3357 * is to move the gap to the next newline (or the end of the buffer). | |
3358 * Thus this change. | |
3359 * | |
3360 * Yech! | |
3361 */ | |
3362 if (GPT > BEG && GPT_ADDR[-1] != '\n') | |
3363 move_gap (find_next_newline (GPT, 1)); | |
3364 #endif | |
3365 | |
3366 failure = 0; | |
3367 immediate_quit = 1; | |
3368 | |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3369 if (STRINGP (start)) |
230 | 3370 { |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3371 failure = 0 > a_write (desc, XSTRING (start)->data, |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3372 XSTRING (start)->size, 0, &annotations); |
230 | 3373 save_errno = errno; |
3374 } | |
3375 else if (XINT (start) != XINT (end)) | |
3376 { | |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3377 int nwritten = 0; |
230 | 3378 if (XINT (start) < GPT) |
3379 { | |
3380 register int end1 = XINT (end); | |
3381 tem = XINT (start); | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3382 failure = 0 > a_write (desc, &FETCH_CHAR (tem), |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3383 min (GPT, end1) - tem, tem, &annotations); |
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3384 nwritten += min (GPT, end1) - tem; |
230 | 3385 save_errno = errno; |
3386 } | |
3387 | |
3388 if (XINT (end) > GPT && !failure) | |
3389 { | |
3390 tem = XINT (start); | |
3391 tem = max (tem, GPT); | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3392 failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3393 tem, &annotations); |
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3394 nwritten += XINT (end) - tem; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3395 save_errno = errno; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3396 } |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3397 |
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3398 if (nwritten == 0) |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3399 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3400 /* If file was empty, still need to write the annotations */ |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3401 failure = 0 > a_write (desc, "", 0, XINT (start), &annotations); |
230 | 3402 save_errno = errno; |
3403 } | |
3404 } | |
3405 | |
3406 immediate_quit = 0; | |
3407 | |
2280
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
3408 #ifdef HAVE_FSYNC |
230 | 3409 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). |
3410 Disk full in NFS may be reported here. */ | |
3415
c37d05ce7e52
(Fwrite_region): Don't fsync if autosaving.
Richard M. Stallman <rms@gnu.org>
parents:
3410
diff
changeset
|
3411 /* mib says that closing the file will try to write as fast as NFS can do |
c37d05ce7e52
(Fwrite_region): Don't fsync if autosaving.
Richard M. Stallman <rms@gnu.org>
parents:
3410
diff
changeset
|
3412 it, and that means the fsync here is not crucial for autosave files. */ |
c37d05ce7e52
(Fwrite_region): Don't fsync if autosaving.
Richard M. Stallman <rms@gnu.org>
parents:
3410
diff
changeset
|
3413 if (!auto_saving && fsync (desc) < 0) |
230 | 3414 failure = 1, save_errno = errno; |
3415 #endif | |
3416 | |
3417 /* Spurious "file has changed on disk" warnings have been | |
3418 observed on Suns as well. | |
3419 It seems that `close' can change the modtime, under nfs. | |
3420 | |
3421 (This has supposedly been fixed in Sunos 4, | |
3422 but who knows about all the other machines with NFS?) */ | |
3423 #if 0 | |
3424 | |
3425 /* On VMS and APOLLO, must do the stat after the close | |
3426 since closing changes the modtime. */ | |
3427 #ifndef VMS | |
3428 #ifndef APOLLO | |
3429 /* Recall that #if defined does not work on VMS. */ | |
3430 #define FOO | |
3431 fstat (desc, &st); | |
3432 #endif | |
3433 #endif | |
3434 #endif | |
3435 | |
3436 /* NFS can report a write failure now. */ | |
3437 if (close (desc) < 0) | |
3438 failure = 1, save_errno = errno; | |
3439 | |
3440 #ifdef VMS | |
3441 /* If we wrote to a temporary name and had no errors, rename to real name. */ | |
3442 if (fname) | |
3443 { | |
3444 if (!failure) | |
3445 failure = (rename (fn, fname) != 0), save_errno = errno; | |
3446 fn = fname; | |
3447 } | |
3448 #endif /* VMS */ | |
3449 | |
3450 #ifndef FOO | |
3451 stat (fn, &st); | |
3452 #endif | |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3453 /* Discard the unwind protect for close_file_unwind. */ |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3454 specpdl_ptr = specpdl + count1; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3455 /* Restore the original current buffer. */ |
8662
627a2ed242c0
(Ffile_accessible_directory_p): No need for gcpro.
Richard M. Stallman <rms@gnu.org>
parents:
8603
diff
changeset
|
3456 visit_file = unbind_to (count, visit_file); |
230 | 3457 |
3458 #ifdef CLASH_DETECTION | |
3459 if (!auto_saving) | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3460 unlock_file (visit_file); |
230 | 3461 #endif /* CLASH_DETECTION */ |
3462 | |
3463 /* Do this before reporting IO error | |
3464 to avoid a "file has changed on disk" warning on | |
3465 next attempt to save. */ | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3466 if (visiting) |
230 | 3467 current_buffer->modtime = st.st_mtime; |
3468 | |
3469 if (failure) | |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
3470 error ("IO error writing %s: %s", fn, strerror (save_errno)); |
230 | 3471 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3472 if (visiting) |
230 | 3473 { |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3474 SAVE_MODIFF = MODIFF; |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3475 XSETFASTINT (current_buffer->save_length, Z - BEG); |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3476 current_buffer->filename = visit_file; |
7551
69f20f10799a
(Fwrite_region): Set update_mode_lines.
Richard M. Stallman <rms@gnu.org>
parents:
7549
diff
changeset
|
3477 update_mode_lines++; |
230 | 3478 } |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3479 else if (quietly) |
230 | 3480 return Qnil; |
3481 | |
3482 if (!auto_saving) | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3483 message ("Wrote %s", XSTRING (visit_file)->data); |
230 | 3484 |
3485 return Qnil; | |
3486 } | |
3487 | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3488 Lisp_Object merge (); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3489 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3490 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, |
4853
3ec2205d12b5
(Fcar_less_than_car): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
4841
diff
changeset
|
3491 "Return t if (car A) is numerically less than (car B).") |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3492 (a, b) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3493 Lisp_Object a, b; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3494 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3495 return Flss (Fcar (a), Fcar (b)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3496 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3497 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3498 /* Build the complete list of annotations appropriate for writing out |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3499 the text between START and END, by calling all the functions in |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3500 write-region-annotate-functions and merging the lists they return. |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3501 If one of these functions switches to a different buffer, we assume |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3502 that buffer contains altered text. Therefore, the caller must |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3503 make sure to restore the current buffer in all cases, |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3504 as save-excursion would do. */ |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3505 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3506 static Lisp_Object |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3507 build_annotations (start, end) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3508 Lisp_Object start, end; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3509 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3510 Lisp_Object annotations; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3511 Lisp_Object p, res; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3512 struct gcpro gcpro1, gcpro2; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3513 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3514 annotations = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3515 p = Vwrite_region_annotate_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3516 GCPRO2 (annotations, p); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3517 while (!NILP (p)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3518 { |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3519 struct buffer *given_buffer = current_buffer; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3520 Vwrite_region_annotations_so_far = annotations; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3521 res = call2 (Fcar (p), start, end); |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3522 /* If the function makes a different buffer current, |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3523 assume that means this buffer contains altered text to be output. |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3524 Reset START and END from the buffer bounds |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3525 and discard all previous annotations because they should have |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3526 been dealt with by this function. */ |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3527 if (current_buffer != given_buffer) |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3528 { |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3529 start = BEGV; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3530 end = ZV; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3531 annotations = Qnil; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
3532 } |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3533 Flength (res); /* Check basic validity of return value */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3534 annotations = merge (annotations, res, Qcar_less_than_car); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3535 p = Fcdr (p); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3536 } |
11053
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3537 |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3538 /* Now do the same for annotation functions implied by the file-format */ |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3539 if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3540 p = Vauto_save_file_format; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3541 else |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3542 p = current_buffer->file_format; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3543 while (!NILP (p)) |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3544 { |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3545 struct buffer *given_buffer = current_buffer; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3546 Vwrite_region_annotations_so_far = annotations; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3547 res = call3 (Qformat_annotate_function, Fcar (p), start, end); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3548 if (current_buffer != given_buffer) |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3549 { |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3550 start = BEGV; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3551 end = ZV; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3552 annotations = Qnil; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3553 } |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3554 Flength (res); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3555 annotations = merge (annotations, res, Qcar_less_than_car); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3556 p = Fcdr (p); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
3557 } |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3558 UNGCPRO; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3559 return annotations; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3560 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3561 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3562 /* Write to descriptor DESC the LEN characters starting at ADDR, |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3563 assuming they start at position POS in the buffer. |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3564 Intersperse with them the annotations from *ANNOT |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3565 (those which fall within the range of positions POS to POS + LEN), |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3566 each at its appropriate position. |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3567 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3568 Modify *ANNOT by discarding elements as we output them. |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3569 The return value is negative in case of system call failure. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3570 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3571 int |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3572 a_write (desc, addr, len, pos, annot) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3573 int desc; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3574 register char *addr; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3575 register int len; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3576 int pos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3577 Lisp_Object *annot; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3578 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3579 Lisp_Object tem; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3580 int nextpos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3581 int lastpos = pos + len; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3582 |
8079
3f543986a45a
(a_write): Loop while *ANNOT is listp, not consp. Previous code omitted
Roland McGrath <roland@gnu.org>
parents:
8068
diff
changeset
|
3583 while (NILP (*annot) || CONSP (*annot)) |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3584 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3585 tem = Fcar_safe (Fcar (*annot)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3586 if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3587 nextpos = XFASTINT (tem); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3588 else |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3589 return e_write (desc, addr, lastpos - pos); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3590 if (nextpos > pos) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3591 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3592 if (0 > e_write (desc, addr, nextpos - pos)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3593 return -1; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3594 addr += nextpos - pos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3595 pos = nextpos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3596 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3597 tem = Fcdr (Fcar (*annot)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3598 if (STRINGP (tem)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3599 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3600 if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3601 return -1; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3602 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3603 *annot = Fcdr (*annot); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3604 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3605 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3606 |
230 | 3607 int |
3608 e_write (desc, addr, len) | |
3609 int desc; | |
3610 register char *addr; | |
3611 register int len; | |
3612 { | |
3613 char buf[16 * 1024]; | |
3614 register char *p, *end; | |
3615 | |
3616 if (!EQ (current_buffer->selective_display, Qt)) | |
3617 return write (desc, addr, len) - len; | |
3618 else | |
3619 { | |
3620 p = buf; | |
3621 end = p + sizeof buf; | |
3622 while (len--) | |
3623 { | |
3624 if (p == end) | |
3625 { | |
3626 if (write (desc, buf, sizeof buf) != sizeof buf) | |
3627 return -1; | |
3628 p = buf; | |
3629 } | |
3630 *p = *addr++; | |
3631 if (*p++ == '\015') | |
3632 p[-1] = '\n'; | |
3633 } | |
3634 if (p != buf) | |
3635 if (write (desc, buf, p - buf) != p - buf) | |
3636 return -1; | |
3637 } | |
3638 return 0; | |
3639 } | |
3640 | |
3641 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, | |
3642 Sverify_visited_file_modtime, 1, 1, 0, | |
3643 "Return t if last mod time of BUF's visited file matches what BUF records.\n\ | |
3644 This means that the file has not been changed since it was visited or saved.") | |
3645 (buf) | |
3646 Lisp_Object buf; | |
3647 { | |
3648 struct buffer *b; | |
3649 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3650 Lisp_Object handler; |
230 | 3651 |
3652 CHECK_BUFFER (buf, 0); | |
3653 b = XBUFFER (buf); | |
3654 | |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
3655 if (!STRINGP (b->filename)) return Qt; |
230 | 3656 if (b->modtime == 0) return Qt; |
3657 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3658 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3659 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3660 handler = Ffind_file_name_handler (b->filename, |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3661 Qverify_visited_file_modtime); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3662 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3663 return call2 (handler, Qverify_visited_file_modtime, buf); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3664 |
230 | 3665 if (stat (XSTRING (b->filename)->data, &st) < 0) |
3666 { | |
3667 /* If the file doesn't exist now and didn't exist before, | |
3668 we say that it isn't modified, provided the error is a tame one. */ | |
3669 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) | |
3670 st.st_mtime = -1; | |
3671 else | |
3672 st.st_mtime = 0; | |
3673 } | |
3674 if (st.st_mtime == b->modtime | |
3675 /* If both are positive, accept them if they are off by one second. */ | |
3676 || (st.st_mtime > 0 && b->modtime > 0 | |
3677 && (st.st_mtime == b->modtime + 1 | |
3678 || st.st_mtime == b->modtime - 1))) | |
3679 return Qt; | |
3680 return Qnil; | |
3681 } | |
3682 | |
3683 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, | |
3684 Sclear_visited_file_modtime, 0, 0, 0, | |
3685 "Clear out records of last mod time of visited file.\n\ | |
3686 Next attempt to save will certainly not complain of a discrepancy.") | |
3687 () | |
3688 { | |
3689 current_buffer->modtime = 0; | |
3690 return Qnil; | |
3691 } | |
3692 | |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3693 DEFUN ("visited-file-modtime", Fvisited_file_modtime, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3694 Svisited_file_modtime, 0, 0, 0, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3695 "Return the current buffer's recorded visited file modification time.\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3696 The value is a list of the form (HIGH . LOW), like the time values\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3697 that `file-attributes' returns.") |
230 | 3698 () |
3699 { | |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3700 return long_to_cons (current_buffer->modtime); |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3701 } |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3702 |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3703 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3704 Sset_visited_file_modtime, 0, 1, 0, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3705 "Update buffer's recorded modification time from the visited file's time.\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3706 Useful if the buffer was not read from the file normally\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3707 or if the file itself has been changed for some known benign reason.\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3708 An argument specifies the modification time value to use\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3709 \(instead of that of the visited file), in the form of a list\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3710 \(HIGH . LOW) or (HIGH LOW).") |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3711 (time_list) |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3712 Lisp_Object time_list; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3713 { |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3714 if (!NILP (time_list)) |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3715 current_buffer->modtime = cons_to_long (time_list); |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3716 else |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3717 { |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3718 register Lisp_Object filename; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3719 struct stat st; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3720 Lisp_Object handler; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3721 |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3722 filename = Fexpand_file_name (current_buffer->filename, Qnil); |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3723 |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3724 /* If the file name has special constructs in it, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3725 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3726 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3727 if (!NILP (handler)) |
3721
4550c56785d8
(Fset_visited_file_modtime): Don't give the handler
Richard M. Stallman <rms@gnu.org>
parents:
3705
diff
changeset
|
3728 /* The handler can find the file name the same way we did. */ |
3829
4130587b6ffc
* fileio.c (Fset_visited_file_modtime): We're only passing two
Jim Blandy <jimb@redhat.com>
parents:
3787
diff
changeset
|
3729 return call2 (handler, Qset_visited_file_modtime, Qnil); |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3730 else if (stat (XSTRING (filename)->data, &st) >= 0) |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3731 current_buffer->modtime = st.st_mtime; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3732 } |
230 | 3733 |
3734 return Qnil; | |
3735 } | |
3736 | |
3737 Lisp_Object | |
3738 auto_save_error () | |
3739 { | |
3740 ring_bell (); | |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
3741 message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); |
806 | 3742 Fsleep_for (make_number (1), Qnil); |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
3743 message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data); |
806 | 3744 Fsleep_for (make_number (1), Qnil); |
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
parents:
8597
diff
changeset
|
3745 message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); |
806 | 3746 Fsleep_for (make_number (1), Qnil); |
230 | 3747 return Qnil; |
3748 } | |
3749 | |
3750 Lisp_Object | |
3751 auto_save_1 () | |
3752 { | |
3753 unsigned char *fn; | |
3754 struct stat st; | |
3755 | |
3756 /* Get visited file's mode to become the auto save file's mode. */ | |
3757 if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0) | |
3758 /* But make sure we can overwrite it later! */ | |
3759 auto_save_mode_bits = st.st_mode | 0600; | |
3760 else | |
3761 auto_save_mode_bits = 0666; | |
3762 | |
3763 return | |
3764 Fwrite_region (Qnil, Qnil, | |
3765 current_buffer->auto_save_file_name, | |
3766 Qnil, Qlambda); | |
3767 } | |
3768 | |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3769 static Lisp_Object |
7526
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3770 do_auto_save_unwind (desc) /* used as unwind-protect function */ |
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3771 Lisp_Object desc; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3772 { |
7526
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3773 close (XINT (desc)); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3774 return Qnil; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3775 } |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3776 |
230 | 3777 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", |
3778 "Auto-save all buffers that need it.\n\ | |
3779 This is all buffers that have auto-saving enabled\n\ | |
3780 and are changed since last auto-saved.\n\ | |
3781 Auto-saving writes the buffer into a file\n\ | |
3782 so that your editing is not lost if the system crashes.\n\ | |
6209
2a8a76b9a2fe
(Fdo_auto_save): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
6194
diff
changeset
|
3783 This file is not the file you visited; that changes only when you save.\n\ |
2a8a76b9a2fe
(Fdo_auto_save): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
6194
diff
changeset
|
3784 Normally we run the normal hook `auto-save-hook' before saving.\n\n\ |
230 | 3785 Non-nil first argument means do not print any message if successful.\n\ |
621 | 3786 Non-nil second argument means save only current buffer.") |
1775
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3787 (no_message, current_only) |
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3788 Lisp_Object no_message, current_only; |
230 | 3789 { |
3790 struct buffer *old = current_buffer, *b; | |
3791 Lisp_Object tail, buf; | |
3792 int auto_saved = 0; | |
3793 char *omessage = echo_area_glyphs; | |
5875
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3794 int omessage_length = echo_area_glyphs_length; |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3795 extern int minibuf_level; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3796 int do_handled_files; |
4270
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3797 Lisp_Object oquit; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3798 int listdesc; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3799 int count = specpdl_ptr - specpdl; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3800 int *ptr; |
4270
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3801 |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3802 /* Ordinarily don't quit within this function, |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3803 but don't make it impossible to quit (in case we get hung in I/O). */ |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3804 oquit = Vquit_flag; |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3805 Vquit_flag = Qnil; |
230 | 3806 |
3807 /* No GCPRO needed, because (when it matters) all Lisp_Object variables | |
3808 point to non-strings reached from Vbuffer_alist. */ | |
3809 | |
3810 auto_saving = 1; | |
3811 if (minibuf_level) | |
1775
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3812 no_message = Qt; |
230 | 3813 |
485 | 3814 if (!NILP (Vrun_hooks)) |
230 | 3815 call1 (Vrun_hooks, intern ("auto-save-hook")); |
3816 | |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3817 if (STRINGP (Vauto_save_list_file_name)) |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3818 { |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3819 #ifdef DOS_NT |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3820 listdesc = open (XSTRING (Vauto_save_list_file_name)->data, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3821 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3822 S_IREAD | S_IWRITE); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3823 #else /* not DOS_NT */ |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3824 listdesc = creat (XSTRING (Vauto_save_list_file_name)->data, 0666); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
3825 #endif /* not DOS_NT */ |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3826 } |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3827 else |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3828 listdesc = -1; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3829 |
7526
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3830 /* Arrange to close that file whether or not we get an error. */ |
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3831 if (listdesc >= 0) |
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3832 record_unwind_protect (do_auto_save_unwind, make_number (listdesc)); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3833 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3834 /* First, save all files which don't have handlers. If Emacs is |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3835 crashing, the handlers may tweak what is causing Emacs to crash |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3836 in the first place, and it would be a shame if Emacs failed to |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3837 autosave perfectly ordinary files because it couldn't handle some |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3838 ange-ftp'd file. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3839 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) |
9962
72bee09fc541
(Fdo_auto_save): Use the new type-test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9955
diff
changeset
|
3840 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr) |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3841 { |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3842 buf = XCONS (XCONS (tail)->car)->cdr; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3843 b = XBUFFER (buf); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3844 |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3845 /* Record all the buffers that have auto save mode |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3846 in the special file that lists them. */ |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
3847 if (STRINGP (b->auto_save_file_name) |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3848 && listdesc >= 0 && do_handled_files == 0) |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3849 { |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3850 write (listdesc, XSTRING (b->auto_save_file_name)->data, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3851 XSTRING (b->auto_save_file_name)->size); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3852 write (listdesc, "\n", 1); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3853 } |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3854 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3855 if (!NILP (current_only) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3856 && b != current_buffer) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3857 continue; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3858 |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3859 /* Don't auto-save indirect buffers. |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3860 The base buffer takes care of it. */ |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3861 if (b->base_buffer) |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3862 continue; |
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3863 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3864 /* Check for auto save enabled |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3865 and file changed since last auto save |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3866 and file changed since last real save. */ |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
3867 if (STRINGP (b->auto_save_file_name) |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3868 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3869 && b->auto_save_modified < BUF_MODIFF (b) |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3870 /* -1 means we've turned off autosaving for a while--see below. */ |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3871 && XINT (b->save_length) >= 0 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3872 && (do_handled_files |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3873 || NILP (Ffind_file_name_handler (b->auto_save_file_name, |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3874 Qwrite_region)))) |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3875 { |
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3876 EMACS_TIME before_time, after_time; |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3877 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3878 EMACS_GET_TIME (before_time); |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3879 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3880 /* If we had a failure, don't try again for 20 minutes. */ |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3881 if (b->auto_save_failure_time >= 0 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3882 && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200) |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3883 continue; |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3884 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3885 if ((XFASTINT (b->save_length) * 10 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3886 > (BUF_Z (b) - BUF_BEG (b)) * 13) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3887 /* A short file is likely to change a large fraction; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3888 spare the user annoying messages. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3889 && XFASTINT (b->save_length) > 5000 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3890 /* These messages are frequent and annoying for `*mail*'. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3891 && !EQ (b->filename, Qnil) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3892 && NILP (no_message)) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3893 { |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3894 /* It has shrunk too much; turn off auto-saving here. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3895 message ("Buffer %s has shrunk a lot; auto save turned off there", |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3896 XSTRING (b->name)->data); |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3897 /* Turn off auto-saving until there's a real save, |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3898 and prevent any more warnings. */ |
9266
811ad893828b
(Fdefault_file_modes, Finsert_file_contents, Fdo_auto_save): Use new accessor
Karl Heuer <kwzh@gnu.org>
parents:
9241
diff
changeset
|
3899 XSETINT (b->save_length, -1); |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3900 Fsleep_for (make_number (1), Qnil); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3901 continue; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3902 } |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3903 set_buffer_internal (b); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3904 if (!auto_saved && NILP (no_message)) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3905 message1 ("Auto-saving..."); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3906 internal_condition_case (auto_save_1, Qt, auto_save_error); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3907 auto_saved++; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3908 b->auto_save_modified = BUF_MODIFF (b); |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3909 XSETFASTINT (current_buffer->save_length, Z - BEG); |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3910 set_buffer_internal (old); |
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3911 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3912 EMACS_GET_TIME (after_time); |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3913 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3914 /* If auto-save took more than 60 seconds, |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3915 assume it was an NFS failure that got a timeout. */ |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3916 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3917 b->auto_save_failure_time = EMACS_SECS (after_time); |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3918 } |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3919 } |
230 | 3920 |
1059
430923239064
(Fdo_auto_save): Always call record_auto_save.
Richard M. Stallman <rms@gnu.org>
parents:
1044
diff
changeset
|
3921 /* Prevent another auto save till enough input events come in. */ |
430923239064
(Fdo_auto_save): Always call record_auto_save.
Richard M. Stallman <rms@gnu.org>
parents:
1044
diff
changeset
|
3922 record_auto_save (); |
230 | 3923 |
1775
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3924 if (auto_saved && NILP (no_message)) |
5875
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3925 { |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3926 if (omessage) |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3927 message2 (omessage, omessage_length); |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3928 else |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3929 message1 ("Auto-saving...done"); |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3930 } |
230 | 3931 |
4270
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3932 Vquit_flag = oquit; |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3933 |
230 | 3934 auto_saving = 0; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3935 unbind_to (count, Qnil); |
230 | 3936 return Qnil; |
3937 } | |
3938 | |
3939 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, | |
3940 Sset_buffer_auto_saved, 0, 0, 0, | |
3941 "Mark current buffer as auto-saved with its current text.\n\ | |
3942 No auto-save file will be written until the buffer changes again.") | |
3943 () | |
3944 { | |
3945 current_buffer->auto_save_modified = MODIFF; | |
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
parents:
9291
diff
changeset
|
3946 XSETFASTINT (current_buffer->save_length, Z - BEG); |
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3947 current_buffer->auto_save_failure_time = -1; |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3948 return Qnil; |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3949 } |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3950 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3951 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3952 Sclear_buffer_auto_save_failure, 0, 0, 0, |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3953 "Clear any record of a recent auto-save failure in the current buffer.") |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3954 () |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3955 { |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3956 current_buffer->auto_save_failure_time = -1; |
230 | 3957 return Qnil; |
3958 } | |
3959 | |
3960 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, | |
3961 0, 0, 0, | |
3962 "Return t if buffer has been auto-saved since last read in or saved.") | |
3963 () | |
3964 { | |
10304
ce5ab980a14f
Use SAVE_MODIFF and BUF_SAVE_MODIFF
Richard M. Stallman <rms@gnu.org>
parents:
10084
diff
changeset
|
3965 return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil; |
230 | 3966 } |
3967 | |
3968 /* Reading and completing file names */ | |
3969 extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions (); | |
3970 | |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3971 /* In the string VAL, change each $ to $$ and return the result. */ |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3972 |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3973 static Lisp_Object |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3974 double_dollars (val) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3975 Lisp_Object val; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3976 { |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3977 register unsigned char *old, *new; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3978 register int n; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3979 int osize, count; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3980 |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3981 osize = XSTRING (val)->size; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3982 /* Quote "$" as "$$" to get it past substitute-in-file-name */ |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3983 for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3984 if (*old++ == '$') count++; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3985 if (count > 0) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3986 { |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3987 old = XSTRING (val)->data; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3988 val = Fmake_string (make_number (osize + count), make_number (0)); |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3989 new = XSTRING (val)->data; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3990 for (n = osize; n > 0; n--) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3991 if (*old != '$') |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3992 *new++ = *old++; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3993 else |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3994 { |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3995 *new++ = '$'; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3996 *new++ = '$'; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3997 old++; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3998 } |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3999 } |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4000 return val; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4001 } |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4002 |
230 | 4003 DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, |
4004 3, 3, 0, | |
4005 "Internal subroutine for read-file-name. Do not call this.") | |
4006 (string, dir, action) | |
4007 Lisp_Object string, dir, action; | |
4008 /* action is nil for complete, t for return list of completions, | |
4009 lambda for verify final value */ | |
4010 { | |
4011 Lisp_Object name, specdir, realdir, val, orig_string; | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4012 int changed; |
9955
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
4013 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4014 |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4015 realdir = dir; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4016 name = string; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4017 orig_string = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4018 specdir = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4019 changed = 0; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4020 /* No need to protect ACTION--we only compare it with t and nil. */ |
9955
dfb5d7e86733
(Fread_file_name_internal): Protect orig_string.
Richard M. Stallman <rms@gnu.org>
parents:
9921
diff
changeset
|
4021 GCPRO5 (string, realdir, name, specdir, orig_string); |
230 | 4022 |
4023 if (XSTRING (string)->size == 0) | |
4024 { | |
4025 if (EQ (action, Qlambda)) | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4026 { |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4027 UNGCPRO; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4028 return Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4029 } |
230 | 4030 } |
4031 else | |
4032 { | |
4033 orig_string = string; | |
4034 string = Fsubstitute_in_file_name (string); | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4035 changed = NILP (Fstring_equal (string, orig_string)); |
230 | 4036 name = Ffile_name_nondirectory (string); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4037 val = Ffile_name_directory (string); |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4038 if (! NILP (val)) |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4039 realdir = Fexpand_file_name (val, realdir); |
230 | 4040 } |
4041 | |
485 | 4042 if (NILP (action)) |
230 | 4043 { |
4044 specdir = Ffile_name_directory (string); | |
4045 val = Ffile_name_completion (name, realdir); | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4046 UNGCPRO; |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
4047 if (!STRINGP (val)) |
230 | 4048 { |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4049 if (changed) |
8454
b09c4b7a4729
(Fread_file_name_internal): Call double_dollars when `changed' is set.
Richard M. Stallman <rms@gnu.org>
parents:
8317
diff
changeset
|
4050 return double_dollars (string); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4051 return val; |
230 | 4052 } |
4053 | |
485 | 4054 if (!NILP (specdir)) |
230 | 4055 val = concat2 (specdir, val); |
4056 #ifndef VMS | |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4057 return double_dollars (val); |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4058 #else /* not VMS */ |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4059 return val; |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4060 #endif /* not VMS */ |
230 | 4061 } |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4062 UNGCPRO; |
230 | 4063 |
4064 if (EQ (action, Qt)) | |
4065 return Ffile_name_all_completions (name, realdir); | |
4066 /* Only other case actually used is ACTION = lambda */ | |
4067 #ifdef VMS | |
4068 /* Supposedly this helps commands such as `cd' that read directory names, | |
4069 but can someone explain how it helps them? -- RMS */ | |
4070 if (XSTRING (name)->size == 0) | |
4071 return Qt; | |
4072 #endif /* VMS */ | |
4073 return Ffile_exists_p (string); | |
4074 } | |
4075 | |
4076 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, | |
4077 "Read file name, prompting with PROMPT and completing in directory DIR.\n\ | |
4078 Value is not expanded---you must call `expand-file-name' yourself.\n\ | |
4079 Default name to DEFAULT if user enters a null string.\n\ | |
9078
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4080 (If DEFAULT is omitted, the visited file name is used,\n\ |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4081 except that if INITIAL is specified, that combined with DIR is used.)\n\ |
230 | 4082 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\ |
4083 Non-nil and non-t means also require confirmation after completion.\n\ | |
4084 Fifth arg INITIAL specifies text to start with.\n\ | |
4085 DIR defaults to current buffer's directory default.") | |
4086 (prompt, dir, defalt, mustmatch, initial) | |
4087 Lisp_Object prompt, dir, defalt, mustmatch, initial; | |
4088 { | |
866 | 4089 Lisp_Object val, insdef, insdef1, tem; |
230 | 4090 struct gcpro gcpro1, gcpro2; |
4091 register char *homedir; | |
4092 int count; | |
4093 | |
485 | 4094 if (NILP (dir)) |
230 | 4095 dir = current_buffer->directory; |
485 | 4096 if (NILP (defalt)) |
9078
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4097 { |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4098 if (! NILP (initial)) |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4099 defalt = Fexpand_file_name (initial, dir); |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4100 else |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4101 defalt = current_buffer->filename; |
283534a85f5a
(Ffile_writable_p): Use stat to test for existence.
Richard M. Stallman <rms@gnu.org>
parents:
8885
diff
changeset
|
4102 } |
230 | 4103 |
4104 /* If dir starts with user's homedir, change that to ~. */ | |
4105 homedir = (char *) egetenv ("HOME"); | |
4106 if (homedir != 0 | |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
4107 && STRINGP (dir) |
230 | 4108 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
4109 && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)])) |
230 | 4110 { |
4111 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, | |
4112 XSTRING (dir)->size - strlen (homedir) + 1); | |
4113 XSTRING (dir)->data[0] = '~'; | |
4114 } | |
4115 | |
4116 if (insert_default_directory) | |
4117 { | |
4118 insdef = dir; | |
485 | 4119 if (!NILP (initial)) |
230 | 4120 { |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4121 Lisp_Object args[2], pos; |
230 | 4122 |
4123 args[0] = insdef; | |
4124 args[1] = initial; | |
4125 insdef = Fconcat (2, args); | |
6181
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
4126 pos = make_number (XSTRING (double_dollars (dir))->size); |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4127 insdef1 = Fcons (double_dollars (insdef), pos); |
230 | 4128 } |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4129 else |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
4130 insdef1 = double_dollars (insdef); |
230 | 4131 } |
6181
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
4132 else if (!NILP (initial)) |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
4133 { |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
4134 insdef = initial; |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
4135 insdef1 = Fcons (double_dollars (insdef), 0); |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
4136 } |
230 | 4137 else |
866 | 4138 insdef = Qnil, insdef1 = Qnil; |
230 | 4139 |
4140 #ifdef VMS | |
4141 count = specpdl_ptr - specpdl; | |
4142 specbind (intern ("completion-ignore-case"), Qt); | |
4143 #endif | |
4144 | |
4145 GCPRO2 (insdef, defalt); | |
4146 val = Fcompleting_read (prompt, intern ("read-file-name-internal"), | |
866 | 4147 dir, mustmatch, insdef1, |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4148 Qfile_name_history); |
230 | 4149 |
4150 #ifdef VMS | |
4151 unbind_to (count, Qnil); | |
4152 #endif | |
4153 | |
4154 UNGCPRO; | |
485 | 4155 if (NILP (val)) |
230 | 4156 error ("No file name specified"); |
4157 tem = Fstring_equal (val, insdef); | |
485 | 4158 if (!NILP (tem) && !NILP (defalt)) |
230 | 4159 return defalt; |
3032
371058345c42
(Fread_file_name): If input is empty, do return the default
Richard M. Stallman <rms@gnu.org>
parents:
3017
diff
changeset
|
4160 if (XSTRING (val)->size == 0 && NILP (insdef)) |
5245
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
4161 { |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
4162 if (!NILP (defalt)) |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
4163 return defalt; |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
4164 else |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
4165 error ("No default file name"); |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
4166 } |
230 | 4167 return Fsubstitute_in_file_name (val); |
4168 } | |
4169 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
4170 #if 0 /* Old version */ |
230 | 4171 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, |
6347
c7e1f551e97a
(Fread_file_name): Delete docstring of second version of function, to avoid
Karl Heuer <kwzh@gnu.org>
parents:
6328
diff
changeset
|
4172 /* Don't confuse make-docfile by having two doc strings for this function. |
c7e1f551e97a
(Fread_file_name): Delete docstring of second version of function, to avoid
Karl Heuer <kwzh@gnu.org>
parents:
6328
diff
changeset
|
4173 make-docfile does not pay attention to #if, for good reason! */ |
c7e1f551e97a
(Fread_file_name): Delete docstring of second version of function, to avoid
Karl Heuer <kwzh@gnu.org>
parents:
6328
diff
changeset
|
4174 0) |
230 | 4175 (prompt, dir, defalt, mustmatch, initial) |
4176 Lisp_Object prompt, dir, defalt, mustmatch, initial; | |
4177 { | |
4178 Lisp_Object val, insdef, tem; | |
4179 struct gcpro gcpro1, gcpro2; | |
4180 register char *homedir; | |
4181 int count; | |
4182 | |
485 | 4183 if (NILP (dir)) |
230 | 4184 dir = current_buffer->directory; |
485 | 4185 if (NILP (defalt)) |
230 | 4186 defalt = current_buffer->filename; |
4187 | |
4188 /* If dir starts with user's homedir, change that to ~. */ | |
4189 homedir = (char *) egetenv ("HOME"); | |
4190 if (homedir != 0 | |
9131
2190d1e7a69f
(Ffind_file_name_handler, Fcopy_file, Frename_file, Fadd_name_to_file,
Karl Heuer <kwzh@gnu.org>
parents:
9078
diff
changeset
|
4191 && STRINGP (dir) |
230 | 4192 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) |
4193 && XSTRING (dir)->data[strlen (homedir)] == '/') | |
4194 { | |
4195 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, | |
4196 XSTRING (dir)->size - strlen (homedir) + 1); | |
4197 XSTRING (dir)->data[0] = '~'; | |
4198 } | |
4199 | |
485 | 4200 if (!NILP (initial)) |
230 | 4201 insdef = initial; |
4202 else if (insert_default_directory) | |
4203 insdef = dir; | |
4204 else | |
4205 insdef = build_string (""); | |
4206 | |
4207 #ifdef VMS | |
4208 count = specpdl_ptr - specpdl; | |
4209 specbind (intern ("completion-ignore-case"), Qt); | |
4210 #endif | |
4211 | |
4212 GCPRO2 (insdef, defalt); | |
4213 val = Fcompleting_read (prompt, intern ("read-file-name-internal"), | |
4214 dir, mustmatch, | |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4215 insert_default_directory ? insdef : Qnil, |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4216 Qfile_name_history); |
230 | 4217 |
4218 #ifdef VMS | |
4219 unbind_to (count, Qnil); | |
4220 #endif | |
4221 | |
4222 UNGCPRO; | |
485 | 4223 if (NILP (val)) |
230 | 4224 error ("No file name specified"); |
4225 tem = Fstring_equal (val, insdef); | |
485 | 4226 if (!NILP (tem) && !NILP (defalt)) |
230 | 4227 return defalt; |
4228 return Fsubstitute_in_file_name (val); | |
4229 } | |
4230 #endif /* Old version */ | |
4231 | |
4232 syms_of_fileio () | |
4233 { | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
4234 Qexpand_file_name = intern ("expand-file-name"); |
10719
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
4235 Qsubstitute_in_file_name = intern ("substitute-in-file-name"); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
4236 Qdirectory_file_name = intern ("directory-file-name"); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
4237 Qfile_name_directory = intern ("file-name-directory"); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
4238 Qfile_name_nondirectory = intern ("file-name-nondirectory"); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4239 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory"); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
4240 Qfile_name_as_directory = intern ("file-name-as-directory"); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4241 Qcopy_file = intern ("copy-file"); |
8227
0e6b7eeedc3b
(Fmake_directory_internal): Use Qmake_directory_internal.
Richard M. Stallman <rms@gnu.org>
parents:
8185
diff
changeset
|
4242 Qmake_directory_internal = intern ("make-directory-internal"); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4243 Qdelete_directory = intern ("delete-directory"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4244 Qdelete_file = intern ("delete-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4245 Qrename_file = intern ("rename-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4246 Qadd_name_to_file = intern ("add-name-to-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4247 Qmake_symbolic_link = intern ("make-symbolic-link"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4248 Qfile_exists_p = intern ("file-exists-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4249 Qfile_executable_p = intern ("file-executable-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4250 Qfile_readable_p = intern ("file-readable-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4251 Qfile_symlink_p = intern ("file-symlink-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4252 Qfile_writable_p = intern ("file-writable-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4253 Qfile_directory_p = intern ("file-directory-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4254 Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4255 Qfile_modes = intern ("file-modes"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4256 Qset_file_modes = intern ("set-file-modes"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4257 Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4258 Qinsert_file_contents = intern ("insert-file-contents"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4259 Qwrite_region = intern ("write-region"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4260 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); |
3560
95021dcb923b
(syms_of_fileio): Set up Qset_visited_file_modtime.
Richard M. Stallman <rms@gnu.org>
parents:
3415
diff
changeset
|
4261 Qset_visited_file_modtime = intern ("set-visited-file-modtime"); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
4262 |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4263 staticpro (&Qexpand_file_name); |
10719
40ae63b409f4
(Fexpand_file_name): Look for a handler for defalt.
Richard M. Stallman <rms@gnu.org>
parents:
10499
diff
changeset
|
4264 staticpro (&Qsubstitute_in_file_name); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4265 staticpro (&Qdirectory_file_name); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4266 staticpro (&Qfile_name_directory); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4267 staticpro (&Qfile_name_nondirectory); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4268 staticpro (&Qunhandled_file_name_directory); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4269 staticpro (&Qfile_name_as_directory); |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4270 staticpro (&Qcopy_file); |
8243
bf7b3b969ab5
(syms_of_fileio): Finish previous change.
Richard M. Stallman <rms@gnu.org>
parents:
8227
diff
changeset
|
4271 staticpro (&Qmake_directory_internal); |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4272 staticpro (&Qdelete_directory); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4273 staticpro (&Qdelete_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4274 staticpro (&Qrename_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4275 staticpro (&Qadd_name_to_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4276 staticpro (&Qmake_symbolic_link); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4277 staticpro (&Qfile_exists_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4278 staticpro (&Qfile_executable_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4279 staticpro (&Qfile_readable_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4280 staticpro (&Qfile_symlink_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4281 staticpro (&Qfile_writable_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4282 staticpro (&Qfile_directory_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4283 staticpro (&Qfile_accessible_directory_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4284 staticpro (&Qfile_modes); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4285 staticpro (&Qset_file_modes); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4286 staticpro (&Qfile_newer_than_file_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4287 staticpro (&Qinsert_file_contents); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4288 staticpro (&Qwrite_region); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4289 staticpro (&Qverify_visited_file_modtime); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4290 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4291 Qfile_name_history = intern ("file-name-history"); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4292 Fset (Qfile_name_history, Qnil); |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4293 staticpro (&Qfile_name_history); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
4294 |
230 | 4295 Qfile_error = intern ("file-error"); |
4296 staticpro (&Qfile_error); | |
4297 Qfile_already_exists = intern("file-already-exists"); | |
4298 staticpro (&Qfile_already_exists); | |
4299 | |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
4300 #ifdef DOS_NT |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4301 Qfind_buffer_file_type = intern ("find-buffer-file-type"); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4302 staticpro (&Qfind_buffer_file_type); |
9789
a1e6724db219
Change explicit uses of the Unix directory separator
Richard M. Stallman <rms@gnu.org>
parents:
9572
diff
changeset
|
4303 #endif /* DOS_NT */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4304 |
11053
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4305 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format, |
11090
290c241031e9
(syms_of_fileio): Fix missing \n\.
Karl Heuer <kwzh@gnu.org>
parents:
11053
diff
changeset
|
4306 "*Format in which to write auto-save files.\n\ |
11053
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4307 Should be a list of symbols naming formats that are defined in `format-alist'.\n\ |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4308 If it is t, which is the default, auto-save files are written in the\n\ |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4309 same format as a regular save would use."); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4310 Vauto_save_file_format = Qt; |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4311 |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4312 Qformat_decode = intern ("format-decode"); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4313 staticpro (&Qformat_decode); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4314 Qformat_annotate_function = intern ("format-annotate-function"); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4315 staticpro (&Qformat_annotate_function); |
f14a518fcb33
(Finsert_file_contents): Call format-decode.
Boris Goldowsky <boris@gnu.org>
parents:
10734
diff
changeset
|
4316 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4317 Qcar_less_than_car = intern ("car-less-than-car"); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4318 staticpro (&Qcar_less_than_car); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4319 |
230 | 4320 Fput (Qfile_error, Qerror_conditions, |
4321 Fcons (Qfile_error, Fcons (Qerror, Qnil))); | |
4322 Fput (Qfile_error, Qerror_message, | |
4323 build_string ("File error")); | |
4324 | |
4325 Fput (Qfile_already_exists, Qerror_conditions, | |
4326 Fcons (Qfile_already_exists, | |
4327 Fcons (Qfile_error, Fcons (Qerror, Qnil)))); | |
4328 Fput (Qfile_already_exists, Qerror_message, | |
4329 build_string ("File already exists")); | |
4330 | |
4331 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, | |
4332 "*Non-nil means when reading a filename start with default dir in minibuffer."); | |
4333 insert_default_directory = 1; | |
4334 | |
4335 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm, | |
4336 "*Non-nil means write new files with record format `stmlf'.\n\ | |
4337 nil means use format `var'. This variable is meaningful only on VMS."); | |
4338 vms_stmlf_recfm = 0; | |
4339 | |
850
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4340 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4341 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4342 If a file name matches REGEXP, then all I/O on that file is done by calling\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4343 HANDLER.\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4344 \n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4345 The first argument given to HANDLER is the name of the I/O primitive\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4346 to be handled; the remaining arguments are the arguments that were\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4347 passed to that primitive. For example, if you do\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4348 (file-exists-p FILENAME)\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4349 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4350 (funcall HANDLER 'file-exists-p FILENAME)\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4351 The function `find-file-name-handler' checks this list for a handler\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4352 for its argument."); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4353 Vfile_name_handler_alist = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4354 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4355 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, |
4989
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4356 "A list of functions to be called at the end of `insert-file-contents'.\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4357 Each is passed one argument, the number of bytes inserted. It should return\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4358 the new byte count, and leave point the same. If `insert-file-contents' is\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4359 intercepted by a handler from `file-name-handler-alist', that handler is\n\ |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4360 responsible for calling the after-insert-file-functions if appropriate."); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4361 Vafter_insert_file_functions = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4362 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4363 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, |
4989
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4364 "A list of functions to be called at the start of `write-region'.\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4365 Each is passed two arguments, START and END as for `write-region'. It should\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4366 return a list of pairs (POSITION . STRING) of strings to be effectively\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4367 inserted at the specified positions of the file being written (1 means to\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4368 insert before the first byte written). The POSITIONs must be sorted into\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4369 increasing order. If there are several functions in the list, the several\n\ |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4370 lists are merged destructively."); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4371 Vwrite_region_annotate_functions = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4372 |
8317
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4373 DEFVAR_LISP ("write-region-annotations-so-far", |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4374 &Vwrite_region_annotations_so_far, |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4375 "When an annotation function is called, this holds the previous annotations.\n\ |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4376 These are the annotations made by other annotation functions\n\ |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4377 that were already called. See also `write-region-annotate-functions'."); |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4378 Vwrite_region_annotations_so_far = Qnil; |
c59be9428778
(Fwrite_region): Do unwind the new unwind protect.
Richard M. Stallman <rms@gnu.org>
parents:
8243
diff
changeset
|
4379 |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
4380 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, |
7549
ccb8b7f8dce7
(syms_of_fileio): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
7526
diff
changeset
|
4381 "A list of file name handlers that temporarily should not be used.\n\ |
7182
f0ecad45bb35
(inhibit-file-name-handers): Correct documentation.
Richard M. Stallman <rms@gnu.org>
parents:
7130
diff
changeset
|
4382 This applies only to the operation `inhibit-file-name-operation'."); |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
4383 Vinhibit_file_name_handlers = Qnil; |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
4384 |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4385 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation, |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4386 "The operation for which `inhibit-file-name-handlers' is applicable."); |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4387 Vinhibit_file_name_operation = Qnil; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4388 |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4389 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4390 "File name in which we write a list of all auto save file names."); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4391 Vauto_save_list_file_name = Qnil; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4392 |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4393 defsubr (&Sfind_file_name_handler); |
230 | 4394 defsubr (&Sfile_name_directory); |
4395 defsubr (&Sfile_name_nondirectory); | |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4396 defsubr (&Sunhandled_file_name_directory); |
230 | 4397 defsubr (&Sfile_name_as_directory); |
4398 defsubr (&Sdirectory_file_name); | |
4399 defsubr (&Smake_temp_name); | |
4400 defsubr (&Sexpand_file_name); | |
4401 defsubr (&Ssubstitute_in_file_name); | |
4402 defsubr (&Scopy_file); | |
1533
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
4403 defsubr (&Smake_directory_internal); |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
648
diff
changeset
|
4404 defsubr (&Sdelete_directory); |
230 | 4405 defsubr (&Sdelete_file); |
4406 defsubr (&Srename_file); | |
4407 defsubr (&Sadd_name_to_file); | |
4408 #ifdef S_IFLNK | |
4409 defsubr (&Smake_symbolic_link); | |
4410 #endif /* S_IFLNK */ | |
4411 #ifdef VMS | |
4412 defsubr (&Sdefine_logical_name); | |
4413 #endif /* VMS */ | |
4414 #ifdef HPUX_NET | |
4415 defsubr (&Ssysnetunam); | |
4416 #endif /* HPUX_NET */ | |
4417 defsubr (&Sfile_name_absolute_p); | |
4418 defsubr (&Sfile_exists_p); | |
4419 defsubr (&Sfile_executable_p); | |
4420 defsubr (&Sfile_readable_p); | |
4421 defsubr (&Sfile_writable_p); | |
4422 defsubr (&Sfile_symlink_p); | |
4423 defsubr (&Sfile_directory_p); | |
536 | 4424 defsubr (&Sfile_accessible_directory_p); |
9346
fec27dfc0684
(Ffile_regular_p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9307
diff
changeset
|
4425 defsubr (&Sfile_regular_p); |
230 | 4426 defsubr (&Sfile_modes); |
4427 defsubr (&Sset_file_modes); | |
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
4428 defsubr (&Sset_default_file_modes); |
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
4429 defsubr (&Sdefault_file_modes); |
230 | 4430 defsubr (&Sfile_newer_than_file_p); |
4431 defsubr (&Sinsert_file_contents); | |
4432 defsubr (&Swrite_region); | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4433 defsubr (&Scar_less_than_car); |
230 | 4434 defsubr (&Sverify_visited_file_modtime); |
4435 defsubr (&Sclear_visited_file_modtime); | |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
4436 defsubr (&Svisited_file_modtime); |
230 | 4437 defsubr (&Sset_visited_file_modtime); |
4438 defsubr (&Sdo_auto_save); | |
4439 defsubr (&Sset_buffer_auto_saved); | |
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
4440 defsubr (&Sclear_buffer_auto_save_failure); |
230 | 4441 defsubr (&Srecent_auto_save_p); |
4442 | |
4443 defsubr (&Sread_file_name_internal); | |
4444 defsubr (&Sread_file_name); | |
689
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
4445 |
1204
567860ca77e0
* fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync
Jim Blandy <jimb@redhat.com>
parents:
1178
diff
changeset
|
4446 #ifdef unix |
689
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
4447 defsubr (&Sunix_sync); |
1204
567860ca77e0
* fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync
Jim Blandy <jimb@redhat.com>
parents:
1178
diff
changeset
|
4448 #endif |
230 | 4449 } |