annotate src/fileio.c @ 230:5eb609139f6f

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