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