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