![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fileio.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src|
Return to fileio.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* File IO for GNU Emacs.
2: Copyright (C) 1985 Richard M. Stallman.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include <sys/types.h>
23: #include <sys/stat.h>
24: #include <pwd.h>
25: #include <ctype.h>
26: #include <sys/dir.h>
27: #include <errno.h>
28: #undef NULL
29: #include "config.h"
30: #include "lisp.h"
31: #include "buffer.h"
32: #include "window.h"
33:
34: #define min(a, b) ((a) < (b) ? (a) : (b))
35: #define max(a, b) ((a) > (b) ? (a) : (b))
36:
37: /* Nonzero during writing of auto-save files */
38: int auto_saving;
39:
40: /* Nonzero means, when reading a filename in the minibuffer,
41: start out by inserting the default directory into the minibuffer. */
42: int insert_default_directory;
43:
44: Lisp_Object Qfile_error, Qfile_already_exists;
45:
46: report_file_error (string, data)
47: char *string;
48: Lisp_Object data;
49: {
50: Lisp_Object errstring;
51: extern char *sys_errlist[];
52: extern int errno;
53: extern int sys_nerr;
54:
55: if (errno < sys_nerr)
56: errstring = build_string (sys_errlist[errno]);
57: else
58: errstring = build_string ("undocumented error code");
59:
60: /* System error messages are capitalized. Downcase the initial. */
61: if (XSTRING (errstring)->data[0] >= 'A' &&
62: XSTRING (errstring)->data[0] <= 'Z')
63: XSTRING (errstring)->data[0] += 040;
64:
65: while (1)
66: Fsignal (Qfile_error,
67: Fcons (build_string (string), Fcons (errstring, data)));
68: }
69:
70: DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
71: 1, 1, 0,
72: "Return the directory component in file name NAME.\n\
73: Return nil if NAME does not include a directory.\n\
74: Otherwise return a string ending in a slash.")
75: (file)
76: Lisp_Object file;
77: {
78: register unsigned char *beg;
79: register unsigned char *p;
80:
81: CHECK_STRING (file, 0);
82:
83: beg = XSTRING (file)->data;
84: p = beg + XSTRING (file)->size;
85:
86: while (p != beg && p[-1] != '/') p--;
87:
88: if (p == beg)
89: return Qnil;
90: return make_string (beg, p - beg);
91: }
92:
93: DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
94: 1, 1, 0,
95: "Return file name NAME sans its directory.\n\
96: This is everything after the last slash in NAME, if NAME contains a slash.")
97: (file)
98: Lisp_Object file;
99: {
100: register unsigned char *beg, *p, *end;
101:
102: CHECK_STRING (file, 0);
103:
104: beg = XSTRING (file)->data;
105: end = p = beg + XSTRING (file)->size;
106:
107: while (p != beg && p[-1] != '/') p--;
108:
109: return make_string (p, end - p);
110: }
111:
112: DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
113: "Generate temporary name (string) starting with PREFIX (a string).")
114: (prefix)
115: Lisp_Object prefix;
116: {
117: Lisp_Object val;
118: val = concat2 (prefix, build_string ("XXXXXX"));
119: mktemp (XSTRING (val)->data);
120: return val;
121: }
122:
123: DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
124: "Convert FILENAME to absolute, and canonicalize it.\n\
125: Second arg DEFAULT is directory to start with if FILENAME is relative\n\
126: (does not start with slash); if DEFAULT is nil or missing,\n\
127: the current buffer's value of default-directory is used.\n\
128: Filenames containing . or .. as components are simplified;\n\
129: initial ~ is expanded. See also the function substitute-in-file-name.")
130: (name, defalt)
131: Lisp_Object name, defalt;
132: {
133: unsigned char *nm;
134:
135: register unsigned char *newdir, *p, *o;
136: int tlen;
137: unsigned char *target;
138: struct passwd *pw;
139: int lose;
140:
141: CHECK_STRING (name, 0);
142:
143: nm = XSTRING (name)->data;
144:
145: /* If nm is absolute, flush ...// and detect /./ and /../.
146: If no /./ or /../ we can return right away. */
147: if (nm[0] == '/')
148: {
149: p = nm;
150: lose = 0;
151: while (*p)
152: {
153: if (p[0] == '/' && p[1] == '/'
154: #ifdef APOLLO
155: /* // at start of filename is meaningful on Apollo system */
156: && nm != p
157: #endif /* APOLLO */
158: )
159: nm = p + 1;
160: if (p[0] == '/' && p[1] == '~')
161: nm = p + 1, lose = 1;
162: if (p[0] == '/' && p[1] == '.'
163: && (p[2] == '/' || p[2] == 0
164: || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
165: lose = 1;
166: p++;
167: }
168: if (!lose)
169: {
170: if (nm == XSTRING (name)->data)
171: return name;
172: return build_string (nm);
173: }
174: }
175:
176: /* Now determine directory to start with and put it in newdir */
177:
178: newdir = 0;
179:
180: if (nm[0] == '~') /* prefix ~ */
181: if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
182: {
183: if (!(newdir = (unsigned char *) getenv ("HOME")))
184: newdir = (unsigned char *) "";
185: nm++;
186: }
187: else /* ~user/filename */
188: {
189: for (p = nm; *p && *p != '/'; p++);
190: o = (unsigned char *) alloca (p - nm + 1);
191: bcopy ((char *) nm, o, p - nm);
192: o [p - nm] = 0;
193:
194: pw = (struct passwd *) getpwnam (o + 1);
195: if (!pw)
196: error ("\"%s\" isn't a registered user", o + 1);
197:
198: nm = p;
199: newdir = (unsigned char *) pw -> pw_dir;
200: }
201:
202: if (nm[0] != '/' && !newdir)
203: {
204: if (NULL (defalt))
205: defalt = bf_cur->directory;
206: CHECK_STRING (defalt, 1);
207: newdir = XSTRING (defalt)->data;
208: }
209:
210: /* Now concatenate the directory and name to new space in thestack frame */
211:
212: tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
213: target = (unsigned char *) alloca (tlen);
214: *target = 0;
215:
216: if (newdir)
217: {
218: strcpy (target, newdir);
219:
220: /* Make sure there is a slash to separate directory from following */
221: if (target[strlen (target) - 1] != '/' && nm[0] != '/' && nm[0])
222: strcat (target, "/");
223: }
224:
225: strcat (target, nm);
226:
227: /* Now canonicalize by removing /. and /foo/.. if they appear */
228:
229: p = target;
230: o = target;
231:
232: while (*p)
233: {
234: if (*p != '/')
235: {
236: *o++ = *p++;
237: }
238: else if (!strncmp (p, "//", 2)
239: #ifdef APOLLO
240: /* // at start of filename is meaningful in Apollo system */
241: && o != target
242: #endif /* APOLLO */
243: )
244: {
245: o = target;
246: p++;
247: }
248: else if (p[0] == '/' && p[1] == '.' &&
249: (p[2] == '/' || p[2] == 0))
250: p += 2;
251: else if (!strncmp (p, "/..", 3)
252: && (p[3] == '/' || p[3] == 0))
253: {
254: while (o != target && *--o != '/');
255: p += 3;
256: }
257: else
258: {
259: *o++ = *p++;
260: }
261: }
262:
263: return make_string (target, o - target);
264: }
265:
266: DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
267: Ssubstitute_in_file_name, 1, 1, 0,
268: "Substitute environment variables referred to in STRING.\n\
269: A $ begins a request to substitute; the env variable name is\n\
270: the alphanumeric characters after the $, or else is surrounded by braces.\n\
271: If a ~ appears following a /, everything through that / is discarded.")
272: (string)
273: Lisp_Object string;
274: {
275: unsigned char *nm;
276:
277: register unsigned char *s, *p, *o, *x, *endp;
278: unsigned char *target;
279: int total = 0;
280: unsigned char *xnm;
281:
282: CHECK_STRING (string, 0);
283:
284: nm = XSTRING (string)->data;
285: endp = nm + XSTRING (string)->size;
286:
287: /* If /~ or // appears, discard everything through first slash. */
288:
289: for (p = nm; p != endp; p++)
290: {
291: if ((p[0] == '~' ||
292: #ifdef APOLLO
293: /* // at start of file name is meaningful in Apollo system */
294: (p[0] == '/' && p - 1 != nm)
295: #else /* not APOLLO */
296: p[0] == '/'
297: #endif /* not APOLLO */
298: )
299: && p != nm && p[-1] == '/')
300: {
301: nm = p;
302: total = 1;
303: }
304: }
305:
306: /* See if any variables are substituted into the string
307: and find the total length of their values in `total' */
308:
309: for (p = nm; p != endp;)
310: if (*p == '$')
311: {
312: p++;
313: if (p == endp) goto badsubst;
314: if (*p == '{')
315: {
316: o = ++p;
317: while (p != endp && *p != '}') p++;
318: if (*p != '}') goto missingclose;
319: s = p;
320: }
321: else
322: {
323: o = p;
324: while (p != endp && isalnum(*p)) p++;
325: s = p;
326: }
327:
328: /* Copy out the variable name */
329: target = (unsigned char *) alloca (s - o + 1);
330: strncpy (target, o, s - o);
331: target[s - o] = 0;
332:
333: /* Get variable value */
334: o = (unsigned char *) getenv (target);
335: /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
336: #if 0
337: #ifdef USG
338: if (!o && !strcmp (target, "USER"))
339: o = (unsigned char *) getenv ("LOGNAME");
340: #endif /* USG */
341: #endif /* 0 */
342: if (!o)
343: goto badvar;
344: total += strlen (o);
345: }
346: else p++;
347:
348: if (!total)
349: return string;
350:
351: /* If substitution required, recopy the string and do it */
352: /* Make space in stack frame for the new copy */
353: xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
354: x = xnm;
355:
356: /* Copy the rest of the name through, replacing $ constructs with values */
357: for (p = nm; *p;)
358: if (*p == '$')
359: {
360: p++;
361: if (p == endp) goto badsubst;
362: if (*p == '{')
363: {
364: o = ++p;
365: while (p != endp && *p != '}') p++;
366: if (*p != '}') goto missingclose;
367: s = p++;
368: }
369: else
370: {
371: o = p;
372: while (p != endp && isalnum(*p)) p++;
373: s = p;
374: }
375:
376: /* Copy out the variable name */
377: target = (unsigned char *) alloca (s - o + 1);
378: strncpy (target, o, s - o);
379: target[s - o] = 0;
380:
381: /* Get variable value */
382: o = (unsigned char *) getenv (target);
383: /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
384: #if 0
385: #ifdef USG
386: if (!o && !strcmp (target, "USER"))
387: o = (unsigned char *) getenv ("LOGNAME");
388: #endif /* USG */
389: #endif /* 0 */
390: if (!o)
391: goto badvar;
392:
393: strcpy (x, o);
394: x += strlen (o);
395: }
396: else
397: *x++ = *p++;
398:
399: *x = 0;
400:
401: /* If /~ or // appears, discard everything through first slash. */
402:
403: for (p = xnm; p != x; p++)
404: if ((p[0] == '~' ||
405: #ifdef APOLLO
406: /* // at start of file name is meaningful in Apollo system */
407: (p[0] == '/' && p - 1 != xnm)
408: #else /* not APOLLO */
409: p[0] == '/'
410: #endif /* not APOLLO */
411: )
412: && p != nm && p[-1] == '/')
413: xnm = p;
414:
415: return make_string (xnm, x - xnm);
416:
417: badsubst:
418: error ("Bad format environment-variable substitution");
419: missingclose:
420: error ("Missing \"}\" in environment-variable substitution");
421: badvar:
422: error ("Substituting nonexistent environment variable %s", target);
423:
424: /* NOTREACHED */
425: }
426:
427: barf_or_query_if_file_exists (absname, querystring)
428: Lisp_Object absname;
429: unsigned char *querystring;
430: {
431: Lisp_Object tem;
432: if (access (XSTRING (absname)->data, 4) >= 0)
433: if (!(Finteractive_p ()) ||
434: (tem = Fyes_or_no_p
435: (format1 ("File %s already exists; %s anyway? ",
436: XSTRING (absname)->data, querystring)),
437: NULL (tem)))
438: Fsignal (Qfile_already_exists, Fcons (absname, Qnil));
439: return;
440: }
441:
442: DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 3,
443: "fCopy file: \nFCopy %s to file: ",
444: "Copy FILE to NEWNAME. Both args strings.\n\
445: Signals a file-already-exists error if NEWNAME already exists,\n\
446: unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.")
447: (filename, newname, ok_if_already_exists)
448: Lisp_Object filename, newname, ok_if_already_exists;
449: {
450: int ifd, ofd, n;
451: char buf[2048];
452: struct stat st;
453:
454: CHECK_STRING (filename, 0);
455: CHECK_STRING (newname, 1);
456: filename = Fexpand_file_name (filename, Qnil);
457: newname = Fexpand_file_name (newname, Qnil);
458: if (NULL (ok_if_already_exists))
459: barf_or_query_if_file_exists (newname, "copy to it");
460:
461: ifd = open (XSTRING (filename)->data, 0);
462: if (ifd < 0)
463: report_file_error ("Opening input file", Fcons (filename, Qnil));
464:
465: ofd = creat (XSTRING (newname)->data, 0666);
466: if (ofd < 0)
467: {
468: close (ifd);
469: report_file_error ("Opening output file", Fcons (newname, Qnil));
470: }
471:
472: while ((n = read (ifd, buf, sizeof buf)) > 0)
473: write (ofd, buf, n);
474:
475: if (fstat (ifd, &st) >= 0)
476: #if defined (BSD) && !defined (BSD4_1)
477: fchmod (ofd, st.st_mode & 07777);
478: #else
479: chmod (XSTRING (newname)->data, st.st_mode & 07777);
480: #endif
481:
482: close (ifd);
483: close (ofd);
484: return Qnil;
485: }
486:
487: DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
488: "Delete specified file. One argument, a file name string.\n\
489: If file has multiple names, it continues to exist with the other names.")
490: (filename)
491: Lisp_Object filename;
492: {
493: CHECK_STRING (filename, 0);
494: filename = Fexpand_file_name (filename, Qnil);
495: if (0 > unlink (XSTRING (filename)->data))
496: report_file_error ("Removing old name", Flist (1, &filename));
497: return Qnil;
498: }
499:
500: DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
501: "fRename file: \nFRename %s to file: ",
502: "Rename FILE as NEWNAME. Both args strings.\n\
503: If file has names other than FILE, it continues to have those names.\n\
504: Signals a file-already-exists error if NEWNAME already exists\n\
505: unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.")
506: (filename, newname, ok_if_already_exists)
507: Lisp_Object filename, newname, ok_if_already_exists;
508: {
509: extern int errno;
510: #ifdef NO_ARG_ARRAY
511: Lisp_Object args[2];
512: #endif
513:
514: CHECK_STRING (filename, 0);
515: CHECK_STRING (newname, 1);
516: filename = Fexpand_file_name (filename, Qnil);
517: newname = Fexpand_file_name (newname, Qnil);
518: if (NULL (ok_if_already_exists))
519: barf_or_query_if_file_exists (newname, "rename to it");
520: #ifndef BSD4_1
521: if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
522: #else
523: if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
524: || 0 > unlink (XSTRING (filename)->data))
525: #endif
526: {
527: if (errno == EXDEV)
528: {
529: Fcopy_file (filename, newname, ok_if_already_exists);
530: Fdelete_file (filename);
531: }
532: else
533: #ifdef NO_ARG_ARRAY
534: {
535: args[0] = filename;
536: args[1] = newname;
537: report_file_error ("Renaming", Flist (2, args));
538: }
539: #else
540: report_file_error ("Renaming", Flist (2, &filename));
541: #endif
542: }
543: return Qnil;
544: }
545:
546: DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
547: "fAdd name to file: \nFName to add to %s: ",
548: "Give FILE additional name NEWNAME. Both args strings.\n\
549: Signals a file-already-exists error if NEWNAME already exists\n\
550: unlesss optional third argument OK-IF-ALREADY-EXISTS is non-nil.")
551: (filename, newname, ok_if_already_exists)
552: Lisp_Object filename, newname, ok_if_already_exists;
553: {
554: #ifdef NO_ARG_ARRAY
555: Lisp_Object args[2];
556: #endif
557:
558: CHECK_STRING (filename, 0);
559: CHECK_STRING (newname, 1);
560: filename = Fexpand_file_name (filename, Qnil);
561: newname = Fexpand_file_name (newname, Qnil);
562: if (NULL (ok_if_already_exists))
563: barf_or_query_if_file_exists (newname, "make it a new name");
564: unlink (XSTRING (newname)->data);
565: if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
566: {
567: #ifdef NO_ARG_ARRAY
568: args[0] = filename;
569: args[1] = newname;
570: report_file_error ("Adding new name", Flist (2, args));
571: #else
572: report_file_error ("Adding new name", Flist (2, &filename));
573: #endif
574: }
575:
576: return Qnil;
577: }
578:
579: #ifdef S_IFLNK
580: DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
581: "FMake symbolic link to file: \nFMake symbolic link to file %s: ",
582: "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
583: Signals a file-already-exists error if NEWNAME already exists\n\
584: unlesss optional third argument OK-IF-ALREADY-EXISTS is non-nil.")
585:
586: (filename, newname, ok_if_already_exists)
587: Lisp_Object filename, newname, ok_if_already_exists;
588: {
589: #ifdef NO_ARG_ARRAY
590: Lisp_Object args[2];
591: #endif
592:
593: CHECK_STRING (filename, 0);
594: CHECK_STRING (newname, 1);
595: filename = Fexpand_file_name (filename, Qnil);
596: newname = Fexpand_file_name (newname, Qnil);
597: if (NULL (ok_if_already_exists))
598: barf_or_query_if_file_exists (newname, "make it a link");
599: if (0 > symlink (XSTRING (filename)->data, XSTRING (newname)->data))
600: {
601: #ifdef NO_ARG_ARRAY
602: args[0] = filename;
603: args[1] = newname;
604: report_file_error ("Making symbolic link", Flist (2, args));
605: #else
606: report_file_error ("Making symbolic link", Flist (2, &filename));
607: #endif
608: }
609: return Qnil;
610: }
611: #endif /* S_IFLNK */
612:
613: DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
614: "Return t if file FILENAME exists and you can read it.\n\
615: Use file-attributes to check for existence not caring about readability.")
616: (filename)
617: Lisp_Object filename;
618: {
619: Lisp_Object abspath;
620:
621: CHECK_STRING (filename, 0);
622: abspath = Fexpand_file_name (filename, Qnil);
623: return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
624: }
625:
626: DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
627: "Return t if file FILENAME can be written or created by you.")
628: (filename)
629: Lisp_Object filename;
630: {
631: Lisp_Object abspath, dir;
632:
633: CHECK_STRING (filename, 0);
634: abspath = Fexpand_file_name (filename, Qnil);
635: if (access (XSTRING (abspath)->data, 0) >= 0)
636: return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
637: dir = Ffile_name_directory (abspath);
638: return (access (!NULL (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
639: ? Qt : Qnil);
640: }
641:
642: DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
643: "If file FILENAME is the name of a symbolic link\n\
644: returns the name of the file to which it is linked.\n\
645: Otherwise returns NIL.")
646: (filename)
647: Lisp_Object filename;
648: {
649: #ifdef S_IFLNK
650: char *buf;
651: int bufsize;
652: int valsize;
653: Lisp_Object val;
654:
655: CHECK_STRING (filename, 0);
656:
657: bufsize = 100;
658: while (1)
659: {
660: buf = (char *) xmalloc (bufsize);
661: bzero (buf, bufsize);
662: valsize = readlink (XSTRING (filename)->data, buf, bufsize);
663: if (valsize < bufsize) break;
664: /* Buffer was not long enough */
665: free (buf);
666: bufsize *= 2;
667: }
668: if (valsize == -1)
669: {
670: free (buf);
671: return Qnil;
672: }
673: val = make_string (buf, valsize);
674: free (buf);
675: return val;
676: #else /* not S_IFLNK */
677: return Qnil;
678: #endif /* not S_IFLNK */
679: }
680:
681: DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
682: "Return t if file FILENAME is the name of a directory.")
683: (filename)
684: Lisp_Object filename;
685: {
686: register Lisp_Object abspath;
687: struct stat st;
688:
689: abspath = Fexpand_file_name (filename, bf_cur->directory);
690: /* Remove final slash, if any (unless path is root).
691: stat behaves differently depending! */
692: if (XSTRING (abspath)->size > 1
693: && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
694: {
695: if (EQ (abspath, filename))
696: abspath = Fcopy_sequence (abspath);
697: XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
698: }
699:
700: if (stat (XSTRING (abspath)->data, &st) < 0)
701: return Qnil;
702: return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
703: }
704:
705: DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
706: "Return mode bits of FILE, as an integer.")
707: (filename)
708: Lisp_Object filename;
709: {
710: Lisp_Object abspath;
711: struct stat st;
712:
713: abspath = Fexpand_file_name (filename, bf_cur->directory);
714:
715: /* Remove final slash, if any (unless path is the root).
716: stat behaves differently depending! */
717: if (XSTRING (abspath)->size > 1
718: && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
719: {
720: if (EQ (abspath, filename))
721: abspath = Fcopy_sequence (abspath);
722: XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
723: }
724:
725: if (stat (XSTRING (abspath)->data, &st) < 0)
726: return Qnil;
727: return make_number (st.st_mode & 07777);
728: }
729:
730: DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
731: "Set mode bits of FILE to MODE (an integer).\n\
732: Only the 12 low bits of MODE are used.")
733: (filename, mode)
734: Lisp_Object filename, mode;
735: {
736: Lisp_Object abspath;
737:
738: abspath = Fexpand_file_name (filename, bf_cur->directory);
739: CHECK_NUMBER (mode, 1);
740: if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
741: report_file_error ("Doing chmod", Fcons (abspath, Qnil));
742: return Qnil;
743: }
744:
745: close_file_unwind (fd)
746: Lisp_Object fd;
747: {
748: close (XFASTINT (fd));
749: }
750:
751: DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
752: 1, 2, 0,
753: "Insert contents of file FILENAME after point.\n\
754: Returns list of absolute pathname and length of data inserted.\n\
755: If second argument VISIT is non-nil, the buffer's\n\
756: visited filename and last save file modtime are set,\n\
757: and it is marked unmodified.")
758: (filename, visit)
759: Lisp_Object filename, visit;
760: {
761: struct stat st;
762: register int fd;
763: register int n, i;
764: int count = specpdl_ptr - specpdl;
765:
766: if (!NULL (bf_cur->read_only))
767: Fbarf_if_buffer_read_only();
768:
769: CHECK_STRING (filename, 0);
770: filename = Fexpand_file_name (filename, Qnil);
771:
772: if (stat (XSTRING (filename)->data, &st) < 0
773: || (fd = open (XSTRING (filename)->data, 0)) < 0)
774: report_file_error ("Opening input file", Fcons (filename, Qnil));
775:
776: record_unwind_protect (close_file_unwind, make_number (fd));
777:
778: if (NULL (visit))
779: prepare_to_modify_buffer ();
780:
781: RecordInsert (point, st.st_size);
782: bf_modified++;
783:
784: GapTo (point);
785: if (bf_gap < st.st_size)
786: make_gap (st.st_size);
787:
788: n = 0;
789: while ((i = read (fd, bf_p1 + bf_s1 + 1, st.st_size - n)) > 0)
790: {
791: bf_s1 += i;
792: bf_gap -= i;
793: bf_p2 -= i;
794: n += i;
795: }
796:
797: if (!NULL (visit))
798: DoneIsDone ();
799:
800: close (fd);
801: /* Discard the unwind protect */
802: specpdl_ptr = specpdl + count;
803:
804: if (i < 0)
805: error ("IO error reading %s", XSTRING (filename)->data);
806:
807: if (!NULL (visit))
808: {
809: bf_cur->modtime = st.st_mtime;
810: bf_cur->save_modified = bf_modified;
811: bf_cur->auto_save_modified = bf_modified;
812: XFASTINT (bf_cur->save_length) = NumCharacters;
813: #ifdef CLASH_DETECTION
814: if (!NULL (bf_cur->filename))
815: unlock_file (bf_cur->filename);
816: unlock_file (filename);
817: #endif /* CLASH_DETECTION */
818: bf_cur->filename = filename;
819: }
820:
821: return Fcons (filename, Fcons (make_number (st.st_size), Qnil));
822: }
823:
824: DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
825: "r\nFWrite region to file: ",
826: "Write current region into specified file.\n\
827: When called from a program, takes three arguments:\n\
828: START, END and FILENAME. START and END are buffer positions.\n\
829: Optional fourth argument APPEND if non-nil means\n\
830: append to existing file contents (if any).\n\
831: Optional fifth argument VISIT if t means\n\
832: set last-save-file-modtime of buffer to this file's modtime\n\
833: and mark buffer not modified.\n\
834: If VISIT is neither t nor nil, it means do not print\n\
835: the \"Wrote file\" message.")
836: (start, end, filename, append, visit)
837: Lisp_Object start, end, filename, append, visit;
838: {
839: register int fd;
840: int failure = 0;
841: unsigned char *fn;
842: struct stat st;
843: int tem;
844: int count = specpdl_ptr - specpdl;
845:
846: /* Special kludge to simplify auto-saving */
847: if (NULL (start))
848: {
849: XFASTINT (start) = 1;
850: XFASTINT (end) = 1 + bf_s1 + bf_s2;
851: }
852: else
853: validate_region (&start, &end);
854:
855: filename = Fexpand_file_name (filename, Qnil);
856: fn = XSTRING (filename)->data;
857:
858: #ifdef CLASH_DETECTION
859: if (!auto_saving)
860: lock_file (filename);
861: #endif /* CLASH_DETECTION */
862:
863: fd = -1;
864: if (!NULL (append))
865: fd = open (fn, 1);
866:
867: if (fd < 0)
868: fd = creat (fn, 0666);
869:
870: if (fd < 0)
871: {
872: #ifdef CLASH_DETECTION
873: if (!auto_saving) unlock_file (filename);
874: #endif /* CLASH_DETECTION */
875: report_file_error ("Opening output file", Fcons (filename, Qnil));
876: }
877:
878: record_unwind_protect (close_file_unwind, make_number (fd));
879:
880: if (!NULL (append))
881: if (lseek (fd, 0, 2) < 0)
882: {
883: #ifdef CLASH_DETECTION
884: if (!auto_saving) unlock_file (filename);
885: #endif /* CLASH_DETECTION */
886: report_file_error ("Lseek error", Fcons (filename, Qnil));
887: }
888:
889: failure = 0;
890: if (XINT (start) != XINT (end))
891: {
892: if (XINT (start) - 1 < bf_s1)
893: failure = 0 > e_write (fd, &CharAt (XINT (start)),
894: min (bf_s1 + 1, XINT (end)) - XINT (start));
895:
896: if (XINT (end) - 1 > bf_s1 && !failure)
897: {
898: tem = max (XINT (start), bf_s1 + 1);
899: failure = 0 > e_write (fd, &CharAt (tem), XINT (end) - tem);
900: }
901: }
902:
903: fstat (fd, &st);
904: close (fd);
905: /* Discard the unwind protect */
906: specpdl_ptr = specpdl + count;
907:
908: #ifdef CLASH_DETECTION
909: if (!auto_saving)
910: unlock_file (filename);
911: #endif /* CLASH_DETECTION */
912:
913: if (failure)
914: error ("IO error writing %s", fn);
915:
916: if (EQ (visit, Qt))
917: {
918: bf_cur->modtime = st.st_mtime;
919: bf_cur->save_modified = bf_modified;
920: XFASTINT (bf_cur->save_length) = NumCharacters;
921: bf_cur->filename = filename;
922: }
923: else if (!NULL (visit))
924: return Qnil;
925:
926: if (!auto_saving)
927: message ("Wrote %s", fn);
928:
929: return Qnil;
930: }
931:
932: int
933: e_write (fd, addr, len)
934: int fd;
935: register char *addr;
936: register int len;
937: {
938: char buf[1024];
939: register char *p, *end;
940:
941: if (!EQ (bf_cur->selective_display, Qt))
942: return write (fd, addr, len) - len;
943: else
944: {
945: p = buf;
946: end = p + sizeof buf;
947: while (len--)
948: {
949: if (p == end)
950: {
951: if (write (fd, buf, sizeof buf) != sizeof buf)
952: return -1;
953: p = buf;
954: }
955: *p = *addr++;
956: if (*p++ == '\015')
957: p[-1] = '\n';
958: }
959: if (p != buf)
960: if (write (fd, buf, p - buf) != p - buf)
961: return -1;
962: }
963: return 0;
964: }
965:
966: DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
967: Sverify_visited_file_modtime, 1, 1, 0,
968: "Return t if last mod time of BUF's visited file matches what BUF records.\n\
969: This means that the file has not been changed since it was visited or saved.")
970: (buf)
971: Lisp_Object buf;
972: {
973: struct buffer *b = XBUFFER (buf);
974: struct stat st;
975:
976: CHECK_BUFFER (buf, 0);
977:
978: if (XTYPE (b->filename) != Lisp_String) return Qt;
979: if (!b->modtime) return Qt;
980: if (stat (XSTRING (b->filename)->data, &st) < 0)
981: return Qnil;
982: if (st.st_mtime != b->modtime)
983: return Qnil;
984: return Qt;
985: }
986:
987: DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
988: Sclear_visited_file_modtime, 0, 0, 0,
989: "Clear out records of last mod time of visited file.\n\
990: Next attempt to save will certainly not complain of a discrepancy.")
991: ()
992: {
993: bf_cur->modtime = 0;
994: return Qnil;
995: }
996:
997: Lisp_Object
998: auto_save_error ()
999: {
1000: return Qnil;
1001: }
1002:
1003: Lisp_Object
1004: auto_save_1 ()
1005: {
1006: return
1007: Fwrite_region (Qnil, Qnil,
1008: bf_cur->auto_save_file_name,
1009: Qnil, Qlambda);
1010: }
1011:
1012: DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 1, "",
1013: "Auto-save all buffers that need it.\n\
1014: This is all buffers that have auto-saving enabled\n\
1015: and are changed since last auto-saved.\n\
1016: Auto-saving writes the buffer into a file\n\
1017: so that your editing is not lost if the system crashes.\n\
1018: This file is not the file you visited; that changes only when you save.\n\n\
1019: Non-nil argument means do not print any message.")
1020: (nomsg)
1021: Lisp_Object nomsg;
1022: {
1023: struct buffer *old = bf_cur, *b;
1024: Lisp_Object tail, buf;
1025: int auto_saved = 0;
1026: char *omessage = minibuf_message;
1027: extern MinibufDepth;
1028:
1029: auto_saving = 1;
1030: if (MinibufDepth)
1031: nomsg = Qt;
1032:
1033: bf_cur->text = bf_text;
1034:
1035: for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
1036: tail = XCONS (tail)->cdr)
1037: {
1038: buf = XCONS (XCONS (tail)->car)->cdr;
1039: b = XBUFFER (buf);
1040: /* Check for auto save enabled
1041: and file changed since last auto save
1042: and file changed since last real save. */
1043: if (XTYPE (b->auto_save_file_name) == Lisp_String
1044: && b->save_modified < b->text.modified
1045: && b->auto_save_modified < b->text.modified)
1046: {
1047: if (XFASTINT (b->save_length) * 10
1048: > (b->text.size1 + b->text.size2) * 13)
1049: {
1050: /* It has shrunk too much; don't chckpoint. */
1051: /*** Should report this to user somehow ***/
1052: continue;
1053: }
1054: SetBfp (b);
1055: if (!auto_saved && NULL (nomsg))
1056: message1 ("Auto-saving...");
1057: internal_condition_case (auto_save_1, Qt, auto_save_error);
1058: auto_saved++;
1059: b->auto_save_modified = b->text.modified;
1060: XFASTINT (bf_cur->save_length) = NumCharacters;
1061: SetBfp (old);
1062: }
1063: }
1064:
1065: if (auto_saved && NULL (nomsg))
1066: message1 (omessage ? omessage : "Auto-saving...done");
1067:
1068: auto_saving = 0;
1069: return Qnil;
1070: }
1071:
1072: DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
1073: Sset_buffer_auto_saved, 0, 0, 0,
1074: "Mark current buffer as auto-saved with its current text.\n\
1075: No auto-save file will be written until the buffer changes again.")
1076: ()
1077: {
1078: bf_cur->auto_save_modified = bf_modified;
1079: return Qnil;
1080: }
1081:
1082: DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
1083: 0, 0, 0,
1084: "Return t if buffer has been auto-saved since last read in or saved.")
1085: ()
1086: {
1087: return (bf_cur->save_modified < bf_cur->auto_save_modified) ? Qt : Qnil;
1088: }
1089:
1090: /* Reading and completing file names */
1091: extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
1092:
1093: DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
1094: 3, 3, 0,
1095: "Internal subroutine for read-file-name. Do not call this.")
1096: (string, dir, action)
1097: Lisp_Object string, dir, action;
1098: /* action is nil for complete, t for return list of completions,
1099: lambda for verify final value */
1100: {
1101: Lisp_Object name, specdir, realdir, val;
1102: if (XSTRING (string)->size == 0)
1103: {
1104: name = string;
1105: realdir = dir;
1106: if (EQ (action, Qlambda))
1107: return Qnil;
1108: }
1109: else
1110: {
1111: string = Fsubstitute_in_file_name (string);
1112: name = Ffile_name_nondirectory (string);
1113: realdir = Ffile_name_directory (string);
1114: if (NULL (realdir))
1115: realdir = dir;
1116: else
1117: realdir = Fexpand_file_name (realdir, dir);
1118: }
1119:
1120: if (NULL (action))
1121: {
1122: specdir = Ffile_name_directory (string);
1123: val = Ffile_name_completion (name, realdir);
1124: if (XTYPE (val) == Lisp_String && !NULL (specdir))
1125: return concat2 (specdir, val);
1126: return val;
1127: }
1128: if (EQ (action, Qt))
1129: return Ffile_name_all_completions (name, realdir);
1130: /* Only other case actually used is ACTION = lambda */
1131: return Ffile_exists_p (string);
1132: }
1133:
1134: DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 4, 0,
1135: "Read file name, prompting with PROMPT and completing in directory DIR.\n\
1136: Value is not expanded! You must call expand-file-name yourself.\n\
1137: Default name to DEFAULT if user enters a null string.\n\
1138: Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
1139: Non-nil and non-t means also require confirmation after completion.\n\
1140: DIR defaults to current buffer's directory default.")
1141: (prompt, dir, defalt, mustmatch)
1142: Lisp_Object prompt, dir, defalt, mustmatch;
1143: {
1144: Lisp_Object val, insdef, tem;
1145: struct gcpro gcpro1, gcpro2;
1146: register char *homedir;
1147:
1148: if (NULL (dir))
1149: dir = bf_cur->directory;
1150: if (NULL (defalt))
1151: defalt = bf_cur->filename;
1152:
1153: /* If dir starts with user's homedir, change that to ~. */
1154: homedir = (char *) getenv ("HOME");
1155: if (XTYPE (dir) == Lisp_String
1156: && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
1157: && XSTRING (dir)->data[strlen (homedir)] == '/')
1158: {
1159: dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
1160: XSTRING (dir)->size - strlen (homedir) + 1);
1161: XSTRING (dir)->data[0] = '~';
1162: }
1163:
1164: if (insert_default_directory)
1165: insdef = dir;
1166: else
1167: insdef = build_string ("");
1168:
1169: GCPRO2 (insdef, defalt);
1170: val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
1171: dir, mustmatch,
1172: insert_default_directory ? insdef : Qnil);
1173: UNGCPRO;
1174: if (NULL (val))
1175: error ("No file name specified");
1176: tem = Fstring_equal (val, insdef);
1177: if (!NULL (tem) && !NULL (defalt))
1178: return defalt;
1179: return Fsubstitute_in_file_name (val);
1180: }
1181:
1182: syms_of_fileio ()
1183: {
1184: Qfile_error = intern ("file-error");
1185: staticpro (&Qfile_error);
1186: Qfile_already_exists = intern("file-already-exists");
1187: staticpro (&Qfile_already_exists);
1188:
1189: Fput (Qfile_error, Qerror_conditions,
1190: Fcons (Qfile_error, Fcons (Qerror, Qnil)));
1191: Fput (Qfile_error, Qerror_message,
1192: build_string ("File error"));
1193:
1194: Fput (Qfile_already_exists, Qerror_conditions,
1195: Fcons (Qfile_already_exists,
1196: Fcons (Qfile_error, Fcons (Qerror, Qnil))));
1197: Fput (Qfile_already_exists, Qerror_message,
1198: build_string ("File already exists"));
1199:
1200: DefBoolVar ("insert-default-directory", &insert_default_directory,
1201: "*Non-nil means when reading a filename start with default dir in minibuffer.");
1202: insert_default_directory = 1;
1203:
1204: defsubr (&Sfile_name_directory);
1205: defsubr (&Sfile_name_nondirectory);
1206: defsubr (&Smake_temp_name);
1207: defsubr (&Sexpand_file_name);
1208: defsubr (&Ssubstitute_in_file_name);
1209: defsubr (&Scopy_file);
1210: defsubr (&Sdelete_file);
1211: defsubr (&Srename_file);
1212: defsubr (&Sadd_name_to_file);
1213: #ifdef S_IFLNK
1214: defsubr (&Smake_symbolic_link);
1215: #endif /* S_IFLNK */
1216: defsubr (&Sfile_exists_p);
1217: defalias (&Sfile_exists_p, "file-readable-p");
1218: defsubr (&Sfile_writable_p);
1219: defsubr (&Sfile_symlink_p);
1220: defsubr (&Sfile_directory_p);
1221: defsubr (&Sfile_modes);
1222: defsubr (&Sset_file_modes);
1223: defsubr (&Sinsert_file_contents);
1224: defsubr (&Swrite_region);
1225: defsubr (&Sverify_visited_file_modtime);
1226: defsubr (&Sclear_visited_file_modtime);
1227: defsubr (&Sdo_auto_save);
1228: defsubr (&Sset_buffer_auto_saved);
1229: defsubr (&Srecent_auto_save_p);
1230:
1231: defsubr (&Sread_file_name_internal);
1232: defsubr (&Sread_file_name);
1233: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.