|
230
|
1 /* File IO for GNU Emacs.
|
|
621
|
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 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
|
|
648
|
20 #include "config.h"
|
|
230
|
21
|
|
|
22 #include <sys/types.h>
|
|
|
23 #include <sys/stat.h>
|
|
372
|
24
|
|
|
25 #ifdef VMS
|
|
564
|
26 #include "vms-pwd.h"
|
|
372
|
27 #else
|
|
230
|
28 #include <pwd.h>
|
|
372
|
29 #endif
|
|
|
30
|
|
230
|
31 #include <ctype.h>
|
|
372
|
32
|
|
|
33 #ifdef VMS
|
|
|
34 #include "dir.h"
|
|
|
35 #include <perror.h>
|
|
|
36 #include <stddef.h>
|
|
|
37 #include <string.h>
|
|
|
38 #endif
|
|
|
39
|
|
230
|
40 #include <errno.h>
|
|
|
41
|
|
372
|
42 #ifndef vax11c
|
|
230
|
43 extern int errno;
|
|
|
44 extern char *sys_errlist[];
|
|
|
45 extern int sys_nerr;
|
|
|
46 #endif
|
|
|
47
|
|
|
48 #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
|
|
|
49
|
|
|
50 #ifdef APOLLO
|
|
|
51 #include <sys/time.h>
|
|
|
52 #endif
|
|
|
53
|
|
|
54 #include "lisp.h"
|
|
1299
|
55 #include "intervals.h"
|
|
230
|
56 #include "buffer.h"
|
|
|
57 #include "window.h"
|
|
|
58
|
|
|
59 #ifdef VMS
|
|
|
60 #include <file.h>
|
|
|
61 #include <rmsdef.h>
|
|
|
62 #include <fab.h>
|
|
|
63 #include <nam.h>
|
|
|
64 #endif
|
|
|
65
|
|
564
|
66 #include "systime.h"
|
|
230
|
67
|
|
|
68 #ifdef HPUX
|
|
|
69 #include <netio.h>
|
|
350
|
70 #ifndef HPUX8
|
|
230
|
71 #include <errnet.h>
|
|
|
72 #endif
|
|
350
|
73 #endif
|
|
230
|
74
|
|
|
75 #ifndef O_WRONLY
|
|
|
76 #define O_WRONLY 1
|
|
|
77 #endif
|
|
|
78
|
|
|
79 #define min(a, b) ((a) < (b) ? (a) : (b))
|
|
|
80 #define max(a, b) ((a) > (b) ? (a) : (b))
|
|
|
81
|
|
|
82 /* Nonzero during writing of auto-save files */
|
|
|
83 int auto_saving;
|
|
|
84
|
|
|
85 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
|
|
|
86 a new file with the same mode as the original */
|
|
|
87 int auto_save_mode_bits;
|
|
|
88
|
|
843
|
89 /* Alist of elements (REGEXP . HANDLER) for file names
|
|
|
90 whose I/O is done with a special handler. */
|
|
|
91 Lisp_Object Vfile_name_handler_alist;
|
|
|
92
|
|
230
|
93 /* Nonzero means, when reading a filename in the minibuffer,
|
|
|
94 start out by inserting the default directory into the minibuffer. */
|
|
|
95 int insert_default_directory;
|
|
|
96
|
|
|
97 /* On VMS, nonzero means write new files with record format stmlf.
|
|
|
98 Zero means use var format. */
|
|
|
99 int vms_stmlf_recfm;
|
|
|
100
|
|
|
101 Lisp_Object Qfile_error, Qfile_already_exists;
|
|
|
102
|
|
863
|
103 Lisp_Object Qfile_name_history;
|
|
|
104
|
|
230
|
105 report_file_error (string, data)
|
|
|
106 char *string;
|
|
|
107 Lisp_Object data;
|
|
|
108 {
|
|
|
109 Lisp_Object errstring;
|
|
|
110
|
|
|
111 if (errno >= 0 && errno < sys_nerr)
|
|
|
112 errstring = build_string (sys_errlist[errno]);
|
|
|
113 else
|
|
|
114 errstring = build_string ("undocumented error code");
|
|
|
115
|
|
|
116 /* System error messages are capitalized. Downcase the initial
|
|
|
117 unless it is followed by a slash. */
|
|
|
118 if (XSTRING (errstring)->data[1] != '/')
|
|
|
119 XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
|
|
|
120
|
|
|
121 while (1)
|
|
|
122 Fsignal (Qfile_error,
|
|
|
123 Fcons (build_string (string), Fcons (errstring, data)));
|
|
|
124 }
|
|
592
|
125
|
|
|
126 close_file_unwind (fd)
|
|
|
127 Lisp_Object fd;
|
|
|
128 {
|
|
|
129 close (XFASTINT (fd));
|
|
|
130 }
|
|
230
|
131
|
|
1105
|
132 Lisp_Object Qexpand_file_name;
|
|
|
133 Lisp_Object Qdirectory_file_name;
|
|
|
134 Lisp_Object Qfile_name_directory;
|
|
|
135 Lisp_Object Qfile_name_nondirectory;
|
|
1679
|
136 Lisp_Object Qunhandled_file_name_directory;
|
|
1105
|
137 Lisp_Object Qfile_name_as_directory;
|
|
843
|
138 Lisp_Object Qcopy_file;
|
|
|
139 Lisp_Object Qmake_directory;
|
|
|
140 Lisp_Object Qdelete_directory;
|
|
|
141 Lisp_Object Qdelete_file;
|
|
|
142 Lisp_Object Qrename_file;
|
|
|
143 Lisp_Object Qadd_name_to_file;
|
|
|
144 Lisp_Object Qmake_symbolic_link;
|
|
|
145 Lisp_Object Qfile_exists_p;
|
|
|
146 Lisp_Object Qfile_executable_p;
|
|
|
147 Lisp_Object Qfile_readable_p;
|
|
|
148 Lisp_Object Qfile_symlink_p;
|
|
|
149 Lisp_Object Qfile_writable_p;
|
|
|
150 Lisp_Object Qfile_directory_p;
|
|
|
151 Lisp_Object Qfile_accessible_directory_p;
|
|
|
152 Lisp_Object Qfile_modes;
|
|
|
153 Lisp_Object Qset_file_modes;
|
|
|
154 Lisp_Object Qfile_newer_than_file_p;
|
|
|
155 Lisp_Object Qinsert_file_contents;
|
|
|
156 Lisp_Object Qwrite_region;
|
|
|
157 Lisp_Object Qverify_visited_file_modtime;
|
|
|
158
|
|
1679
|
159 DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0,
|
|
|
160 "Return FILENAME's handler function, if its syntax is handled specially.\n\
|
|
|
161 Otherwise, return nil.\n\
|
|
|
162 A file name is handled if one of the regular expressions in\n\
|
|
|
163 `file-name-handler-alist' matches it.")
|
|
|
164 (filename)
|
|
|
165 Lisp_Object filename;
|
|
843
|
166 {
|
|
1679
|
167 /* This function must not munge the match data. */
|
|
|
168
|
|
843
|
169 Lisp_Object chain;
|
|
848
|
170 for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
|
|
843
|
171 chain = XCONS (chain)->cdr)
|
|
|
172 {
|
|
|
173 Lisp_Object elt;
|
|
|
174 elt = XCONS (chain)->car;
|
|
|
175 if (XTYPE (elt) == Lisp_Cons)
|
|
|
176 {
|
|
|
177 Lisp_Object string;
|
|
|
178 string = XCONS (elt)->car;
|
|
|
179 if (XTYPE (string) == Lisp_String
|
|
1178
|
180 && fast_string_match (string, filename) >= 0)
|
|
843
|
181 return XCONS (elt)->cdr;
|
|
|
182 }
|
|
1679
|
183
|
|
|
184 QUIT;
|
|
843
|
185 }
|
|
|
186 return Qnil;
|
|
|
187 }
|
|
|
188
|
|
230
|
189 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
|
|
|
190 1, 1, 0,
|
|
|
191 "Return the directory component in file name NAME.\n\
|
|
|
192 Return nil if NAME does not include a directory.\n\
|
|
|
193 Otherwise return a directory spec.\n\
|
|
|
194 Given a Unix syntax file name, returns a string ending in slash;\n\
|
|
|
195 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
|
|
|
196 (file)
|
|
|
197 Lisp_Object file;
|
|
|
198 {
|
|
|
199 register unsigned char *beg;
|
|
|
200 register unsigned char *p;
|
|
1105
|
201 Lisp_Object handler;
|
|
230
|
202
|
|
|
203 CHECK_STRING (file, 0);
|
|
|
204
|
|
1105
|
205 /* If the file name has special constructs in it,
|
|
|
206 call the corresponding file handler. */
|
|
1679
|
207 handler = Ffind_file_name_handler (file);
|
|
1105
|
208 if (!NILP (handler))
|
|
|
209 return call2 (handler, Qfile_name_directory, file);
|
|
|
210
|
|
230
|
211 beg = XSTRING (file)->data;
|
|
|
212 p = beg + XSTRING (file)->size;
|
|
|
213
|
|
|
214 while (p != beg && p[-1] != '/'
|
|
|
215 #ifdef VMS
|
|
|
216 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
|
|
|
217 #endif /* VMS */
|
|
|
218 ) p--;
|
|
|
219
|
|
|
220 if (p == beg)
|
|
|
221 return Qnil;
|
|
|
222 return make_string (beg, p - beg);
|
|
|
223 }
|
|
|
224
|
|
|
225 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
|
|
|
226 1, 1, 0,
|
|
|
227 "Return file name NAME sans its directory.\n\
|
|
|
228 For example, in a Unix-syntax file name,\n\
|
|
|
229 this is everything after the last slash,\n\
|
|
|
230 or the entire name if it contains no slash.")
|
|
|
231 (file)
|
|
|
232 Lisp_Object file;
|
|
|
233 {
|
|
|
234 register unsigned char *beg, *p, *end;
|
|
1105
|
235 Lisp_Object handler;
|
|
230
|
236
|
|
|
237 CHECK_STRING (file, 0);
|
|
|
238
|
|
1105
|
239 /* If the file name has special constructs in it,
|
|
|
240 call the corresponding file handler. */
|
|
1679
|
241 handler = Ffind_file_name_handler (file);
|
|
1105
|
242 if (!NILP (handler))
|
|
|
243 return call2 (handler, Qfile_name_nondirectory, file);
|
|
|
244
|
|
230
|
245 beg = XSTRING (file)->data;
|
|
|
246 end = p = beg + XSTRING (file)->size;
|
|
|
247
|
|
|
248 while (p != beg && p[-1] != '/'
|
|
|
249 #ifdef VMS
|
|
|
250 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
|
|
|
251 #endif /* VMS */
|
|
|
252 ) p--;
|
|
|
253
|
|
|
254 return make_string (p, end - p);
|
|
|
255 }
|
|
1679
|
256
|
|
|
257 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
|
|
|
258 "Return a directly usable directory name somehow associated with FILENAME.\n\
|
|
|
259 A `directly usable' directory name is one that may be used without the\n\
|
|
|
260 intervention of any file handler.\n\
|
|
|
261 If FILENAME is a directly usable file itself, return\n\
|
|
|
262 (file-name-directory FILENAME).\n\
|
|
|
263 The `call-process' and `start-process' functions use this function to\n\
|
|
|
264 get a current directory to run processes in.")
|
|
|
265 (filename)
|
|
|
266 Lisp_Object filename;
|
|
|
267 {
|
|
|
268 Lisp_Object handler;
|
|
|
269
|
|
|
270 /* If the file name has special constructs in it,
|
|
|
271 call the corresponding file handler. */
|
|
|
272 handler = Ffind_file_name_handler (filename);
|
|
|
273 if (!NILP (handler))
|
|
|
274 return call2 (handler, Qunhandled_file_name_directory, filename);
|
|
|
275
|
|
|
276 return Ffile_name_directory (filename);
|
|
|
277 }
|
|
|
278
|
|
230
|
279
|
|
|
280 char *
|
|
|
281 file_name_as_directory (out, in)
|
|
|
282 char *out, *in;
|
|
|
283 {
|
|
|
284 int size = strlen (in) - 1;
|
|
|
285
|
|
|
286 strcpy (out, in);
|
|
|
287
|
|
|
288 #ifdef VMS
|
|
|
289 /* Is it already a directory string? */
|
|
|
290 if (in[size] == ':' || in[size] == ']' || in[size] == '>')
|
|
|
291 return out;
|
|
|
292 /* Is it a VMS directory file name? If so, hack VMS syntax. */
|
|
|
293 else if (! index (in, '/')
|
|
|
294 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
|
|
|
295 || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
|
|
|
296 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
|
|
|
297 || ! strncmp (&in[size - 5], ".dir", 4))
|
|
|
298 && (in[size - 1] == '.' || in[size - 1] == ';')
|
|
|
299 && in[size] == '1')))
|
|
|
300 {
|
|
|
301 register char *p, *dot;
|
|
|
302 char brack;
|
|
|
303
|
|
|
304 /* x.dir -> [.x]
|
|
|
305 dir:x.dir --> dir:[x]
|
|
|
306 dir:[x]y.dir --> dir:[x.y] */
|
|
|
307 p = in + size;
|
|
|
308 while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
|
|
|
309 if (p != in)
|
|
|
310 {
|
|
|
311 strncpy (out, in, p - in);
|
|
|
312 out[p - in] = '\0';
|
|
|
313 if (*p == ':')
|
|
|
314 {
|
|
|
315 brack = ']';
|
|
|
316 strcat (out, ":[");
|
|
|
317 }
|
|
|
318 else
|
|
|
319 {
|
|
|
320 brack = *p;
|
|
|
321 strcat (out, ".");
|
|
|
322 }
|
|
|
323 p++;
|
|
|
324 }
|
|
|
325 else
|
|
|
326 {
|
|
|
327 brack = ']';
|
|
|
328 strcpy (out, "[.");
|
|
|
329 }
|
|
372
|
330 dot = index (p, '.');
|
|
|
331 if (dot)
|
|
230
|
332 {
|
|
|
333 /* blindly remove any extension */
|
|
|
334 size = strlen (out) + (dot - p);
|
|
|
335 strncat (out, p, dot - p);
|
|
|
336 }
|
|
|
337 else
|
|
|
338 {
|
|
|
339 strcat (out, p);
|
|
|
340 size = strlen (out);
|
|
|
341 }
|
|
|
342 out[size++] = brack;
|
|
|
343 out[size] = '\0';
|
|
|
344 }
|
|
|
345 #else /* not VMS */
|
|
|
346 /* For Unix syntax, Append a slash if necessary */
|
|
|
347 if (out[size] != '/')
|
|
|
348 strcat (out, "/");
|
|
|
349 #endif /* not VMS */
|
|
|
350 return out;
|
|
|
351 }
|
|
|
352
|
|
|
353 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
|
|
|
354 Sfile_name_as_directory, 1, 1, 0,
|
|
|
355 "Return a string representing file FILENAME interpreted as a directory.\n\
|
|
|
356 This operation exists because a directory is also a file, but its name as\n\
|
|
|
357 a directory is different from its name as a file.\n\
|
|
|
358 The result can be used as the value of `default-directory'\n\
|
|
|
359 or passed as second argument to `expand-file-name'.\n\
|
|
|
360 For a Unix-syntax file name, just appends a slash.\n\
|
|
|
361 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
|
|
|
362 (file)
|
|
|
363 Lisp_Object file;
|
|
|
364 {
|
|
|
365 char *buf;
|
|
1105
|
366 Lisp_Object handler;
|
|
230
|
367
|
|
|
368 CHECK_STRING (file, 0);
|
|
485
|
369 if (NILP (file))
|
|
230
|
370 return Qnil;
|
|
1105
|
371
|
|
|
372 /* If the file name has special constructs in it,
|
|
|
373 call the corresponding file handler. */
|
|
1679
|
374 handler = Ffind_file_name_handler (file);
|
|
1105
|
375 if (!NILP (handler))
|
|
|
376 return call2 (handler, Qfile_name_as_directory, file);
|
|
|
377
|
|
230
|
378 buf = (char *) alloca (XSTRING (file)->size + 10);
|
|
|
379 return build_string (file_name_as_directory (buf, XSTRING (file)->data));
|
|
|
380 }
|
|
|
381
|
|
|
382 /*
|
|
|
383 * Convert from directory name to filename.
|
|
|
384 * On VMS:
|
|
|
385 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
|
|
|
386 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
|
|
|
387 * On UNIX, it's simple: just make sure there is a terminating /
|
|
|
388
|
|
|
389 * Value is nonzero if the string output is different from the input.
|
|
|
390 */
|
|
|
391
|
|
|
392 directory_file_name (src, dst)
|
|
|
393 char *src, *dst;
|
|
|
394 {
|
|
|
395 long slen;
|
|
|
396 #ifdef VMS
|
|
|
397 long rlen;
|
|
|
398 char * ptr, * rptr;
|
|
|
399 char bracket;
|
|
|
400 struct FAB fab = cc$rms_fab;
|
|
|
401 struct NAM nam = cc$rms_nam;
|
|
|
402 char esa[NAM$C_MAXRSS];
|
|
|
403 #endif /* VMS */
|
|
|
404
|
|
|
405 slen = strlen (src);
|
|
|
406 #ifdef VMS
|
|
|
407 if (! index (src, '/')
|
|
|
408 && (src[slen - 1] == ']'
|
|
|
409 || src[slen - 1] == ':'
|
|
|
410 || src[slen - 1] == '>'))
|
|
|
411 {
|
|
|
412 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
|
|
|
413 fab.fab$l_fna = src;
|
|
|
414 fab.fab$b_fns = slen;
|
|
|
415 fab.fab$l_nam = &nam;
|
|
|
416 fab.fab$l_fop = FAB$M_NAM;
|
|
|
417
|
|
|
418 nam.nam$l_esa = esa;
|
|
|
419 nam.nam$b_ess = sizeof esa;
|
|
|
420 nam.nam$b_nop |= NAM$M_SYNCHK;
|
|
|
421
|
|
|
422 /* We call SYS$PARSE to handle such things as [--] for us. */
|
|
|
423 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL)
|
|
|
424 {
|
|
|
425 slen = nam.nam$b_esl;
|
|
|
426 if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
|
|
|
427 slen -= 2;
|
|
|
428 esa[slen] = '\0';
|
|
|
429 src = esa;
|
|
|
430 }
|
|
|
431 if (src[slen - 1] != ']' && src[slen - 1] != '>')
|
|
|
432 {
|
|
|
433 /* what about when we have logical_name:???? */
|
|
|
434 if (src[slen - 1] == ':')
|
|
|
435 { /* Xlate logical name and see what we get */
|
|
|
436 ptr = strcpy (dst, src); /* upper case for getenv */
|
|
|
437 while (*ptr)
|
|
|
438 {
|
|
|
439 if ('a' <= *ptr && *ptr <= 'z')
|
|
|
440 *ptr -= 040;
|
|
|
441 ptr++;
|
|
|
442 }
|
|
|
443 dst[slen - 1] = 0; /* remove colon */
|
|
|
444 if (!(src = egetenv (dst)))
|
|
|
445 return 0;
|
|
|
446 /* should we jump to the beginning of this procedure?
|
|
|
447 Good points: allows us to use logical names that xlate
|
|
|
448 to Unix names,
|
|
|
449 Bad points: can be a problem if we just translated to a device
|
|
|
450 name...
|
|
|
451 For now, I'll punt and always expect VMS names, and hope for
|
|
|
452 the best! */
|
|
|
453 slen = strlen (src);
|
|
|
454 if (src[slen - 1] != ']' && src[slen - 1] != '>')
|
|
|
455 { /* no recursion here! */
|
|
|
456 strcpy (dst, src);
|
|
|
457 return 0;
|
|
|
458 }
|
|
|
459 }
|
|
|
460 else
|
|
|
461 { /* not a directory spec */
|
|
|
462 strcpy (dst, src);
|
|
|
463 return 0;
|
|
|
464 }
|
|
|
465 }
|
|
|
466 bracket = src[slen - 1];
|
|
|
467
|
|
|
468 /* If bracket is ']' or '>', bracket - 2 is the corresponding
|
|
|
469 opening bracket. */
|
|
372
|
470 ptr = index (src, bracket - 2);
|
|
|
471 if (ptr == 0)
|
|
230
|
472 { /* no opening bracket */
|
|
|
473 strcpy (dst, src);
|
|
|
474 return 0;
|
|
|
475 }
|
|
|
476 if (!(rptr = rindex (src, '.')))
|
|
|
477 rptr = ptr;
|
|
|
478 slen = rptr - src;
|
|
|
479 strncpy (dst, src, slen);
|
|
|
480 dst[slen] = '\0';
|
|
|
481 if (*rptr == '.')
|
|
|
482 {
|
|
|
483 dst[slen++] = bracket;
|
|
|
484 dst[slen] = '\0';
|
|
|
485 }
|
|
|
486 else
|
|
|
487 {
|
|
|
488 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
|
|
|
489 then translate the device and recurse. */
|
|
|
490 if (dst[slen - 1] == ':'
|
|
|
491 && dst[slen - 2] != ':' /* skip decnet nodes */
|
|
|
492 && strcmp(src + slen, "[000000]") == 0)
|
|
|
493 {
|
|
|
494 dst[slen - 1] = '\0';
|
|
|
495 if ((ptr = egetenv (dst))
|
|
|
496 && (rlen = strlen (ptr) - 1) > 0
|
|
|
497 && (ptr[rlen] == ']' || ptr[rlen] == '>')
|
|
|
498 && ptr[rlen - 1] == '.')
|
|
|
499 {
|
|
1358
|
500 char * buf = (char *) alloca (strlen (ptr) + 1);
|
|
|
501 strcpy (buf, ptr);
|
|
|
502 buf[rlen - 1] = ']';
|
|
|
503 buf[rlen] = '\0';
|
|
|
504 return directory_file_name (buf, dst);
|
|
230
|
505 }
|
|
|
506 else
|
|
|
507 dst[slen - 1] = ':';
|
|
|
508 }
|
|
|
509 strcat (dst, "[000000]");
|
|
|
510 slen += 8;
|
|
|
511 }
|
|
|
512 rptr++;
|
|
|
513 rlen = strlen (rptr) - 1;
|
|
|
514 strncat (dst, rptr, rlen);
|
|
|
515 dst[slen + rlen] = '\0';
|
|
|
516 strcat (dst, ".DIR.1");
|
|
|
517 return 1;
|
|
|
518 }
|
|
|
519 #endif /* VMS */
|
|
|
520 /* Process as Unix format: just remove any final slash.
|
|
|
521 But leave "/" unchanged; do not change it to "". */
|
|
|
522 strcpy (dst, src);
|
|
621
|
523 if (slen > 1 && dst[slen - 1] == '/')
|
|
230
|
524 dst[slen - 1] = 0;
|
|
|
525 return 1;
|
|
|
526 }
|
|
|
527
|
|
|
528 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
|
|
|
529 1, 1, 0,
|
|
|
530 "Returns the file name of the directory named DIR.\n\
|
|
|
531 This is the name of the file that holds the data for the directory DIR.\n\
|
|
|
532 This operation exists because a directory is also a file, but its name as\n\
|
|
|
533 a directory is different from its name as a file.\n\
|
|
|
534 In Unix-syntax, this function just removes the final slash.\n\
|
|
|
535 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
|
|
|
536 it returns a file name such as \"[X]Y.DIR.1\".")
|
|
|
537 (directory)
|
|
|
538 Lisp_Object directory;
|
|
|
539 {
|
|
|
540 char *buf;
|
|
1105
|
541 Lisp_Object handler;
|
|
230
|
542
|
|
|
543 CHECK_STRING (directory, 0);
|
|
|
544
|
|
485
|
545 if (NILP (directory))
|
|
230
|
546 return Qnil;
|
|
1105
|
547
|
|
|
548 /* If the file name has special constructs in it,
|
|
|
549 call the corresponding file handler. */
|
|
1679
|
550 handler = Ffind_file_name_handler (directory);
|
|
1105
|
551 if (!NILP (handler))
|
|
|
552 return call2 (handler, Qdirectory_file_name, directory);
|
|
|
553
|
|
230
|
554 #ifdef VMS
|
|
|
555 /* 20 extra chars is insufficient for VMS, since we might perform a
|
|
|
556 logical name translation. an equivalence string can be up to 255
|
|
|
557 chars long, so grab that much extra space... - sss */
|
|
|
558 buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
|
|
|
559 #else
|
|
|
560 buf = (char *) alloca (XSTRING (directory)->size + 20);
|
|
|
561 #endif
|
|
|
562 directory_file_name (XSTRING (directory)->data, buf);
|
|
|
563 return build_string (buf);
|
|
|
564 }
|
|
|
565
|
|
|
566 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
|
|
|
567 "Generate temporary file name (string) starting with PREFIX (a string).\n\
|
|
|
568 The Emacs process number forms part of the result,\n\
|
|
|
569 so there is no danger of generating a name being used by another process.")
|
|
|
570 (prefix)
|
|
|
571 Lisp_Object prefix;
|
|
|
572 {
|
|
|
573 Lisp_Object val;
|
|
|
574 val = concat2 (prefix, build_string ("XXXXXX"));
|
|
|
575 mktemp (XSTRING (val)->data);
|
|
|
576 return val;
|
|
|
577 }
|
|
|
578
|
|
|
579 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
|
|
|
580 "Convert FILENAME to absolute, and canonicalize it.\n\
|
|
|
581 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
|
|
|
582 (does not start with slash); if DEFAULT is nil or missing,\n\
|
|
|
583 the current buffer's value of default-directory is used.\n\
|
|
536
|
584 Path components that are `.' are removed, and \n\
|
|
|
585 path components followed by `..' are removed, along with the `..' itself;\n\
|
|
|
586 note that these simplifications are done without checking the resulting\n\
|
|
|
587 paths in the file system.\n\
|
|
|
588 An initial `~/' expands to your home directory.\n\
|
|
|
589 An initial `~USER/' expands to USER's home directory.\n\
|
|
230
|
590 See also the function `substitute-in-file-name'.")
|
|
|
591 (name, defalt)
|
|
|
592 Lisp_Object name, defalt;
|
|
|
593 {
|
|
|
594 unsigned char *nm;
|
|
|
595
|
|
|
596 register unsigned char *newdir, *p, *o;
|
|
|
597 int tlen;
|
|
|
598 unsigned char *target;
|
|
|
599 struct passwd *pw;
|
|
|
600 #ifdef VMS
|
|
|
601 unsigned char * colon = 0;
|
|
|
602 unsigned char * close = 0;
|
|
|
603 unsigned char * slash = 0;
|
|
|
604 unsigned char * brack = 0;
|
|
|
605 int lbrack = 0, rbrack = 0;
|
|
|
606 int dots = 0;
|
|
|
607 #endif /* VMS */
|
|
1105
|
608 Lisp_Object handler;
|
|
230
|
609
|
|
|
610 CHECK_STRING (name, 0);
|
|
|
611
|
|
1105
|
612 /* If the file name has special constructs in it,
|
|
|
613 call the corresponding file handler. */
|
|
1679
|
614 handler = Ffind_file_name_handler (name);
|
|
1105
|
615 if (!NILP (handler))
|
|
1178
|
616 return call3 (handler, Qexpand_file_name, name, defalt);
|
|
1105
|
617
|
|
1869
|
618 /* Make sure DEFALT is properly expanded.
|
|
|
619 It would be better to do this down below where we actually use
|
|
|
620 defalt. Unfortunately, calling Fexpand_file_name recursively
|
|
|
621 could invoke GC, and the strings might be relocated. This would
|
|
|
622 be annoying because we have pointers into strings lying around
|
|
|
623 that would need adjusting, and people would add new pointers to
|
|
|
624 the code and forget to adjust them, resulting in intermittent bugs.
|
|
|
625 Putting this call here avoids all that crud. */
|
|
|
626 if (! NILP (defalt))
|
|
|
627 {
|
|
|
628 struct gcpro gcpro1;
|
|
|
629
|
|
|
630 GCPRO1 (name);
|
|
|
631 defalt = Fexpand_file_name (defalt, Qnil);
|
|
|
632 UNGCPRO;
|
|
|
633 }
|
|
|
634
|
|
230
|
635 #ifdef VMS
|
|
|
636 /* Filenames on VMS are always upper case. */
|
|
|
637 name = Fupcase (name);
|
|
|
638 #endif
|
|
|
639
|
|
|
640 nm = XSTRING (name)->data;
|
|
|
641
|
|
|
642 /* If nm is absolute, flush ...// and detect /./ and /../.
|
|
|
643 If no /./ or /../ we can return right away. */
|
|
|
644 if (
|
|
|
645 nm[0] == '/'
|
|
|
646 #ifdef VMS
|
|
|
647 || index (nm, ':')
|
|
|
648 #endif /* VMS */
|
|
|
649 )
|
|
|
650 {
|
|
1869
|
651 /* If it turns out that the filename we want to return is just a
|
|
|
652 suffix of FILENAME, we don't need to go through and edit
|
|
|
653 things; we just need to construct a new string using data
|
|
|
654 starting at the middle of FILENAME. If we set lose to a
|
|
|
655 non-zero value, that means we've discovered that we can't do
|
|
|
656 that cool trick. */
|
|
|
657 int lose = 0;
|
|
|
658
|
|
230
|
659 p = nm;
|
|
|
660 while (*p)
|
|
|
661 {
|
|
1589
|
662 /* Since we know the path is absolute, we can assume that each
|
|
|
663 element starts with a "/". */
|
|
|
664
|
|
|
665 /* "//" anywhere isn't necessarily hairy; we just start afresh
|
|
|
666 with the second slash. */
|
|
230
|
667 if (p[0] == '/' && p[1] == '/'
|
|
|
668 #ifdef APOLLO
|
|
|
669 /* // at start of filename is meaningful on Apollo system */
|
|
|
670 && nm != p
|
|
|
671 #endif /* APOLLO */
|
|
|
672 )
|
|
|
673 nm = p + 1;
|
|
1589
|
674
|
|
|
675 /* "~" is hairy as the start of any path element. */
|
|
230
|
676 if (p[0] == '/' && p[1] == '~')
|
|
|
677 nm = p + 1, lose = 1;
|
|
1589
|
678
|
|
|
679 /* "." and ".." are hairy. */
|
|
|
680 if (p[0] == '/'
|
|
|
681 && p[1] == '.'
|
|
|
682 && (p[2] == '/'
|
|
|
683 || p[2] == 0
|
|
|
684 || (p[2] == '.' && (p[3] == '/'
|
|
|
685 || p[3] == 0))))
|
|
230
|
686 lose = 1;
|
|
|
687 #ifdef VMS
|
|
|
688 if (p[0] == '\\')
|
|
|
689 lose = 1;
|
|
|
690 if (p[0] == '/') {
|
|
|
691 /* if dev:[dir]/, move nm to / */
|
|
|
692 if (!slash && p > nm && (brack || colon)) {
|
|
|
693 nm = (brack ? brack + 1 : colon + 1);
|
|
|
694 lbrack = rbrack = 0;
|
|
|
695 brack = 0;
|
|
|
696 colon = 0;
|
|
|
697 }
|
|
|
698 slash = p;
|
|
|
699 }
|
|
|
700 if (p[0] == '-')
|
|
|
701 #ifndef VMS4_4
|
|
|
702 /* VMS pre V4.4,convert '-'s in filenames. */
|
|
|
703 if (lbrack == rbrack)
|
|
|
704 {
|
|
|
705 if (dots < 2) /* this is to allow negative version numbers */
|
|
|
706 p[0] = '_';
|
|
|
707 }
|
|
|
708 else
|
|
|
709 #endif /* VMS4_4 */
|
|
|
710 if (lbrack > rbrack &&
|
|
|
711 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
|
|
|
712 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
|
|
|
713 lose = 1;
|
|
|
714 #ifndef VMS4_4
|
|
|
715 else
|
|
|
716 p[0] = '_';
|
|
|
717 #endif /* VMS4_4 */
|
|
|
718 /* count open brackets, reset close bracket pointer */
|
|
|
719 if (p[0] == '[' || p[0] == '<')
|
|
|
720 lbrack++, brack = 0;
|
|
|
721 /* count close brackets, set close bracket pointer */
|
|
|
722 if (p[0] == ']' || p[0] == '>')
|
|
|
723 rbrack++, brack = p;
|
|
|
724 /* detect ][ or >< */
|
|
|
725 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
|
|
|
726 lose = 1;
|
|
|
727 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
|
|
|
728 nm = p + 1, lose = 1;
|
|
|
729 if (p[0] == ':' && (colon || slash))
|
|
|
730 /* if dev1:[dir]dev2:, move nm to dev2: */
|
|
|
731 if (brack)
|
|
|
732 {
|
|
|
733 nm = brack + 1;
|
|
|
734 brack = 0;
|
|
|
735 }
|
|
|
736 /* if /pathname/dev:, move nm to dev: */
|
|
|
737 else if (slash)
|
|
|
738 nm = slash + 1;
|
|
|
739 /* if node::dev:, move colon following dev */
|
|
|
740 else if (colon && colon[-1] == ':')
|
|
|
741 colon = p;
|
|
|
742 /* if dev1:dev2:, move nm to dev2: */
|
|
|
743 else if (colon && colon[-1] != ':')
|
|
|
744 {
|
|
|
745 nm = colon + 1;
|
|
|
746 colon = 0;
|
|
|
747 }
|
|
|
748 if (p[0] == ':' && !colon)
|
|
|
749 {
|
|
|
750 if (p[1] == ':')
|
|
|
751 p++;
|
|
|
752 colon = p;
|
|
|
753 }
|
|
|
754 if (lbrack == rbrack)
|
|
|
755 if (p[0] == ';')
|
|
|
756 dots = 2;
|
|
|
757 else if (p[0] == '.')
|
|
|
758 dots++;
|
|
|
759 #endif /* VMS */
|
|
|
760 p++;
|
|
|
761 }
|
|
|
762 if (!lose)
|
|
|
763 {
|
|
|
764 #ifdef VMS
|
|
|
765 if (index (nm, '/'))
|
|
|
766 return build_string (sys_translate_unix (nm));
|
|
|
767 #endif /* VMS */
|
|
|
768 if (nm == XSTRING (name)->data)
|
|
|
769 return name;
|
|
|
770 return build_string (nm);
|
|
|
771 }
|
|
|
772 }
|
|
|
773
|
|
|
774 /* Now determine directory to start with and put it in newdir */
|
|
|
775
|
|
|
776 newdir = 0;
|
|
|
777
|
|
|
778 if (nm[0] == '~') /* prefix ~ */
|
|
1589
|
779 {
|
|
|
780 if (nm[1] == '/'
|
|
230
|
781 #ifdef VMS
|
|
1589
|
782 || nm[1] == ':'
|
|
|
783 #endif /* VMS */
|
|
|
784 || nm[1] == 0) /* ~ by itself */
|
|
|
785 {
|
|
|
786 if (!(newdir = (unsigned char *) egetenv ("HOME")))
|
|
|
787 newdir = (unsigned char *) "";
|
|
|
788 nm++;
|
|
230
|
789 #ifdef VMS
|
|
1589
|
790 nm++; /* Don't leave the slash in nm. */
|
|
|
791 #endif /* VMS */
|
|
|
792 }
|
|
|
793 else /* ~user/filename */
|
|
|
794 {
|
|
|
795 for (p = nm; *p && (*p != '/'
|
|
230
|
796 #ifdef VMS
|
|
1589
|
797 && *p != ':'
|
|
|
798 #endif /* VMS */
|
|
|
799 ); p++);
|
|
|
800 o = (unsigned char *) alloca (p - nm + 1);
|
|
|
801 bcopy ((char *) nm, o, p - nm);
|
|
|
802 o [p - nm] = 0;
|
|
|
803
|
|
|
804 pw = (struct passwd *) getpwnam (o + 1);
|
|
|
805 if (pw)
|
|
|
806 {
|
|
|
807 newdir = (unsigned char *) pw -> pw_dir;
|
|
230
|
808 #ifdef VMS
|
|
1589
|
809 nm = p + 1; /* skip the terminator */
|
|
230
|
810 #else
|
|
1589
|
811 nm = p;
|
|
|
812 #endif /* VMS */
|
|
|
813 }
|
|
|
814
|
|
|
815 /* If we don't find a user of that name, leave the name
|
|
|
816 unchanged; don't move nm forward to p. */
|
|
|
817 }
|
|
|
818 }
|
|
230
|
819
|
|
|
820 if (nm[0] != '/'
|
|
|
821 #ifdef VMS
|
|
|
822 && !index (nm, ':')
|
|
|
823 #endif /* not VMS */
|
|
|
824 && !newdir)
|
|
|
825 {
|
|
485
|
826 if (NILP (defalt))
|
|
230
|
827 defalt = current_buffer->directory;
|
|
|
828 CHECK_STRING (defalt, 1);
|
|
|
829 newdir = XSTRING (defalt)->data;
|
|
|
830 }
|
|
|
831
|
|
372
|
832 if (newdir != 0)
|
|
|
833 {
|
|
|
834 /* Get rid of any slash at the end of newdir. */
|
|
|
835 int length = strlen (newdir);
|
|
|
836 if (newdir[length - 1] == '/')
|
|
|
837 {
|
|
|
838 unsigned char *temp = (unsigned char *) alloca (length);
|
|
|
839 bcopy (newdir, temp, length - 1);
|
|
|
840 temp[length - 1] = 0;
|
|
|
841 newdir = temp;
|
|
|
842 }
|
|
|
843 tlen = length + 1;
|
|
|
844 }
|
|
|
845 else
|
|
|
846 tlen = 0;
|
|
230
|
847
|
|
372
|
848 /* Now concatenate the directory and name to new space in the stack frame */
|
|
|
849 tlen += strlen (nm) + 1;
|
|
230
|
850 target = (unsigned char *) alloca (tlen);
|
|
|
851 *target = 0;
|
|
|
852
|
|
|
853 if (newdir)
|
|
|
854 {
|
|
|
855 #ifndef VMS
|
|
|
856 if (nm[0] == 0 || nm[0] == '/')
|
|
|
857 strcpy (target, newdir);
|
|
|
858 else
|
|
|
859 #endif
|
|
1589
|
860 file_name_as_directory (target, newdir);
|
|
230
|
861 }
|
|
|
862
|
|
|
863 strcat (target, nm);
|
|
|
864 #ifdef VMS
|
|
|
865 if (index (target, '/'))
|
|
|
866 strcpy (target, sys_translate_unix (target));
|
|
|
867 #endif /* VMS */
|
|
|
868
|
|
1589
|
869 /* Now canonicalize by removing /. and /foo/.. if they appear. */
|
|
230
|
870
|
|
|
871 p = target;
|
|
|
872 o = target;
|
|
|
873
|
|
|
874 while (*p)
|
|
|
875 {
|
|
|
876 #ifdef VMS
|
|
|
877 if (*p != ']' && *p != '>' && *p != '-')
|
|
|
878 {
|
|
|
879 if (*p == '\\')
|
|
|
880 p++;
|
|
|
881 *o++ = *p++;
|
|
|
882 }
|
|
|
883 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
|
|
|
884 /* brackets are offset from each other by 2 */
|
|
|
885 {
|
|
|
886 p += 2;
|
|
|
887 if (*p != '.' && *p != '-' && o[-1] != '.')
|
|
|
888 /* convert [foo][bar] to [bar] */
|
|
|
889 while (o[-1] != '[' && o[-1] != '<')
|
|
|
890 o--;
|
|
|
891 else if (*p == '-' && *o != '.')
|
|
|
892 *--p = '.';
|
|
|
893 }
|
|
|
894 else if (p[0] == '-' && o[-1] == '.' &&
|
|
|
895 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
|
|
|
896 /* flush .foo.- ; leave - if stopped by '[' or '<' */
|
|
|
897 {
|
|
|
898 do
|
|
|
899 o--;
|
|
|
900 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
|
|
|
901 if (p[1] == '.') /* foo.-.bar ==> bar*/
|
|
|
902 p += 2;
|
|
|
903 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
|
|
|
904 p++, o--;
|
|
|
905 /* else [foo.-] ==> [-] */
|
|
|
906 }
|
|
|
907 else
|
|
|
908 {
|
|
|
909 #ifndef VMS4_4
|
|
|
910 if (*p == '-' &&
|
|
|
911 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
|
|
|
912 p[1] != ']' && p[1] != '>' && p[1] != '.')
|
|
|
913 *p = '_';
|
|
|
914 #endif /* VMS4_4 */
|
|
|
915 *o++ = *p++;
|
|
|
916 }
|
|
|
917 #else /* not VMS */
|
|
|
918 if (*p != '/')
|
|
|
919 {
|
|
|
920 *o++ = *p++;
|
|
|
921 }
|
|
|
922 else if (!strncmp (p, "//", 2)
|
|
|
923 #ifdef APOLLO
|
|
|
924 /* // at start of filename is meaningful in Apollo system */
|
|
|
925 && o != target
|
|
|
926 #endif /* APOLLO */
|
|
|
927 )
|
|
|
928 {
|
|
|
929 o = target;
|
|
|
930 p++;
|
|
|
931 }
|
|
1589
|
932 else if (p[0] == '/'
|
|
|
933 && p[1] == '.'
|
|
|
934 && (p[2] == '/'
|
|
|
935 || p[2] == 0))
|
|
|
936 {
|
|
|
937 /* If "/." is the entire filename, keep the "/". Otherwise,
|
|
|
938 just delete the whole "/.". */
|
|
|
939 if (o == target && p[2] == '\0')
|
|
|
940 *o++ = *p;
|
|
|
941 p += 2;
|
|
|
942 }
|
|
230
|
943 else if (!strncmp (p, "/..", 3)
|
|
|
944 /* `/../' is the "superroot" on certain file systems. */
|
|
|
945 && o != target
|
|
|
946 && (p[3] == '/' || p[3] == 0))
|
|
|
947 {
|
|
|
948 while (o != target && *--o != '/')
|
|
|
949 ;
|
|
|
950 #ifdef APOLLO
|
|
|
951 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
|
|
|
952 ++o;
|
|
|
953 else
|
|
|
954 #endif /* APOLLO */
|
|
|
955 if (o == target && *o == '/')
|
|
|
956 ++o;
|
|
|
957 p += 3;
|
|
|
958 }
|
|
|
959 else
|
|
|
960 {
|
|
|
961 *o++ = *p++;
|
|
|
962 }
|
|
|
963 #endif /* not VMS */
|
|
|
964 }
|
|
|
965
|
|
|
966 return make_string (target, o - target);
|
|
|
967 }
|
|
|
968 #if 0
|
|
732
|
969 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
|
|
|
970 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
|
|
230
|
971 "Convert FILENAME to absolute, and canonicalize it.\n\
|
|
|
972 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
|
|
|
973 (does not start with slash); if DEFAULT is nil or missing,\n\
|
|
|
974 the current buffer's value of default-directory is used.\n\
|
|
|
975 Filenames containing `.' or `..' as components are simplified;\n\
|
|
|
976 initial `~/' expands to your home directory.\n\
|
|
|
977 See also the function `substitute-in-file-name'.")
|
|
|
978 (name, defalt)
|
|
|
979 Lisp_Object name, defalt;
|
|
|
980 {
|
|
|
981 unsigned char *nm;
|
|
|
982
|
|
|
983 register unsigned char *newdir, *p, *o;
|
|
|
984 int tlen;
|
|
|
985 unsigned char *target;
|
|
|
986 struct passwd *pw;
|
|
|
987 int lose;
|
|
|
988 #ifdef VMS
|
|
|
989 unsigned char * colon = 0;
|
|
|
990 unsigned char * close = 0;
|
|
|
991 unsigned char * slash = 0;
|
|
|
992 unsigned char * brack = 0;
|
|
|
993 int lbrack = 0, rbrack = 0;
|
|
|
994 int dots = 0;
|
|
|
995 #endif /* VMS */
|
|
|
996
|
|
|
997 CHECK_STRING (name, 0);
|
|
|
998
|
|
|
999 #ifdef VMS
|
|
|
1000 /* Filenames on VMS are always upper case. */
|
|
|
1001 name = Fupcase (name);
|
|
|
1002 #endif
|
|
|
1003
|
|
|
1004 nm = XSTRING (name)->data;
|
|
|
1005
|
|
|
1006 /* If nm is absolute, flush ...// and detect /./ and /../.
|
|
|
1007 If no /./ or /../ we can return right away. */
|
|
|
1008 if (
|
|
|
1009 nm[0] == '/'
|
|
|
1010 #ifdef VMS
|
|
|
1011 || index (nm, ':')
|
|
|
1012 #endif /* VMS */
|
|
|
1013 )
|
|
|
1014 {
|
|
|
1015 p = nm;
|
|
|
1016 lose = 0;
|
|
|
1017 while (*p)
|
|
|
1018 {
|
|
|
1019 if (p[0] == '/' && p[1] == '/'
|
|
|
1020 #ifdef APOLLO
|
|
|
1021 /* // at start of filename is meaningful on Apollo system */
|
|
|
1022 && nm != p
|
|
|
1023 #endif /* APOLLO */
|
|
|
1024 )
|
|
|
1025 nm = p + 1;
|
|
|
1026 if (p[0] == '/' && p[1] == '~')
|
|
|
1027 nm = p + 1, lose = 1;
|
|
|
1028 if (p[0] == '/' && p[1] == '.'
|
|
|
1029 && (p[2] == '/' || p[2] == 0
|
|
|
1030 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
|
|
|
1031 lose = 1;
|
|
|
1032 #ifdef VMS
|
|
|
1033 if (p[0] == '\\')
|
|
|
1034 lose = 1;
|
|
|
1035 if (p[0] == '/') {
|
|
|
1036 /* if dev:[dir]/, move nm to / */
|
|
|
1037 if (!slash && p > nm && (brack || colon)) {
|
|
|
1038 nm = (brack ? brack + 1 : colon + 1);
|
|
|
1039 lbrack = rbrack = 0;
|
|
|
1040 brack = 0;
|
|
|
1041 colon = 0;
|
|
|
1042 }
|
|
|
1043 slash = p;
|
|
|
1044 }
|
|
|
1045 if (p[0] == '-')
|
|
|
1046 #ifndef VMS4_4
|
|
|
1047 /* VMS pre V4.4,convert '-'s in filenames. */
|
|
|
1048 if (lbrack == rbrack)
|
|
|
1049 {
|
|
|
1050 if (dots < 2) /* this is to allow negative version numbers */
|
|
|
1051 p[0] = '_';
|
|
|
1052 }
|
|
|
1053 else
|
|
|
1054 #endif /* VMS4_4 */
|
|
|
1055 if (lbrack > rbrack &&
|
|
|
1056 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
|
|
|
1057 (p[1] == '.' || p[1] == ']' || p[1] == '>')))
|
|
|
1058 lose = 1;
|
|
|
1059 #ifndef VMS4_4
|
|
|
1060 else
|
|
|
1061 p[0] = '_';
|
|
|
1062 #endif /* VMS4_4 */
|
|
|
1063 /* count open brackets, reset close bracket pointer */
|
|
|
1064 if (p[0] == '[' || p[0] == '<')
|
|
|
1065 lbrack++, brack = 0;
|
|
|
1066 /* count close brackets, set close bracket pointer */
|
|
|
1067 if (p[0] == ']' || p[0] == '>')
|
|
|
1068 rbrack++, brack = p;
|
|
|
1069 /* detect ][ or >< */
|
|
|
1070 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
|
|
|
1071 lose = 1;
|
|
|
1072 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
|
|
|
1073 nm = p + 1, lose = 1;
|
|
|
1074 if (p[0] == ':' && (colon || slash))
|
|
|
1075 /* if dev1:[dir]dev2:, move nm to dev2: */
|
|
|
1076 if (brack)
|
|
|
1077 {
|
|
|
1078 nm = brack + 1;
|
|
|
1079 brack = 0;
|
|
|
1080 }
|
|
|
1081 /* if /pathname/dev:, move nm to dev: */
|
|
|
1082 else if (slash)
|
|
|
1083 nm = slash + 1;
|
|
|
1084 /* if node::dev:, move colon following dev */
|
|
|
1085 else if (colon && colon[-1] == ':')
|
|
|
1086 colon = p;
|
|
|
1087 /* if dev1:dev2:, move nm to dev2: */
|
|
|
1088 else if (colon && colon[-1] != ':')
|
|
|
1089 {
|
|
|
1090 nm = colon + 1;
|
|
|
1091 colon = 0;
|
|
|
1092 }
|
|
|
1093 if (p[0] == ':' && !colon)
|
|
|
1094 {
|
|
|
1095 if (p[1] == ':')
|
|
|
1096 p++;
|
|
|
1097 colon = p;
|
|
|
1098 }
|
|
|
1099 if (lbrack == rbrack)
|
|
|
1100 if (p[0] == ';')
|
|
|
1101 dots = 2;
|
|
|
1102 else if (p[0] == '.')
|
|
|
1103 dots++;
|
|
|
1104 #endif /* VMS */
|
|
|
1105 p++;
|
|
|
1106 }
|
|
|
1107 if (!lose)
|
|
|
1108 {
|
|
|
1109 #ifdef VMS
|
|
|
1110 if (index (nm, '/'))
|
|
|
1111 return build_string (sys_translate_unix (nm));
|
|
|
1112 #endif /* VMS */
|
|
|
1113 if (nm == XSTRING (name)->data)
|
|
|
1114 return name;
|
|
|
1115 return build_string (nm);
|
|
|
1116 }
|
|
|
1117 }
|
|
|
1118
|
|
|
1119 /* Now determine directory to start with and put it in NEWDIR */
|
|
|
1120
|
|
|
1121 newdir = 0;
|
|
|
1122
|
|
|
1123 if (nm[0] == '~') /* prefix ~ */
|
|
|
1124 if (nm[1] == '/'
|
|
|
1125 #ifdef VMS
|
|
|
1126 || nm[1] == ':'
|
|
|
1127 #endif /* VMS */
|
|
|
1128 || nm[1] == 0)/* ~/filename */
|
|
|
1129 {
|
|
|
1130 if (!(newdir = (unsigned char *) egetenv ("HOME")))
|
|
|
1131 newdir = (unsigned char *) "";
|
|
|
1132 nm++;
|
|
|
1133 #ifdef VMS
|
|
|
1134 nm++; /* Don't leave the slash in nm. */
|
|
|
1135 #endif /* VMS */
|
|
|
1136 }
|
|
|
1137 else /* ~user/filename */
|
|
|
1138 {
|
|
|
1139 /* Get past ~ to user */
|
|
|
1140 unsigned char *user = nm + 1;
|
|
|
1141 /* Find end of name. */
|
|
|
1142 unsigned char *ptr = (unsigned char *) index (user, '/');
|
|
|
1143 int len = ptr ? ptr - user : strlen (user);
|
|
|
1144 #ifdef VMS
|
|
|
1145 unsigned char *ptr1 = index (user, ':');
|
|
|
1146 if (ptr1 != 0 && ptr1 - user < len)
|
|
|
1147 len = ptr1 - user;
|
|
|
1148 #endif /* VMS */
|
|
|
1149 /* Copy the user name into temp storage. */
|
|
|
1150 o = (unsigned char *) alloca (len + 1);
|
|
|
1151 bcopy ((char *) user, o, len);
|
|
|
1152 o[len] = 0;
|
|
|
1153
|
|
|
1154 /* Look up the user name. */
|
|
|
1155 pw = (struct passwd *) getpwnam (o + 1);
|
|
|
1156 if (!pw)
|
|
|
1157 error ("\"%s\" isn't a registered user", o + 1);
|
|
|
1158
|
|
|
1159 newdir = (unsigned char *) pw->pw_dir;
|
|
|
1160
|
|
|
1161 /* Discard the user name from NM. */
|
|
|
1162 nm += len;
|
|
|
1163 }
|
|
|
1164
|
|
|
1165 if (nm[0] != '/'
|
|
|
1166 #ifdef VMS
|
|
|
1167 && !index (nm, ':')
|
|
|
1168 #endif /* not VMS */
|
|
|
1169 && !newdir)
|
|
|
1170 {
|
|
485
|
1171 if (NILP (defalt))
|
|
230
|
1172 defalt = current_buffer->directory;
|
|
|
1173 CHECK_STRING (defalt, 1);
|
|
|
1174 newdir = XSTRING (defalt)->data;
|
|
|
1175 }
|
|
|
1176
|
|
|
1177 /* Now concatenate the directory and name to new space in the stack frame */
|
|
|
1178
|
|
|
1179 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
|
|
|
1180 target = (unsigned char *) alloca (tlen);
|
|
|
1181 *target = 0;
|
|
|
1182
|
|
|
1183 if (newdir)
|
|
|
1184 {
|
|
|
1185 #ifndef VMS
|
|
|
1186 if (nm[0] == 0 || nm[0] == '/')
|
|
|
1187 strcpy (target, newdir);
|
|
|
1188 else
|
|
|
1189 #endif
|
|
|
1190 file_name_as_directory (target, newdir);
|
|
|
1191 }
|
|
|
1192
|
|
|
1193 strcat (target, nm);
|
|
|
1194 #ifdef VMS
|
|
|
1195 if (index (target, '/'))
|
|
|
1196 strcpy (target, sys_translate_unix (target));
|
|
|
1197 #endif /* VMS */
|
|
|
1198
|
|
|
1199 /* Now canonicalize by removing /. and /foo/.. if they appear */
|
|
|
1200
|
|
|
1201 p = target;
|
|
|
1202 o = target;
|
|
|
1203
|
|
|
1204 while (*p)
|
|
|
1205 {
|
|
|
1206 #ifdef VMS
|
|
|
1207 if (*p != ']' && *p != '>' && *p != '-')
|
|
|
1208 {
|
|
|
1209 if (*p == '\\')
|
|
|
1210 p++;
|
|
|
1211 *o++ = *p++;
|
|
|
1212 }
|
|
|
1213 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
|
|
|
1214 /* brackets are offset from each other by 2 */
|
|
|
1215 {
|
|
|
1216 p += 2;
|
|
|
1217 if (*p != '.' && *p != '-' && o[-1] != '.')
|
|
|
1218 /* convert [foo][bar] to [bar] */
|
|
|
1219 while (o[-1] != '[' && o[-1] != '<')
|
|
|
1220 o--;
|
|
|
1221 else if (*p == '-' && *o != '.')
|
|
|
1222 *--p = '.';
|
|
|
1223 }
|
|
|
1224 else if (p[0] == '-' && o[-1] == '.' &&
|
|
|
1225 (p[1] == '.' || p[1] == ']' || p[1] == '>'))
|
|
|
1226 /* flush .foo.- ; leave - if stopped by '[' or '<' */
|
|
|
1227 {
|
|
|
1228 do
|
|
|
1229 o--;
|
|
|
1230 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
|
|
|
1231 if (p[1] == '.') /* foo.-.bar ==> bar*/
|
|
|
1232 p += 2;
|
|
|
1233 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
|
|
|
1234 p++, o--;
|
|
|
1235 /* else [foo.-] ==> [-] */
|
|
|
1236 }
|
|
|
1237 else
|
|
|
1238 {
|
|
|
1239 #ifndef VMS4_4
|
|
|
1240 if (*p == '-' &&
|
|
|
1241 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
|
|
|
1242 p[1] != ']' && p[1] != '>' && p[1] != '.')
|
|
|
1243 *p = '_';
|
|
|
1244 #endif /* VMS4_4 */
|
|
|
1245 *o++ = *p++;
|
|
|
1246 }
|
|
|
1247 #else /* not VMS */
|
|
|
1248 if (*p != '/')
|
|
|
1249 {
|
|
|
1250 *o++ = *p++;
|
|
|
1251 }
|
|
|
1252 else if (!strncmp (p, "//", 2)
|
|
|
1253 #ifdef APOLLO
|
|
|
1254 /* // at start of filename is meaningful in Apollo system */
|
|
|
1255 && o != target
|
|
|
1256 #endif /* APOLLO */
|
|
|
1257 )
|
|
|
1258 {
|
|
|
1259 o = target;
|
|
|
1260 p++;
|
|
|
1261 }
|
|
|
1262 else if (p[0] == '/' && p[1] == '.' &&
|
|
|
1263 (p[2] == '/' || p[2] == 0))
|
|
|
1264 p += 2;
|
|
|
1265 else if (!strncmp (p, "/..", 3)
|
|
|
1266 /* `/../' is the "superroot" on certain file systems. */
|
|
|
1267 && o != target
|
|
|
1268 && (p[3] == '/' || p[3] == 0))
|
|
|
1269 {
|
|
|
1270 while (o != target && *--o != '/')
|
|
|
1271 ;
|
|
|
1272 #ifdef APOLLO
|
|
|
1273 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
|
|
|
1274 ++o;
|
|
|
1275 else
|
|
|
1276 #endif /* APOLLO */
|
|
|
1277 if (o == target && *o == '/')
|
|
|
1278 ++o;
|
|
|
1279 p += 3;
|
|
|
1280 }
|
|
|
1281 else
|
|
|
1282 {
|
|
|
1283 *o++ = *p++;
|
|
|
1284 }
|
|
|
1285 #endif /* not VMS */
|
|
|
1286 }
|
|
|
1287
|
|
|
1288 return make_string (target, o - target);
|
|
|
1289 }
|
|
|
1290 #endif
|
|
|
1291
|
|
|
1292 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
|
|
|
1293 Ssubstitute_in_file_name, 1, 1, 0,
|
|
|
1294 "Substitute environment variables referred to in FILENAME.\n\
|
|
|
1295 `$FOO' where FOO is an environment variable name means to substitute\n\
|
|
|
1296 the value of that variable. The variable name should be terminated\n\
|
|
|
1297 with a character not a letter, digit or underscore; otherwise, enclose\n\
|
|
|
1298 the entire variable name in braces.\n\
|
|
|
1299 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
|
|
|
1300 On VMS, `$' substitution is not done; this function does little and only\n\
|
|
|
1301 duplicates what `expand-file-name' does.")
|
|
|
1302 (string)
|
|
|
1303 Lisp_Object string;
|
|
|
1304 {
|
|
|
1305 unsigned char *nm;
|
|
|
1306
|
|
|
1307 register unsigned char *s, *p, *o, *x, *endp;
|
|
|
1308 unsigned char *target;
|
|
|
1309 int total = 0;
|
|
|
1310 int substituted = 0;
|
|
|
1311 unsigned char *xnm;
|
|
|
1312
|
|
|
1313 CHECK_STRING (string, 0);
|
|
|
1314
|
|
|
1315 nm = XSTRING (string)->data;
|
|
|
1316 endp = nm + XSTRING (string)->size;
|
|
|
1317
|
|
|
1318 /* If /~ or // appears, discard everything through first slash. */
|
|
|
1319
|
|
|
1320 for (p = nm; p != endp; p++)
|
|
|
1321 {
|
|
|
1322 if ((p[0] == '~' ||
|
|
|
1323 #ifdef APOLLO
|
|
|
1324 /* // at start of file name is meaningful in Apollo system */
|
|
|
1325 (p[0] == '/' && p - 1 != nm)
|
|
|
1326 #else /* not APOLLO */
|
|
|
1327 p[0] == '/'
|
|
|
1328 #endif /* not APOLLO */
|
|
|
1329 )
|
|
|
1330 && p != nm &&
|
|
|
1331 #ifdef VMS
|
|
|
1332 (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' ||
|
|
|
1333 #endif /* VMS */
|
|
|
1334 p[-1] == '/')
|
|
|
1335 #ifdef VMS
|
|
|
1336 )
|
|
|
1337 #endif /* VMS */
|
|
|
1338 {
|
|
|
1339 nm = p;
|
|
|
1340 substituted = 1;
|
|
|
1341 }
|
|
|
1342 }
|
|
|
1343
|
|
|
1344 #ifdef VMS
|
|
|
1345 return build_string (nm);
|
|
|
1346 #else
|
|
|
1347
|
|
|
1348 /* See if any variables are substituted into the string
|
|
|
1349 and find the total length of their values in `total' */
|
|
|
1350
|
|
|
1351 for (p = nm; p != endp;)
|
|
|
1352 if (*p != '$')
|
|
|
1353 p++;
|
|
|
1354 else
|
|
|
1355 {
|
|
|
1356 p++;
|
|
|
1357 if (p == endp)
|
|
|
1358 goto badsubst;
|
|
|
1359 else if (*p == '$')
|
|
|
1360 {
|
|
|
1361 /* "$$" means a single "$" */
|
|
|
1362 p++;
|
|
|
1363 total -= 1;
|
|
|
1364 substituted = 1;
|
|
|
1365 continue;
|
|
|
1366 }
|
|
|
1367 else if (*p == '{')
|
|
|
1368 {
|
|
|
1369 o = ++p;
|
|
|
1370 while (p != endp && *p != '}') p++;
|
|
|
1371 if (*p != '}') goto missingclose;
|
|
|
1372 s = p;
|
|
|
1373 }
|
|
|
1374 else
|
|
|
1375 {
|
|
|
1376 o = p;
|
|
|
1377 while (p != endp && (isalnum (*p) || *p == '_')) p++;
|
|
|
1378 s = p;
|
|
|
1379 }
|
|
|
1380
|
|
|
1381 /* Copy out the variable name */
|
|
|
1382 target = (unsigned char *) alloca (s - o + 1);
|
|
|
1383 strncpy (target, o, s - o);
|
|
|
1384 target[s - o] = 0;
|
|
|
1385
|
|
|
1386 /* Get variable value */
|
|
|
1387 o = (unsigned char *) egetenv (target);
|
|
|
1388 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
|
|
|
1389 #if 0
|
|
|
1390 #ifdef USG
|
|
|
1391 if (!o && !strcmp (target, "USER"))
|
|
|
1392 o = egetenv ("LOGNAME");
|
|
|
1393 #endif /* USG */
|
|
|
1394 #endif /* 0 */
|
|
|
1395 if (!o) goto badvar;
|
|
|
1396 total += strlen (o);
|
|
|
1397 substituted = 1;
|
|
|
1398 }
|
|
|
1399
|
|
|
1400 if (!substituted)
|
|
|
1401 return string;
|
|
|
1402
|
|
|
1403 /* If substitution required, recopy the string and do it */
|
|
|
1404 /* Make space in stack frame for the new copy */
|
|
|
1405 xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
|
|
|
1406 x = xnm;
|
|
|
1407
|
|
|
1408 /* Copy the rest of the name through, replacing $ constructs with values */
|
|
|
1409 for (p = nm; *p;)
|
|
|
1410 if (*p != '$')
|
|
|
1411 *x++ = *p++;
|
|
|
1412 else
|
|
|
1413 {
|
|
|
1414 p++;
|
|
|
1415 if (p == endp)
|
|
|
1416 goto badsubst;
|
|
|
1417 else if (*p == '$')
|
|
|
1418 {
|
|
|
1419 *x++ = *p++;
|
|
|
1420 continue;
|
|
|
1421 }
|
|
|
1422 else if (*p == '{')
|
|
|
1423 {
|
|
|
1424 o = ++p;
|
|
|
1425 while (p != endp && *p != '}') p++;
|
|
|
1426 if (*p != '}') goto missingclose;
|
|
|
1427 s = p++;
|
|
|
1428 }
|
|
|
1429 else
|
|
|
1430 {
|
|
|
1431 o = p;
|
|
|
1432 while (p != endp && (isalnum (*p) || *p == '_')) p++;
|
|
|
1433 s = p;
|
|
|
1434 }
|
|
|
1435
|
|
|
1436 /* Copy out the variable name */
|
|
|
1437 target = (unsigned char *) alloca (s - o + 1);
|
|
|
1438 strncpy (target, o, s - o);
|
|
|
1439 target[s - o] = 0;
|
|
|
1440
|
|
|
1441 /* Get variable value */
|
|
|
1442 o = (unsigned char *) egetenv (target);
|
|
|
1443 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
|
|
|
1444 #if 0
|
|
|
1445 #ifdef USG
|
|
|
1446 if (!o && !strcmp (target, "USER"))
|
|
|
1447 o = egetenv ("LOGNAME");
|
|
|
1448 #endif /* USG */
|
|
|
1449 #endif /* 0 */
|
|
|
1450 if (!o)
|
|
|
1451 goto badvar;
|
|
|
1452
|
|
|
1453 strcpy (x, o);
|
|
|
1454 x += strlen (o);
|
|
|
1455 }
|
|
|
1456
|
|
|
1457 *x = 0;
|
|
|
1458
|
|
|
1459 /* If /~ or // appears, discard everything through first slash. */
|
|
|
1460
|
|
|
1461 for (p = xnm; p != x; p++)
|
|
|
1462 if ((p[0] == '~' ||
|
|
|
1463 #ifdef APOLLO
|
|
|
1464 /* // at start of file name is meaningful in Apollo system */
|
|
|
1465 (p[0] == '/' && p - 1 != xnm)
|
|
|
1466 #else /* not APOLLO */
|
|
|
1467 p[0] == '/'
|
|
|
1468 #endif /* not APOLLO */
|
|
|
1469 )
|
|
|
1470 && p != nm && p[-1] == '/')
|
|
|
1471 xnm = p;
|
|
|
1472
|
|
|
1473 return make_string (xnm, x - xnm);
|
|
|
1474
|
|
|
1475 badsubst:
|
|
|
1476 error ("Bad format environment-variable substitution");
|
|
|
1477 missingclose:
|
|
|
1478 error ("Missing \"}\" in environment-variable substitution");
|
|
|
1479 badvar:
|
|
|
1480 error ("Substituting nonexistent environment variable \"%s\"", target);
|
|
|
1481
|
|
|
1482 /* NOTREACHED */
|
|
|
1483 #endif /* not VMS */
|
|
|
1484 }
|
|
|
1485
|
|
853
|
1486 /* A slightly faster and more convenient way to get
|
|
|
1487 (directory-file-name (expand-file-name FOO)). The return value may
|
|
|
1488 have had its last character zapped with a '\0' character, meaning
|
|
|
1489 that it is acceptable to system calls, but not to other lisp
|
|
|
1490 functions. Callers should make sure that the return value doesn't
|
|
|
1491 escape. */
|
|
|
1492
|
|
230
|
1493 Lisp_Object
|
|
|
1494 expand_and_dir_to_file (filename, defdir)
|
|
|
1495 Lisp_Object filename, defdir;
|
|
|
1496 {
|
|
|
1497 register Lisp_Object abspath;
|
|
|
1498
|
|
|
1499 abspath = Fexpand_file_name (filename, defdir);
|
|
|
1500 #ifdef VMS
|
|
|
1501 {
|
|
|
1502 register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1];
|
|
|
1503 if (c == ':' || c == ']' || c == '>')
|
|
|
1504 abspath = Fdirectory_file_name (abspath);
|
|
|
1505 }
|
|
|
1506 #else
|
|
|
1507 /* Remove final slash, if any (unless path is root).
|
|
|
1508 stat behaves differently depending! */
|
|
|
1509 if (XSTRING (abspath)->size > 1
|
|
|
1510 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
|
|
|
1511 {
|
|
|
1512 if (EQ (abspath, filename))
|
|
|
1513 abspath = Fcopy_sequence (abspath);
|
|
|
1514 XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
|
|
|
1515 }
|
|
|
1516 #endif
|
|
|
1517 return abspath;
|
|
|
1518 }
|
|
|
1519
|
|
|
1520 barf_or_query_if_file_exists (absname, querystring, interactive)
|
|
|
1521 Lisp_Object absname;
|
|
|
1522 unsigned char *querystring;
|
|
|
1523 int interactive;
|
|
|
1524 {
|
|
|
1525 register Lisp_Object tem;
|
|
|
1526 struct gcpro gcpro1;
|
|
|
1527
|
|
|
1528 if (access (XSTRING (absname)->data, 4) >= 0)
|
|
|
1529 {
|
|
|
1530 if (! interactive)
|
|
|
1531 Fsignal (Qfile_already_exists,
|
|
|
1532 Fcons (build_string ("File already exists"),
|
|
|
1533 Fcons (absname, Qnil)));
|
|
|
1534 GCPRO1 (absname);
|
|
|
1535 tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
|
|
|
1536 XSTRING (absname)->data, querystring));
|
|
|
1537 UNGCPRO;
|
|
485
|
1538 if (NILP (tem))
|
|
230
|
1539 Fsignal (Qfile_already_exists,
|
|
|
1540 Fcons (build_string ("File already exists"),
|
|
|
1541 Fcons (absname, Qnil)));
|
|
|
1542 }
|
|
|
1543 return;
|
|
|
1544 }
|
|
|
1545
|
|
|
1546 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
|
|
410
|
1547 "fCopy file: \nFCopy %s to file: \np\nP",
|
|
230
|
1548 "Copy FILE to NEWNAME. Both args must be strings.\n\
|
|
|
1549 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
|
|
|
1550 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
|
|
|
1551 A number as third arg means request confirmation if NEWNAME already exists.\n\
|
|
|
1552 This is what happens in interactive use with M-x.\n\
|
|
410
|
1553 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
|
|
|
1554 last-modified time as the old one. (This works on only some systems.)\n\
|
|
|
1555 A prefix arg makes KEEP-TIME non-nil.")
|
|
230
|
1556 (filename, newname, ok_if_already_exists, keep_date)
|
|
|
1557 Lisp_Object filename, newname, ok_if_already_exists, keep_date;
|
|
|
1558 {
|
|
|
1559 int ifd, ofd, n;
|
|
|
1560 char buf[16 * 1024];
|
|
|
1561 struct stat st;
|
|
843
|
1562 Lisp_Object handler;
|
|
230
|
1563 struct gcpro gcpro1, gcpro2;
|
|
592
|
1564 int count = specpdl_ptr - specpdl;
|
|
230
|
1565
|
|
|
1566 GCPRO2 (filename, newname);
|
|
|
1567 CHECK_STRING (filename, 0);
|
|
|
1568 CHECK_STRING (newname, 1);
|
|
|
1569 filename = Fexpand_file_name (filename, Qnil);
|
|
|
1570 newname = Fexpand_file_name (newname, Qnil);
|
|
843
|
1571
|
|
1105
|
1572 /* If the input file name has special constructs in it,
|
|
843
|
1573 call the corresponding file handler. */
|
|
1679
|
1574 handler = Ffind_file_name_handler (filename);
|
|
843
|
1575 if (!NILP (handler))
|
|
|
1576 return call3 (handler, Qcopy_file, filename, newname);
|
|
1105
|
1577 /* Likewise for output file name. */
|
|
1679
|
1578 handler = Ffind_file_name_handler (newname);
|
|
1105
|
1579 if (!NILP (handler))
|
|
|
1580 return call3 (handler, Qcopy_file, filename, newname);
|
|
843
|
1581
|
|
485
|
1582 if (NILP (ok_if_already_exists)
|
|
230
|
1583 || XTYPE (ok_if_already_exists) == Lisp_Int)
|
|
|
1584 barf_or_query_if_file_exists (newname, "copy to it",
|
|
|
1585 XTYPE (ok_if_already_exists) == Lisp_Int);
|
|
|
1586
|
|
|
1587 ifd = open (XSTRING (filename)->data, 0);
|
|
|
1588 if (ifd < 0)
|
|
|
1589 report_file_error ("Opening input file", Fcons (filename, Qnil));
|
|
|
1590
|
|
592
|
1591 record_unwind_protect (close_file_unwind, make_number (ifd));
|
|
|
1592
|
|
230
|
1593 #ifdef VMS
|
|
|
1594 /* Create the copy file with the same record format as the input file */
|
|
|
1595 ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
|
|
|
1596 #else
|
|
|
1597 ofd = creat (XSTRING (newname)->data, 0666);
|
|
|
1598 #endif /* VMS */
|
|
|
1599 if (ofd < 0)
|
|
595
|
1600 report_file_error ("Opening output file", Fcons (newname, Qnil));
|
|
230
|
1601
|
|
592
|
1602 record_unwind_protect (close_file_unwind, make_number (ofd));
|
|
|
1603
|
|
|
1604 immediate_quit = 1;
|
|
|
1605 QUIT;
|
|
230
|
1606 while ((n = read (ifd, buf, sizeof buf)) > 0)
|
|
|
1607 if (write (ofd, buf, n) != n)
|
|
595
|
1608 report_file_error ("I/O error", Fcons (newname, Qnil));
|
|
592
|
1609 immediate_quit = 0;
|
|
230
|
1610
|
|
|
1611 if (fstat (ifd, &st) >= 0)
|
|
|
1612 {
|
|
485
|
1613 if (!NILP (keep_date))
|
|
230
|
1614 {
|
|
564
|
1615 EMACS_TIME atime, mtime;
|
|
|
1616 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
|
|
|
1617 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
|
|
|
1618 EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime);
|
|
230
|
1619 }
|
|
|
1620 #ifdef APOLLO
|
|
|
1621 if (!egetenv ("USE_DOMAIN_ACLS"))
|
|
|
1622 #endif
|
|
564
|
1623 chmod (XSTRING (newname)->data, st.st_mode & 07777);
|
|
230
|
1624 }
|
|
|
1625
|
|
592
|
1626 /* Discard the unwind protects. */
|
|
|
1627 specpdl_ptr = specpdl + count;
|
|
|
1628
|
|
230
|
1629 close (ifd);
|
|
|
1630 if (close (ofd) < 0)
|
|
|
1631 report_file_error ("I/O error", Fcons (newname, Qnil));
|
|
|
1632
|
|
|
1633 UNGCPRO;
|
|
|
1634 return Qnil;
|
|
|
1635 }
|
|
|
1636
|
|
1533
|
1637 DEFUN ("make-directory-internal", Fmake_directory_internal,
|
1536
0877009e6324
* fileio.c (Fmake_directory_internal): Remove extra paren before the
Jim Blandy <jimb@redhat.com>
diff
changeset
|
1638 Smake_directory_internal, 1, 1, 0,
|
|
230
|
1639 "Create a directory. One argument, a file name string.")
|
|
|
1640 (dirname)
|
|
|
1641 Lisp_Object dirname;
|
|
|
1642 {
|
|
|
1643 unsigned char *dir;
|
|
843
|
1644 Lisp_Object handler;
|
|
230
|
1645
|
|
|
1646 CHECK_STRING (dirname, 0);
|
|
|
1647 dirname = Fexpand_file_name (dirname, Qnil);
|
|
843
|
1648
|
|
1679
|
1649 handler = Ffind_file_name_handler (dirname);
|
|
843
|
1650 if (!NILP (handler))
|
|
1533
|
1651 return call3 (handler, Qmake_directory, dirname, Qnil);
|
|
|
1652
|
|
230
|
1653 dir = XSTRING (dirname)->data;
|
|
|
1654
|
|
|
1655 if (mkdir (dir, 0777) != 0)
|
|
|
1656 report_file_error ("Creating directory", Flist (1, &dirname));
|
|
|
1657
|
|
843
|
1658 return Qnil;
|
|
230
|
1659 }
|
|
|
1660
|
|
686
|
1661 DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
|
|
|
1662 "Delete a directory. One argument, a file name string.")
|
|
230
|
1663 (dirname)
|
|
|
1664 Lisp_Object dirname;
|
|
|
1665 {
|
|
|
1666 unsigned char *dir;
|
|
843
|
1667 Lisp_Object handler;
|
|
230
|
1668
|
|
|
1669 CHECK_STRING (dirname, 0);
|
|
|
1670 dirname = Fexpand_file_name (dirname, Qnil);
|
|
|
1671 dir = XSTRING (dirname)->data;
|
|
|
1672
|
|
1679
|
1673 handler = Ffind_file_name_handler (dirname);
|
|
843
|
1674 if (!NILP (handler))
|
|
|
1675 return call2 (handler, Qdelete_directory, dirname);
|
|
|
1676
|
|
230
|
1677 if (rmdir (dir) != 0)
|
|
|
1678 report_file_error ("Removing directory", Flist (1, &dirname));
|
|
|
1679
|
|
|
1680 return Qnil;
|
|
|
1681 }
|
|
|
1682
|
|
|
1683 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
|
|
|
1684 "Delete specified file. One argument, a file name string.\n\
|
|
|
1685 If file has multiple names, it continues to exist with the other names.")
|
|
|
1686 (filename)
|
|
|
1687 Lisp_Object filename;
|
|
|
1688 {
|
|
843
|
1689 Lisp_Object handler;
|
|
230
|
1690 CHECK_STRING (filename, 0);
|
|
|
1691 filename = Fexpand_file_name (filename, Qnil);
|
|
843
|
1692
|
|
1679
|
1693 handler = Ffind_file_name_handler (filename);
|
|
843
|
1694 if (!NILP (handler))
|
|
|
1695 return call2 (handler, Qdelete_file, filename);
|
|
|
1696
|
|
230
|
1697 if (0 > unlink (XSTRING (filename)->data))
|
|
|
1698 report_file_error ("Removing old name", Flist (1, &filename));
|
|
|
1699 return Qnil;
|
|
|
1700 }
|
|
|
1701
|
|
|
1702 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
|
|
|
1703 "fRename file: \nFRename %s to file: \np",
|
|
|
1704 "Rename FILE as NEWNAME. Both args strings.\n\
|
|
|
1705 If file has names other than FILE, it continues to have those names.\n\
|
|
|
1706 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
|
|
|
1707 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
|
|
|
1708 A number as third arg means request confirmation if NEWNAME already exists.\n\
|
|
|
1709 This is what happens in interactive use with M-x.")
|
|
|
1710 (filename, newname, ok_if_already_exists)
|
|
|
1711 Lisp_Object filename, newname, ok_if_already_exists;
|
|
|
1712 {
|
|
|
1713 #ifdef NO_ARG_ARRAY
|
|
|
1714 Lisp_Object args[2];
|
|
|
1715 #endif
|
|
843
|
1716 Lisp_Object handler;
|
|
230
|
1717 struct gcpro gcpro1, gcpro2;
|
|
|
1718
|
|
|
1719 GCPRO2 (filename, newname);
|
|
|
1720 CHECK_STRING (filename, 0);
|
|
|
1721 CHECK_STRING (newname, 1);
|
|
|
1722 filename = Fexpand_file_name (filename, Qnil);
|
|
|
1723 newname = Fexpand_file_name (newname, Qnil);
|
|
843
|
1724
|
|
|
1725 /* If the file name has special constructs in it,
|
|
|
1726 call the corresponding file handler. */
|
|
1679
|
1727 handler = Ffind_file_name_handler (filename);
|
|
843
|
1728 if (!NILP (handler))
|
|
|
1729 return call3 (handler, Qrename_file, filename, newname);
|
|
|
1730
|
|
485
|
1731 if (NILP (ok_if_already_exists)
|
|
230
|
1732 || XTYPE (ok_if_already_exists) == Lisp_Int)
|
|
|
1733 barf_or_query_if_file_exists (newname, "rename to it",
|
|
|
1734 XTYPE (ok_if_already_exists) == Lisp_Int);
|
|
|
1735 #ifndef BSD4_1
|
|
|
1736 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
|
|
|
1737 #else
|
|
|
1738 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
|
|
|
1739 || 0 > unlink (XSTRING (filename)->data))
|
|
|
1740 #endif
|
|
|
1741 {
|
|
|
1742 if (errno == EXDEV)
|
|
|
1743 {
|
|
|
1744 Fcopy_file (filename, newname, ok_if_already_exists, Qt);
|
|
|
1745 Fdelete_file (filename);
|
|
|
1746 }
|
|
|
1747 else
|
|
|
1748 #ifdef NO_ARG_ARRAY
|
|
|
1749 {
|
|
|
1750 args[0] = filename;
|
|
|
1751 args[1] = newname;
|
|
|
1752 report_file_error ("Renaming", Flist (2, args));
|
|
|
1753 }
|
|
|
1754 #else
|
|
|
1755 report_file_error ("Renaming", Flist (2, &filename));
|
|
|
1756 #endif
|
|
|
1757 }
|
|
|
1758 UNGCPRO;
|
|
|
1759 return Qnil;
|
|
|
1760 }
|
|
|
1761
|
|
|
1762 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
|
|
|
1763 "fAdd name to file: \nFName to add to %s: \np",
|
|
|
1764 "Give FILE additional name NEWNAME. Both args strings.\n\
|
|
|
1765 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
|
|
|
1766 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
|
|
|
1767 A number as third arg means request confirmation if NEWNAME already exists.\n\
|
|
|
1768 This is what happens in interactive use with M-x.")
|
|
|
1769 (filename, newname, ok_if_already_exists)
|
|
|
1770 Lisp_Object filename, newname, ok_if_already_exists;
|
|
|
1771 {
|
|
|
1772 #ifdef NO_ARG_ARRAY
|
|
|
1773 Lisp_Object args[2];
|
|
|
1774 #endif
|
|
843
|
1775 Lisp_Object handler;
|
|
230
|
1776 struct gcpro gcpro1, gcpro2;
|
|
|
1777
|
|
|
1778 GCPRO2 (filename, newname);
|
|
|
1779 CHECK_STRING (filename, 0);
|
|
|
1780 CHECK_STRING (newname, 1);
|
|
|
1781 filename = Fexpand_file_name (filename, Qnil);
|
|
|
1782 newname = Fexpand_file_name (newname, Qnil);
|
|
843
|
1783
|
|
|
1784 /* If the file name has special constructs in it,
|
|
|
1785 call the corresponding file handler. */
|
|
1679
|
1786 handler = Ffind_file_name_handler (filename);
|
|
843
|
1787 if (!NILP (handler))
|
|
|
1788 return call3 (handler, Qadd_name_to_file, filename, newname);
|
|
|
1789
|
|
485
|
1790 if (NILP (ok_if_already_exists)
|
|
230
|
1791 || XTYPE (ok_if_already_exists) == Lisp_Int)
|
|
|
1792 barf_or_query_if_file_exists (newname, "make it a new name",
|
|
|
1793 XTYPE (ok_if_already_exists) == Lisp_Int);
|
|
|
1794 unlink (XSTRING (newname)->data);
|
|
|
1795 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
|
|
|
1796 {
|
|
|
1797 #ifdef NO_ARG_ARRAY
|
|
|
1798 args[0] = filename;
|
|
|
1799 args[1] = newname;
|
|
|
1800 report_file_error ("Adding new name", Flist (2, args));
|
|
|
1801 #else
|
|
|
1802 report_file_error ("Adding new name", Flist (2, &filename));
|
|
|
1803 #endif
|
|
|
1804 }
|
|
|
1805
|
|
|
1806 UNGCPRO;
|
|
|
1807 return Qnil;
|
|
|
1808 }
|
|
|
1809
|
|
|
1810 #ifdef S_IFLNK
|
|
|
1811 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
|
|
|
1812 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
|
|
|
1813 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
|
|
|
1814 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
|
|
|
1815 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
|
|
|
1816 A number as third arg means request confirmation if NEWNAME already exists.\n\
|
|
|
1817 This happens for interactive use with M-x.")
|
|
732
|
1818 (filename, linkname, ok_if_already_exists)
|
|
|
1819 Lisp_Object filename, linkname, ok_if_already_exists;
|
|
230
|
1820 {
|
|
|
1821 #ifdef NO_ARG_ARRAY
|
|
|
1822 Lisp_Object args[2];
|
|
|
1823 #endif
|
|
843
|
1824 Lisp_Object handler;
|
|
230
|
1825 struct gcpro gcpro1, gcpro2;
|
|
|
1826
|
|
732
|
1827 GCPRO2 (filename, linkname);
|
|
230
|
1828 CHECK_STRING (filename, 0);
|
|
732
|
1829 CHECK_STRING (linkname, 1);
|
|
230
|
1830 #if 0 /* This made it impossible to make a link to a relative name. */
|
|
|
1831 filename = Fexpand_file_name (filename, Qnil);
|
|
|
1832 #endif
|
|
732
|
1833 linkname = Fexpand_file_name (linkname, Qnil);
|
|
843
|
1834
|
|
|
1835 /* If the file name has special constructs in it,
|
|
|
1836 call the corresponding file handler. */
|
|
1679
|
1837 handler = Ffind_file_name_handler (filename);
|
|
843
|
1838 if (!NILP (handler))
|
|
848
|
1839 return call3 (handler, Qmake_symbolic_link, filename, linkname);
|
|
843
|
1840
|
|
485
|
1841 if (NILP (ok_if_already_exists)
|
|
230
|
1842 || XTYPE (ok_if_already_exists) == Lisp_Int)
|
|
732
|
1843 barf_or_query_if_file_exists (linkname, "make it a link",
|
|
230
|
1844 XTYPE (ok_if_already_exists) == Lisp_Int);
|
|
732
|
1845 if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
|
|
230
|
1846 {
|
|
|
1847 /* If we didn't complain already, silently delete existing file. */
|
|
|
1848 if (errno == EEXIST)
|
|
|
1849 {
|
|
|
1850 unlink (XSTRING (filename)->data);
|
|
732
|
1851 if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
|
|
230
|
1852 return Qnil;
|
|
|
1853 }
|
|
|
1854
|
|
|
1855 #ifdef NO_ARG_ARRAY
|
|
|
1856 args[0] = filename;
|
|
732
|
1857 args[1] = linkname;
|
|
230
|
1858 report_file_error ("Making symbolic link", Flist (2, args));
|
|
|
1859 #else
|
|
|
1860 report_file_error ("Making symbolic link", Flist (2, &filename));
|
|
|
1861 #endif
|
|
|
1862 }
|
|
|
1863 UNGCPRO;
|
|
|
1864 return Qnil;
|
|
|
1865 }
|
|
|
1866 #endif /* S_IFLNK */
|
|
|
1867
|
|
|
1868 #ifdef VMS
|
|
|
1869
|
|
|
1870 DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
|
|
|
1871 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
|
|
|
1872 "Define the job-wide logical name NAME to have the value STRING.\n\
|
|
|
1873 If STRING is nil or a null string, the logical name NAME is deleted.")
|
|
|
1874 (varname, string)
|
|
|
1875 Lisp_Object varname;
|
|
|
1876 Lisp_Object string;
|
|
|
1877 {
|
|
|
1878 CHECK_STRING (varname, 0);
|
|
485
|
1879 if (NILP (string))
|
|
230
|
1880 delete_logical_name (XSTRING (varname)->data);
|
|
|
1881 else
|
|
|
1882 {
|
|
|
1883 CHECK_STRING (string, 1);
|
|
|
1884
|
|
|
1885 if (XSTRING (string)->size == 0)
|
|
|
1886 delete_logical_name (XSTRING (varname)->data);
|
|
|
1887 else
|
|
|
1888 define_logical_name (XSTRING (varname)->data, XSTRING (string)->data);
|
|
|
1889 }
|
|
|
1890
|
|
|
1891 return string;
|
|
|
1892 }
|
|
|
1893 #endif /* VMS */
|
|
|
1894
|
|
|
1895 #ifdef HPUX_NET
|
|
|
1896
|
|
|
1897 DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
|
|
|
1898 "Open a network connection to PATH using LOGIN as the login string.")
|
|
|
1899 (path, login)
|
|
|
1900 Lisp_Object path, login;
|
|
|
1901 {
|
|
|
1902 int netresult;
|
|
|
1903
|
|
|
1904 CHECK_STRING (path, 0);
|
|
|
1905 CHECK_STRING (login, 0);
|
|
|
1906
|
|
|
1907 netresult = netunam (XSTRING (path)->data, XSTRING (login)->data);
|
|
|
1908
|
|
|
1909 if (netresult == -1)
|
|
|
1910 return Qnil;
|
|
|
1911 else
|
|
|
1912 return Qt;
|
|
|
1913 }
|
|
|
1914 #endif /* HPUX_NET */
|
|
|
1915
|
|
|
1916 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
|
|
|
1917 1, 1, 0,
|
|
|
1918 "Return t if file FILENAME specifies an absolute path name.\n\
|
|
|
1919 On Unix, this is a name starting with a `/' or a `~'.")
|
|
|
1920 (filename)
|
|
|
1921 Lisp_Object filename;
|
|
|
1922 {
|
|
|
1923 unsigned char *ptr;
|
|
|
1924
|
|
|
1925 CHECK_STRING (filename, 0);
|
|
|
1926 ptr = XSTRING (filename)->data;
|
|
|
1927 if (*ptr == '/' || *ptr == '~'
|
|
|
1928 #ifdef VMS
|
|
|
1929 /* ??? This criterion is probably wrong for '<'. */
|
|
|
1930 || index (ptr, ':') || index (ptr, '<')
|
|
|
1931 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
|
|
|
1932 && ptr[1] != '.')
|
|
|
1933 #endif /* VMS */
|
|
|
1934 )
|
|
|
1935 return Qt;
|
|
|
1936 else
|
|
|
1937 return Qnil;
|
|
|
1938 }
|
|
|
1939
|
|
|
1940 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
|
|
|
1941 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
|
|
|
1942 See also `file-readable-p' and `file-attributes'.")
|
|
|
1943 (filename)
|
|
|
1944 Lisp_Object filename;
|
|
|
1945 {
|
|
|
1946 Lisp_Object abspath;
|
|
843
|
1947 Lisp_Object handler;
|
|
230
|
1948
|
|
|
1949 CHECK_STRING (filename, 0);
|
|
|
1950 abspath = Fexpand_file_name (filename, Qnil);
|
|
843
|
1951
|
|
|
1952 /* If the file name has special constructs in it,
|
|
|
1953 call the corresponding file handler. */
|
|
1679
|
1954 handler = Ffind_file_name_handler (abspath);
|
|
843
|
1955 if (!NILP (handler))
|
|
1178
|
1956 return call2 (handler, Qfile_exists_p, abspath);
|
|
843
|
1957
|
|
230
|
1958 return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
|
|
|
1959 }
|
|
|
1960
|
|
|
1961 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
|
|
|
1962 "Return t if FILENAME can be executed by you.\n\
|
|
|
1963 For directories this means you can change to that directory.")
|
|
|
1964 (filename)
|
|
|
1965 Lisp_Object filename;
|
|
|
1966
|
|
|
1967 {
|
|
|
1968 Lisp_Object abspath;
|
|
843
|
1969 Lisp_Object handler;
|
|
230
|
1970
|
|
|
1971 CHECK_STRING (filename, 0);
|
|
|
1972 abspath = Fexpand_file_name (filename, Qnil);
|
|
843
|
1973
|
|
|
1974 /* If the file name has special constructs in it,
|
|
|
1975 call the corresponding file handler. */
|
|
1679
|
1976 handler = Ffind_file_name_handler (abspath);
|
|
843
|
1977 if (!NILP (handler))
|
|
1178
|
1978 return call2 (handler, Qfile_executable_p, abspath);
|
|
843
|
1979
|
|
230
|
1980 return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
|
|
|
1981 }
|
|
|
1982
|
|
|
1983 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
|
|
|
1984 "Return t if file FILENAME exists and you can read it.\n\
|
|
|
1985 See also `file-exists-p' and `file-attributes'.")
|
|
|
1986 (filename)
|
|
|
1987 Lisp_Object filename;
|
|
|
1988 {
|
|
|
1989 Lisp_Object abspath;
|
|
843
|
1990 Lisp_Object handler;
|
|
230
|
1991
|
|
|
1992 CHECK_STRING (filename, 0);
|
|
|
1993 abspath = Fexpand_file_name (filename, Qnil);
|
|
843
|
1994
|
|
|
1995 /* If the file name has special constructs in it,
|
|
|
1996 call the corresponding file handler. */
|
|
1679
|
1997 handler = Ffind_file_name_handler (abspath);
|
|
843
|
1998 if (!NILP (handler))
|
|
1178
|
1999 return call2 (handler, Qfile_readable_p, abspath);
|
|
843
|
2000
|
|
230
|
2001 return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
|
|
|
2002 }
|
|
|
2003
|
|
|
2004 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
|
|
|
2005 "If file FILENAME is the name of a symbolic link\n\
|
|
|
2006 returns the name of the file to which it is linked.\n\
|
|
|
2007 Otherwise returns NIL.")
|
|
|
2008 (filename)
|
|
|
2009 Lisp_Object filename;
|
|
|
2010 {
|
|
|
2011 #ifdef S_IFLNK
|
|
|
2012 char *buf;
|
|
|
2013 int bufsize;
|
|
|
2014 int valsize;
|
|
|
2015 Lisp_Object val;
|
|
843
|
2016 Lisp_Object handler;
|
|
230
|
2017
|
|
|
2018 CHECK_STRING (filename, 0);
|
|
|
2019 filename = Fexpand_file_name (filename, Qnil);
|
|
|
2020
|
|
843
|
2021 /* If the file name has special constructs in it,
|
|
|
2022 call the corresponding file handler. */
|
|
1679
|
2023 handler = Ffind_file_name_handler (filename);
|
|
843
|
2024 if (!NILP (handler))
|
|
|
2025 return call2 (handler, Qfile_symlink_p, filename);
|
|
|
2026
|
|
230
|
2027 bufsize = 100;
|
|
|
2028 while (1)
|
|
|
2029 {
|
|
|
2030 buf = (char *) xmalloc (bufsize);
|
|
|
2031 bzero (buf, bufsize);
|
|
|
2032 valsize = readlink (XSTRING (filename)->data, buf, bufsize);
|
|
|
2033 if (valsize < bufsize) break;
|
|
|
2034 /* Buffer was not long enough */
|
|
|
2035 free (buf);
|
|
|
2036 bufsize *= 2;
|
|
|
2037 }
|
|
|
2038 if (valsize == -1)
|
|
|
2039 {
|
|
|
2040 free (buf);
|
|
|
2041 return Qnil;
|
|
|
2042 }
|
|
|
2043 val = make_string (buf, valsize);
|
|
|
2044 free (buf);
|
|
|
2045 return val;
|
|
|
2046 #else /* not S_IFLNK */
|
|
|
2047 return Qnil;
|
|
|
2048 #endif /* not S_IFLNK */
|
|
|
2049 }
|
|
|
2050
|
|
|
2051 /* Having this before file-symlink-p mysteriously caused it to be forgotten
|
|
|
2052 on the RT/PC. */
|
|
|
2053 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
|
|
|
2054 "Return t if file FILENAME can be written or created by you.")
|
|
|
2055 (filename)
|
|
|
2056 Lisp_Object filename;
|
|
|
2057 {
|
|
|
2058 Lisp_Object abspath, dir;
|
|
843
|
2059 Lisp_Object handler;
|
|
230
|
2060
|
|
|
2061 CHECK_STRING (filename, 0);
|
|
|
2062 abspath = Fexpand_file_name (filename, Qnil);
|
|
843
|
2063
|
|
|
2064 /* If the file name has special constructs in it,
|
|
|
2065 call the corresponding file handler. */
|
|
1679
|
2066 handler = Ffind_file_name_handler (abspath);
|
|
843
|
2067 if (!NILP (handler))
|
|
1178
|
2068 return call2 (handler, Qfile_writable_p, abspath);
|
|
843
|
2069
|
|
230
|
2070 if (access (XSTRING (abspath)->data, 0) >= 0)
|
|
|
2071 return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
|
|
|
2072 dir = Ffile_name_directory (abspath);
|
|
|
2073 #ifdef VMS
|
|
485
|
2074 if (!NILP (dir))
|
|
230
|
2075 dir = Fdirectory_file_name (dir);
|
|
|
2076 #endif /* VMS */
|
|
485
|
2077 return (access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
|
|
230
|
2078 ? Qt : Qnil);
|
|
|
2079 }
|
|
|
2080
|
|
|
2081 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
|
|
|
2082 "Return t if file FILENAME is the name of a directory as a file.\n\
|
|
|
2083 A directory name spec may be given instead; then the value is t\n\
|
|
|
2084 if the directory so specified exists and really is a directory.")
|
|
|
2085 (filename)
|
|
|
2086 Lisp_Object filename;
|
|
|
2087 {
|
|
|
2088 register Lisp_Object abspath;
|
|
|
2089 struct stat st;
|
|
843
|
2090 Lisp_Object handler;
|
|
230
|
2091
|
|
|
2092 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
|
|
|
2093
|
|
843
|
2094 /* If the file name has special constructs in it,
|
|
|
2095 call the corresponding file handler. */
|
|
1679
|
2096 handler = Ffind_file_name_handler (abspath);
|
|
843
|
2097 if (!NILP (handler))
|
|
1178
|
2098 return call2 (handler, Qfile_directory_p, abspath);
|
|
843
|
2099
|
|
230
|
2100 if (stat (XSTRING (abspath)->data, &st) < 0)
|
|
|
2101 return Qnil;
|
|
|
2102 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
|
|
|
2103 }
|
|
|
2104
|
|
536
|
2105 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
|
|
|
2106 "Return t if file FILENAME is the name of a directory as a file,\n\
|
|
|
2107 and files in that directory can be opened by you. In order to use a\n\
|
|
|
2108 directory as a buffer's current directory, this predicate must return true.\n\
|
|
|
2109 A directory name spec may be given instead; then the value is t\n\
|
|
|
2110 if the directory so specified exists and really is a readable and\n\
|
|
|
2111 searchable directory.")
|
|
|
2112 (filename)
|
|
|
2113 Lisp_Object filename;
|
|
|
2114 {
|
|
843
|
2115 Lisp_Object handler;
|
|
|
2116
|
|
|
2117 /* If the file name has special constructs in it,
|
|
|
2118 call the corresponding file handler. */
|
|
1679
|
2119 handler = Ffind_file_name_handler (filename);
|
|
843
|
2120 if (!NILP (handler))
|
|
|
2121 return call2 (handler, Qfile_accessible_directory_p, filename);
|
|
|
2122
|
|
536
|
2123 if (NILP (Ffile_directory_p (filename))
|
|
|
2124 || NILP (Ffile_executable_p (filename)))
|
|
|
2125 return Qnil;
|
|
|
2126 else
|
|
|
2127 return Qt;
|
|
|
2128 }
|
|
|
2129
|
|
230
|
2130 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
|
|
|
2131 "Return mode bits of FILE, as an integer.")
|
|
|
2132 (filename)
|
|
|
2133 Lisp_Object filename;
|
|
|
2134 {
|
|
|
2135 Lisp_Object abspath;
|
|
|
2136 struct stat st;
|
|
843
|
2137 Lisp_Object handler;
|
|
230
|
2138
|
|
|
2139 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
|
|
|
2140
|
|
843
|
2141 /* If the file name has special constructs in it,
|
|
|
2142 call the corresponding file handler. */
|
|
1679
|
2143 handler = Ffind_file_name_handler (abspath);
|
|
843
|
2144 if (!NILP (handler))
|
|
1178
|
2145 return call2 (handler, Qfile_modes, abspath);
|
|
843
|
2146
|
|
230
|
2147 if (stat (XSTRING (abspath)->data, &st) < 0)
|
|
|
2148 return Qnil;
|
|
|
2149 return make_number (st.st_mode & 07777);
|
|
|
2150 }
|
|
|
2151
|
|
|
2152 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
|
|
|
2153 "Set mode bits of FILE to MODE (an integer).\n\
|
|
|
2154 Only the 12 low bits of MODE are used.")
|
|
|
2155 (filename, mode)
|
|
|
2156 Lisp_Object filename, mode;
|
|
|
2157 {
|
|
|
2158 Lisp_Object abspath;
|
|
843
|
2159 Lisp_Object handler;
|
|
230
|
2160
|
|
|
2161 abspath = Fexpand_file_name (filename, current_buffer->directory);
|
|
|
2162 CHECK_NUMBER (mode, 1);
|
|
|
2163
|
|
843
|
2164 /* If the file name has special constructs in it,
|
|
|
2165 call the corresponding file handler. */
|
|
1679
|
2166 handler = Ffind_file_name_handler (abspath);
|
|
843
|
2167 if (!NILP (handler))
|
|
1178
|
2168 return call3 (handler, Qset_file_modes, abspath, mode);
|
|
843
|
2169
|
|
230
|
2170 #ifndef APOLLO
|
|
|
2171 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
|
|
|
2172 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
|
|
|
2173 #else /* APOLLO */
|
|
|
2174 if (!egetenv ("USE_DOMAIN_ACLS"))
|
|
|
2175 {
|
|
|
2176 struct stat st;
|
|
|
2177 struct timeval tvp[2];
|
|
|
2178
|
|
|
2179 /* chmod on apollo also change the file's modtime; need to save the
|
|
|
2180 modtime and then restore it. */
|
|
|
2181 if (stat (XSTRING (abspath)->data, &st) < 0)
|
|
|
2182 {
|
|
|
2183 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
|
|
|
2184 return (Qnil);
|
|
|
2185 }
|
|
|
2186
|
|
|
2187 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
|
|
|
2188 report_file_error ("Doing chmod", Fcons (abspath, Qnil));
|
|
|
2189
|
|
|
2190 /* reset the old accessed and modified times. */
|
|
|
2191 tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
|
|
|
2192 tvp[0].tv_usec = 0;
|
|
|
2193 tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
|
|
|
2194 tvp[1].tv_usec = 0;
|
|
|
2195
|
|
|
2196 if (utimes (XSTRING (abspath)->data, tvp) < 0)
|
|
|
2197 report_file_error ("Doing utimes", Fcons (abspath, Qnil));
|
|
|
2198 }
|
|
|
2199 #endif /* APOLLO */
|
|
|
2200
|
|
|
2201 return Qnil;
|
|
|
2202 }
|
|
|
2203
|
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2204 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
|
|
1762
|
2205 "Set the file permission bits for newly created files.\n\
|
|
|
2206 The argument MODE should be an integer; only the low 9 bits are used.\n\
|
|
550
|
2207 This setting is inherited by subprocesses.")
|
|
1762
|
2208 (mode)
|
|
|
2209 Lisp_Object mode;
|
|
550
|
2210 {
|
|
1762
|
2211 CHECK_NUMBER (mode, 0);
|
|
550
|
2212
|
|
1762
|
2213 umask ((~ XINT (mode)) & 0777);
|
|
550
|
2214
|
|
|
2215 return Qnil;
|
|
|
2216 }
|
|
|
2217
|
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2218 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
|
|
1762
|
2219 "Return the default file protection for created files.\n\
|
|
|
2220 The value is an integer.")
|
|
550
|
2221 ()
|
|
|
2222 {
|
|
1762
|
2223 int realmask;
|
|
|
2224 Lisp_Object value;
|
|
|
2225
|
|
|
2226 realmask = umask (0);
|
|
|
2227 umask (realmask);
|
|
|
2228
|
|
|
2229 XSET (value, Lisp_Int, (~ realmask) & 0777);
|
|
|
2230 return value;
|
|
550
|
2231 }
|
|
|
2232
|
|
689
|
2233 #ifdef unix
|
|
|
2234
|
|
|
2235 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
|
|
|
2236 "Tell Unix to finish all pending disk updates.")
|
|
|
2237 ()
|
|
|
2238 {
|
|
|
2239 sync ();
|
|
|
2240 return Qnil;
|
|
|
2241 }
|
|
|
2242
|
|
|
2243 #endif /* unix */
|
|
|
2244
|
|
230
|
2245 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
|
|
|
2246 "Return t if file FILE1 is newer than file FILE2.\n\
|
|
|
2247 If FILE1 does not exist, the answer is nil;\n\
|
|
|
2248 otherwise, if FILE2 does not exist, the answer is t.")
|
|
|
2249 (file1, file2)
|
|
|
2250 Lisp_Object file1, file2;
|
|
|
2251 {
|
|
843
|
2252 Lisp_Object abspath1, abspath2;
|
|
230
|
2253 struct stat st;
|
|
|
2254 int mtime1;
|
|
843
|
2255 Lisp_Object handler;
|
|
1178
|
2256 struct gcpro gcpro1, gcpro2;
|
|
230
|
2257
|
|
|
2258 CHECK_STRING (file1, 0);
|
|
|
2259 CHECK_STRING (file2, 0);
|
|
|
2260
|
|
1178
|
2261 abspath1 = Qnil;
|
|
|
2262 GCPRO2 (abspath1, file2);
|
|
843
|
2263 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
|
|
|
2264 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
|
|
1178
|
2265 UNGCPRO;
|
|
843
|
2266
|
|
|
2267 /* If the file name has special constructs in it,
|
|
|
2268 call the corresponding file handler. */
|
|
1679
|
2269 handler = Ffind_file_name_handler (abspath1);
|
|
843
|
2270 if (!NILP (handler))
|
|
|
2271 return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
|
|
|
2272
|
|
|
2273 if (stat (XSTRING (abspath1)->data, &st) < 0)
|
|
230
|
2274 return Qnil;
|
|
|
2275
|
|
|
2276 mtime1 = st.st_mtime;
|
|
|
2277
|
|
843
|
2278 if (stat (XSTRING (abspath2)->data, &st) < 0)
|
|
230
|
2279 return Qt;
|
|
|
2280
|
|
|
2281 return (mtime1 > st.st_mtime) ? Qt : Qnil;
|
|
|
2282 }
|
|
|
2283
|
|
|
2284 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
|
|
|
2285 1, 2, 0,
|
|
|
2286 "Insert contents of file FILENAME after point.\n\
|
|
|
2287 Returns list of absolute pathname and length of data inserted.\n\
|
|
|
2288 If second argument VISIT is non-nil, the buffer's visited filename\n\
|
|
|
2289 and last save file modtime are set, and it is marked unmodified.\n\
|
|
|
2290 If visiting and the file does not exist, visiting is completed\n\
|
|
|
2291 before the error is signaled.")
|
|
|
2292 (filename, visit)
|
|
|
2293 Lisp_Object filename, visit;
|
|
|
2294 {
|
|
|
2295 struct stat st;
|
|
|
2296 register int fd;
|
|
|
2297 register int inserted = 0;
|
|
|
2298 register int how_much;
|
|
|
2299 int count = specpdl_ptr - specpdl;
|
|
|
2300 struct gcpro gcpro1;
|
|
843
|
2301 Lisp_Object handler, val;
|
|
|
2302
|
|
|
2303 val = Qnil;
|
|
|
2304
|
|
230
|
2305 GCPRO1 (filename);
|
|
485
|
2306 if (!NILP (current_buffer->read_only))
|
|
230
|
2307 Fbarf_if_buffer_read_only();
|
|
|
2308
|
|
|
2309 CHECK_STRING (filename, 0);
|
|
|
2310 filename = Fexpand_file_name (filename, Qnil);
|
|
|
2311
|
|
843
|
2312 /* If the file name has special constructs in it,
|
|
|
2313 call the corresponding file handler. */
|
|
1679
|
2314 handler = Ffind_file_name_handler (filename);
|
|
843
|
2315 if (!NILP (handler))
|
|
|
2316 {
|
|
|
2317 val = call3 (handler, Qinsert_file_contents, filename, visit);
|
|
|
2318 st.st_mtime = 0;
|
|
|
2319 goto handled;
|
|
|
2320 }
|
|
|
2321
|
|
230
|
2322 fd = -1;
|
|
|
2323
|
|
|
2324 #ifndef APOLLO
|
|
|
2325 if (stat (XSTRING (filename)->data, &st) < 0
|
|
410
|
2326 || (fd = open (XSTRING (filename)->data, 0)) < 0)
|
|
230
|
2327 #else
|
|
|
2328 if ((fd = open (XSTRING (filename)->data, 0)) < 0
|
|
|
2329 || fstat (fd, &st) < 0)
|
|
|
2330 #endif /* not APOLLO */
|
|
|
2331 {
|
|
|
2332 if (fd >= 0) close (fd);
|
|
485
|
2333 if (NILP (visit))
|
|
230
|
2334 report_file_error ("Opening input file", Fcons (filename, Qnil));
|
|
|
2335 st.st_mtime = -1;
|
|
|
2336 how_much = 0;
|
|
|
2337 goto notfound;
|
|
|
2338 }
|
|
|
2339
|
|
|
2340 record_unwind_protect (close_file_unwind, make_number (fd));
|
|
|
2341
|
|
752
|
2342 #ifdef S_IFSOCK
|
|
|
2343 /* This code will need to be changed in order to work on named
|
|
|
2344 pipes, and it's probably just not worth it. So we should at
|
|
|
2345 least signal an error. */
|
|
|
2346 if ((st.st_mode & S_IFMT) == S_IFSOCK)
|
|
|
2347 Fsignal (Qfile_error,
|
|
|
2348 Fcons (build_string ("reading from named pipe"),
|
|
|
2349 Fcons (filename, Qnil)));
|
|
|
2350 #endif
|
|
|
2351
|
|
230
|
2352 /* Supposedly happens on VMS. */
|
|
|
2353 if (st.st_size < 0)
|
|
|
2354 error ("File size is negative");
|
|
752
|
2355
|
|
230
|
2356 {
|
|
|
2357 register Lisp_Object temp;
|
|
|
2358
|
|
|
2359 /* Make sure point-max won't overflow after this insertion. */
|
|
|
2360 XSET (temp, Lisp_Int, st.st_size + Z);
|
|
|
2361 if (st.st_size + Z != XINT (temp))
|
|
|
2362 error ("maximum buffer size exceeded");
|
|
|
2363 }
|
|
|
2364
|
|
485
|
2365 if (NILP (visit))
|
|
230
|
2366 prepare_to_modify_buffer (point, point);
|
|
|
2367
|
|
|
2368 move_gap (point);
|
|
|
2369 if (GAP_SIZE < st.st_size)
|
|
|
2370 make_gap (st.st_size - GAP_SIZE);
|
|
|
2371
|
|
|
2372 while (1)
|
|
|
2373 {
|
|
|
2374 int try = min (st.st_size - inserted, 64 << 10);
|
|
592
|
2375 int this;
|
|
|
2376
|
|
|
2377 /* Allow quitting out of the actual I/O. */
|
|
|
2378 immediate_quit = 1;
|
|
|
2379 QUIT;
|
|
|
2380 this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
|
|
|
2381 immediate_quit = 0;
|
|
230
|
2382
|
|
|
2383 if (this <= 0)
|
|
|
2384 {
|
|
|
2385 how_much = this;
|
|
|
2386 break;
|
|
|
2387 }
|
|
|
2388
|
|
|
2389 GPT += this;
|
|
|
2390 GAP_SIZE -= this;
|
|
|
2391 ZV += this;
|
|
|
2392 Z += this;
|
|
|
2393 inserted += this;
|
|
|
2394 }
|
|
|
2395
|
|
|
2396 if (inserted > 0)
|
|
1240
|
2397 {
|
|
|
2398 record_insert (point, inserted);
|
|
1299
|
2399
|
|
|
2400 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
|
|
|
2401 offset_intervals (current_buffer, point, inserted);
|
|
1240
|
2402 MODIFF++;
|
|
|
2403 }
|
|
230
|
2404
|
|
|
2405 close (fd);
|
|
|
2406
|
|
|
2407 /* Discard the unwind protect */
|
|
|
2408 specpdl_ptr = specpdl + count;
|
|
|
2409
|
|
|
2410 if (how_much < 0)
|
|
|
2411 error ("IO error reading %s: %s",
|
|
|
2412 XSTRING (filename)->data, err_str (errno));
|
|
|
2413
|
|
|
2414 notfound:
|
|
843
|
2415 handled:
|
|
230
|
2416
|
|
485
|
2417 if (!NILP (visit))
|
|
230
|
2418 {
|
|
|
2419 current_buffer->undo_list = Qnil;
|
|
|
2420 #ifdef APOLLO
|
|
|
2421 stat (XSTRING (filename)->data, &st);
|
|
|
2422 #endif
|
|
|
2423 current_buffer->modtime = st.st_mtime;
|
|
|
2424 current_buffer->save_modified = MODIFF;
|
|
|
2425 current_buffer->auto_save_modified = MODIFF;
|
|
|
2426 XFASTINT (current_buffer->save_length) = Z - BEG;
|
|
|
2427 #ifdef CLASH_DETECTION
|
|
843
|
2428 if (NILP (handler))
|
|
|
2429 {
|
|
|
2430 if (!NILP (current_buffer->filename))
|
|
|
2431 unlock_file (current_buffer->filename);
|
|
|
2432 unlock_file (filename);
|
|
|
2433 }
|
|
230
|
2434 #endif /* CLASH_DETECTION */
|
|
|
2435 current_buffer->filename = filename;
|
|
|
2436 /* If visiting nonexistent file, return nil. */
|
|
843
|
2437 if (current_buffer->modtime == -1)
|
|
230
|
2438 report_file_error ("Opening input file", Fcons (filename, Qnil));
|
|
|
2439 }
|
|
|
2440
|
|
|
2441 signal_after_change (point, 0, inserted);
|
|
|
2442
|
|
843
|
2443 if (!NILP (val))
|
|
|
2444 RETURN_UNGCPRO (val);
|
|
350
|
2445 RETURN_UNGCPRO (Fcons (filename,
|
|
|
2446 Fcons (make_number (inserted),
|
|
|
2447 Qnil)));
|
|
230
|
2448 }
|
|
|
2449
|
|
|
2450 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
|
|
|
2451 "r\nFWrite region to file: ",
|
|
|
2452 "Write current region into specified file.\n\
|
|
|
2453 When called from a program, takes three arguments:\n\
|
|
|
2454 START, END and FILENAME. START and END are buffer positions.\n\
|
|
|
2455 Optional fourth argument APPEND if non-nil means\n\
|
|
|
2456 append to existing file contents (if any).\n\
|
|
|
2457 Optional fifth argument VISIT if t means\n\
|
|
|
2458 set the last-save-file-modtime of buffer to this file's modtime\n\
|
|
|
2459 and mark buffer not modified.\n\
|
|
1377
|
2460 If VISIT is a string, it is a second file name;\n\
|
|
|
2461 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
|
|
|
2462 VISIT is also the file name to lock and unlock for clash detection.\n\
|
|
1761
|
2463 If VISIT is neither t nor nil nor a string,\n\
|
|
|
2464 that means do not print the \"Wrote file\" message.\n\
|
|
230
|
2465 Kludgy feature: if START is a string, then that string is written\n\
|
|
|
2466 to the file, instead of any buffer contents, and END is ignored.")
|
|
|
2467 (start, end, filename, append, visit)
|
|
|
2468 Lisp_Object start, end, filename, append, visit;
|
|
|
2469 {
|
|
|
2470 register int desc;
|
|
|
2471 int failure;
|
|
|
2472 int save_errno;
|
|
|
2473 unsigned char *fn;
|
|
|
2474 struct stat st;
|
|
|
2475 int tem;
|
|
|
2476 int count = specpdl_ptr - specpdl;
|
|
|
2477 #ifdef VMS
|
|
|
2478 unsigned char *fname = 0; /* If non-0, original filename (must rename) */
|
|
|
2479 #endif /* VMS */
|
|
848
|
2480 Lisp_Object handler;
|
|
1377
|
2481 Lisp_Object visit_file = XTYPE (visit) == Lisp_String ? visit : filename;
|
|
|
2482 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
230
|
2483
|
|
|
2484 /* Special kludge to simplify auto-saving */
|
|
485
|
2485 if (NILP (start))
|
|
230
|
2486 {
|
|
|
2487 XFASTINT (start) = BEG;
|
|
|
2488 XFASTINT (end) = Z;
|
|
|
2489 }
|
|
|
2490 else if (XTYPE (start) != Lisp_String)
|
|
|
2491 validate_region (&start, &end);
|
|
|
2492
|
|
1377
|
2493 GCPRO4 (start, filename, visit, visit_file);
|
|
230
|
2494 filename = Fexpand_file_name (filename, Qnil);
|
|
|
2495
|
|
843
|
2496 /* If the file name has special constructs in it,
|
|
|
2497 call the corresponding file handler. */
|
|
1679
|
2498 handler = Ffind_file_name_handler (filename);
|
|
848
|
2499
|
|
843
|
2500 if (!NILP (handler))
|
|
|
2501 {
|
|
|
2502 Lisp_Object args[7];
|
|
|
2503 Lisp_Object val;
|
|
|
2504 args[0] = handler;
|
|
|
2505 args[1] = Qwrite_region;
|
|
|
2506 args[2] = start;
|
|
|
2507 args[3] = end;
|
|
|
2508 args[4] = filename;
|
|
|
2509 args[5] = append;
|
|
|
2510 args[6] = visit;
|
|
|
2511 val = Ffuncall (7, args);
|
|
|
2512
|
|
|
2513 /* Do this before reporting IO error
|
|
|
2514 to avoid a "file has changed on disk" warning on
|
|
|
2515 next attempt to save. */
|
|
1377
|
2516 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
|
|
843
|
2517 {
|
|
|
2518 current_buffer->modtime = 0;
|
|
|
2519 current_buffer->save_modified = MODIFF;
|
|
|
2520 XFASTINT (current_buffer->save_length) = Z - BEG;
|
|
1377
|
2521 current_buffer->filename = visit_file;
|
|
843
|
2522 }
|
|
1178
|
2523 UNGCPRO;
|
|
843
|
2524 return val;
|
|
|
2525 }
|
|
|
2526
|
|
230
|
2527 #ifdef CLASH_DETECTION
|
|
|
2528 if (!auto_saving)
|
|
1377
|
2529 lock_file (visit_file);
|
|
230
|
2530 #endif /* CLASH_DETECTION */
|
|
|
2531
|
|
1178
|
2532 fn = XSTRING (filename)->data;
|
|
230
|
2533 desc = -1;
|
|
485
|
2534 if (!NILP (append))
|
|
230
|
2535 desc = open (fn, O_WRONLY);
|
|
|
2536
|
|
|
2537 if (desc < 0)
|
|
|
2538 #ifdef VMS
|
|
|
2539 if (auto_saving) /* Overwrite any previous version of autosave file */
|
|
|
2540 {
|
|
|
2541 vms_truncate (fn); /* if fn exists, truncate to zero length */
|
|
|
2542 desc = open (fn, O_RDWR);
|
|
|
2543 if (desc < 0)
|
|
|
2544 desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String
|
|
536
|
2545 ? XSTRING (current_buffer->filename)->data : 0,
|
|
|
2546 fn);
|
|
230
|
2547 }
|
|
|
2548 else /* Write to temporary name and rename if no errors */
|
|
|
2549 {
|
|
|
2550 Lisp_Object temp_name;
|
|
|
2551 temp_name = Ffile_name_directory (filename);
|
|
|
2552
|
|
485
|
2553 if (!NILP (temp_name))
|
|
230
|
2554 {
|
|
|
2555 temp_name = Fmake_temp_name (concat2 (temp_name,
|
|
|
2556 build_string ("$$SAVE$$")));
|
|
|
2557 fname = XSTRING (filename)->data;
|
|
|
2558 fn = XSTRING (temp_name)->data;
|
|
|
2559 desc = creat_copy_attrs (fname, fn);
|
|
|
2560 if (desc < 0)
|
|
|
2561 {
|
|
|
2562 /* If we can't open the temporary file, try creating a new
|
|
|
2563 version of the original file. VMS "creat" creates a
|
|
|
2564 new version rather than truncating an existing file. */
|
|
|
2565 fn = fname;
|
|
|
2566 fname = 0;
|
|
|
2567 desc = creat (fn, 0666);
|
|
|
2568 #if 0 /* This can clobber an existing file and fail to replace it,
|
|
|
2569 if the user runs out of space. */
|
|
|
2570 if (desc < 0)
|
|
|
2571 {
|
|
|
2572 /* We can't make a new version;
|
|
|
2573 try to truncate and rewrite existing version if any. */
|
|
|
2574 vms_truncate (fn);
|
|
|
2575 desc = open (fn, O_RDWR);
|
|
|
2576 }
|
|
|
2577 #endif
|
|
|
2578 }
|
|
|
2579 }
|
|
|
2580 else
|
|
|
2581 desc = creat (fn, 0666);
|
|
|
2582 }
|
|
|
2583 #else /* not VMS */
|
|
|
2584 desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
|
|
|
2585 #endif /* not VMS */
|
|
|
2586
|
|
1178
|
2587 UNGCPRO;
|
|
|
2588
|
|
230
|
2589 if (desc < 0)
|
|
|
2590 {
|
|
|
2591 #ifdef CLASH_DETECTION
|
|
|
2592 save_errno = errno;
|
|
1377
|
2593 if (!auto_saving) unlock_file (visit_file);
|
|
230
|
2594 errno = save_errno;
|
|
|
2595 #endif /* CLASH_DETECTION */
|
|
|
2596 report_file_error ("Opening output file", Fcons (filename, Qnil));
|
|
|
2597 }
|
|
|
2598
|
|
|
2599 record_unwind_protect (close_file_unwind, make_number (desc));
|
|
|
2600
|
|
485
|
2601 if (!NILP (append))
|
|
230
|
2602 if (lseek (desc, 0, 2) < 0)
|
|
|
2603 {
|
|
|
2604 #ifdef CLASH_DETECTION
|
|
1377
|
2605 if (!auto_saving) unlock_file (visit_file);
|
|
230
|
2606 #endif /* CLASH_DETECTION */
|
|
|
2607 report_file_error ("Lseek error", Fcons (filename, Qnil));
|
|
|
2608 }
|
|
|
2609
|
|
|
2610 #ifdef VMS
|
|
|
2611 /*
|
|
|
2612 * Kludge Warning: The VMS C RTL likes to insert carriage returns
|
|
|
2613 * if we do writes that don't end with a carriage return. Furthermore
|
|
|
2614 * it cannot handle writes of more then 16K. The modified
|
|
|
2615 * version of "sys_write" in SYSDEP.C (see comment there) copes with
|
|
|
2616 * this EXCEPT for the last record (iff it doesn't end with a carriage
|
|
|
2617 * return). This implies that if your buffer doesn't end with a carriage
|
|
|
2618 * return, you get one free... tough. However it also means that if
|
|
|
2619 * we make two calls to sys_write (a la the following code) you can
|
|
|
2620 * get one at the gap as well. The easiest way to fix this (honest)
|
|
|
2621 * is to move the gap to the next newline (or the end of the buffer).
|
|
|
2622 * Thus this change.
|
|
|
2623 *
|
|
|
2624 * Yech!
|
|
|
2625 */
|
|
|
2626 if (GPT > BEG && GPT_ADDR[-1] != '\n')
|
|
|
2627 move_gap (find_next_newline (GPT, 1));
|
|
|
2628 #endif
|
|
|
2629
|
|
|
2630 failure = 0;
|
|
|
2631 immediate_quit = 1;
|
|
|
2632
|
|
|
2633 if (XTYPE (start) == Lisp_String)
|
|
|
2634 {
|
|
|
2635 failure = 0 > e_write (desc, XSTRING (start)->data,
|
|
|
2636 XSTRING (start)->size);
|
|
|
2637 save_errno = errno;
|
|
|
2638 }
|
|
|
2639 else if (XINT (start) != XINT (end))
|
|
|
2640 {
|
|
|
2641 if (XINT (start) < GPT)
|
|
|
2642 {
|
|
|
2643 register int end1 = XINT (end);
|
|
|
2644 tem = XINT (start);
|
|
|
2645 failure = 0 > e_write (desc, &FETCH_CHAR (tem),
|
|
|
2646 min (GPT, end1) - tem);
|
|
|
2647 save_errno = errno;
|
|
|
2648 }
|
|
|
2649
|
|
|
2650 if (XINT (end) > GPT && !failure)
|
|
|
2651 {
|
|
|
2652 tem = XINT (start);
|
|
|
2653 tem = max (tem, GPT);
|
|
|
2654 failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem);
|
|
|
2655 save_errno = errno;
|
|
|
2656 }
|
|
|
2657 }
|
|
|
2658
|
|
|
2659 immediate_quit = 0;
|
|
|
2660
|
|
|
2661 #ifndef USG
|
|
|
2662 #ifndef VMS
|
|
|
2663 #ifndef BSD4_1
|
|
|
2664 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
|
|
|
2665 Disk full in NFS may be reported here. */
|
|
|
2666 if (fsync (desc) < 0)
|
|
|
2667 failure = 1, save_errno = errno;
|
|
|
2668 #endif
|
|
|
2669 #endif
|
|
|
2670 #endif
|
|
|
2671
|
|
|
2672 /* Spurious "file has changed on disk" warnings have been
|
|
|
2673 observed on Suns as well.
|
|
|
2674 It seems that `close' can change the modtime, under nfs.
|
|
|
2675
|
|
|
2676 (This has supposedly been fixed in Sunos 4,
|
|
|
2677 but who knows about all the other machines with NFS?) */
|
|
|
2678 #if 0
|
|
|
2679
|
|
|
2680 /* On VMS and APOLLO, must do the stat after the close
|
|
|
2681 since closing changes the modtime. */
|
|
|
2682 #ifndef VMS
|
|
|
2683 #ifndef APOLLO
|
|
|
2684 /* Recall that #if defined does not work on VMS. */
|
|
|
2685 #define FOO
|
|
|
2686 fstat (desc, &st);
|
|
|
2687 #endif
|
|
|
2688 #endif
|
|
|
2689 #endif
|
|
|
2690
|
|
|
2691 /* NFS can report a write failure now. */
|
|
|
2692 if (close (desc) < 0)
|
|
|
2693 failure = 1, save_errno = errno;
|
|
|
2694
|
|
|
2695 #ifdef VMS
|
|
|
2696 /* If we wrote to a temporary name and had no errors, rename to real name. */
|
|
|
2697 if (fname)
|
|
|
2698 {
|
|
|
2699 if (!failure)
|
|
|
2700 failure = (rename (fn, fname) != 0), save_errno = errno;
|
|
|
2701 fn = fname;
|
|
|
2702 }
|
|
|
2703 #endif /* VMS */
|
|
|
2704
|
|
|
2705 #ifndef FOO
|
|
|
2706 stat (fn, &st);
|
|
|
2707 #endif
|
|
|
2708 /* Discard the unwind protect */
|
|
|
2709 specpdl_ptr = specpdl + count;
|
|
|
2710
|
|
|
2711 #ifdef CLASH_DETECTION
|
|
|
2712 if (!auto_saving)
|
|
1377
|
2713 unlock_file (visit_file);
|
|
230
|
2714 #endif /* CLASH_DETECTION */
|
|
|
2715
|
|
|
2716 /* Do this before reporting IO error
|
|
|
2717 to avoid a "file has changed on disk" warning on
|
|
|
2718 next attempt to save. */
|
|
1377
|
2719 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
|
|
230
|
2720 current_buffer->modtime = st.st_mtime;
|
|
|
2721
|
|
|
2722 if (failure)
|
|
|
2723 error ("IO error writing %s: %s", fn, err_str (save_errno));
|
|
|
2724
|
|
1377
|
2725 if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
|
|
230
|
2726 {
|
|
|
2727 current_buffer->save_modified = MODIFF;
|
|
|
2728 XFASTINT (current_buffer->save_length) = Z - BEG;
|
|
1377
|
2729 current_buffer->filename = visit_file;
|
|
230
|
2730 }
|
|
485
|
2731 else if (!NILP (visit))
|
|
230
|
2732 return Qnil;
|
|
|
2733
|
|
|
2734 if (!auto_saving)
|
|
1377
|
2735 message ("Wrote %s", XSTRING (visit_file)->data);
|
|
230
|
2736
|
|
|
2737 return Qnil;
|
|
|
2738 }
|
|
|
2739
|
|
|
2740 int
|
|
|
2741 e_write (desc, addr, len)
|
|
|
2742 int desc;
|
|
|
2743 register char *addr;
|
|
|
2744 register int len;
|
|
|
2745 {
|
|
|
2746 char buf[16 * 1024];
|
|
|
2747 register char *p, *end;
|
|
|
2748
|
|
|
2749 if (!EQ (current_buffer->selective_display, Qt))
|
|
|
2750 return write (desc, addr, len) - len;
|
|
|
2751 else
|
|
|
2752 {
|
|
|
2753 p = buf;
|
|
|
2754 end = p + sizeof buf;
|
|
|
2755 while (len--)
|
|
|
2756 {
|
|
|
2757 if (p == end)
|
|
|
2758 {
|
|
|
2759 if (write (desc, buf, sizeof buf) != sizeof buf)
|
|
|
2760 return -1;
|
|
|
2761 p = buf;
|
|
|
2762 }
|
|
|
2763 *p = *addr++;
|
|
|
2764 if (*p++ == '\015')
|
|
|
2765 p[-1] = '\n';
|
|
|
2766 }
|
|
|
2767 if (p != buf)
|
|
|
2768 if (write (desc, buf, p - buf) != p - buf)
|
|
|
2769 return -1;
|
|
|
2770 }
|
|
|
2771 return 0;
|
|
|
2772 }
|
|
|
2773
|
|
|
2774 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
|
|
|
2775 Sverify_visited_file_modtime, 1, 1, 0,
|
|
|
2776 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
|
|
|
2777 This means that the file has not been changed since it was visited or saved.")
|
|
|
2778 (buf)
|
|
|
2779 Lisp_Object buf;
|
|
|
2780 {
|
|
|
2781 struct buffer *b;
|
|
|
2782 struct stat st;
|
|
843
|
2783 Lisp_Object handler;
|
|
230
|
2784
|
|
|
2785 CHECK_BUFFER (buf, 0);
|
|
|
2786 b = XBUFFER (buf);
|
|
|
2787
|
|
|
2788 if (XTYPE (b->filename) != Lisp_String) return Qt;
|
|
|
2789 if (b->modtime == 0) return Qt;
|
|
|
2790
|
|
843
|
2791 /* If the file name has special constructs in it,
|
|
|
2792 call the corresponding file handler. */
|
|
1679
|
2793 handler = Ffind_file_name_handler (b->filename);
|
|
843
|
2794 if (!NILP (handler))
|
|
1178
|
2795 return call2 (handler, Qverify_visited_file_modtime, buf);
|
|
843
|
2796
|
|
230
|
2797 if (stat (XSTRING (b->filename)->data, &st) < 0)
|
|
|
2798 {
|
|
|
2799 /* If the file doesn't exist now and didn't exist before,
|
|
|
2800 we say that it isn't modified, provided the error is a tame one. */
|
|
|
2801 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
|
|
|
2802 st.st_mtime = -1;
|
|
|
2803 else
|
|
|
2804 st.st_mtime = 0;
|
|
|
2805 }
|
|
|
2806 if (st.st_mtime == b->modtime
|
|
|
2807 /* If both are positive, accept them if they are off by one second. */
|
|
|
2808 || (st.st_mtime > 0 && b->modtime > 0
|
|
|
2809 && (st.st_mtime == b->modtime + 1
|
|
|
2810 || st.st_mtime == b->modtime - 1)))
|
|
|
2811 return Qt;
|
|
|
2812 return Qnil;
|
|
|
2813 }
|
|
|
2814
|
|
|
2815 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
|
|
|
2816 Sclear_visited_file_modtime, 0, 0, 0,
|
|
|
2817 "Clear out records of last mod time of visited file.\n\
|
|
|
2818 Next attempt to save will certainly not complain of a discrepancy.")
|
|
|
2819 ()
|
|
|
2820 {
|
|
|
2821 current_buffer->modtime = 0;
|
|
|
2822 return Qnil;
|
|
|
2823 }
|
|
|
2824
|
|
|
2825 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
|
|
|
2826 Sset_visited_file_modtime, 0, 0, 0,
|
|
|
2827 "Update buffer's recorded modification time from the visited file's time.\n\
|
|
|
2828 Useful if the buffer was not read from the file normally\n\
|
|
|
2829 or if the file itself has been changed for some known benign reason.")
|
|
|
2830 ()
|
|
|
2831 {
|
|
|
2832 register Lisp_Object filename;
|
|
|
2833 struct stat st;
|
|
848
|
2834 Lisp_Object handler;
|
|
230
|
2835
|
|
|
2836 filename = Fexpand_file_name (current_buffer->filename, Qnil);
|
|
843
|
2837
|
|
|
2838 /* If the file name has special constructs in it,
|
|
|
2839 call the corresponding file handler. */
|
|
1679
|
2840 handler = Ffind_file_name_handler (filename);
|
|
843
|
2841 if (!NILP (handler))
|
|
|
2842 current_buffer->modtime = 0;
|
|
230
|
2843
|
|
843
|
2844 else if (stat (XSTRING (filename)->data, &st) >= 0)
|
|
230
|
2845 current_buffer->modtime = st.st_mtime;
|
|
|
2846
|
|
|
2847 return Qnil;
|
|
|
2848 }
|
|
|
2849
|
|
|
2850 Lisp_Object
|
|
|
2851 auto_save_error ()
|
|
|
2852 {
|
|
|
2853 unsigned char *name = XSTRING (current_buffer->name)->data;
|
|
|
2854
|
|
|
2855 ring_bell ();
|
|
|
2856 message ("Autosaving...error for %s", name);
|
|
806
|
2857 Fsleep_for (make_number (1), Qnil);
|
|
230
|
2858 message ("Autosaving...error!for %s", name);
|
|
806
|
2859 Fsleep_for (make_number (1), Qnil);
|
|
230
|
2860 message ("Autosaving...error for %s", name);
|
|
806
|
2861 Fsleep_for (make_number (1), Qnil);
|
|
230
|
2862 return Qnil;
|
|
|
2863 }
|
|
|
2864
|
|
|
2865 Lisp_Object
|
|
|
2866 auto_save_1 ()
|
|
|
2867 {
|
|
|
2868 unsigned char *fn;
|
|
|
2869 struct stat st;
|
|
|
2870
|
|
|
2871 /* Get visited file's mode to become the auto save file's mode. */
|
|
|
2872 if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
|
|
|
2873 /* But make sure we can overwrite it later! */
|
|
|
2874 auto_save_mode_bits = st.st_mode | 0600;
|
|
|
2875 else
|
|
|
2876 auto_save_mode_bits = 0666;
|
|
|
2877
|
|
|
2878 return
|
|
|
2879 Fwrite_region (Qnil, Qnil,
|
|
|
2880 current_buffer->auto_save_file_name,
|
|
|
2881 Qnil, Qlambda);
|
|
|
2882 }
|
|
|
2883
|
|
|
2884 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
|
|
|
2885 "Auto-save all buffers that need it.\n\
|
|
|
2886 This is all buffers that have auto-saving enabled\n\
|
|
|
2887 and are changed since last auto-saved.\n\
|
|
|
2888 Auto-saving writes the buffer into a file\n\
|
|
|
2889 so that your editing is not lost if the system crashes.\n\
|
|
|
2890 This file is not the file you visited; that changes only when you save.\n\n\
|
|
|
2891 Non-nil first argument means do not print any message if successful.\n\
|
|
621
|
2892 Non-nil second argument means save only current buffer.")
|
|
1775
|
2893 (no_message, current_only)
|
|
|
2894 Lisp_Object no_message, current_only;
|
|
230
|
2895 {
|
|
|
2896 struct buffer *old = current_buffer, *b;
|
|
|
2897 Lisp_Object tail, buf;
|
|
|
2898 int auto_saved = 0;
|
|
|
2899 char *omessage = echo_area_glyphs;
|
|
1869
|
2900 extern int minibuf_level;
|
|
|
2901 int do_handled_files;
|
|
230
|
2902
|
|
|
2903 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
|
|
|
2904 point to non-strings reached from Vbuffer_alist. */
|
|
|
2905
|
|
|
2906 auto_saving = 1;
|
|
|
2907 if (minibuf_level)
|
|
1775
|
2908 no_message = Qt;
|
|
230
|
2909
|
|
|
2910 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
|
|
|
2911 eventually call do-auto-save, so don't err here in that case. */
|
|
485
|
2912 if (!NILP (Vrun_hooks))
|
|
230
|
2913 call1 (Vrun_hooks, intern ("auto-save-hook"));
|
|
|
2914
|
|
1869
|
2915 /* First, save all files which don't have handlers. If Emacs is
|
|
|
2916 crashing, the handlers may tweak what is causing Emacs to crash
|
|
|
2917 in the first place, and it would be a shame if Emacs failed to
|
|
|
2918 autosave perfectly ordinary files because it couldn't handle some
|
|
|
2919 ange-ftp'd file. */
|
|
|
2920 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
|
|
|
2921 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
|
|
|
2922 tail = XCONS (tail)->cdr)
|
|
|
2923 {
|
|
|
2924 buf = XCONS (XCONS (tail)->car)->cdr;
|
|
|
2925 b = XBUFFER (buf);
|
|
|
2926
|
|
|
2927 if (!NILP (current_only)
|
|
|
2928 && b != current_buffer)
|
|
|
2929 continue;
|
|
1775
|
2930
|
|
1869
|
2931 /* Check for auto save enabled
|
|
|
2932 and file changed since last auto save
|
|
|
2933 and file changed since last real save. */
|
|
|
2934 if (XTYPE (b->auto_save_file_name) == Lisp_String
|
|
|
2935 && b->save_modified < BUF_MODIFF (b)
|
|
|
2936 && b->auto_save_modified < BUF_MODIFF (b)
|
|
|
2937 && (do_handled_files
|
|
|
2938 || NILP (Ffind_file_name_handler (b->auto_save_file_name))))
|
|
|
2939 {
|
|
|
2940 if ((XFASTINT (b->save_length) * 10
|
|
|
2941 > (BUF_Z (b) - BUF_BEG (b)) * 13)
|
|
|
2942 /* A short file is likely to change a large fraction;
|
|
|
2943 spare the user annoying messages. */
|
|
|
2944 && XFASTINT (b->save_length) > 5000
|
|
|
2945 /* These messages are frequent and annoying for `*mail*'. */
|
|
|
2946 && !EQ (b->filename, Qnil)
|
|
|
2947 && NILP (no_message))
|
|
|
2948 {
|
|
|
2949 /* It has shrunk too much; turn off auto-saving here. */
|
|
|
2950 message ("Buffer %s has shrunk a lot; auto save turned off there",
|
|
|
2951 XSTRING (b->name)->data);
|
|
|
2952 /* User can reenable saving with M-x auto-save. */
|
|
|
2953 b->auto_save_file_name = Qnil;
|
|
|
2954 /* Prevent warning from repeating if user does so. */
|
|
|
2955 XFASTINT (b->save_length) = 0;
|
|
|
2956 Fsleep_for (make_number (1), Qnil);
|
|
|
2957 continue;
|
|
|
2958 }
|
|
|
2959 set_buffer_internal (b);
|
|
|
2960 if (!auto_saved && NILP (no_message))
|
|
|
2961 message1 ("Auto-saving...");
|
|
|
2962 internal_condition_case (auto_save_1, Qt, auto_save_error);
|
|
|
2963 auto_saved++;
|
|
|
2964 b->auto_save_modified = BUF_MODIFF (b);
|
|
|
2965 XFASTINT (current_buffer->save_length) = Z - BEG;
|
|
|
2966 set_buffer_internal (old);
|
|
|
2967 }
|
|
|
2968 }
|
|
230
|
2969
|
|
1059
|
2970 /* Prevent another auto save till enough input events come in. */
|
|
|
2971 record_auto_save ();
|
|
230
|
2972
|
|
1775
|
2973 if (auto_saved && NILP (no_message))
|
|
230
|
2974 message1 (omessage ? omessage : "Auto-saving...done");
|
|
|
2975
|
|
|
2976 auto_saving = 0;
|
|
|
2977 return Qnil;
|
|
|
2978 }
|
|
|
2979
|
|
|
2980 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
|
|
|
2981 Sset_buffer_auto_saved, 0, 0, 0,
|
|
|
2982 "Mark current buffer as auto-saved with its current text.\n\
|
|
|
2983 No auto-save file will be written until the buffer changes again.")
|
|
|
2984 ()
|
|
|
2985 {
|
|
|
2986 current_buffer->auto_save_modified = MODIFF;
|
|
|
2987 XFASTINT (current_buffer->save_length) = Z - BEG;
|
|
|
2988 return Qnil;
|
|
|
2989 }
|
|
|
2990
|
|
|
2991 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
|
|
|
2992 0, 0, 0,
|
|
|
2993 "Return t if buffer has been auto-saved since last read in or saved.")
|
|
|
2994 ()
|
|
|
2995 {
|
|
|
2996 return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
|
|
|
2997 }
|
|
|
2998
|
|
|
2999 /* Reading and completing file names */
|
|
|
3000 extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
|
|
|
3001
|
|
|
3002 DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
|
|
|
3003 3, 3, 0,
|
|
|
3004 "Internal subroutine for read-file-name. Do not call this.")
|
|
|
3005 (string, dir, action)
|
|
|
3006 Lisp_Object string, dir, action;
|
|
|
3007 /* action is nil for complete, t for return list of completions,
|
|
|
3008 lambda for verify final value */
|
|
|
3009 {
|
|
|
3010 Lisp_Object name, specdir, realdir, val, orig_string;
|
|
1178
|
3011 int changed;
|
|
|
3012 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
|
3013
|
|
|
3014 realdir = dir;
|
|
|
3015 name = string;
|
|
|
3016 orig_string = Qnil;
|
|
|
3017 specdir = Qnil;
|
|
|
3018 changed = 0;
|
|
|
3019 /* No need to protect ACTION--we only compare it with t and nil. */
|
|
|
3020 GCPRO4 (string, realdir, name, specdir);
|
|
230
|
3021
|
|
|
3022 if (XSTRING (string)->size == 0)
|
|
|
3023 {
|
|
|
3024 if (EQ (action, Qlambda))
|
|
1178
|
3025 {
|
|
|
3026 UNGCPRO;
|
|
|
3027 return Qnil;
|
|
|
3028 }
|
|
230
|
3029 }
|
|
|
3030 else
|
|
|
3031 {
|
|
|
3032 orig_string = string;
|
|
|
3033 string = Fsubstitute_in_file_name (string);
|
|
1178
|
3034 changed = NILP (Fstring_equal (string, orig_string));
|
|
230
|
3035 name = Ffile_name_nondirectory (string);
|
|
1178
|
3036 val = Ffile_name_directory (string);
|
|
|
3037 if (! NILP (val))
|
|
|
3038 realdir = Fexpand_file_name (val, realdir);
|
|
230
|
3039 }
|
|
|
3040
|
|
485
|
3041 if (NILP (action))
|
|
230
|
3042 {
|
|
|
3043 specdir = Ffile_name_directory (string);
|
|
|
3044 val = Ffile_name_completion (name, realdir);
|
|
1178
|
3045 UNGCPRO;
|
|
230
|
3046 if (XTYPE (val) != Lisp_String)
|
|
|
3047 {
|
|
1178
|
3048 if (changed)
|
|
230
|
3049 return string;
|
|
1178
|
3050 return val;
|
|
230
|
3051 }
|
|
|
3052
|
|
485
|
3053 if (!NILP (specdir))
|
|
230
|
3054 val = concat2 (specdir, val);
|
|
|
3055 #ifndef VMS
|
|
|
3056 {
|
|
|
3057 register unsigned char *old, *new;
|
|
|
3058 register int n;
|
|
|
3059 int osize, count;
|
|
|
3060
|
|
|
3061 osize = XSTRING (val)->size;
|
|
|
3062 /* Quote "$" as "$$" to get it past substitute-in-file-name */
|
|
|
3063 for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
|
|
|
3064 if (*old++ == '$') count++;
|
|
|
3065 if (count > 0)
|
|
|
3066 {
|
|
|
3067 old = XSTRING (val)->data;
|
|
|
3068 val = Fmake_string (make_number (osize + count), make_number (0));
|
|
|
3069 new = XSTRING (val)->data;
|
|
|
3070 for (n = osize; n > 0; n--)
|
|
|
3071 if (*old != '$')
|
|
|
3072 *new++ = *old++;
|
|
|
3073 else
|
|
|
3074 {
|
|
|
3075 *new++ = '$';
|
|
|
3076 *new++ = '$';
|
|
|
3077 old++;
|
|
|
3078 }
|
|
|
3079 }
|
|
|
3080 }
|
|
|
3081 #endif /* Not VMS */
|
|
1178
|
3082 return val;
|
|
230
|
3083 }
|
|
1178
|
3084 UNGCPRO;
|
|
230
|
3085
|
|
|
3086 if (EQ (action, Qt))
|
|
|
3087 return Ffile_name_all_completions (name, realdir);
|
|
|
3088 /* Only other case actually used is ACTION = lambda */
|
|
|
3089 #ifdef VMS
|
|
|
3090 /* Supposedly this helps commands such as `cd' that read directory names,
|
|
|
3091 but can someone explain how it helps them? -- RMS */
|
|
|
3092 if (XSTRING (name)->size == 0)
|
|
|
3093 return Qt;
|
|
|
3094 #endif /* VMS */
|
|
|
3095 return Ffile_exists_p (string);
|
|
|
3096 }
|
|
|
3097
|
|
|
3098 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
|
|
|
3099 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
|
|
|
3100 Value is not expanded---you must call `expand-file-name' yourself.\n\
|
|
|
3101 Default name to DEFAULT if user enters a null string.\n\
|
|
|
3102 (If DEFAULT is omitted, the visited file name is used.)\n\
|
|
|
3103 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
|
|
|
3104 Non-nil and non-t means also require confirmation after completion.\n\
|
|
|
3105 Fifth arg INITIAL specifies text to start with.\n\
|
|
|
3106 DIR defaults to current buffer's directory default.")
|
|
|
3107 (prompt, dir, defalt, mustmatch, initial)
|
|
|
3108 Lisp_Object prompt, dir, defalt, mustmatch, initial;
|
|
|
3109 {
|
|
866
|
3110 Lisp_Object val, insdef, insdef1, tem;
|
|
230
|
3111 struct gcpro gcpro1, gcpro2;
|
|
|
3112 register char *homedir;
|
|
|
3113 int count;
|
|
|
3114
|
|
485
|
3115 if (NILP (dir))
|
|
230
|
3116 dir = current_buffer->directory;
|
|
485
|
3117 if (NILP (defalt))
|
|
230
|
3118 defalt = current_buffer->filename;
|
|
|
3119
|
|
|
3120 /* If dir starts with user's homedir, change that to ~. */
|
|
|
3121 homedir = (char *) egetenv ("HOME");
|
|
|
3122 if (homedir != 0
|
|
|
3123 && XTYPE (dir) == Lisp_String
|
|
|
3124 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
|
|
|
3125 && XSTRING (dir)->data[strlen (homedir)] == '/')
|
|
|
3126 {
|
|
|
3127 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
|
|
|
3128 XSTRING (dir)->size - strlen (homedir) + 1);
|
|
|
3129 XSTRING (dir)->data[0] = '~';
|
|
|
3130 }
|
|
|
3131
|
|
|
3132 if (insert_default_directory)
|
|
|
3133 {
|
|
|
3134 insdef = dir;
|
|
866
|
3135 insdef1 = dir;
|
|
485
|
3136 if (!NILP (initial))
|
|
230
|
3137 {
|
|
863
|
3138 Lisp_Object args[2], pos;
|
|
230
|
3139
|
|
|
3140 args[0] = insdef;
|
|
|
3141 args[1] = initial;
|
|
|
3142 insdef = Fconcat (2, args);
|
|
964
|
3143 pos = make_number (XSTRING (dir)->size);
|
|
866
|
3144 insdef1 = Fcons (insdef, pos);
|
|
230
|
3145 }
|
|
|
3146 }
|
|
|
3147 else
|
|
866
|
3148 insdef = Qnil, insdef1 = Qnil;
|
|
230
|
3149
|
|
|
3150 #ifdef VMS
|
|
|
3151 count = specpdl_ptr - specpdl;
|
|
|
3152 specbind (intern ("completion-ignore-case"), Qt);
|
|
|
3153 #endif
|
|
|
3154
|
|
|
3155 GCPRO2 (insdef, defalt);
|
|
|
3156 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
|
|
866
|
3157 dir, mustmatch, insdef1,
|
|
863
|
3158 Qfile_name_history);
|
|
230
|
3159
|
|
|
3160 #ifdef VMS
|
|
|
3161 unbind_to (count, Qnil);
|
|
|
3162 #endif
|
|
|
3163
|
|
|
3164 UNGCPRO;
|
|
485
|
3165 if (NILP (val))
|
|
230
|
3166 error ("No file name specified");
|
|
|
3167 tem = Fstring_equal (val, insdef);
|
|
485
|
3168 if (!NILP (tem) && !NILP (defalt))
|
|
230
|
3169 return defalt;
|
|
|
3170 return Fsubstitute_in_file_name (val);
|
|
|
3171 }
|
|
|
3172
|
|
|
3173 #if 0 /* Old version */
|
|
|
3174 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
|
|
|
3175 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
|
|
|
3176 Value is not expanded---you must call `expand-file-name' yourself.\n\
|
|
|
3177 Default name to DEFAULT if user enters a null string.\n\
|
|
|
3178 (If DEFAULT is omitted, the visited file name is used.)\n\
|
|
|
3179 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
|
|
|
3180 Non-nil and non-t means also require confirmation after completion.\n\
|
|
|
3181 Fifth arg INITIAL specifies text to start with.\n\
|
|
|
3182 DIR defaults to current buffer's directory default.")
|
|
|
3183 (prompt, dir, defalt, mustmatch, initial)
|
|
|
3184 Lisp_Object prompt, dir, defalt, mustmatch, initial;
|
|
|
3185 {
|
|
|
3186 Lisp_Object val, insdef, tem;
|
|
|
3187 struct gcpro gcpro1, gcpro2;
|
|
|
3188 register char *homedir;
|
|
|
3189 int count;
|
|
|
3190
|
|
485
|
3191 if (NILP (dir))
|
|
230
|
3192 dir = current_buffer->directory;
|
|
485
|
3193 if (NILP (defalt))
|
|
230
|
3194 defalt = current_buffer->filename;
|
|
|
3195
|
|
|
3196 /* If dir starts with user's homedir, change that to ~. */
|
|
|
3197 homedir = (char *) egetenv ("HOME");
|
|
|
3198 if (homedir != 0
|
|
|
3199 && XTYPE (dir) == Lisp_String
|
|
|
3200 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
|
|
|
3201 && XSTRING (dir)->data[strlen (homedir)] == '/')
|
|
|
3202 {
|
|
|
3203 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
|
|
|
3204 XSTRING (dir)->size - strlen (homedir) + 1);
|
|
|
3205 XSTRING (dir)->data[0] = '~';
|
|
|
3206 }
|
|
|
3207
|
|
485
|
3208 if (!NILP (initial))
|
|
230
|
3209 insdef = initial;
|
|
|
3210 else if (insert_default_directory)
|
|
|
3211 insdef = dir;
|
|
|
3212 else
|
|
|
3213 insdef = build_string ("");
|
|
|
3214
|
|
|
3215 #ifdef VMS
|
|
|
3216 count = specpdl_ptr - specpdl;
|
|
|
3217 specbind (intern ("completion-ignore-case"), Qt);
|
|
|
3218 #endif
|
|
|
3219
|
|
|
3220 GCPRO2 (insdef, defalt);
|
|
|
3221 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
|
|
|
3222 dir, mustmatch,
|
|
863
|
3223 insert_default_directory ? insdef : Qnil,
|
|
|
3224 Qfile_name_history);
|
|
230
|
3225
|
|
|
3226 #ifdef VMS
|
|
|
3227 unbind_to (count, Qnil);
|
|
|
3228 #endif
|
|
|
3229
|
|
|
3230 UNGCPRO;
|
|
485
|
3231 if (NILP (val))
|
|
230
|
3232 error ("No file name specified");
|
|
|
3233 tem = Fstring_equal (val, insdef);
|
|
485
|
3234 if (!NILP (tem) && !NILP (defalt))
|
|
230
|
3235 return defalt;
|
|
|
3236 return Fsubstitute_in_file_name (val);
|
|
|
3237 }
|
|
|
3238 #endif /* Old version */
|
|
|
3239
|
|
|
3240 syms_of_fileio ()
|
|
|
3241 {
|
|
1105
|
3242 Qexpand_file_name = intern ("expand-file-name");
|
|
|
3243 Qdirectory_file_name = intern ("directory-file-name");
|
|
|
3244 Qfile_name_directory = intern ("file-name-directory");
|
|
|
3245 Qfile_name_nondirectory = intern ("file-name-nondirectory");
|
|
1679
|
3246 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
|
|
1105
|
3247 Qfile_name_as_directory = intern ("file-name-as-directory");
|
|
843
|
3248 Qcopy_file = intern ("copy-file");
|
|
|
3249 Qmake_directory = intern ("make-directory");
|
|
|
3250 Qdelete_directory = intern ("delete-directory");
|
|
|
3251 Qdelete_file = intern ("delete-file");
|
|
|
3252 Qrename_file = intern ("rename-file");
|
|
|
3253 Qadd_name_to_file = intern ("add-name-to-file");
|
|
|
3254 Qmake_symbolic_link = intern ("make-symbolic-link");
|
|
|
3255 Qfile_exists_p = intern ("file-exists-p");
|
|
|
3256 Qfile_executable_p = intern ("file-executable-p");
|
|
|
3257 Qfile_readable_p = intern ("file-readable-p");
|
|
|
3258 Qfile_symlink_p = intern ("file-symlink-p");
|
|
|
3259 Qfile_writable_p = intern ("file-writable-p");
|
|
|
3260 Qfile_directory_p = intern ("file-directory-p");
|
|
|
3261 Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
|
|
|
3262 Qfile_modes = intern ("file-modes");
|
|
|
3263 Qset_file_modes = intern ("set-file-modes");
|
|
|
3264 Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
|
|
|
3265 Qinsert_file_contents = intern ("insert-file-contents");
|
|
|
3266 Qwrite_region = intern ("write-region");
|
|
|
3267 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
|
|
|
3268
|
|
1679
|
3269 staticpro (&Qexpand_file_name);
|
|
|
3270 staticpro (&Qdirectory_file_name);
|
|
|
3271 staticpro (&Qfile_name_directory);
|
|
|
3272 staticpro (&Qfile_name_nondirectory);
|
|
|
3273 staticpro (&Qunhandled_file_name_directory);
|
|
|
3274 staticpro (&Qfile_name_as_directory);
|
|
863
|
3275 staticpro (&Qcopy_file);
|
|
|
3276 staticpro (&Qmake_directory);
|
|
|
3277 staticpro (&Qdelete_directory);
|
|
|
3278 staticpro (&Qdelete_file);
|
|
|
3279 staticpro (&Qrename_file);
|
|
|
3280 staticpro (&Qadd_name_to_file);
|
|
|
3281 staticpro (&Qmake_symbolic_link);
|
|
|
3282 staticpro (&Qfile_exists_p);
|
|
|
3283 staticpro (&Qfile_executable_p);
|
|
|
3284 staticpro (&Qfile_readable_p);
|
|
|
3285 staticpro (&Qfile_symlink_p);
|
|
|
3286 staticpro (&Qfile_writable_p);
|
|
|
3287 staticpro (&Qfile_directory_p);
|
|
|
3288 staticpro (&Qfile_accessible_directory_p);
|
|
|
3289 staticpro (&Qfile_modes);
|
|
|
3290 staticpro (&Qset_file_modes);
|
|
|
3291 staticpro (&Qfile_newer_than_file_p);
|
|
|
3292 staticpro (&Qinsert_file_contents);
|
|
|
3293 staticpro (&Qwrite_region);
|
|
|
3294 staticpro (&Qverify_visited_file_modtime);
|
|
1679
|
3295
|
|
|
3296 Qfile_name_history = intern ("file-name-history");
|
|
|
3297 Fset (Qfile_name_history, Qnil);
|
|
863
|
3298 staticpro (&Qfile_name_history);
|
|
|
3299
|
|
230
|
3300 Qfile_error = intern ("file-error");
|
|
|
3301 staticpro (&Qfile_error);
|
|
|
3302 Qfile_already_exists = intern("file-already-exists");
|
|
|
3303 staticpro (&Qfile_already_exists);
|
|
|
3304
|
|
|
3305 Fput (Qfile_error, Qerror_conditions,
|
|
|
3306 Fcons (Qfile_error, Fcons (Qerror, Qnil)));
|
|
|
3307 Fput (Qfile_error, Qerror_message,
|
|
|
3308 build_string ("File error"));
|
|
|
3309
|
|
|
3310 Fput (Qfile_already_exists, Qerror_conditions,
|
|
|
3311 Fcons (Qfile_already_exists,
|
|
|
3312 Fcons (Qfile_error, Fcons (Qerror, Qnil))));
|
|
|
3313 Fput (Qfile_already_exists, Qerror_message,
|
|
|
3314 build_string ("File already exists"));
|
|
|
3315
|
|
|
3316 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
|
|
|
3317 "*Non-nil means when reading a filename start with default dir in minibuffer.");
|
|
|
3318 insert_default_directory = 1;
|
|
|
3319
|
|
|
3320 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
|
|
|
3321 "*Non-nil means write new files with record format `stmlf'.\n\
|
|
|
3322 nil means use format `var'. This variable is meaningful only on VMS.");
|
|
|
3323 vms_stmlf_recfm = 0;
|
|
|
3324
|
|
850
|
3325 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
|
|
|
3326 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
|
|
|
3327 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
|
|
|
3328 HANDLER.\n\
|
|
|
3329 \n\
|
|
|
3330 The first argument given to HANDLER is the name of the I/O primitive\n\
|
|
|
3331 to be handled; the remaining arguments are the arguments that were\n\
|
|
|
3332 passed to that primitive. For example, if you do\n\
|
|
|
3333 (file-exists-p FILENAME)\n\
|
|
|
3334 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
|
|
1679
|
3335 (funcall HANDLER 'file-exists-p FILENAME)\n\
|
|
|
3336 The function `find-file-name-handler' checks this list for a handler\n\
|
|
|
3337 for its argument.");
|
|
1178
|
3338 Vfile_name_handler_alist = Qnil;
|
|
|
3339
|
|
1679
|
3340 defsubr (&Sfind_file_name_handler);
|
|
230
|
3341 defsubr (&Sfile_name_directory);
|
|
|
3342 defsubr (&Sfile_name_nondirectory);
|
|
1679
|
3343 defsubr (&Sunhandled_file_name_directory);
|
|
230
|
3344 defsubr (&Sfile_name_as_directory);
|
|
|
3345 defsubr (&Sdirectory_file_name);
|
|
|
3346 defsubr (&Smake_temp_name);
|
|
|
3347 defsubr (&Sexpand_file_name);
|
|
|
3348 defsubr (&Ssubstitute_in_file_name);
|
|
|
3349 defsubr (&Scopy_file);
|
|
1533
|
3350 defsubr (&Smake_directory_internal);
|
|
686
|
3351 defsubr (&Sdelete_directory);
|
|
230
|
3352 defsubr (&Sdelete_file);
|
|
|
3353 defsubr (&Srename_file);
|
|
|
3354 defsubr (&Sadd_name_to_file);
|
|
|
3355 #ifdef S_IFLNK
|
|
|
3356 defsubr (&Smake_symbolic_link);
|
|
|
3357 #endif /* S_IFLNK */
|
|
|
3358 #ifdef VMS
|
|
|
3359 defsubr (&Sdefine_logical_name);
|
|
|
3360 #endif /* VMS */
|
|
|
3361 #ifdef HPUX_NET
|
|
|
3362 defsubr (&Ssysnetunam);
|
|
|
3363 #endif /* HPUX_NET */
|
|
|
3364 defsubr (&Sfile_name_absolute_p);
|
|
|
3365 defsubr (&Sfile_exists_p);
|
|
|
3366 defsubr (&Sfile_executable_p);
|
|
|
3367 defsubr (&Sfile_readable_p);
|
|
|
3368 defsubr (&Sfile_writable_p);
|
|
|
3369 defsubr (&Sfile_symlink_p);
|
|
|
3370 defsubr (&Sfile_directory_p);
|
|
536
|
3371 defsubr (&Sfile_accessible_directory_p);
|
|
230
|
3372 defsubr (&Sfile_modes);
|
|
|
3373 defsubr (&Sset_file_modes);
|
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3374 defsubr (&Sset_default_file_modes);
|
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3375 defsubr (&Sdefault_file_modes);
|
|
230
|
3376 defsubr (&Sfile_newer_than_file_p);
|
|
|
3377 defsubr (&Sinsert_file_contents);
|
|
|
3378 defsubr (&Swrite_region);
|
|
|
3379 defsubr (&Sverify_visited_file_modtime);
|
|
|
3380 defsubr (&Sclear_visited_file_modtime);
|
|
|
3381 defsubr (&Sset_visited_file_modtime);
|
|
|
3382 defsubr (&Sdo_auto_save);
|
|
|
3383 defsubr (&Sset_buffer_auto_saved);
|
|
|
3384 defsubr (&Srecent_auto_save_p);
|
|
|
3385
|
|
|
3386 defsubr (&Sread_file_name_internal);
|
|
|
3387 defsubr (&Sread_file_name);
|
|
689
|
3388
|
|
1204
|
3389 #ifdef unix
|
|
689
|
3390 defsubr (&Sunix_sync);
|
|
1204
|
3391 #endif
|
|
230
|
3392 }
|
