230
|
1 /* File IO for GNU Emacs.
|
64770
|
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
|
|
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
75348
|
4 2005, 2006, 2007 Free Software Foundation, Inc.
|
230
|
5
|
|
6 This file is part of GNU Emacs.
|
|
7
|
|
8 GNU Emacs is free software; you can redistribute it and/or modify
|
|
9 it under the terms of the GNU General Public License as published by
|
621
|
10 the Free Software Foundation; either version 2, or (at your option)
|
230
|
11 any later version.
|
|
12
|
|
13 GNU Emacs is distributed in the hope that it will be useful,
|
|
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
16 GNU General Public License for more details.
|
|
17
|
|
18 You should have received a copy of the GNU General Public License
|
|
19 along with GNU Emacs; see the file COPYING. If not, write to
|
64084
|
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
21 Boston, MA 02110-1301, USA. */
|
230
|
22
|
4696
|
23 #include <config.h>
|
230
|
24
|
48652
|
25 #ifdef HAVE_FCNTL_H
|
16534
|
26 #include <fcntl.h>
|
|
27 #endif
|
|
28
|
18270
|
29 #include <stdio.h>
|
230
|
30 #include <sys/types.h>
|
|
31 #include <sys/stat.h>
|
372
|
32
|
6862
|
33 #ifdef HAVE_UNISTD_H
|
|
34 #include <unistd.h>
|
|
35 #endif
|
|
36
|
4879
|
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
|
|
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
|
|
39 #endif
|
|
40
|
16534
|
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
|
|
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
|
|
43 #endif
|
|
44
|
4879
|
45 #if !defined (S_ISREG) && defined (S_IFREG)
|
|
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
|
|
47 #endif
|
|
48
|
61700
|
49 #ifdef HAVE_PWD_H
|
230
|
50 #include <pwd.h>
|
372
|
51 #endif
|
|
52
|
230
|
53 #include <ctype.h>
|
372
|
54
|
|
55 #ifdef VMS
|
5877
|
56 #include "vmsdir.h"
|
372
|
57 #include <perror.h>
|
|
58 #include <stddef.h>
|
|
59 #include <string.h>
|
|
60 #endif
|
|
61
|
230
|
62 #include <errno.h>
|
|
63
|
372
|
64 #ifndef vax11c
|
31095
|
65 #ifndef USE_CRT_DLL
|
230
|
66 extern int errno;
|
|
67 #endif
|
31095
|
68 #endif
|
230
|
69
|
|
70 #ifdef APOLLO
|
|
71 #include <sys/time.h>
|
|
72 #endif
|
|
73
|
|
74 #include "lisp.h"
|
1299
|
75 #include "intervals.h"
|
230
|
76 #include "buffer.h"
|
17062
|
77 #include "charset.h"
|
|
78 #include "coding.h"
|
230
|
79 #include "window.h"
|
71818
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
80 #include "blockinput.h"
|
230
|
81
|
9789
|
82 #ifdef WINDOWSNT
|
|
83 #define NOMINMAX 1
|
|
84 #include <windows.h>
|
|
85 #include <stdlib.h>
|
|
86 #include <fcntl.h>
|
|
87 #endif /* not WINDOWSNT */
|
|
88
|
21787
|
89 #ifdef MSDOS
|
|
90 #include "msdos.h"
|
|
91 #include <sys/param.h>
|
|
92 #if __DJGPP__ >= 2
|
|
93 #include <fcntl.h>
|
|
94 #include <string.h>
|
|
95 #endif
|
|
96 #endif
|
|
97
|
15097
|
98 #ifdef DOS_NT
|
|
99 #define CORRECT_DIR_SEPS(s) \
|
|
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
|
|
101 else unixtodos_filename (s); \
|
|
102 } while (0)
|
|
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
|
|
104 redirector allows the six letters between 'Z' and 'a' as well. */
|
|
105 #ifdef MSDOS
|
|
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
|
15617
|
107 #endif
|
|
108 #ifdef WINDOWSNT
|
|
109 #define IS_DRIVE(x) isalpha (x)
|
|
110 #endif
|
15587
|
111 /* Need to lower-case the drive letter, or else expanded
|
|
112 filenames will sometimes compare inequal, because
|
|
113 `expand-file-name' doesn't always down-case the drive letter. */
|
|
114 #define DRIVE_LETTER(x) (tolower (x))
|
15097
|
115 #endif
|
|
116
|
230
|
117 #ifdef VMS
|
|
118 #include <file.h>
|
|
119 #include <rmsdef.h>
|
|
120 #include <fab.h>
|
|
121 #include <nam.h>
|
|
122 #endif
|
|
123
|
564
|
124 #include "systime.h"
|
230
|
125
|
|
126 #ifdef HPUX
|
|
127 #include <netio.h>
|
350
|
128 #ifndef HPUX8
|
3410
|
129 #ifndef HPUX9
|
230
|
130 #include <errnet.h>
|
|
131 #endif
|
350
|
132 #endif
|
3410
|
133 #endif
|
230
|
134
|
25006
|
135 #include "commands.h"
|
|
136 extern int use_dialog_box;
|
53189
|
137 extern int use_file_dialog;
|
25006
|
138
|
230
|
139 #ifndef O_WRONLY
|
|
140 #define O_WRONLY 1
|
|
141 #endif
|
|
142
|
8597
|
143 #ifndef O_RDONLY
|
|
144 #define O_RDONLY 0
|
|
145 #endif
|
|
146
|
24367
|
147 #ifndef S_ISLNK
|
|
148 # define lstat stat
|
|
149 #endif
|
|
150
|
60354
|
151 #ifndef FILE_SYSTEM_CASE
|
|
152 #define FILE_SYSTEM_CASE(filename) (filename)
|
|
153 #endif
|
|
154
|
230
|
155 /* Nonzero during writing of auto-save files */
|
|
156 int auto_saving;
|
|
157
|
|
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
|
|
159 a new file with the same mode as the original */
|
|
160 int auto_save_mode_bits;
|
|
161
|
51357
|
162 /* The symbol bound to coding-system-for-read when
|
|
163 insert-file-contents is called for recovering a file. This is not
|
|
164 an actual coding system name, but just an indicator to tell
|
|
165 insert-file-contents to use `emacs-mule' with a special flag for
|
|
166 auto saving and recovering a file. */
|
|
167 Lisp_Object Qauto_save_coding;
|
|
168
|
19861
|
169 /* Coding system for file names, or nil if none. */
|
|
170 Lisp_Object Vfile_name_coding_system;
|
|
171
|
21048
|
172 /* Coding system for file names used only when
|
|
173 Vfile_name_coding_system is nil. */
|
|
174 Lisp_Object Vdefault_file_name_coding_system;
|
|
175
|
15097
|
176 /* Alist of elements (REGEXP . HANDLER) for file names
|
843
|
177 whose I/O is done with a special handler. */
|
|
178 Lisp_Object Vfile_name_handler_alist;
|
|
179
|
61942
|
180 /* Property name of a file name handler,
|
|
181 which gives a list of operations it handles.. */
|
|
182 Lisp_Object Qoperations;
|
|
183
|
11053
|
184 /* Lisp functions for translating file formats */
|
|
185 Lisp_Object Qformat_decode, Qformat_annotate_function;
|
|
186
|
19448
|
187 /* Function to be called to decide a coding system of a reading file. */
|
19641
|
188 Lisp_Object Vset_auto_coding_function;
|
19448
|
189
|
4841
|
190 /* Functions to be called to process text properties in inserted file. */
|
|
191 Lisp_Object Vafter_insert_file_functions;
|
|
192
|
50546
|
193 /* Lisp function for setting buffer-file-coding-system and the
|
50530
|
194 multibyteness of the current buffer after inserting a file. */
|
50546
|
195 Lisp_Object Qafter_insert_file_set_coding;
|
50530
|
196
|
4841
|
197 /* Functions to be called to create text property annotations for file. */
|
|
198 Lisp_Object Vwrite_region_annotate_functions;
|
50829
|
199 Lisp_Object Qwrite_region_annotate_functions;
|
4841
|
200
|
8317
|
201 /* During build_annotations, each time an annotation function is called,
|
|
202 this holds the annotations made by the previous functions. */
|
|
203 Lisp_Object Vwrite_region_annotations_so_far;
|
|
204
|
7445
|
205 /* File name in which we write a list of all our auto save files. */
|
|
206 Lisp_Object Vauto_save_list_file_name;
|
|
207
|
45544
|
208 /* Function to call to read a file name. */
|
49207
|
209 Lisp_Object Vread_file_name_function;
|
45544
|
210
|
|
211 /* Current predicate used by read_file_name_internal. */
|
|
212 Lisp_Object Vread_file_name_predicate;
|
|
213
|
56340
|
214 /* Nonzero means completion ignores case when reading file name. */
|
|
215 int read_file_name_completion_ignore_case;
|
|
216
|
230
|
217 /* Nonzero means, when reading a filename in the minibuffer,
|
|
218 start out by inserting the default directory into the minibuffer. */
|
|
219 int insert_default_directory;
|
|
220
|
|
221 /* On VMS, nonzero means write new files with record format stmlf.
|
|
222 Zero means use var format. */
|
|
223 int vms_stmlf_recfm;
|
|
224
|
15097
|
225 /* On NT, specifies the directory separator character, used (eg.) when
|
|
226 expanding file names. This can be bound to / or \. */
|
|
227 Lisp_Object Vdirectory_sep_char;
|
|
228
|
65513
|
229 #ifdef HAVE_FSYNC
|
|
230 /* Nonzero means skip the call to fsync in Fwrite-region. */
|
|
231 int write_region_inhibit_fsync;
|
|
232 #endif
|
|
233
|
16317
|
234 extern Lisp_Object Vuser_login_name;
|
|
235
|
22681
|
236 #ifdef WINDOWSNT
|
|
237 extern Lisp_Object Vw32_get_true_file_attributes;
|
|
238 #endif
|
|
239
|
16317
|
240 extern int minibuf_level;
|
|
241
|
18861
|
242 extern int minibuffer_auto_raise;
|
|
243
|
59050
|
244 extern int history_delete_duplicates;
|
|
245
|
7041
|
246 /* These variables describe handlers that have "already" had a chance
|
|
247 to handle the current operation.
|
|
248
|
|
249 Vinhibit_file_name_handlers is a list of file name handlers.
|
|
250 Vinhibit_file_name_operation is the operation being handled.
|
|
251 If we try to handle that operation, we ignore those handlers. */
|
|
252
|
6678
|
253 static Lisp_Object Vinhibit_file_name_handlers;
|
7041
|
254 static Lisp_Object Vinhibit_file_name_operation;
|
6678
|
255
|
17271
|
256 Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
|
25595
|
257 Lisp_Object Qexcl;
|
863
|
258 Lisp_Object Qfile_name_history;
|
|
259
|
4841
|
260 Lisp_Object Qcar_less_than_car;
|
|
261
|
26855
|
262 static int a_write P_ ((int, Lisp_Object, int, int,
|
20560
|
263 Lisp_Object *, struct coding_system *));
|
26855
|
264 static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *));
|
|
265
|
20533
|
266
|
20370
|
267 void
|
230
|
268 report_file_error (string, data)
|
46465
|
269 const char *string;
|
230
|
270 Lisp_Object data;
|
|
271 {
|
|
272 Lisp_Object errstring;
|
25595
|
273 int errorno = errno;
|
230
|
274
|
26526
|
275 synchronize_system_messages_locale ();
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
276 errstring = code_convert_string_norecord (build_string (strerror (errorno)),
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
277 Vlocale_coding_system, 0);
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
278
|
230
|
279 while (1)
|
25595
|
280 switch (errorno)
|
|
281 {
|
|
282 case EEXIST:
|
71977
|
283 xsignal (Qfile_already_exists, Fcons (errstring, data));
|
25595
|
284 break;
|
|
285 default:
|
|
286 /* System error messages are capitalized. Downcase the initial
|
|
287 unless it is followed by a slash. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
288 if (SREF (errstring, 1) != '/')
|
46424
|
289 SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
|
25595
|
290
|
71977
|
291 xsignal (Qfile_error,
|
25595
|
292 Fcons (build_string (string), Fcons (errstring, data)));
|
|
293 }
|
230
|
294 }
|
592
|
295
|
20313
|
296 Lisp_Object
|
592
|
297 close_file_unwind (fd)
|
|
298 Lisp_Object fd;
|
|
299 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
300 emacs_close (XFASTINT (fd));
|
20313
|
301 return Qnil;
|
592
|
302 }
|
6036
|
303
|
|
304 /* Restore point, having saved it as a marker. */
|
|
305
|
20533
|
306 static Lisp_Object
|
6036
|
307 restore_point_unwind (location)
|
15097
|
308 Lisp_Object location;
|
6036
|
309 {
|
20533
|
310 Fgoto_char (location);
|
6036
|
311 Fset_marker (location, Qnil, Qnil);
|
20313
|
312 return Qnil;
|
6036
|
313 }
|
230
|
314
|
1105
|
315 Lisp_Object Qexpand_file_name;
|
10719
|
316 Lisp_Object Qsubstitute_in_file_name;
|
1105
|
317 Lisp_Object Qdirectory_file_name;
|
|
318 Lisp_Object Qfile_name_directory;
|
|
319 Lisp_Object Qfile_name_nondirectory;
|
1679
|
320 Lisp_Object Qunhandled_file_name_directory;
|
1105
|
321 Lisp_Object Qfile_name_as_directory;
|
843
|
322 Lisp_Object Qcopy_file;
|
8227
|
323 Lisp_Object Qmake_directory_internal;
|
28697
|
324 Lisp_Object Qmake_directory;
|
843
|
325 Lisp_Object Qdelete_directory;
|
|
326 Lisp_Object Qdelete_file;
|
|
327 Lisp_Object Qrename_file;
|
|
328 Lisp_Object Qadd_name_to_file;
|
|
329 Lisp_Object Qmake_symbolic_link;
|
|
330 Lisp_Object Qfile_exists_p;
|
|
331 Lisp_Object Qfile_executable_p;
|
|
332 Lisp_Object Qfile_readable_p;
|
16155
|
333 Lisp_Object Qfile_writable_p;
|
843
|
334 Lisp_Object Qfile_symlink_p;
|
16155
|
335 Lisp_Object Qaccess_file;
|
843
|
336 Lisp_Object Qfile_directory_p;
|
11599
|
337 Lisp_Object Qfile_regular_p;
|
843
|
338 Lisp_Object Qfile_accessible_directory_p;
|
|
339 Lisp_Object Qfile_modes;
|
|
340 Lisp_Object Qset_file_modes;
|
55194
|
341 Lisp_Object Qset_file_times;
|
843
|
342 Lisp_Object Qfile_newer_than_file_p;
|
|
343 Lisp_Object Qinsert_file_contents;
|
|
344 Lisp_Object Qwrite_region;
|
|
345 Lisp_Object Qverify_visited_file_modtime;
|
3560
|
346 Lisp_Object Qset_visited_file_modtime;
|
843
|
347
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
348 DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
|
40123
|
349 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
|
|
350 Otherwise, return nil.
|
|
351 A file name is handled if one of the regular expressions in
|
|
352 `file-name-handler-alist' matches it.
|
|
353
|
|
354 If OPERATION equals `inhibit-file-name-operation', then we ignore
|
|
355 any handlers that are members of `inhibit-file-name-handlers',
|
|
356 but we still do run any other handlers. This lets handlers
|
|
357 use the standard functions without calling themselves recursively. */)
|
|
358 (filename, operation)
|
|
359 Lisp_Object filename, operation;
|
843
|
360 {
|
1679
|
361 /* This function must not munge the match data. */
|
41655
|
362 Lisp_Object chain, inhibited_handlers, result;
|
41595
|
363 int pos = -1;
|
1679
|
364
|
41655
|
365 result = Qnil;
|
40656
|
366 CHECK_STRING (filename);
|
2895
|
367
|
7041
|
368 if (EQ (operation, Vinhibit_file_name_operation))
|
|
369 inhibited_handlers = Vinhibit_file_name_handlers;
|
|
370 else
|
|
371 inhibited_handlers = Qnil;
|
6678
|
372
|
9131
|
373 for (chain = Vfile_name_handler_alist; CONSP (chain);
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
374 chain = XCDR (chain))
|
843
|
375 {
|
|
376 Lisp_Object elt;
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
377 elt = XCAR (chain);
|
9131
|
378 if (CONSP (elt))
|
843
|
379 {
|
61942
|
380 Lisp_Object string = XCAR (elt);
|
41595
|
381 int match_pos;
|
61942
|
382 Lisp_Object handler = XCDR (elt);
|
62296
|
383 Lisp_Object operations = Qnil;
|
|
384
|
|
385 if (SYMBOLP (handler))
|
|
386 operations = Fget (handler, Qoperations);
|
61942
|
387
|
41595
|
388 if (STRINGP (string)
|
61942
|
389 && (match_pos = fast_string_match (string, filename)) > pos
|
|
390 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
|
7041
|
391 {
|
61942
|
392 Lisp_Object tem;
|
7041
|
393
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
394 handler = XCDR (elt);
|
7041
|
395 tem = Fmemq (handler, inhibited_handlers);
|
|
396 if (NILP (tem))
|
41595
|
397 {
|
|
398 result = handler;
|
|
399 pos = match_pos;
|
|
400 }
|
7041
|
401 }
|
843
|
402 }
|
1679
|
403
|
|
404 QUIT;
|
843
|
405 }
|
41595
|
406 return result;
|
843
|
407 }
|
|
408
|
230
|
409 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
|
40123
|
410 1, 1, 0,
|
|
411 doc: /* Return the directory component in file name FILENAME.
|
|
412 Return nil if FILENAME does not include a directory.
|
|
413 Otherwise return a directory spec.
|
|
414 Given a Unix syntax file name, returns a string ending in slash;
|
|
415 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
|
|
416 (filename)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
417 Lisp_Object filename;
|
230
|
418 {
|
46948
|
419 #ifndef DOS_NT
|
46465
|
420 register const unsigned char *beg;
|
46948
|
421 #else
|
|
422 register unsigned char *beg;
|
|
423 #endif
|
46465
|
424 register const unsigned char *p;
|
1105
|
425 Lisp_Object handler;
|
230
|
426
|
40656
|
427 CHECK_STRING (filename);
|
230
|
428
|
1105
|
429 /* If the file name has special constructs in it,
|
|
430 call the corresponding file handler. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
431 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
|
1105
|
432 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
433 return call2 (handler, Qfile_name_directory, filename);
|
1105
|
434
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
435 filename = FILE_SYSTEM_CASE (filename);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
436 beg = SDATA (filename);
|
15097
|
437 #ifdef DOS_NT
|
|
438 beg = strcpy (alloca (strlen (beg) + 1), beg);
|
|
439 #endif
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
440 p = beg + SBYTES (filename);
|
230
|
441
|
15097
|
442 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
|
230
|
443 #ifdef VMS
|
|
444 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
|
|
445 #endif /* VMS */
|
15097
|
446 #ifdef DOS_NT
|
22172
|
447 /* only recognise drive specifier at the beginning */
|
|
448 && !(p[-1] == ':'
|
|
449 /* handle the "/:d:foo" and "/:foo" cases correctly */
|
|
450 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
|
|
451 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
|
15097
|
452 #endif
|
230
|
453 ) p--;
|
|
454
|
|
455 if (p == beg)
|
|
456 return Qnil;
|
9789
|
457 #ifdef DOS_NT
|
5494
|
458 /* Expansion of "c:" to drive and default directory. */
|
22172
|
459 if (p[-1] == ':')
|
5494
|
460 {
|
|
461 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
|
15097
|
462 unsigned char *res = alloca (MAXPATHLEN + 1);
|
22172
|
463 unsigned char *r = res;
|
|
464
|
|
465 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
|
|
466 {
|
|
467 strncpy (res, beg, 2);
|
|
468 beg += 2;
|
|
469 r += 2;
|
|
470 }
|
|
471
|
|
472 if (getdefdir (toupper (*beg) - 'A' + 1, r))
|
5494
|
473 {
|
15097
|
474 if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
|
5494
|
475 strcat (res, "/");
|
|
476 beg = res;
|
|
477 p = beg + strlen (beg);
|
|
478 }
|
|
479 }
|
15097
|
480 CORRECT_DIR_SEPS (beg);
|
9789
|
481 #endif /* DOS_NT */
|
20621
|
482
|
50196
|
483 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
|
230
|
484 }
|
|
485
|
20621
|
486 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
|
|
487 Sfile_name_nondirectory, 1, 1, 0,
|
40123
|
488 doc: /* Return file name FILENAME sans its directory.
|
|
489 For example, in a Unix-syntax file name,
|
|
490 this is everything after the last slash,
|
|
491 or the entire name if it contains no slash. */)
|
|
492 (filename)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
493 Lisp_Object filename;
|
230
|
494 {
|
46465
|
495 register const unsigned char *beg, *p, *end;
|
1105
|
496 Lisp_Object handler;
|
230
|
497
|
40656
|
498 CHECK_STRING (filename);
|
230
|
499
|
1105
|
500 /* If the file name has special constructs in it,
|
|
501 call the corresponding file handler. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
502 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
|
1105
|
503 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
504 return call2 (handler, Qfile_name_nondirectory, filename);
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
505
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
506 beg = SDATA (filename);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
507 end = p = beg + SBYTES (filename);
|
230
|
508
|
15097
|
509 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
|
230
|
510 #ifdef VMS
|
|
511 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
|
|
512 #endif /* VMS */
|
15097
|
513 #ifdef DOS_NT
|
|
514 /* only recognise drive specifier at beginning */
|
22172
|
515 && !(p[-1] == ':'
|
|
516 /* handle the "/:d:foo" case correctly */
|
|
517 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
|
15097
|
518 #endif
|
20621
|
519 )
|
|
520 p--;
|
|
521
|
50196
|
522 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
|
230
|
523 }
|
1679
|
524
|
20621
|
525 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
|
|
526 Sunhandled_file_name_directory, 1, 1, 0,
|
40123
|
527 doc: /* Return a directly usable directory name somehow associated with FILENAME.
|
|
528 A `directly usable' directory name is one that may be used without the
|
|
529 intervention of any file handler.
|
|
530 If FILENAME is a directly usable file itself, return
|
|
531 \(file-name-directory FILENAME).
|
|
532 The `call-process' and `start-process' functions use this function to
|
|
533 get a current directory to run processes in. */)
|
|
534 (filename)
|
|
535 Lisp_Object filename;
|
1679
|
536 {
|
|
537 Lisp_Object handler;
|
|
538
|
|
539 /* If the file name has special constructs in it,
|
|
540 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
541 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
|
1679
|
542 if (!NILP (handler))
|
|
543 return call2 (handler, Qunhandled_file_name_directory, filename);
|
|
544
|
|
545 return Ffile_name_directory (filename);
|
|
546 }
|
|
547
|
230
|
548
|
|
549 char *
|
|
550 file_name_as_directory (out, in)
|
|
551 char *out, *in;
|
|
552 {
|
|
553 int size = strlen (in) - 1;
|
|
554
|
20790
|
555 strcpy (out, in);
|
|
556
|
20651
|
557 if (size < 0)
|
20790
|
558 {
|
21543
|
559 out[0] = '.';
|
|
560 out[1] = '/';
|
|
561 out[2] = 0;
|
20790
|
562 return out;
|
|
563 }
|
230
|
564
|
|
565 #ifdef VMS
|
|
566 /* Is it already a directory string? */
|
|
567 if (in[size] == ':' || in[size] == ']' || in[size] == '>')
|
|
568 return out;
|
|
569 /* Is it a VMS directory file name? If so, hack VMS syntax. */
|
|
570 else if (! index (in, '/')
|
|
571 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR"))
|
|
572 || (size > 3 && ! strcmp (&in[size - 3], ".dir"))
|
|
573 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4)
|
|
574 || ! strncmp (&in[size - 5], ".dir", 4))
|
|
575 && (in[size - 1] == '.' || in[size - 1] == ';')
|
|
576 && in[size] == '1')))
|
|
577 {
|
|
578 register char *p, *dot;
|
|
579 char brack;
|
|
580
|
|
581 /* x.dir -> [.x]
|
|
582 dir:x.dir --> dir:[x]
|
|
583 dir:[x]y.dir --> dir:[x.y] */
|
|
584 p = in + size;
|
|
585 while (p != in && *p != ':' && *p != '>' && *p != ']') p--;
|
|
586 if (p != in)
|
|
587 {
|
|
588 strncpy (out, in, p - in);
|
|
589 out[p - in] = '\0';
|
|
590 if (*p == ':')
|
|
591 {
|
|
592 brack = ']';
|
|
593 strcat (out, ":[");
|
|
594 }
|
|
595 else
|
|
596 {
|
|
597 brack = *p;
|
|
598 strcat (out, ".");
|
|
599 }
|
|
600 p++;
|
|
601 }
|
|
602 else
|
|
603 {
|
|
604 brack = ']';
|
|
605 strcpy (out, "[.");
|
|
606 }
|
372
|
607 dot = index (p, '.');
|
|
608 if (dot)
|
230
|
609 {
|
|
610 /* blindly remove any extension */
|
|
611 size = strlen (out) + (dot - p);
|
|
612 strncat (out, p, dot - p);
|
|
613 }
|
|
614 else
|
|
615 {
|
|
616 strcat (out, p);
|
|
617 size = strlen (out);
|
|
618 }
|
|
619 out[size++] = brack;
|
|
620 out[size] = '\0';
|
|
621 }
|
|
622 #else /* not VMS */
|
|
623 /* For Unix syntax, Append a slash if necessary */
|
15097
|
624 if (!IS_DIRECTORY_SEP (out[size]))
|
9789
|
625 {
|
46566
2f6929599b1a
(file_name_as_directory): Use literal '/' instead of DIRECTORY_SEP.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
626 /* Cannot use DIRECTORY_SEP, which could have any value */
|
2f6929599b1a
(file_name_as_directory): Use literal '/' instead of DIRECTORY_SEP.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
627 out[size + 1] = '/';
|
9789
|
628 out[size + 2] = '\0';
|
|
629 }
|
15097
|
630 #ifdef DOS_NT
|
|
631 CORRECT_DIR_SEPS (out);
|
|
632 #endif
|
230
|
633 #endif /* not VMS */
|
|
634 return out;
|
|
635 }
|
|
636
|
|
637 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
|
|
638 Sfile_name_as_directory, 1, 1, 0,
|
46561
|
639 doc: /* Return a string representing the file name FILE interpreted as a directory.
|
40123
|
640 This operation exists because a directory is also a file, but its name as
|
|
641 a directory is different from its name as a file.
|
|
642 The result can be used as the value of `default-directory'
|
|
643 or passed as second argument to `expand-file-name'.
|
|
644 For a Unix-syntax file name, just appends a slash.
|
|
645 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
|
|
646 (file)
|
230
|
647 Lisp_Object file;
|
|
648 {
|
|
649 char *buf;
|
1105
|
650 Lisp_Object handler;
|
230
|
651
|
40656
|
652 CHECK_STRING (file);
|
485
|
653 if (NILP (file))
|
230
|
654 return Qnil;
|
1105
|
655
|
|
656 /* If the file name has special constructs in it,
|
|
657 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
658 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
|
1105
|
659 if (!NILP (handler))
|
|
660 return call2 (handler, Qfile_name_as_directory, file);
|
|
661
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
662 buf = (char *) alloca (SBYTES (file) + 10);
|
50196
|
663 file_name_as_directory (buf, SDATA (file));
|
|
664 return make_specified_string (buf, -1, strlen (buf),
|
|
665 STRING_MULTIBYTE (file));
|
230
|
666 }
|
|
667
|
|
668 /*
|
|
669 * Convert from directory name to filename.
|
|
670 * On VMS:
|
|
671 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
|
|
672 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
|
15097
|
673 * On UNIX, it's simple: just make sure there isn't a terminating /
|
230
|
674
|
|
675 * Value is nonzero if the string output is different from the input.
|
|
676 */
|
|
677
|
21514
|
678 int
|
230
|
679 directory_file_name (src, dst)
|
|
680 char *src, *dst;
|
|
681 {
|
|
682 long slen;
|
|
683 #ifdef VMS
|
|
684 long rlen;
|
|
685 char * ptr, * rptr;
|
|
686 char bracket;
|
|
687 struct FAB fab = cc$rms_fab;
|
|
688 struct NAM nam = cc$rms_nam;
|
|
689 char esa[NAM$C_MAXRSS];
|
|
690 #endif /* VMS */
|
|
691
|
|
692 slen = strlen (src);
|
|
693 #ifdef VMS
|
|
694 if (! index (src, '/')
|
|
695 && (src[slen - 1] == ']'
|
|
696 || src[slen - 1] == ':'
|
|
697 || src[slen - 1] == '>'))
|
|
698 {
|
|
699 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
|
|
700 fab.fab$l_fna = src;
|
|
701 fab.fab$b_fns = slen;
|
|
702 fab.fab$l_nam = &nam;
|
|
703 fab.fab$l_fop = FAB$M_NAM;
|
|
704
|
|
705 nam.nam$l_esa = esa;
|
|
706 nam.nam$b_ess = sizeof esa;
|
|
707 nam.nam$b_nop |= NAM$M_SYNCHK;
|
|
708
|
|
709 /* We call SYS$PARSE to handle such things as [--] for us. */
|
15097
|
710 if (SYS$PARSE (&fab, 0, 0) == RMS$_NORMAL)
|
230
|
711 {
|
|
712 slen = nam.nam$b_esl;
|
|
713 if (esa[slen - 1] == ';' && esa[slen - 2] == '.')
|
|
714 slen -= 2;
|
|
715 esa[slen] = '\0';
|
|
716 src = esa;
|
|
717 }
|
|
718 if (src[slen - 1] != ']' && src[slen - 1] != '>')
|
|
719 {
|
|
720 /* what about when we have logical_name:???? */
|
|
721 if (src[slen - 1] == ':')
|
9789
|
722 { /* Xlate logical name and see what we get */
|
230
|
723 ptr = strcpy (dst, src); /* upper case for getenv */
|
|
724 while (*ptr)
|
|
725 {
|
|
726 if ('a' <= *ptr && *ptr <= 'z')
|
|
727 *ptr -= 040;
|
|
728 ptr++;
|
|
729 }
|
9789
|
730 dst[slen - 1] = 0; /* remove colon */
|
230
|
731 if (!(src = egetenv (dst)))
|
|
732 return 0;
|
|
733 /* should we jump to the beginning of this procedure?
|
|
734 Good points: allows us to use logical names that xlate
|
|
735 to Unix names,
|
|
736 Bad points: can be a problem if we just translated to a device
|
|
737 name...
|
|
738 For now, I'll punt and always expect VMS names, and hope for
|
|
739 the best! */
|
|
740 slen = strlen (src);
|
|
741 if (src[slen - 1] != ']' && src[slen - 1] != '>')
|
|
742 { /* no recursion here! */
|
|
743 strcpy (dst, src);
|
|
744 return 0;
|
|
745 }
|
|
746 }
|
|
747 else
|
9789
|
748 { /* not a directory spec */
|
230
|
749 strcpy (dst, src);
|
|
750 return 0;
|
|
751 }
|
|
752 }
|
|
753 bracket = src[slen - 1];
|
|
754
|
|
755 /* If bracket is ']' or '>', bracket - 2 is the corresponding
|
|
756 opening bracket. */
|
372
|
757 ptr = index (src, bracket - 2);
|
|
758 if (ptr == 0)
|
230
|
759 { /* no opening bracket */
|
|
760 strcpy (dst, src);
|
|
761 return 0;
|
|
762 }
|
|
763 if (!(rptr = rindex (src, '.')))
|
|
764 rptr = ptr;
|
|
765 slen = rptr - src;
|
|
766 strncpy (dst, src, slen);
|
|
767 dst[slen] = '\0';
|
|
768 if (*rptr == '.')
|
|
769 {
|
|
770 dst[slen++] = bracket;
|
|
771 dst[slen] = '\0';
|
|
772 }
|
|
773 else
|
|
774 {
|
|
775 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
|
|
776 then translate the device and recurse. */
|
|
777 if (dst[slen - 1] == ':'
|
9789
|
778 && dst[slen - 2] != ':' /* skip decnet nodes */
|
15097
|
779 && strcmp (src + slen, "[000000]") == 0)
|
230
|
780 {
|
|
781 dst[slen - 1] = '\0';
|
|
782 if ((ptr = egetenv (dst))
|
|
783 && (rlen = strlen (ptr) - 1) > 0
|
|
784 && (ptr[rlen] == ']' || ptr[rlen] == '>')
|
|
785 && ptr[rlen - 1] == '.')
|
|
786 {
|
1358
|
787 char * buf = (char *) alloca (strlen (ptr) + 1);
|
|
788 strcpy (buf, ptr);
|
|
789 buf[rlen - 1] = ']';
|
|
790 buf[rlen] = '\0';
|
|
791 return directory_file_name (buf, dst);
|
230
|
792 }
|
|
793 else
|
|
794 dst[slen - 1] = ':';
|
|
795 }
|
|
796 strcat (dst, "[000000]");
|
|
797 slen += 8;
|
|
798 }
|
|
799 rptr++;
|
|
800 rlen = strlen (rptr) - 1;
|
|
801 strncat (dst, rptr, rlen);
|
|
802 dst[slen + rlen] = '\0';
|
|
803 strcat (dst, ".DIR.1");
|
|
804 return 1;
|
|
805 }
|
|
806 #endif /* VMS */
|
|
807 /* Process as Unix format: just remove any final slash.
|
|
808 But leave "/" unchanged; do not change it to "". */
|
|
809 strcpy (dst, src);
|
11667
|
810 #ifdef APOLLO
|
|
811 /* Handle // as root for apollo's. */
|
|
812 if ((slen > 2 && dst[slen - 1] == '/')
|
|
813 || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
|
|
814 dst[slen - 1] = 0;
|
|
815 #else
|
15097
|
816 if (slen > 1
|
9789
|
817 && IS_DIRECTORY_SEP (dst[slen - 1])
|
12369
54271828fd4e
(directory_file_name): Don't get confused by // at end on Unix-like systems.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
818 #ifdef DOS_NT
|
54271828fd4e
(directory_file_name): Don't get confused by // at end on Unix-like systems.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
819 && !IS_ANY_SEP (dst[slen - 2])
|
54271828fd4e
(directory_file_name): Don't get confused by // at end on Unix-like systems.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
820 #endif
|
54271828fd4e
(directory_file_name): Don't get confused by // at end on Unix-like systems.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
821 )
|
230
|
822 dst[slen - 1] = 0;
|
11667
|
823 #endif
|
15097
|
824 #ifdef DOS_NT
|
|
825 CORRECT_DIR_SEPS (dst);
|
|
826 #endif
|
230
|
827 return 1;
|
|
828 }
|
|
829
|
|
830 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
|
40123
|
831 1, 1, 0,
|
|
832 doc: /* Returns the file name of the directory named DIRECTORY.
|
|
833 This is the name of the file that holds the data for the directory DIRECTORY.
|
|
834 This operation exists because a directory is also a file, but its name as
|
|
835 a directory is different from its name as a file.
|
|
836 In Unix-syntax, this function just removes the final slash.
|
|
837 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
|
|
838 it returns a file name such as \"[X]Y.DIR.1\". */)
|
|
839 (directory)
|
230
|
840 Lisp_Object directory;
|
|
841 {
|
|
842 char *buf;
|
1105
|
843 Lisp_Object handler;
|
230
|
844
|
40656
|
845 CHECK_STRING (directory);
|
230
|
846
|
485
|
847 if (NILP (directory))
|
230
|
848 return Qnil;
|
1105
|
849
|
|
850 /* If the file name has special constructs in it,
|
|
851 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
852 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
|
1105
|
853 if (!NILP (handler))
|
|
854 return call2 (handler, Qdirectory_file_name, directory);
|
|
855
|
230
|
856 #ifdef VMS
|
|
857 /* 20 extra chars is insufficient for VMS, since we might perform a
|
|
858 logical name translation. an equivalence string can be up to 255
|
|
859 chars long, so grab that much extra space... - sss */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
860 buf = (char *) alloca (SBYTES (directory) + 20 + 255);
|
230
|
861 #else
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
862 buf = (char *) alloca (SBYTES (directory) + 20);
|
230
|
863 #endif
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
864 directory_file_name (SDATA (directory), buf);
|
50196
|
865 return make_specified_string (buf, -1, strlen (buf),
|
|
866 STRING_MULTIBYTE (directory));
|
230
|
867 }
|
|
868
|
21684
|
869 static char make_temp_name_tbl[64] =
|
|
870 {
|
|
871 'A','B','C','D','E','F','G','H',
|
|
872 'I','J','K','L','M','N','O','P',
|
|
873 'Q','R','S','T','U','V','W','X',
|
|
874 'Y','Z','a','b','c','d','e','f',
|
|
875 'g','h','i','j','k','l','m','n',
|
|
876 'o','p','q','r','s','t','u','v',
|
|
877 'w','x','y','z','0','1','2','3',
|
|
878 '4','5','6','7','8','9','-','_'
|
|
879 };
|
28928
|
880
|
21684
|
881 static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
|
|
882
|
28928
|
883 /* Value is a temporary file name starting with PREFIX, a string.
|
49207
|
884
|
28928
|
885 The Emacs process number forms part of the result, so there is
|
|
886 no danger of generating a name being used by another process.
|
|
887 In addition, this function makes an attempt to choose a name
|
|
888 which has no existing file. To make this work, PREFIX should be
|
|
889 an absolute file name.
|
49207
|
890
|
28928
|
891 BASE64_P non-zero means add the pid as 3 characters in base64
|
|
892 encoding. In this case, 6 characters will be added to PREFIX to
|
|
893 form the file name. Otherwise, if Emacs is running on a system
|
|
894 with long file names, add the pid as a decimal number.
|
|
895
|
|
896 This function signals an error if no unique file name could be
|
|
897 generated. */
|
|
898
|
|
899 Lisp_Object
|
|
900 make_temp_name (prefix, base64_p)
|
230
|
901 Lisp_Object prefix;
|
28928
|
902 int base64_p;
|
230
|
903 {
|
|
904 Lisp_Object val;
|
56615
|
905 int len, clen;
|
21684
|
906 int pid;
|
|
907 unsigned char *p, *data;
|
|
908 char pidbuf[20];
|
|
909 int pidlen;
|
49207
|
910
|
40656
|
911 CHECK_STRING (prefix);
|
21684
|
912
|
|
913 /* VAL is created by adding 6 characters to PREFIX. The first
|
|
914 three are the PID of this process, in base 64, and the second
|
|
915 three are incremented if the file already exists. This ensures
|
|
916 262144 unique file names per PID per PREFIX. */
|
|
917
|
|
918 pid = (int) getpid ();
|
|
919
|
28928
|
920 if (base64_p)
|
|
921 {
|
|
922 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
|
|
923 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
|
|
924 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
|
|
925 pidlen = 3;
|
|
926 }
|
|
927 else
|
|
928 {
|
21684
|
929 #ifdef HAVE_LONG_FILE_NAMES
|
28928
|
930 sprintf (pidbuf, "%d", pid);
|
|
931 pidlen = strlen (pidbuf);
|
14519
|
932 #else
|
28928
|
933 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
|
|
934 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
|
|
935 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
|
|
936 pidlen = 3;
|
14519
|
937 #endif
|
28928
|
938 }
|
49207
|
939
|
56615
|
940 len = SBYTES (prefix); clen = SCHARS (prefix);
|
|
941 val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
|
|
942 if (!STRING_MULTIBYTE (prefix))
|
|
943 STRING_SET_UNIBYTE (val);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
944 data = SDATA (val);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
945 bcopy(SDATA (prefix), data, len);
|
21684
|
946 p = data + len;
|
|
947
|
|
948 bcopy (pidbuf, p, pidlen);
|
|
949 p += pidlen;
|
|
950
|
|
951 /* Here we try to minimize useless stat'ing when this function is
|
|
952 invoked many times successively with the same PREFIX. We achieve
|
|
953 this by initializing count to a random value, and incrementing it
|
21917
|
954 afterwards.
|
|
955
|
|
956 We don't want make-temp-name to be called while dumping,
|
|
957 because then make_temp_name_count_initialized_p would get set
|
|
958 and then make_temp_name_count would not be set when Emacs starts. */
|
|
959
|
21684
|
960 if (!make_temp_name_count_initialized_p)
|
|
961 {
|
|
962 make_temp_name_count = (unsigned) time (NULL);
|
|
963 make_temp_name_count_initialized_p = 1;
|
|
964 }
|
|
965
|
|
966 while (1)
|
|
967 {
|
|
968 struct stat ignored;
|
21900
|
969 unsigned num = make_temp_name_count;
|
21684
|
970
|
|
971 p[0] = make_temp_name_tbl[num & 63], num >>= 6;
|
|
972 p[1] = make_temp_name_tbl[num & 63], num >>= 6;
|
|
973 p[2] = make_temp_name_tbl[num & 63], num >>= 6;
|
|
974
|
21900
|
975 /* Poor man's congruential RN generator. Replace with
|
|
976 ++make_temp_name_count for debugging. */
|
|
977 make_temp_name_count += 25229;
|
|
978 make_temp_name_count %= 225307;
|
|
979
|
21684
|
980 if (stat (data, &ignored) < 0)
|
|
981 {
|
|
982 /* We want to return only if errno is ENOENT. */
|
|
983 if (errno == ENOENT)
|
|
984 return val;
|
|
985 else
|
|
986 /* The error here is dubious, but there is little else we
|
|
987 can do. The alternatives are to return nil, which is
|
|
988 as bad as (and in many cases worse than) throwing the
|
|
989 error, or to ignore the error, which will likely result
|
21900
|
990 in looping through 225307 stat's, which is not only
|
|
991 dog-slow, but also useless since it will fallback to
|
|
992 the errow below, anyway. */
|
29813
|
993 report_file_error ("Cannot create temporary name for prefix",
|
21684
|
994 Fcons (prefix, Qnil));
|
|
995 /* not reached */
|
|
996 }
|
|
997 }
|
|
998
|
|
999 error ("Cannot create temporary name for prefix `%s'",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1000 SDATA (prefix));
|
21684
|
1001 return Qnil;
|
230
|
1002 }
|
21684
|
1003
|
28928
|
1004
|
|
1005 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
|
40123
|
1006 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
|
|
1007 The Emacs process number forms part of the result,
|
|
1008 so there is no danger of generating a name being used by another process.
|
|
1009
|
|
1010 In addition, this function makes an attempt to choose a name
|
|
1011 which has no existing file. To make this work,
|
|
1012 PREFIX should be an absolute file name.
|
|
1013
|
|
1014 There is a race condition between calling `make-temp-name' and creating the
|
|
1015 file which opens all kinds of security holes. For that reason, you should
|
43680
|
1016 probably use `make-temp-file' instead, except in three circumstances:
|
|
1017
|
|
1018 * If you are creating the file in the user's home directory.
|
|
1019 * If you are creating a directory rather than an ordinary file.
|
|
1020 * If you are taking special precautions as `make-temp-file' does. */)
|
40123
|
1021 (prefix)
|
28928
|
1022 Lisp_Object prefix;
|
|
1023 {
|
|
1024 return make_temp_name (prefix, 0);
|
|
1025 }
|
|
1026
|
|
1027
|
230
|
1028
|
|
1029 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
|
40123
|
1030 doc: /* Convert filename NAME to absolute, and canonicalize it.
|
|
1031 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
|
61060
|
1032 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
|
62188
a89a98d0bb8c
(Fexpand_file_name, Frename_file, Fadd_name_to_file, Fmake_symbolic_link,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1033 the current buffer's value of `default-directory' is used.
|
40123
|
1034 File name components that are `.' are removed, and
|
|
1035 so are file name components followed by `..', along with the `..' itself;
|
|
1036 note that these simplifications are done without checking the resulting
|
|
1037 file names in the file system.
|
|
1038 An initial `~/' expands to your home directory.
|
|
1039 An initial `~USER/' expands to USER's home directory.
|
|
1040 See also the function `substitute-in-file-name'. */)
|
|
1041 (name, default_directory)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1042 Lisp_Object name, default_directory;
|
230
|
1043 {
|
|
1044 unsigned char *nm;
|
15097
|
1045
|
230
|
1046 register unsigned char *newdir, *p, *o;
|
|
1047 int tlen;
|
|
1048 unsigned char *target;
|
|
1049 struct passwd *pw;
|
|
1050 #ifdef VMS
|
|
1051 unsigned char * colon = 0;
|
|
1052 unsigned char * close = 0;
|
|
1053 unsigned char * slash = 0;
|
|
1054 unsigned char * brack = 0;
|
|
1055 int lbrack = 0, rbrack = 0;
|
|
1056 int dots = 0;
|
|
1057 #endif /* VMS */
|
9789
|
1058 #ifdef DOS_NT
|
15097
|
1059 int drive = 0;
|
15109
|
1060 int collapse_newdir = 1;
|
21987
|
1061 int is_escaped = 0;
|
9789
|
1062 #endif /* DOS_NT */
|
15097
|
1063 int length;
|
50340
|
1064 Lisp_Object handler, result;
|
65504
|
1065 int multibyte;
|
15097
|
1066
|
40656
|
1067 CHECK_STRING (name);
|
230
|
1068
|
1105
|
1069 /* If the file name has special constructs in it,
|
|
1070 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1071 handler = Ffind_file_name_handler (name, Qexpand_file_name);
|
1105
|
1072 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1073 return call3 (handler, Qexpand_file_name, name, default_directory);
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1074
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1075 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1076 if (NILP (default_directory))
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1077 default_directory = current_buffer->directory;
|
19754
|
1078 if (! STRINGP (default_directory))
|
42191
|
1079 {
|
|
1080 #ifdef DOS_NT
|
|
1081 /* "/" is not considered a root directory on DOS_NT, so using "/"
|
|
1082 here causes an infinite recursion in, e.g., the following:
|
|
1083
|
|
1084 (let (default-directory)
|
|
1085 (expand-file-name "a"))
|
|
1086
|
|
1087 To avoid this, we set default_directory to the root of the
|
|
1088 current drive. */
|
|
1089 extern char *emacs_root_dir (void);
|
|
1090
|
|
1091 default_directory = build_string (emacs_root_dir ());
|
|
1092 #else
|
|
1093 default_directory = build_string ("/");
|
|
1094 #endif
|
|
1095 }
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1096
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1097 if (!NILP (default_directory))
|
10719
|
1098 {
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1099 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
|
10719
|
1100 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1101 return call3 (handler, Qexpand_file_name, name, default_directory);
|
10719
|
1102 }
|
1105
|
1103
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1104 o = SDATA (default_directory);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1105
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1106 /* Make sure DEFAULT_DIRECTORY is properly expanded.
|
1869
|
1107 It would be better to do this down below where we actually use
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1108 default_directory. Unfortunately, calling Fexpand_file_name recursively
|
1869
|
1109 could invoke GC, and the strings might be relocated. This would
|
|
1110 be annoying because we have pointers into strings lying around
|
|
1111 that would need adjusting, and people would add new pointers to
|
|
1112 the code and forget to adjust them, resulting in intermittent bugs.
|
2407
|
1113 Putting this call here avoids all that crud.
|
|
1114
|
|
1115 The EQ test avoids infinite recursion. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1116 if (! NILP (default_directory) && !EQ (default_directory, name)
|
15097
|
1117 /* Save time in some common cases - as long as default_directory
|
|
1118 is not relative, it can be canonicalized with name below (if it
|
|
1119 is needed at all) without requiring it to be expanded now. */
|
14697
|
1120 #ifdef DOS_NT
|
15097
|
1121 /* Detect MSDOS file names with drive specifiers. */
|
21987
|
1122 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))
|
15097
|
1123 #ifdef WINDOWSNT
|
|
1124 /* Detect Windows file names in UNC format. */
|
|
1125 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
|
14697
|
1126 #endif
|
15097
|
1127 #else /* not DOS_NT */
|
|
1128 /* Detect Unix absolute file names (/... alone is not absolute on
|
|
1129 DOS or Windows). */
|
|
1130 && ! (IS_DIRECTORY_SEP (o[0]))
|
|
1131 #endif /* not DOS_NT */
|
|
1132 )
|
1869
|
1133 {
|
|
1134 struct gcpro gcpro1;
|
|
1135
|
|
1136 GCPRO1 (name);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
1137 default_directory = Fexpand_file_name (default_directory, Qnil);
|
1869
|
1138 UNGCPRO;
|
|
1139 }
|
|
1140
|
5494
|
1141 name = FILE_SYSTEM_CASE (name);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1142 nm = SDATA (name);
|
65504
|
1143 multibyte = STRING_MULTIBYTE (name);
|
9789
|
1144
|
|
1145 #ifdef DOS_NT
|
15097
|
1146 /* We will force directory separators to be either all \ or /, so make
|
|
1147 a local copy to modify, even if there ends up being no change. */
|
|
1148 nm = strcpy (alloca (strlen (nm) + 1), nm);
|
|
1149
|
21987
|
1150 /* Note if special escape prefix is present, but remove for now. */
|
|
1151 if (nm[0] == '/' && nm[1] == ':')
|
|
1152 {
|
|
1153 is_escaped = 1;
|
|
1154 nm += 2;
|
|
1155 }
|
|
1156
|
15097
|
1157 /* Find and remove drive specifier if present; this makes nm absolute
|
21987
|
1158 even if the rest of the name appears to be relative. Only look for
|
|
1159 drive specifier at the beginning. */
|
|
1160 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
|
|
1161 {
|
|
1162 drive = nm[0];
|
|
1163 nm += 2;
|
|
1164 }
|
19695
|
1165
|
|
1166 #ifdef WINDOWSNT
|
|
1167 /* If we see "c://somedir", we want to strip the first slash after the
|
|
1168 colon when stripping the drive letter. Otherwise, this expands to
|
|
1169 "//somedir". */
|
|
1170 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
|
|
1171 nm++;
|
|
1172 #endif /* WINDOWSNT */
|
9789
|
1173 #endif /* DOS_NT */
|
5494
|
1174
|
15097
|
1175 #ifdef WINDOWSNT
|
|
1176 /* Discard any previous drive specifier if nm is now in UNC format. */
|
|
1177 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
|
|
1178 {
|
|
1179 drive = 0;
|
|
1180 }
|
|
1181 #endif
|
|
1182
|
36482
|
1183 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
|
|
1184 none are found, we can probably return right away. We will avoid
|
|
1185 allocating a new string if name is already fully expanded. */
|
230
|
1186 if (
|
9789
|
1187 IS_DIRECTORY_SEP (nm[0])
|
15097
|
1188 #ifdef MSDOS
|
21987
|
1189 && drive && !is_escaped
|
15097
|
1190 #endif
|
|
1191 #ifdef WINDOWSNT
|
21987
|
1192 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
|
15097
|
1193 #endif
|
230
|
1194 #ifdef VMS
|
|
1195 || index (nm, ':')
|
|
1196 #endif /* VMS */
|
|
1197 )
|
|
1198 {
|
1869
|
1199 /* If it turns out that the filename we want to return is just a
|
|
1200 suffix of FILENAME, we don't need to go through and edit
|
|
1201 things; we just need to construct a new string using data
|
|
1202 starting at the middle of FILENAME. If we set lose to a
|
|
1203 non-zero value, that means we've discovered that we can't do
|
|
1204 that cool trick. */
|
|
1205 int lose = 0;
|
|
1206
|
230
|
1207 p = nm;
|
|
1208 while (*p)
|
|
1209 {
|
15097
|
1210 /* Since we know the name is absolute, we can assume that each
|
1589
|
1211 element starts with a "/". */
|
|
1212
|
|
1213 /* "." and ".." are hairy. */
|
9789
|
1214 if (IS_DIRECTORY_SEP (p[0])
|
1589
|
1215 && p[1] == '.'
|
9789
|
1216 && (IS_DIRECTORY_SEP (p[2])
|
1589
|
1217 || p[2] == 0
|
9789
|
1218 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
|
1589
|
1219 || p[3] == 0))))
|
230
|
1220 lose = 1;
|
36482
|
1221 /* We want to replace multiple `/' in a row with a single
|
|
1222 slash. */
|
|
1223 else if (p > nm
|
|
1224 && IS_DIRECTORY_SEP (p[0])
|
|
1225 && IS_DIRECTORY_SEP (p[1]))
|
|
1226 lose = 1;
|
49207
|
1227
|
230
|
1228 #ifdef VMS
|
|
1229 if (p[0] == '\\')
|
|
1230 lose = 1;
|
|
1231 if (p[0] == '/') {
|
|
1232 /* if dev:[dir]/, move nm to / */
|
|
1233 if (!slash && p > nm && (brack || colon)) {
|
|
1234 nm = (brack ? brack + 1 : colon + 1);
|
|
1235 lbrack = rbrack = 0;
|
|
1236 brack = 0;
|
|
1237 colon = 0;
|
|
1238 }
|
|
1239 slash = p;
|
|
1240 }
|
|
1241 if (p[0] == '-')
|
60387
|
1242 #ifdef NO_HYPHENS_IN_FILENAMES
|
230
|
1243 if (lbrack == rbrack)
|
|
1244 {
|
60387
|
1245 /* Avoid clobbering negative version numbers. */
|
|
1246 if (dots < 2)
|
230
|
1247 p[0] = '_';
|
|
1248 }
|
|
1249 else
|
60387
|
1250 #endif /* NO_HYPHENS_IN_FILENAMES */
|
74108
|
1251 if (lbrack > rbrack
|
|
1252 && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
|
|
1253 && (p[1] == '.' || p[1] == ']' || p[1] == '>')))
|
230
|
1254 lose = 1;
|
60387
|
1255 #ifdef NO_HYPHENS_IN_FILENAMES
|
230
|
1256 else
|
|
1257 p[0] = '_';
|
60387
|
1258 #endif /* NO_HYPHENS_IN_FILENAMES */
|
230
|
1259 /* count open brackets, reset close bracket pointer */
|
|
1260 if (p[0] == '[' || p[0] == '<')
|
|
1261 lbrack++, brack = 0;
|
|
1262 /* count close brackets, set close bracket pointer */
|
|
1263 if (p[0] == ']' || p[0] == '>')
|
|
1264 rbrack++, brack = p;
|
|
1265 /* detect ][ or >< */
|
|
1266 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
|
|
1267 lose = 1;
|
|
1268 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
|
|
1269 nm = p + 1, lose = 1;
|
|
1270 if (p[0] == ':' && (colon || slash))
|
|
1271 /* if dev1:[dir]dev2:, move nm to dev2: */
|
|
1272 if (brack)
|
|
1273 {
|
|
1274 nm = brack + 1;
|
|
1275 brack = 0;
|
|
1276 }
|
15097
|
1277 /* if /name/dev:, move nm to dev: */
|
230
|
1278 else if (slash)
|
|
1279 nm = slash + 1;
|
|
1280 /* if node::dev:, move colon following dev */
|
|
1281 else if (colon && colon[-1] == ':')
|
|
1282 colon = p;
|
|
1283 /* if dev1:dev2:, move nm to dev2: */
|
|
1284 else if (colon && colon[-1] != ':')
|
|
1285 {
|
|
1286 nm = colon + 1;
|
|
1287 colon = 0;
|
|
1288 }
|
|
1289 if (p[0] == ':' && !colon)
|
|
1290 {
|
|
1291 if (p[1] == ':')
|
|
1292 p++;
|
|
1293 colon = p;
|
|
1294 }
|
|
1295 if (lbrack == rbrack)
|
|
1296 if (p[0] == ';')
|
|
1297 dots = 2;
|
|
1298 else if (p[0] == '.')
|
|
1299 dots++;
|
|
1300 #endif /* VMS */
|
|
1301 p++;
|
|
1302 }
|
|
1303 if (!lose)
|
|
1304 {
|
|
1305 #ifdef VMS
|
|
1306 if (index (nm, '/'))
|
50196
|
1307 {
|
|
1308 nm = sys_translate_unix (nm);
|
65504
|
1309 return make_specified_string (nm, -1, strlen (nm), multibyte);
|
50196
|
1310 }
|
230
|
1311 #endif /* VMS */
|
15097
|
1312 #ifdef DOS_NT
|
|
1313 /* Make sure directories are all separated with / or \ as
|
|
1314 desired, but avoid allocation of a new string when not
|
|
1315 required. */
|
|
1316 CORRECT_DIR_SEPS (nm);
|
|
1317 #ifdef WINDOWSNT
|
|
1318 if (IS_DIRECTORY_SEP (nm[1]))
|
|
1319 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1320 if (strcmp (nm, SDATA (name)) != 0)
|
65504
|
1321 name = make_specified_string (nm, -1, strlen (nm), multibyte);
|
15097
|
1322 }
|
|
1323 else
|
|
1324 #endif
|
|
1325 /* drive must be set, so this is okay */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1326 if (strcmp (nm - 2, SDATA (name)) != 0)
|
15097
|
1327 {
|
50213
|
1328 char temp[] = " :";
|
|
1329
|
65504
|
1330 name = make_specified_string (nm, -1, p - nm, multibyte);
|
50213
|
1331 temp[0] = DRIVE_LETTER (drive);
|
|
1332 name = concat2 (build_string (temp), name);
|
15097
|
1333 }
|
|
1334 return name;
|
|
1335 #else /* not DOS_NT */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1336 if (nm == SDATA (name))
|
230
|
1337 return name;
|
65504
|
1338 return make_specified_string (nm, -1, strlen (nm), multibyte);
|
9789
|
1339 #endif /* not DOS_NT */
|
230
|
1340 }
|
|
1341 }
|
|
1342
|
15097
|
1343 /* At this point, nm might or might not be an absolute file name. We
|
|
1344 need to expand ~ or ~user if present, otherwise prefix nm with
|
|
1345 default_directory if nm is not absolute, and finally collapse /./
|
|
1346 and /foo/../ sequences.
|
|
1347
|
|
1348 We set newdir to be the appropriate prefix if one is needed:
|
|
1349 - the relevant user directory if nm starts with ~ or ~user
|
|
1350 - the specified drive's working dir (DOS/NT only) if nm does not
|
|
1351 start with /
|
|
1352 - the value of default_directory.
|
|
1353
|
|
1354 Note that these prefixes are not guaranteed to be absolute (except
|
|
1355 for the working dir of a drive). Therefore, to ensure we always
|
|
1356 return an absolute name, if the final prefix is not absolute we
|
|
1357 append it to the current working directory. */
|
230
|
1358
|
|
1359 newdir = 0;
|
|
1360
|
|
1361 if (nm[0] == '~') /* prefix ~ */
|
1589
|
1362 {
|
9789
|
1363 if (IS_DIRECTORY_SEP (nm[1])
|
230
|
1364 #ifdef VMS
|
1589
|
1365 || nm[1] == ':'
|
9789
|
1366 #endif /* VMS */
|
1589
|
1367 || nm[1] == 0) /* ~ by itself */
|
|
1368 {
|
|
1369 if (!(newdir = (unsigned char *) egetenv ("HOME")))
|
|
1370 newdir = (unsigned char *) "";
|
15097
|
1371 nm++;
|
9789
|
1372 #ifdef DOS_NT
|
15109
|
1373 collapse_newdir = 0;
|
5494
|
1374 #endif
|
230
|
1375 #ifdef VMS
|
1589
|
1376 nm++; /* Don't leave the slash in nm. */
|
9789
|
1377 #endif /* VMS */
|
1589
|
1378 }
|
|
1379 else /* ~user/filename */
|
|
1380 {
|
9789
|
1381 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)
|
230
|
1382 #ifdef VMS
|
1589
|
1383 && *p != ':'
|
9789
|
1384 #endif /* VMS */
|
1589
|
1385 ); p++);
|
|
1386 o = (unsigned char *) alloca (p - nm + 1);
|
|
1387 bcopy ((char *) nm, o, p - nm);
|
|
1388 o [p - nm] = 0;
|
|
1389
|
71818
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1390 BLOCK_INPUT;
|
1589
|
1391 pw = (struct passwd *) getpwnam (o + 1);
|
71818
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1392 UNBLOCK_INPUT;
|
1589
|
1393 if (pw)
|
|
1394 {
|
|
1395 newdir = (unsigned char *) pw -> pw_dir;
|
230
|
1396 #ifdef VMS
|
1589
|
1397 nm = p + 1; /* skip the terminator */
|
230
|
1398 #else
|
1589
|
1399 nm = p;
|
15097
|
1400 #ifdef DOS_NT
|
15109
|
1401 collapse_newdir = 0;
|
15097
|
1402 #endif
|
9789
|
1403 #endif /* VMS */
|
1589
|
1404 }
|
|
1405
|
|
1406 /* If we don't find a user of that name, leave the name
|
|
1407 unchanged; don't move nm forward to p. */
|
|
1408 }
|
|
1409 }
|
230
|
1410
|
15097
|
1411 #ifdef DOS_NT
|
|
1412 /* On DOS and Windows, nm is absolute if a drive name was specified;
|
|
1413 use the drive's current directory as the prefix if needed. */
|
|
1414 if (!newdir && drive)
|
|
1415 {
|
|
1416 /* Get default directory if needed to make nm absolute. */
|
|
1417 if (!IS_DIRECTORY_SEP (nm[0]))
|
|
1418 {
|
|
1419 newdir = alloca (MAXPATHLEN + 1);
|
|
1420 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
|
|
1421 newdir = NULL;
|
|
1422 }
|
|
1423 if (!newdir)
|
|
1424 {
|
|
1425 /* Either nm starts with /, or drive isn't mounted. */
|
|
1426 newdir = alloca (4);
|
15324
|
1427 newdir[0] = DRIVE_LETTER (drive);
|
15097
|
1428 newdir[1] = ':';
|
|
1429 newdir[2] = '/';
|
|
1430 newdir[3] = 0;
|
|
1431 }
|
|
1432 }
|
|
1433 #endif /* DOS_NT */
|
|
1434
|
|
1435 /* Finally, if no prefix has been specified and nm is not absolute,
|
|
1436 then it must be expanded relative to default_directory. */
|
|
1437
|
15124
|
1438 if (1
|
15097
|
1439 #ifndef DOS_NT
|
|
1440 /* /... alone is not absolute on DOS and Windows. */
|
15124
|
1441 && !IS_DIRECTORY_SEP (nm[0])
|
15097
|
1442 #endif
|
|
1443 #ifdef WINDOWSNT
|
15124
|
1444 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
|
15097
|
1445 #endif
|
230
|
1446 #ifdef VMS
|
|
1447 && !index (nm, ':')
|
15097
|
1448 #endif
|
230
|
1449 && !newdir)
|
|
1450 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1451 newdir = SDATA (default_directory);
|
65504
|
1452 multibyte |= STRING_MULTIBYTE (default_directory);
|
21987
|
1453 #ifdef DOS_NT
|
|
1454 /* Note if special escape prefix is present, but remove for now. */
|
|
1455 if (newdir[0] == '/' && newdir[1] == ':')
|
|
1456 {
|
|
1457 is_escaped = 1;
|
|
1458 newdir += 2;
|
|
1459 }
|
|
1460 #endif
|
230
|
1461 }
|
|
1462
|
9789
|
1463 #ifdef DOS_NT
|
15097
|
1464 if (newdir)
|
|
1465 {
|
|
1466 /* First ensure newdir is an absolute name. */
|
|
1467 if (
|
|
1468 /* Detect MSDOS file names with drive specifiers. */
|
|
1469 ! (IS_DRIVE (newdir[0])
|
|
1470 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
|
|
1471 #ifdef WINDOWSNT
|
|
1472 /* Detect Windows file names in UNC format. */
|
|
1473 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
|
|
1474 #endif
|
|
1475 )
|
|
1476 {
|
|
1477 /* Effectively, let newdir be (expand-file-name newdir cwd).
|
|
1478 Because of the admonition against calling expand-file-name
|
|
1479 when we have pointers into lisp strings, we accomplish this
|
|
1480 indirectly by prepending newdir to nm if necessary, and using
|
|
1481 cwd (or the wd of newdir's drive) as the new newdir. */
|
|
1482
|
61060
|
1483 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
|
15097
|
1484 {
|
|
1485 drive = newdir[0];
|
|
1486 newdir += 2;
|
|
1487 }
|
|
1488 if (!IS_DIRECTORY_SEP (nm[0]))
|
|
1489 {
|
|
1490 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
|
|
1491 file_name_as_directory (tmp, newdir);
|
|
1492 strcat (tmp, nm);
|
|
1493 nm = tmp;
|
|
1494 }
|
|
1495 newdir = alloca (MAXPATHLEN + 1);
|
|
1496 if (drive)
|
|
1497 {
|
|
1498 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
|
|
1499 newdir = "/";
|
|
1500 }
|
|
1501 else
|
|
1502 getwd (newdir);
|
|
1503 }
|
|
1504
|
|
1505 /* Strip off drive name from prefix, if present. */
|
61060
|
1506 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
|
15097
|
1507 {
|
|
1508 drive = newdir[0];
|
|
1509 newdir += 2;
|
|
1510 }
|
|
1511
|
|
1512 /* Keep only a prefix from newdir if nm starts with slash
|
19754
|
1513 (//server/share for UNC, nothing otherwise). */
|
15109
|
1514 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
|
15097
|
1515 {
|
|
1516 #ifdef WINDOWSNT
|
|
1517 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
|
|
1518 {
|
|
1519 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
|
|
1520 p = newdir + 2;
|
|
1521 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
|
|
1522 p++;
|
|
1523 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
|
|
1524 *p = 0;
|
|
1525 }
|
|
1526 else
|
|
1527 #endif
|
|
1528 newdir = "";
|
|
1529 }
|
|
1530 }
|
9789
|
1531 #endif /* DOS_NT */
|
15097
|
1532
|
|
1533 if (newdir)
|
372
|
1534 {
|
15313
|
1535 /* Get rid of any slash at the end of newdir, unless newdir is
|
21987
|
1536 just / or // (an incomplete UNC name). */
|
15097
|
1537 length = strlen (newdir);
|
21987
|
1538 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
|
15313
|
1539 #ifdef WINDOWSNT
|
|
1540 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
|
|
1541 #endif
|
|
1542 )
|
372
|
1543 {
|
|
1544 unsigned char *temp = (unsigned char *) alloca (length);
|
|
1545 bcopy (newdir, temp, length - 1);
|
|
1546 temp[length - 1] = 0;
|
|
1547 newdir = temp;
|
|
1548 }
|
|
1549 tlen = length + 1;
|
|
1550 }
|
|
1551 else
|
|
1552 tlen = 0;
|
230
|
1553
|
372
|
1554 /* Now concatenate the directory and name to new space in the stack frame */
|
|
1555 tlen += strlen (nm) + 1;
|
9789
|
1556 #ifdef DOS_NT
|
21987
|
1557 /* Reserve space for drive specifier and escape prefix, since either
|
|
1558 or both may need to be inserted. (The Microsoft x86 compiler
|
9789
|
1559 produces incorrect code if the following two lines are combined.) */
|
21987
|
1560 target = (unsigned char *) alloca (tlen + 4);
|
|
1561 target += 4;
|
9789
|
1562 #else /* not DOS_NT */
|
230
|
1563 target = (unsigned char *) alloca (tlen);
|
9789
|
1564 #endif /* not DOS_NT */
|
230
|
1565 *target = 0;
|
|
1566
|
|
1567 if (newdir)
|
|
1568 {
|
|
1569 #ifndef VMS
|
9789
|
1570 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
|
22106
|
1571 {
|
22113
|
1572 #ifdef DOS_NT
|
22106
|
1573 /* If newdir is effectively "C:/", then the drive letter will have
|
|
1574 been stripped and newdir will be "/". Concatenating with an
|
|
1575 absolute directory in nm produces "//", which will then be
|
|
1576 incorrectly treated as a network share. Ignore newdir in
|
|
1577 this case (keeping the drive letter). */
|
49207
|
1578 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
|
22106
|
1579 && newdir[1] == '\0'))
|
|
1580 #endif
|
|
1581 strcpy (target, newdir);
|
|
1582 }
|
230
|
1583 else
|
|
1584 #endif
|
1589
|
1585 file_name_as_directory (target, newdir);
|
230
|
1586 }
|
|
1587
|
|
1588 strcat (target, nm);
|
|
1589 #ifdef VMS
|
|
1590 if (index (target, '/'))
|
|
1591 strcpy (target, sys_translate_unix (target));
|
|
1592 #endif /* VMS */
|
|
1593
|
15097
|
1594 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
|
|
1595
|
36482
|
1596 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
|
|
1597 appear. */
|
230
|
1598
|
|
1599 p = target;
|
|
1600 o = target;
|
|
1601
|
|
1602 while (*p)
|
|
1603 {
|
|
1604 #ifdef VMS
|
|
1605 if (*p != ']' && *p != '>' && *p != '-')
|
|
1606 {
|
|
1607 if (*p == '\\')
|
|
1608 p++;
|
|
1609 *o++ = *p++;
|
|
1610 }
|
|
1611 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
|
|
1612 /* brackets are offset from each other by 2 */
|
|
1613 {
|
|
1614 p += 2;
|
|
1615 if (*p != '.' && *p != '-' && o[-1] != '.')
|
|
1616 /* convert [foo][bar] to [bar] */
|
|
1617 while (o[-1] != '[' && o[-1] != '<')
|
|
1618 o--;
|
|
1619 else if (*p == '-' && *o != '.')
|
|
1620 *--p = '.';
|
|
1621 }
|
74108
|
1622 else if (p[0] == '-' && o[-1] == '.'
|
|
1623 && (p[1] == '.' || p[1] == ']' || p[1] == '>'))
|
230
|
1624 /* flush .foo.- ; leave - if stopped by '[' or '<' */
|
|
1625 {
|
|
1626 do
|
|
1627 o--;
|
|
1628 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
|
9789
|
1629 if (p[1] == '.') /* foo.-.bar ==> bar. */
|
230
|
1630 p += 2;
|
|
1631 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
|
|
1632 p++, o--;
|
|
1633 /* else [foo.-] ==> [-] */
|
|
1634 }
|
|
1635 else
|
|
1636 {
|
60387
|
1637 #ifdef NO_HYPHENS_IN_FILENAMES
|
74108
|
1638 if (*p == '-'
|
|
1639 && o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
|
|
1640 && p[1] != ']' && p[1] != '>' && p[1] != '.')
|
230
|
1641 *p = '_';
|
60387
|
1642 #endif /* NO_HYPHENS_IN_FILENAMES */
|
230
|
1643 *o++ = *p++;
|
|
1644 }
|
|
1645 #else /* not VMS */
|
9789
|
1646 if (!IS_DIRECTORY_SEP (*p))
|
|
1647 {
|
230
|
1648 *o++ = *p++;
|
|
1649 }
|
68118
8b817a6ceff5
(Fexpand_file_name): Remove redundant tests. Fix elimination of // so that
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1650 else if (p[1] == '.'
|
9789
|
1651 && (IS_DIRECTORY_SEP (p[2])
|
1589
|
1652 || p[2] == 0))
|
|
1653 {
|
|
1654 /* If "/." is the entire filename, keep the "/". Otherwise,
|
|
1655 just delete the whole "/.". */
|
|
1656 if (o == target && p[2] == '\0')
|
|
1657 *o++ = *p;
|
|
1658 p += 2;
|
|
1659 }
|
68118
8b817a6ceff5
(Fexpand_file_name): Remove redundant tests. Fix elimination of // so that
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1660 else if (p[1] == '.' && p[2] == '.'
|
62589
|
1661 /* `/../' is the "superroot" on certain file systems.
|
|
1662 Turned off on DOS_NT systems because they have no
|
|
1663 "superroot" and because this causes us to produce
|
|
1664 file names like "d:/../foo" which fail file-related
|
|
1665 functions of the underlying OS. (To reproduce, try a
|
|
1666 long series of "../../" in default_directory, longer
|
|
1667 than the number of levels from the root.) */
|
|
1668 #ifndef DOS_NT
|
230
|
1669 && o != target
|
62589
|
1670 #endif
|
9789
|
1671 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
|
230
|
1672 {
|
9789
|
1673 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
|
230
|
1674 ;
|
17503
|
1675 /* Keep initial / only if this is the whole name. */
|
|
1676 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
|
15427
97557b39e3b7
(Fexpand_file_name): When simplifying /foo/.., keep the initial slash.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1677 ++o;
|
230
|
1678 p += 3;
|
|
1679 }
|
68118
8b817a6ceff5
(Fexpand_file_name): Remove redundant tests. Fix elimination of // so that
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1680 else if (p > target && IS_DIRECTORY_SEP (p[1]))
|
8b817a6ceff5
(Fexpand_file_name): Remove redundant tests. Fix elimination of // so that
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1681 /* Collapse multiple `/' in a row. */
|
8b817a6ceff5
(Fexpand_file_name): Remove redundant tests. Fix elimination of // so that
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1682 p++;
|
230
|
1683 else
|
9789
|
1684 {
|
230
|
1685 *o++ = *p++;
|
|
1686 }
|
|
1687 #endif /* not VMS */
|
|
1688 }
|
|
1689
|
9789
|
1690 #ifdef DOS_NT
|
15097
|
1691 /* At last, set drive name. */
|
9789
|
1692 #ifdef WINDOWSNT
|
15097
|
1693 /* Except for network file name. */
|
|
1694 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
|
9789
|
1695 #endif /* WINDOWSNT */
|
5494
|
1696 {
|
15097
|
1697 if (!drive) abort ();
|
5494
|
1698 target -= 2;
|
15324
|
1699 target[0] = DRIVE_LETTER (drive);
|
5494
|
1700 target[1] = ':';
|
|
1701 }
|
21987
|
1702 /* Reinsert the escape prefix if required. */
|
|
1703 if (is_escaped)
|
|
1704 {
|
|
1705 target -= 2;
|
|
1706 target[0] = '/';
|
|
1707 target[1] = ':';
|
|
1708 }
|
15097
|
1709 CORRECT_DIR_SEPS (target);
|
9789
|
1710 #endif /* DOS_NT */
|
5494
|
1711
|
65504
|
1712 result = make_specified_string (target, -1, o - target, multibyte);
|
50340
|
1713
|
|
1714 /* Again look to see if the file name has special constructs in it
|
|
1715 and perhaps call the corresponding file handler. This is needed
|
|
1716 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
|
|
1717 the ".." component gives us "/user@host:/bar/../baz" which needs
|
|
1718 to be expanded again. */
|
|
1719 handler = Ffind_file_name_handler (result, Qexpand_file_name);
|
|
1720 if (!NILP (handler))
|
|
1721 return call3 (handler, Qexpand_file_name, result, default_directory);
|
|
1722
|
|
1723 return result;
|
230
|
1724 }
|
9789
|
1725
|
40306
|
1726 #if 0
|
|
1727 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
|
|
1728 This is the old version of expand-file-name, before it was thoroughly
|
|
1729 rewritten for Emacs 10.31. We leave this version here commented-out,
|
|
1730 because the code is very complex and likely to have subtle bugs. If
|
|
1731 bugs _are_ found, it might be of interest to look at the old code and
|
|
1732 see what did it do in the relevant situation.
|
|
1733
|
|
1734 Don't remove this code: it's true that it will be accessible via CVS,
|
|
1735 but a few years from deletion, people will forget it is there. */
|
|
1736
|
|
1737 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
|
|
1738 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
|
|
1739 "Convert FILENAME to absolute, and canonicalize it.\n\
|
|
1740 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
|
61060
|
1741 \(does not start with slash); if DEFAULT is nil or missing,\n\
|
40306
|
1742 the current buffer's value of default-directory is used.\n\
|
|
1743 Filenames containing `.' or `..' as components are simplified;\n\
|
|
1744 initial `~/' expands to your home directory.\n\
|
|
1745 See also the function `substitute-in-file-name'.")
|
|
1746 (name, defalt)
|
|
1747 Lisp_Object name, defalt;
|
|
1748 {
|
|
1749 unsigned char *nm;
|
|
1750
|
|
1751 register unsigned char *newdir, *p, *o;
|
|
1752 int tlen;
|
|
1753 unsigned char *target;
|
|
1754 struct passwd *pw;
|
|
1755 int lose;
|
|
1756 #ifdef VMS
|
|
1757 unsigned char * colon = 0;
|
|
1758 unsigned char * close = 0;
|
|
1759 unsigned char * slash = 0;
|
|
1760 unsigned char * brack = 0;
|
|
1761 int lbrack = 0, rbrack = 0;
|
|
1762 int dots = 0;
|
|
1763 #endif /* VMS */
|
|
1764
|
40656
|
1765 CHECK_STRING (name);
|
40306
|
1766
|
|
1767 #ifdef VMS
|
|
1768 /* Filenames on VMS are always upper case. */
|
|
1769 name = Fupcase (name);
|
|
1770 #endif
|
|
1771
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1772 nm = SDATA (name);
|
40306
|
1773
|
|
1774 /* If nm is absolute, flush ...// and detect /./ and /../.
|
|
1775 If no /./ or /../ we can return right away. */
|
|
1776 if (
|
|
1777 nm[0] == '/'
|
|
1778 #ifdef VMS
|
|
1779 || index (nm, ':')
|
|
1780 #endif /* VMS */
|
|
1781 )
|
|
1782 {
|
|
1783 p = nm;
|
|
1784 lose = 0;
|
|
1785 while (*p)
|
|
1786 {
|
|
1787 if (p[0] == '/' && p[1] == '/'
|
|
1788 #ifdef APOLLO
|
|
1789 /* // at start of filename is meaningful on Apollo system. */
|
|
1790 && nm != p
|
|
1791 #endif /* APOLLO */
|
|
1792 )
|
|
1793 nm = p + 1;
|
|
1794 if (p[0] == '/' && p[1] == '~')
|
|
1795 nm = p + 1, lose = 1;
|
|
1796 if (p[0] == '/' && p[1] == '.'
|
|
1797 && (p[2] == '/' || p[2] == 0
|
|
1798 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
|
|
1799 lose = 1;
|
|
1800 #ifdef VMS
|
|
1801 if (p[0] == '\\')
|
|
1802 lose = 1;
|
|
1803 if (p[0] == '/') {
|
|
1804 /* if dev:[dir]/, move nm to / */
|
|
1805 if (!slash && p > nm && (brack || colon)) {
|
|
1806 nm = (brack ? brack + 1 : colon + 1);
|
|
1807 lbrack = rbrack = 0;
|
|
1808 brack = 0;
|
|
1809 colon = 0;
|
|
1810 }
|
|
1811 slash = p;
|
|
1812 }
|
|
1813 if (p[0] == '-')
|
|
1814 #ifndef VMS4_4
|
|
1815 /* VMS pre V4.4,convert '-'s in filenames. */
|
|
1816 if (lbrack == rbrack)
|
|
1817 {
|
|
1818 if (dots < 2) /* this is to allow negative version numbers */
|
|
1819 p[0] = '_';
|
|
1820 }
|
|
1821 else
|
|
1822 #endif /* VMS4_4 */
|
74108
|
1823 if (lbrack > rbrack
|
|
1824 && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
|
|
1825 && (p[1] == '.' || p[1] == ']' || p[1] == '>')))
|
40306
|
1826 lose = 1;
|
|
1827 #ifndef VMS4_4
|
|
1828 else
|
|
1829 p[0] = '_';
|
|
1830 #endif /* VMS4_4 */
|
|
1831 /* count open brackets, reset close bracket pointer */
|
|
1832 if (p[0] == '[' || p[0] == '<')
|
|
1833 lbrack++, brack = 0;
|
|
1834 /* count close brackets, set close bracket pointer */
|
|
1835 if (p[0] == ']' || p[0] == '>')
|
|
1836 rbrack++, brack = p;
|
|
1837 /* detect ][ or >< */
|
|
1838 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<'))
|
|
1839 lose = 1;
|
|
1840 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~')
|
|
1841 nm = p + 1, lose = 1;
|
|
1842 if (p[0] == ':' && (colon || slash))
|
|
1843 /* if dev1:[dir]dev2:, move nm to dev2: */
|
|
1844 if (brack)
|
|
1845 {
|
|
1846 nm = brack + 1;
|
|
1847 brack = 0;
|
|
1848 }
|
|
1849 /* If /name/dev:, move nm to dev: */
|
|
1850 else if (slash)
|
|
1851 nm = slash + 1;
|
|
1852 /* If node::dev:, move colon following dev */
|
|
1853 else if (colon && colon[-1] == ':')
|
|
1854 colon = p;
|
|
1855 /* If dev1:dev2:, move nm to dev2: */
|
|
1856 else if (colon && colon[-1] != ':')
|
|
1857 {
|
|
1858 nm = colon + 1;
|
|
1859 colon = 0;
|
|
1860 }
|
|
1861 if (p[0] == ':' && !colon)
|
|
1862 {
|
|
1863 if (p[1] == ':')
|
|
1864 p++;
|
|
1865 colon = p;
|
|
1866 }
|
|
1867 if (lbrack == rbrack)
|
|
1868 if (p[0] == ';')
|
|
1869 dots = 2;
|
|
1870 else if (p[0] == '.')
|
|
1871 dots++;
|
|
1872 #endif /* VMS */
|
|
1873 p++;
|
|
1874 }
|
|
1875 if (!lose)
|
|
1876 {
|
|
1877 #ifdef VMS
|
|
1878 if (index (nm, '/'))
|
|
1879 return build_string (sys_translate_unix (nm));
|
|
1880 #endif /* VMS */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1881 if (nm == SDATA (name))
|
40306
|
1882 return name;
|
|
1883 return build_string (nm);
|
|
1884 }
|
|
1885 }
|
|
1886
|
|
1887 /* Now determine directory to start with and put it in NEWDIR */
|
|
1888
|
|
1889 newdir = 0;
|
|
1890
|
|
1891 if (nm[0] == '~') /* prefix ~ */
|
|
1892 if (nm[1] == '/'
|
|
1893 #ifdef VMS
|
|
1894 || nm[1] == ':'
|
|
1895 #endif /* VMS */
|
|
1896 || nm[1] == 0)/* ~/filename */
|
|
1897 {
|
|
1898 if (!(newdir = (unsigned char *) egetenv ("HOME")))
|
|
1899 newdir = (unsigned char *) "";
|
|
1900 nm++;
|
|
1901 #ifdef VMS
|
|
1902 nm++; /* Don't leave the slash in nm. */
|
|
1903 #endif /* VMS */
|
|
1904 }
|
|
1905 else /* ~user/filename */
|
|
1906 {
|
|
1907 /* Get past ~ to user */
|
|
1908 unsigned char *user = nm + 1;
|
|
1909 /* Find end of name. */
|
|
1910 unsigned char *ptr = (unsigned char *) index (user, '/');
|
|
1911 int len = ptr ? ptr - user : strlen (user);
|
|
1912 #ifdef VMS
|
|
1913 unsigned char *ptr1 = index (user, ':');
|
|
1914 if (ptr1 != 0 && ptr1 - user < len)
|
|
1915 len = ptr1 - user;
|
|
1916 #endif /* VMS */
|
|
1917 /* Copy the user name into temp storage. */
|
|
1918 o = (unsigned char *) alloca (len + 1);
|
|
1919 bcopy ((char *) user, o, len);
|
|
1920 o[len] = 0;
|
|
1921
|
|
1922 /* Look up the user name. */
|
71818
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1923 BLOCK_INPUT;
|
40306
|
1924 pw = (struct passwd *) getpwnam (o + 1);
|
71818
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
1925 UNBLOCK_INPUT;
|
40306
|
1926 if (!pw)
|
|
1927 error ("\"%s\" isn't a registered user", o + 1);
|
|
1928
|
|
1929 newdir = (unsigned char *) pw->pw_dir;
|
|
1930
|
|
1931 /* Discard the user name from NM. */
|
|
1932 nm += len;
|
|
1933 }
|
|
1934
|
|
1935 if (nm[0] != '/'
|
|
1936 #ifdef VMS
|
|
1937 && !index (nm, ':')
|
|
1938 #endif /* not VMS */
|
|
1939 && !newdir)
|
|
1940 {
|
|
1941 if (NILP (defalt))
|
|
1942 defalt = current_buffer->directory;
|
40656
|
1943 CHECK_STRING (defalt);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
1944 newdir = SDATA (defalt);
|
40306
|
1945 }
|
|
1946
|
|
1947 /* Now concatenate the directory and name to new space in the stack frame */
|
|
1948
|
|
1949 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
|
|
1950 target = (unsigned char *) alloca (tlen);
|
|
1951 *target = 0;
|
|
1952
|
|
1953 if (newdir)
|
|
1954 {
|
|
1955 #ifndef VMS
|
|
1956 if (nm[0] == 0 || nm[0] == '/')
|
|
1957 strcpy (target, newdir);
|
|
1958 else
|
|
1959 #endif
|
|
1960 file_name_as_directory (target, newdir);
|
|
1961 }
|
|
1962
|
|
1963 strcat (target, nm);
|
|
1964 #ifdef VMS
|
|
1965 if (index (target, '/'))
|
|
1966 strcpy (target, sys_translate_unix (target));
|
|
1967 #endif /* VMS */
|
|
1968
|
|
1969 /* Now canonicalize by removing /. and /foo/.. if they appear */
|
|
1970
|
|
1971 p = target;
|
|
1972 o = target;
|
|
1973
|
|
1974 while (*p)
|
|
1975 {
|
|
1976 #ifdef VMS
|
|
1977 if (*p != ']' && *p != '>' && *p != '-')
|
|
1978 {
|
|
1979 if (*p == '\\')
|
|
1980 p++;
|
|
1981 *o++ = *p++;
|
|
1982 }
|
|
1983 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2)
|
|
1984 /* brackets are offset from each other by 2 */
|
|
1985 {
|
|
1986 p += 2;
|
|
1987 if (*p != '.' && *p != '-' && o[-1] != '.')
|
|
1988 /* convert [foo][bar] to [bar] */
|
|
1989 while (o[-1] != '[' && o[-1] != '<')
|
|
1990 o--;
|
|
1991 else if (*p == '-' && *o != '.')
|
|
1992 *--p = '.';
|
|
1993 }
|
74108
|
1994 else if (p[0] == '-' && o[-1] == '.'
|
|
1995 && (p[1] == '.' || p[1] == ']' || p[1] == '>'))
|
40306
|
1996 /* flush .foo.- ; leave - if stopped by '[' or '<' */
|
|
1997 {
|
|
1998 do
|
|
1999 o--;
|
|
2000 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
|
|
2001 if (p[1] == '.') /* foo.-.bar ==> bar. */
|
|
2002 p += 2;
|
|
2003 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
|
|
2004 p++, o--;
|
|
2005 /* else [foo.-] ==> [-] */
|
|
2006 }
|
|
2007 else
|
|
2008 {
|
|
2009 #ifndef VMS4_4
|
74108
|
2010 if (*p == '-'
|
|
2011 && o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
|
|
2012 && p[1] != ']' && p[1] != '>' && p[1] != '.')
|
40306
|
2013 *p = '_';
|
|
2014 #endif /* VMS4_4 */
|
|
2015 *o++ = *p++;
|
|
2016 }
|
|
2017 #else /* not VMS */
|
|
2018 if (*p != '/')
|
|
2019 {
|
|
2020 *o++ = *p++;
|
|
2021 }
|
|
2022 else if (!strncmp (p, "//", 2)
|
|
2023 #ifdef APOLLO
|
|
2024 /* // at start of filename is meaningful in Apollo system. */
|
|
2025 && o != target
|
|
2026 #endif /* APOLLO */
|
|
2027 )
|
|
2028 {
|
|
2029 o = target;
|
|
2030 p++;
|
|
2031 }
|
74108
|
2032 else if (p[0] == '/' && p[1] == '.'
|
|
2033 && (p[2] == '/' || p[2] == 0))
|
40306
|
2034 p += 2;
|
|
2035 else if (!strncmp (p, "/..", 3)
|
|
2036 /* `/../' is the "superroot" on certain file systems. */
|
|
2037 && o != target
|
|
2038 && (p[3] == '/' || p[3] == 0))
|
|
2039 {
|
|
2040 while (o != target && *--o != '/')
|
|
2041 ;
|
|
2042 #ifdef APOLLO
|
|
2043 if (o == target + 1 && o[-1] == '/' && o[0] == '/')
|
|
2044 ++o;
|
|
2045 else
|
|
2046 #endif /* APOLLO */
|
|
2047 if (o == target && *o == '/')
|
|
2048 ++o;
|
|
2049 p += 3;
|
|
2050 }
|
|
2051 else
|
|
2052 {
|
|
2053 *o++ = *p++;
|
|
2054 }
|
|
2055 #endif /* not VMS */
|
|
2056 }
|
|
2057
|
|
2058 return make_string (target, o - target);
|
|
2059 }
|
|
2060 #endif
|
230
|
2061
|
61060
|
2062 /* If /~ or // appears, discard everything through first slash. */
|
|
2063 static int
|
|
2064 file_name_absolute_p (filename)
|
|
2065 const unsigned char *filename;
|
|
2066 {
|
|
2067 return
|
|
2068 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
|
|
2069 #ifdef VMS
|
|
2070 /* ??? This criterion is probably wrong for '<'. */
|
|
2071 || index (filename, ':') || index (filename, '<')
|
|
2072 || (*filename == '[' && (filename[1] != '-'
|
|
2073 || (filename[2] != '.' && filename[2] != ']'))
|
|
2074 && filename[1] != '.')
|
|
2075 #endif /* VMS */
|
|
2076 #ifdef DOS_NT
|
|
2077 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
|
|
2078 && IS_DIRECTORY_SEP (filename[2]))
|
|
2079 #endif
|
|
2080 );
|
|
2081 }
|
|
2082
|
|
2083 static unsigned char *
|
|
2084 search_embedded_absfilename (nm, endp)
|
|
2085 unsigned char *nm, *endp;
|
|
2086 {
|
|
2087 unsigned char *p, *s;
|
|
2088
|
|
2089 for (p = nm + 1; p < endp; p++)
|
|
2090 {
|
|
2091 if ((0
|
|
2092 #ifdef VMS
|
|
2093 || p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
|
|
2094 #endif /* VMS */
|
|
2095 || IS_DIRECTORY_SEP (p[-1]))
|
|
2096 && file_name_absolute_p (p)
|
|
2097 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
|
|
2098 /* // at start of file name is meaningful in Apollo,
|
|
2099 WindowsNT and Cygwin systems. */
|
61151
|
2100 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
|
61060
|
2101 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
|
|
2102 )
|
|
2103 {
|
|
2104 for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
|
|
2105 #ifdef VMS
|
|
2106 && *s != ':'
|
|
2107 #endif /* VMS */
|
|
2108 ); s++);
|
|
2109 if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
|
|
2110 {
|
|
2111 unsigned char *o = alloca (s - p + 1);
|
|
2112 struct passwd *pw;
|
|
2113 bcopy (p, o, s - p);
|
|
2114 o [s - p] = 0;
|
|
2115
|
|
2116 /* If we have ~user and `user' exists, discard
|
|
2117 everything up to ~. But if `user' does not exist, leave
|
|
2118 ~user alone, it might be a literal file name. */
|
71818
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
2119 BLOCK_INPUT;
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
2120 pw = getpwnam (o + 1);
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
2121 UNBLOCK_INPUT;
|
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
2122 if (pw)
|
61060
|
2123 return p;
|
|
2124 }
|
|
2125 else
|
|
2126 return p;
|
|
2127 }
|
|
2128 }
|
|
2129 return NULL;
|
|
2130 }
|
|
2131
|
230
|
2132 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
|
40123
|
2133 Ssubstitute_in_file_name, 1, 1, 0,
|
|
2134 doc: /* Substitute environment variables referred to in FILENAME.
|
|
2135 `$FOO' where FOO is an environment variable name means to substitute
|
|
2136 the value of that variable. The variable name should be terminated
|
|
2137 with a character not a letter, digit or underscore; otherwise, enclose
|
|
2138 the entire variable name in braces.
|
|
2139 If `/~' appears, all of FILENAME through that `/' is discarded.
|
|
2140
|
|
2141 On VMS, `$' substitution is not done; this function does little and only
|
|
2142 duplicates what `expand-file-name' does. */)
|
|
2143 (filename)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2144 Lisp_Object filename;
|
230
|
2145 {
|
|
2146 unsigned char *nm;
|
|
2147
|
|
2148 register unsigned char *s, *p, *o, *x, *endp;
|
31829
|
2149 unsigned char *target = NULL;
|
230
|
2150 int total = 0;
|
|
2151 int substituted = 0;
|
|
2152 unsigned char *xnm;
|
9955
|
2153 Lisp_Object handler;
|
230
|
2154
|
40656
|
2155 CHECK_STRING (filename);
|
230
|
2156
|
9955
|
2157 /* If the file name has special constructs in it,
|
|
2158 call the corresponding file handler. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2159 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
|
9955
|
2160 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2161 return call2 (handler, Qsubstitute_in_file_name, filename);
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2162
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2163 nm = SDATA (filename);
|
15097
|
2164 #ifdef DOS_NT
|
|
2165 nm = strcpy (alloca (strlen (nm) + 1), nm);
|
|
2166 CORRECT_DIR_SEPS (nm);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2167 substituted = (strcmp (nm, SDATA (filename)) != 0);
|
8185
|
2168 #endif
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2169 endp = nm + SBYTES (filename);
|
230
|
2170
|
19754
|
2171 /* If /~ or // appears, discard everything through first slash. */
|
61060
|
2172 p = search_embedded_absfilename (nm, endp);
|
|
2173 if (p)
|
|
2174 /* Start over with the new string, so we check the file-name-handler
|
|
2175 again. Important with filenames like "/home/foo//:/hello///there"
|
|
2176 which whould substitute to "/:/hello///there" rather than "/there". */
|
|
2177 return Fsubstitute_in_file_name
|
|
2178 (make_specified_string (p, -1, endp - p,
|
|
2179 STRING_MULTIBYTE (filename)));
|
230
|
2180
|
|
2181 #ifdef VMS
|
61060
|
2182 return filename;
|
230
|
2183 #else
|
|
2184
|
|
2185 /* See if any variables are substituted into the string
|
|
2186 and find the total length of their values in `total' */
|
|
2187
|
|
2188 for (p = nm; p != endp;)
|
|
2189 if (*p != '$')
|
|
2190 p++;
|
|
2191 else
|
|
2192 {
|
|
2193 p++;
|
|
2194 if (p == endp)
|
|
2195 goto badsubst;
|
|
2196 else if (*p == '$')
|
|
2197 {
|
|
2198 /* "$$" means a single "$" */
|
|
2199 p++;
|
|
2200 total -= 1;
|
|
2201 substituted = 1;
|
|
2202 continue;
|
|
2203 }
|
|
2204 else if (*p == '{')
|
|
2205 {
|
|
2206 o = ++p;
|
|
2207 while (p != endp && *p != '}') p++;
|
|
2208 if (*p != '}') goto missingclose;
|
|
2209 s = p;
|
|
2210 }
|
|
2211 else
|
|
2212 {
|
|
2213 o = p;
|
|
2214 while (p != endp && (isalnum (*p) || *p == '_')) p++;
|
|
2215 s = p;
|
|
2216 }
|
|
2217
|
|
2218 /* Copy out the variable name */
|
|
2219 target = (unsigned char *) alloca (s - o + 1);
|
|
2220 strncpy (target, o, s - o);
|
|
2221 target[s - o] = 0;
|
9789
|
2222 #ifdef DOS_NT
|
5494
|
2223 strupr (target); /* $home == $HOME etc. */
|
9789
|
2224 #endif /* DOS_NT */
|
230
|
2225
|
|
2226 /* Get variable value */
|
|
2227 o = (unsigned char *) egetenv (target);
|
41595
|
2228 if (o)
|
|
2229 {
|
|
2230 total += strlen (o);
|
|
2231 substituted = 1;
|
|
2232 }
|
|
2233 else if (*p == '}')
|
|
2234 goto badvar;
|
230
|
2235 }
|
|
2236
|
|
2237 if (!substituted)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2238 return filename;
|
230
|
2239
|
|
2240 /* If substitution required, recopy the string and do it */
|
|
2241 /* Make space in stack frame for the new copy */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2242 xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
|
230
|
2243 x = xnm;
|
|
2244
|
|
2245 /* Copy the rest of the name through, replacing $ constructs with values */
|
|
2246 for (p = nm; *p;)
|
|
2247 if (*p != '$')
|
|
2248 *x++ = *p++;
|
|
2249 else
|
|
2250 {
|
|
2251 p++;
|
|
2252 if (p == endp)
|
|
2253 goto badsubst;
|
|
2254 else if (*p == '$')
|
|
2255 {
|
|
2256 *x++ = *p++;
|
|
2257 continue;
|
|
2258 }
|
|
2259 else if (*p == '{')
|
|
2260 {
|
|
2261 o = ++p;
|
|
2262 while (p != endp && *p != '}') p++;
|
|
2263 if (*p != '}') goto missingclose;
|
|
2264 s = p++;
|
|
2265 }
|
|
2266 else
|
|
2267 {
|
|
2268 o = p;
|
|
2269 while (p != endp && (isalnum (*p) || *p == '_')) p++;
|
|
2270 s = p;
|
|
2271 }
|
|
2272
|
|
2273 /* Copy out the variable name */
|
|
2274 target = (unsigned char *) alloca (s - o + 1);
|
|
2275 strncpy (target, o, s - o);
|
|
2276 target[s - o] = 0;
|
9789
|
2277 #ifdef DOS_NT
|
5494
|
2278 strupr (target); /* $home == $HOME etc. */
|
9789
|
2279 #endif /* DOS_NT */
|
230
|
2280
|
|
2281 /* Get variable value */
|
|
2282 o = (unsigned char *) egetenv (target);
|
|
2283 if (!o)
|
41595
|
2284 {
|
|
2285 *x++ = '$';
|
|
2286 strcpy (x, target); x+= strlen (target);
|
|
2287 }
|
|
2288 else if (STRING_MULTIBYTE (filename))
|
20621
|
2289 {
|
|
2290 /* If the original string is multibyte,
|
|
2291 convert what we substitute into multibyte. */
|
|
2292 while (*o)
|
|
2293 {
|
26855
|
2294 int c = unibyte_char_to_multibyte (*o++);
|
|
2295 x += CHAR_STRING (c, x);
|
20621
|
2296 }
|
|
2297 }
|
|
2298 else
|
|
2299 {
|
|
2300 strcpy (x, o);
|
|
2301 x += strlen (o);
|
|
2302 }
|
230
|
2303 }
|
|
2304
|
|
2305 *x = 0;
|
|
2306
|
19754
|
2307 /* If /~ or // appears, discard everything through first slash. */
|
61060
|
2308 while ((p = search_embedded_absfilename (xnm, x)))
|
|
2309 /* This time we do not start over because we've already expanded envvars
|
|
2310 and replaced $$ with $. Maybe we should start over as well, but we'd
|
|
2311 need to quote some $ to $$ first. */
|
|
2312 xnm = p;
|
230
|
2313
|
50196
|
2314 return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
|
230
|
2315
|
|
2316 badsubst:
|
|
2317 error ("Bad format environment-variable substitution");
|
|
2318 missingclose:
|
|
2319 error ("Missing \"}\" in environment-variable substitution");
|
|
2320 badvar:
|
|
2321 error ("Substituting nonexistent environment variable \"%s\"", target);
|
|
2322
|
|
2323 /* NOTREACHED */
|
|
2324 #endif /* not VMS */
|
31829
|
2325 return Qnil;
|
230
|
2326 }
|
|
2327
|
853
|
2328 /* A slightly faster and more convenient way to get
|
4451
|
2329 (directory-file-name (expand-file-name FOO)). */
|
853
|
2330
|
230
|
2331 Lisp_Object
|
|
2332 expand_and_dir_to_file (filename, defdir)
|
|
2333 Lisp_Object filename, defdir;
|
|
2334 {
|
15097
|
2335 register Lisp_Object absname;
|
|
2336
|
|
2337 absname = Fexpand_file_name (filename, defdir);
|
230
|
2338 #ifdef VMS
|
|
2339 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2340 register int c = SREF (absname, SBYTES (absname) - 1);
|
230
|
2341 if (c == ':' || c == ']' || c == '>')
|
15097
|
2342 absname = Fdirectory_file_name (absname);
|
230
|
2343 }
|
|
2344 #else
|
15097
|
2345 /* Remove final slash, if any (unless this is the root dir).
|
230
|
2346 stat behaves differently depending! */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2347 if (SCHARS (absname) > 1
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2348 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2349 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
|
4483
|
2350 /* We cannot take shortcuts; they might be wrong for magic file names. */
|
15097
|
2351 absname = Fdirectory_file_name (absname);
|
230
|
2352 #endif
|
15097
|
2353 return absname;
|
230
|
2354 }
|
|
2355
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2356 /* Signal an error if the file ABSNAME already exists.
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2357 If INTERACTIVE is nonzero, ask the user whether to proceed,
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2358 and bypass the error if the user says to go ahead.
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2359 QUERYSTRING is a name for the action that is being considered
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2360 to alter the file.
|
21020
|
2361
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2362 *STATPTR is used to store the stat information if the file exists.
|
21020
|
2363 If the file does not exist, STATPTR->st_mode is set to 0.
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2364 If STATPTR is null, we don't store into it.
|
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2365
|
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2366 If QUICK is nonzero, we ask for y or n, not yes or no. */
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2367
|
8846
|
2368 void
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2369 barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
|
230
|
2370 Lisp_Object absname;
|
|
2371 unsigned char *querystring;
|
|
2372 int interactive;
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2373 struct stat *statptr;
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2374 int quick;
|
230
|
2375 {
|
21949
|
2376 register Lisp_Object tem, encoded_filename;
|
8597
|
2377 struct stat statbuf;
|
230
|
2378 struct gcpro gcpro1;
|
|
2379
|
21949
|
2380 encoded_filename = ENCODE_FILE (absname);
|
|
2381
|
8597
|
2382 /* stat is a good way to tell whether the file exists,
|
|
2383 regardless of what access permissions it has. */
|
55364
|
2384 if (lstat (SDATA (encoded_filename), &statbuf) >= 0)
|
230
|
2385 {
|
|
2386 if (! interactive)
|
71977
|
2387 xsignal2 (Qfile_already_exists,
|
|
2388 build_string ("File already exists"), absname);
|
230
|
2389 GCPRO1 (absname);
|
49445
643eb4ccb3a3
(barf_or_query_if_file_exists): Call format2 instead of format1.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2390 tem = format2 ("File %s already exists; %s anyway? ",
|
643eb4ccb3a3
(barf_or_query_if_file_exists): Call format2 instead of format1.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2391 absname, build_string (querystring));
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2392 if (quick)
|
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2393 tem = Fy_or_n_p (tem);
|
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2394 else
|
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2395 tem = do_yes_or_no_p (tem);
|
230
|
2396 UNGCPRO;
|
485
|
2397 if (NILP (tem))
|
71977
|
2398 xsignal2 (Qfile_already_exists,
|
|
2399 build_string ("File already exists"), absname);
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2400 if (statptr)
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2401 *statptr = statbuf;
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2402 }
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2403 else
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2404 {
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2405 if (statptr)
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2406 statptr->st_mode = 0;
|
230
|
2407 }
|
|
2408 return;
|
|
2409 }
|
|
2410
|
70960
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2411 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
|
60682
|
2412 "fCopy file: \nGCopy %s to file: \np\nP",
|
40123
|
2413 doc: /* Copy FILE to NEWNAME. Both args must be strings.
|
|
2414 If NEWNAME names a directory, copy FILE there.
|
70960
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2415
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2416 This function always sets the file modes of the output file to match
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2417 the input file.
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2418
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2419 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2420 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2421 signal a `file-already-exists' error without overwriting. If
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2422 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2423 about overwriting; this is what happens in interactive use with M-x.
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2424 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2425 existing file.
|
61756
|
2426
|
59671
|
2427 Fourth arg KEEP-TIME non-nil means give the output file the same
|
40123
|
2428 last-modified time as the old one. (This works on only some systems.)
|
61789
|
2429
|
|
2430 A prefix arg makes KEEP-TIME non-nil.
|
|
2431
|
63773
|
2432 If PRESERVE-UID-GID is non-nil, we try to transfer the
|
|
2433 uid and gid of FILE to NEWNAME. */)
|
70960
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2434 (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid)
|
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2435 Lisp_Object file, newname, ok_if_already_exists, keep_time;
|
63773
|
2436 Lisp_Object preserve_uid_gid;
|
230
|
2437 {
|
|
2438 int ifd, ofd, n;
|
|
2439 char buf[16 * 1024];
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2440 struct stat st, out_st;
|
843
|
2441 Lisp_Object handler;
|
19861
|
2442 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
46293
|
2443 int count = SPECPDL_INDEX ();
|
4879
|
2444 int input_file_statable_p;
|
19861
|
2445 Lisp_Object encoded_file, encoded_newname;
|
|
2446
|
|
2447 encoded_file = encoded_newname = Qnil;
|
|
2448 GCPRO4 (file, newname, encoded_file, encoded_newname);
|
40656
|
2449 CHECK_STRING (file);
|
|
2450 CHECK_STRING (newname);
|
19861
|
2451
|
39603
|
2452 if (!NILP (Ffile_directory_p (newname)))
|
53780
|
2453 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
|
39603
|
2454 else
|
|
2455 newname = Fexpand_file_name (newname, Qnil);
|
|
2456
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2457 file = Fexpand_file_name (file, Qnil);
|
843
|
2458
|
1105
|
2459 /* If the input file name has special constructs in it,
|
843
|
2460 call the corresponding file handler. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2461 handler = Ffind_file_name_handler (file, Qcopy_file);
|
3705
|
2462 /* Likewise for output file name. */
|
|
2463 if (NILP (handler))
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2464 handler = Ffind_file_name_handler (newname, Qcopy_file);
|
843
|
2465 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2466 RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
|
34633
|
2467 ok_if_already_exists, keep_time));
|
843
|
2468
|
19861
|
2469 encoded_file = ENCODE_FILE (file);
|
|
2470 encoded_newname = ENCODE_FILE (newname);
|
|
2471
|
485
|
2472 if (NILP (ok_if_already_exists)
|
9131
|
2473 || INTEGERP (ok_if_already_exists))
|
76664
|
2474 barf_or_query_if_file_exists (newname, "copy to it",
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2475 INTEGERP (ok_if_already_exists), &out_st, 0);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2476 else if (stat (SDATA (encoded_newname), &out_st) < 0)
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2477 out_st.st_mode = 0;
|
230
|
2478
|
37292
|
2479 #ifdef WINDOWSNT
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2480 if (!CopyFile (SDATA (encoded_file),
|
49207
|
2481 SDATA (encoded_newname),
|
37292
|
2482 FALSE))
|
|
2483 report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
|
49557
|
2484 /* CopyFile retains the timestamp by default. */
|
|
2485 else if (NILP (keep_time))
|
37292
|
2486 {
|
|
2487 EMACS_TIME now;
|
43792
|
2488 DWORD attributes;
|
|
2489 char * filename;
|
|
2490
|
37292
|
2491 EMACS_GET_TIME (now);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2492 filename = SDATA (encoded_newname);
|
43792
|
2493
|
|
2494 /* Ensure file is writable while its modified time is set. */
|
|
2495 attributes = GetFileAttributes (filename);
|
43799
|
2496 SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
|
43792
|
2497 if (set_file_times (filename, now, now))
|
|
2498 {
|
|
2499 /* Restore original attributes. */
|
|
2500 SetFileAttributes (filename, attributes);
|
71977
|
2501 xsignal2 (Qfile_date_error,
|
|
2502 build_string ("Cannot set file date"), newname);
|
43792
|
2503 }
|
|
2504 /* Restore original attributes. */
|
|
2505 SetFileAttributes (filename, attributes);
|
37292
|
2506 }
|
|
2507 #else /* not WINDOWSNT */
|
48725
|
2508 immediate_quit = 1;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2509 ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
|
48725
|
2510 immediate_quit = 0;
|
|
2511
|
230
|
2512 if (ifd < 0)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2513 report_file_error ("Opening input file", Fcons (file, Qnil));
|
230
|
2514
|
592
|
2515 record_unwind_protect (close_file_unwind, make_number (ifd));
|
|
2516
|
4879
|
2517 /* We can only copy regular files and symbolic links. Other files are not
|
|
2518 copyable by us. */
|
|
2519 input_file_statable_p = (fstat (ifd, &st) >= 0);
|
|
2520
|
63907
|
2521 #if !defined (MSDOS) || __DJGPP__ > 1
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2522 if (out_st.st_mode != 0
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2523 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2524 {
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2525 errno = 0;
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2526 report_file_error ("Input and output files are the same",
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2527 Fcons (file, Fcons (newname, Qnil)));
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2528 }
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2529 #endif
|
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2530
|
4879
|
2531 #if defined (S_ISREG) && defined (S_ISLNK)
|
|
2532 if (input_file_statable_p)
|
|
2533 {
|
|
2534 if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode)))
|
|
2535 {
|
|
2536 #if defined (EISDIR)
|
|
2537 /* Get a better looking error message. */
|
|
2538 errno = EISDIR;
|
|
2539 #endif /* EISDIR */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2540 report_file_error ("Non-regular file", Fcons (file, Qnil));
|
4879
|
2541 }
|
|
2542 }
|
|
2543 #endif /* S_ISREG && S_ISLNK */
|
|
2544
|
230
|
2545 #ifdef VMS
|
|
2546 /* Create the copy file with the same record format as the input file */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2547 ofd = sys_creat (SDATA (encoded_newname), 0666, ifd);
|
230
|
2548 #else
|
5494
|
2549 #ifdef MSDOS
|
|
2550 /* System's default file type was set to binary by _fmode in emacs.c. */
|
61756
|
2551 ofd = emacs_open (SDATA (encoded_newname),
|
61789
|
2552 O_WRONLY | O_TRUNC | O_CREAT
|
70960
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2553 | (NILP (ok_if_already_exists) ? O_EXCL : 0),
|
61756
|
2554 S_IREAD | S_IWRITE);
|
|
2555 #else /* not MSDOS */
|
|
2556 ofd = emacs_open (SDATA (encoded_newname),
|
|
2557 O_WRONLY | O_TRUNC | O_CREAT
|
70960
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2558 | (NILP (ok_if_already_exists) ? O_EXCL : 0),
|
61756
|
2559 0666);
|
5494
|
2560 #endif /* not MSDOS */
|
230
|
2561 #endif /* VMS */
|
|
2562 if (ofd < 0)
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2563 report_file_error ("Opening output file", Fcons (newname, Qnil));
|
230
|
2564
|
592
|
2565 record_unwind_protect (close_file_unwind, make_number (ofd));
|
|
2566
|
|
2567 immediate_quit = 1;
|
|
2568 QUIT;
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2569 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2570 if (emacs_write (ofd, buf, n) != n)
|
13098
e1d400bc526e
(barf_or_query_if_file_exists): New arg STATPTR. Callers changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2571 report_file_error ("I/O error", Fcons (newname, Qnil));
|
592
|
2572 immediate_quit = 0;
|
230
|
2573
|
63907
|
2574 #ifndef MSDOS
|
|
2575 /* Preserve the original file modes, and if requested, also its
|
|
2576 owner and group. */
|
63773
|
2577 if (input_file_statable_p)
|
|
2578 {
|
63907
|
2579 if (! NILP (preserve_uid_gid))
|
|
2580 fchown (ofd, st.st_uid, st.st_gid);
|
63773
|
2581 fchmod (ofd, st.st_mode & 07777);
|
|
2582 }
|
63907
|
2583 #endif /* not MSDOS */
|
63773
|
2584
|
7493
|
2585 /* Closing the output clobbers the file times on some systems. */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2586 if (emacs_close (ofd) < 0)
|
7493
|
2587 report_file_error ("I/O error", Fcons (newname, Qnil));
|
|
2588
|
4879
|
2589 if (input_file_statable_p)
|
230
|
2590 {
|
34633
|
2591 if (!NILP (keep_time))
|
230
|
2592 {
|
564
|
2593 EMACS_TIME atime, mtime;
|
|
2594 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
|
|
2595 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2596 if (set_file_times (SDATA (encoded_newname),
|
19861
|
2597 atime, mtime))
|
71977
|
2598 xsignal2 (Qfile_date_error,
|
|
2599 build_string ("Cannot set file date"), newname);
|
230
|
2600 }
|
|
2601 }
|
|
2602
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2603 emacs_close (ifd);
|
63907
|
2604
|
|
2605 #if defined (__DJGPP__) && __DJGPP__ > 1
|
|
2606 if (input_file_statable_p)
|
|
2607 {
|
|
2608 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
|
|
2609 and if it can't, it tells so. Otherwise, under MSDOS we usually
|
|
2610 get only the READ bit, which will make the copied file read-only,
|
|
2611 so it's better not to chmod at all. */
|
|
2612 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
|
|
2613 chmod (SDATA (encoded_newname), st.st_mode & 07777);
|
|
2614 }
|
|
2615 #endif /* DJGPP version 2 or newer */
|
|
2616 #endif /* not WINDOWSNT */
|
7493
|
2617
|
592
|
2618 /* Discard the unwind protects. */
|
|
2619 specpdl_ptr = specpdl + count;
|
|
2620
|
230
|
2621 UNGCPRO;
|
|
2622 return Qnil;
|
|
2623 }
|
10084
|
2624
|
1533
|
2625 DEFUN ("make-directory-internal", Fmake_directory_internal,
|
1536
0877009e6324
* fileio.c (Fmake_directory_internal): Remove extra paren before the
Jim Blandy <jimb@redhat.com>
diff
changeset
|
2626 Smake_directory_internal, 1, 1, 0,
|
40123
|
2627 doc: /* Create a new directory named DIRECTORY. */)
|
|
2628 (directory)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2629 Lisp_Object directory;
|
230
|
2630 {
|
46465
|
2631 const unsigned char *dir;
|
843
|
2632 Lisp_Object handler;
|
19861
|
2633 Lisp_Object encoded_dir;
|
230
|
2634
|
40656
|
2635 CHECK_STRING (directory);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2636 directory = Fexpand_file_name (directory, Qnil);
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2637
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2638 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
|
843
|
2639 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2640 return call2 (handler, Qmake_directory_internal, directory);
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2641
|
19861
|
2642 encoded_dir = ENCODE_FILE (directory);
|
|
2643
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2644 dir = SDATA (encoded_dir);
|
230
|
2645
|
9789
|
2646 #ifdef WINDOWSNT
|
|
2647 if (mkdir (dir) != 0)
|
|
2648 #else
|
230
|
2649 if (mkdir (dir, 0777) != 0)
|
9789
|
2650 #endif
|
72530
|
2651 report_file_error ("Creating directory", list1 (directory));
|
230
|
2652
|
843
|
2653 return Qnil;
|
230
|
2654 }
|
|
2655
|
686
|
2656 DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
|
49207
|
2657 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
|
40123
|
2658 (directory)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2659 Lisp_Object directory;
|
230
|
2660 {
|
46465
|
2661 const unsigned char *dir;
|
843
|
2662 Lisp_Object handler;
|
19861
|
2663 Lisp_Object encoded_dir;
|
230
|
2664
|
40656
|
2665 CHECK_STRING (directory);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2666 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2667
|
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2668 handler = Ffind_file_name_handler (directory, Qdelete_directory);
|
843
|
2669 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2670 return call2 (handler, Qdelete_directory, directory);
|
843
|
2671
|
19861
|
2672 encoded_dir = ENCODE_FILE (directory);
|
|
2673
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2674 dir = SDATA (encoded_dir);
|
19861
|
2675
|
230
|
2676 if (rmdir (dir) != 0)
|
72530
|
2677 report_file_error ("Removing directory", list1 (directory));
|
230
|
2678
|
|
2679 return Qnil;
|
|
2680 }
|
|
2681
|
|
2682 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
|
49207
|
2683 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
|
40123
|
2684 If file has multiple names, it continues to exist with the other names. */)
|
|
2685 (filename)
|
230
|
2686 Lisp_Object filename;
|
|
2687 {
|
843
|
2688 Lisp_Object handler;
|
19861
|
2689 Lisp_Object encoded_file;
|
49207
|
2690 struct gcpro gcpro1;
|
|
2691
|
|
2692 GCPRO1 (filename);
|
51022
|
2693 if (!NILP (Ffile_directory_p (filename))
|
|
2694 && NILP (Ffile_symlink_p (filename)))
|
71977
|
2695 xsignal2 (Qfile_error,
|
|
2696 build_string ("Removing old name: is a directory"),
|
|
2697 filename);
|
49207
|
2698 UNGCPRO;
|
230
|
2699 filename = Fexpand_file_name (filename, Qnil);
|
843
|
2700
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2701 handler = Ffind_file_name_handler (filename, Qdelete_file);
|
843
|
2702 if (!NILP (handler))
|
9170
|
2703 return call2 (handler, Qdelete_file, filename);
|
843
|
2704
|
19861
|
2705 encoded_file = ENCODE_FILE (filename);
|
|
2706
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2707 if (0 > unlink (SDATA (encoded_file)))
|
72530
|
2708 report_file_error ("Removing old name", list1 (filename));
|
9170
|
2709 return Qnil;
|
230
|
2710 }
|
|
2711
|
10084
|
2712 static Lisp_Object
|
|
2713 internal_delete_file_1 (ignore)
|
|
2714 Lisp_Object ignore;
|
|
2715 {
|
|
2716 return Qt;
|
|
2717 }
|
|
2718
|
|
2719 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
|
|
2720
|
|
2721 int
|
|
2722 internal_delete_file (filename)
|
|
2723 Lisp_Object filename;
|
|
2724 {
|
67337
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2725 Lisp_Object tem;
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2726 tem = internal_condition_case_1 (Fdelete_file, filename,
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2727 Qt, internal_delete_file_1);
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2728 return NILP (tem);
|
10084
|
2729 }
|
|
2730
|
230
|
2731 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
|
60682
|
2732 "fRename file: \nGRename %s to file: \np",
|
62188
a89a98d0bb8c
(Fexpand_file_name, Frename_file, Fadd_name_to_file, Fmake_symbolic_link,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2733 doc: /* Rename FILE as NEWNAME. Both args must be strings.
|
40123
|
2734 If file has names other than FILE, it continues to have those names.
|
|
2735 Signals a `file-already-exists' error if a file NEWNAME already exists
|
|
2736 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
|
|
2737 A number as third arg means request confirmation if NEWNAME already exists.
|
|
2738 This is what happens in interactive use with M-x. */)
|
|
2739 (file, newname, ok_if_already_exists)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2740 Lisp_Object file, newname, ok_if_already_exists;
|
230
|
2741 {
|
843
|
2742 Lisp_Object handler;
|
55364
|
2743 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|
|
2744 Lisp_Object encoded_file, encoded_newname, symlink_target;
|
|
2745
|
|
2746 symlink_target = encoded_file = encoded_newname = Qnil;
|
|
2747 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
|
40656
|
2748 CHECK_STRING (file);
|
|
2749 CHECK_STRING (newname);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2750 file = Fexpand_file_name (file, Qnil);
|
60572
|
2751
|
71426
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2752 if ((!NILP (Ffile_directory_p (newname)))
|
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2753 #ifdef DOS_NT
|
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2754 /* If the file names are identical but for the case,
|
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2755 don't attempt to move directory to itself. */
|
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2756 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
|
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2757 #endif
|
2414d21c77fa
(Frename_file) [DOS_NT]: Don't try to move directory to itself on DOS_NT
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2758 )
|
60572
|
2759 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
|
|
2760 else
|
|
2761 newname = Fexpand_file_name (newname, Qnil);
|
843
|
2762
|
|
2763 /* If the file name has special constructs in it,
|
|
2764 call the corresponding file handler. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2765 handler = Ffind_file_name_handler (file, Qrename_file);
|
3705
|
2766 if (NILP (handler))
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2767 handler = Ffind_file_name_handler (newname, Qrename_file);
|
843
|
2768 if (!NILP (handler))
|
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2769 RETURN_UNGCPRO (call4 (handler, Qrename_file,
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2770 file, newname, ok_if_already_exists));
|
843
|
2771
|
19861
|
2772 encoded_file = ENCODE_FILE (file);
|
|
2773 encoded_newname = ENCODE_FILE (newname);
|
|
2774
|
30376
|
2775 #ifdef DOS_NT
|
|
2776 /* If the file names are identical but for the case, don't ask for
|
|
2777 confirmation: they simply want to change the letter-case of the
|
|
2778 file name. */
|
|
2779 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
|
|
2780 #endif
|
485
|
2781 if (NILP (ok_if_already_exists)
|
9131
|
2782 || INTEGERP (ok_if_already_exists))
|
76664
|
2783 barf_or_query_if_file_exists (newname, "rename to it",
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2784 INTEGERP (ok_if_already_exists), 0, 0);
|
230
|
2785 #ifndef BSD4_1
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2786 if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
|
230
|
2787 #else
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2788 if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2789 || 0 > unlink (SDATA (encoded_file)))
|
230
|
2790 #endif
|
|
2791 {
|
|
2792 if (errno == EXDEV)
|
|
2793 {
|
55368
3d05bc7b23b9
fileio.c (Frename_file): Put symlink handling inside #ifdef S_IFLNK.
Jan Djärv <jan.h.d@swipnet.se>
diff
changeset
|
2794 #ifdef S_IFLNK
|
55364
|
2795 symlink_target = Ffile_symlink_p (file);
|
55368
3d05bc7b23b9
fileio.c (Frename_file): Put symlink handling inside #ifdef S_IFLNK.
Jan Djärv <jan.h.d@swipnet.se>
diff
changeset
|
2796 if (! NILP (symlink_target))
|
3d05bc7b23b9
fileio.c (Frename_file): Put symlink handling inside #ifdef S_IFLNK.
Jan Djärv <jan.h.d@swipnet.se>
diff
changeset
|
2797 Fmake_symbolic_link (symlink_target, newname,
|
55488
|
2798 NILP (ok_if_already_exists) ? Qnil : Qt);
|
55368
3d05bc7b23b9
fileio.c (Frename_file): Put symlink handling inside #ifdef S_IFLNK.
Jan Djärv <jan.h.d@swipnet.se>
diff
changeset
|
2799 else
|
3d05bc7b23b9
fileio.c (Frename_file): Put symlink handling inside #ifdef S_IFLNK.
Jan Djärv <jan.h.d@swipnet.se>
diff
changeset
|
2800 #endif
|
63773
|
2801 Fcopy_file (file, newname,
|
|
2802 /* We have already prompted if it was an integer,
|
|
2803 so don't have copy-file prompt again. */
|
|
2804 NILP (ok_if_already_exists) ? Qnil : Qt,
|
70960
d876c40c06dd
* fileio.c (Fcopy_file): Delete argument MUSTBENEW. Incorporate
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2805 Qt, Qt);
|
63719
|
2806
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2807 Fdelete_file (file);
|
230
|
2808 }
|
|
2809 else
|
72530
|
2810 report_file_error ("Renaming", list2 (file, newname));
|
230
|
2811 }
|
|
2812 UNGCPRO;
|
|
2813 return Qnil;
|
|
2814 }
|
|
2815
|
|
2816 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
|
60682
|
2817 "fAdd name to file: \nGName to add to %s: \np",
|
62188
a89a98d0bb8c
(Fexpand_file_name, Frename_file, Fadd_name_to_file, Fmake_symbolic_link,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2818 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
|
40123
|
2819 Signals a `file-already-exists' error if a file NEWNAME already exists
|
|
2820 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
|
|
2821 A number as third arg means request confirmation if NEWNAME already exists.
|
|
2822 This is what happens in interactive use with M-x. */)
|
|
2823 (file, newname, ok_if_already_exists)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2824 Lisp_Object file, newname, ok_if_already_exists;
|
230
|
2825 {
|
843
|
2826 Lisp_Object handler;
|
19861
|
2827 Lisp_Object encoded_file, encoded_newname;
|
|
2828 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
2829
|
|
2830 GCPRO4 (file, newname, encoded_file, encoded_newname);
|
|
2831 encoded_file = encoded_newname = Qnil;
|
40656
|
2832 CHECK_STRING (file);
|
|
2833 CHECK_STRING (newname);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2834 file = Fexpand_file_name (file, Qnil);
|
60572
|
2835
|
|
2836 if (!NILP (Ffile_directory_p (newname)))
|
|
2837 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
|
|
2838 else
|
|
2839 newname = Fexpand_file_name (newname, Qnil);
|
843
|
2840
|
|
2841 /* If the file name has special constructs in it,
|
|
2842 call the corresponding file handler. */
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2843 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
|
843
|
2844 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2845 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
|
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2846 newname, ok_if_already_exists));
|
843
|
2847
|
12985
|
2848 /* If the new name has special constructs in it,
|
|
2849 call the corresponding file handler. */
|
|
2850 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
|
|
2851 if (!NILP (handler))
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2852 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
|
12985
|
2853 newname, ok_if_already_exists));
|
|
2854
|
19861
|
2855 encoded_file = ENCODE_FILE (file);
|
|
2856 encoded_newname = ENCODE_FILE (newname);
|
|
2857
|
485
|
2858 if (NILP (ok_if_already_exists)
|
9131
|
2859 || INTEGERP (ok_if_already_exists))
|
76664
|
2860 barf_or_query_if_file_exists (newname, "make it a new name",
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2861 INTEGERP (ok_if_already_exists), 0, 0);
|
9789
|
2862
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2863 unlink (SDATA (newname));
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2864 if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
|
72530
|
2865 report_file_error ("Adding new name", list2 (file, newname));
|
230
|
2866
|
|
2867 UNGCPRO;
|
|
2868 return Qnil;
|
|
2869 }
|
|
2870
|
|
2871 #ifdef S_IFLNK
|
|
2872 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
|
60682
|
2873 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
|
62296
|
2874 doc: /* Make a symbolic link to FILENAME, named LINKNAME.
|
|
2875 Both args must be strings.
|
40123
|
2876 Signals a `file-already-exists' error if a file LINKNAME already exists
|
|
2877 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
|
|
2878 A number as third arg means request confirmation if LINKNAME already exists.
|
|
2879 This happens for interactive use with M-x. */)
|
|
2880 (filename, linkname, ok_if_already_exists)
|
732
|
2881 Lisp_Object filename, linkname, ok_if_already_exists;
|
230
|
2882 {
|
843
|
2883 Lisp_Object handler;
|
19861
|
2884 Lisp_Object encoded_filename, encoded_linkname;
|
|
2885 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
2886
|
|
2887 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
|
|
2888 encoded_filename = encoded_linkname = Qnil;
|
40656
|
2889 CHECK_STRING (filename);
|
|
2890 CHECK_STRING (linkname);
|
5245
|
2891 /* If the link target has a ~, we must expand it to get
|
|
2892 a truly valid file name. Otherwise, do not expand;
|
|
2893 we want to permit links to relative file names. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2894 if (SREF (filename, 0) == '~')
|
5245
|
2895 filename = Fexpand_file_name (filename, Qnil);
|
60572
|
2896
|
|
2897 if (!NILP (Ffile_directory_p (linkname)))
|
60574
|
2898 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
|
60572
|
2899 else
|
|
2900 linkname = Fexpand_file_name (linkname, Qnil);
|
843
|
2901
|
|
2902 /* If the file name has special constructs in it,
|
|
2903 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2904 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
|
843
|
2905 if (!NILP (handler))
|
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2906 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
|
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2907 linkname, ok_if_already_exists));
|
843
|
2908
|
12985
|
2909 /* If the new link name has special constructs in it,
|
|
2910 call the corresponding file handler. */
|
|
2911 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
|
|
2912 if (!NILP (handler))
|
|
2913 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
|
|
2914 linkname, ok_if_already_exists));
|
|
2915
|
19861
|
2916 encoded_filename = ENCODE_FILE (filename);
|
|
2917 encoded_linkname = ENCODE_FILE (linkname);
|
|
2918
|
485
|
2919 if (NILP (ok_if_already_exists)
|
9131
|
2920 || INTEGERP (ok_if_already_exists))
|
76664
|
2921 barf_or_query_if_file_exists (linkname, "make it a link",
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2922 INTEGERP (ok_if_already_exists), 0, 0);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2923 if (0 > symlink (SDATA (encoded_filename),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2924 SDATA (encoded_linkname)))
|
230
|
2925 {
|
|
2926 /* If we didn't complain already, silently delete existing file. */
|
|
2927 if (errno == EEXIST)
|
|
2928 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2929 unlink (SDATA (encoded_linkname));
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2930 if (0 <= symlink (SDATA (encoded_filename),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2931 SDATA (encoded_linkname)))
|
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2932 {
|
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2933 UNGCPRO;
|
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2934 return Qnil;
|
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2935 }
|
230
|
2936 }
|
|
2937
|
72530
|
2938 report_file_error ("Making symbolic link", list2 (filename, linkname));
|
230
|
2939 }
|
|
2940 UNGCPRO;
|
|
2941 return Qnil;
|
|
2942 }
|
|
2943 #endif /* S_IFLNK */
|
|
2944
|
|
2945 #ifdef VMS
|
|
2946
|
|
2947 DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name,
|
|
2948 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
|
40123
|
2949 doc: /* Define the job-wide logical name NAME to have the value STRING.
|
|
2950 If STRING is nil or a null string, the logical name NAME is deleted. */)
|
|
2951 (name, string)
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
2952 Lisp_Object name;
|
230
|
2953 Lisp_Object string;
|
|
2954 {
|
40656
|
2955 CHECK_STRING (name);
|
485
|
2956 if (NILP (string))
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2957 delete_logical_name (SDATA (name));
|
230
|
2958 else
|
|
2959 {
|
40656
|
2960 CHECK_STRING (string);
|
230
|
2961
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2962 if (SCHARS (string) == 0)
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2963 delete_logical_name (SDATA (name));
|
230
|
2964 else
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2965 define_logical_name (SDATA (name), SDATA (string));
|
230
|
2966 }
|
|
2967
|
|
2968 return string;
|
|
2969 }
|
|
2970 #endif /* VMS */
|
|
2971
|
|
2972 #ifdef HPUX_NET
|
|
2973
|
|
2974 DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0,
|
40123
|
2975 doc: /* Open a network connection to PATH using LOGIN as the login string. */)
|
230
|
2976 (path, login)
|
|
2977 Lisp_Object path, login;
|
|
2978 {
|
|
2979 int netresult;
|
15097
|
2980
|
40656
|
2981 CHECK_STRING (path);
|
|
2982 CHECK_STRING (login);
|
15097
|
2983
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
2984 netresult = netunam (SDATA (path), SDATA (login));
|
230
|
2985
|
|
2986 if (netresult == -1)
|
|
2987 return Qnil;
|
|
2988 else
|
|
2989 return Qt;
|
|
2990 }
|
|
2991 #endif /* HPUX_NET */
|
|
2992
|
|
2993 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
|
|
2994 1, 1, 0,
|
40123
|
2995 doc: /* Return t if file FILENAME specifies an absolute file name.
|
|
2996 On Unix, this is a name starting with a `/' or a `~'. */)
|
230
|
2997 (filename)
|
|
2998 Lisp_Object filename;
|
|
2999 {
|
40656
|
3000 CHECK_STRING (filename);
|
61060
|
3001 return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil;
|
230
|
3002 }
|
9078
|
3003
|
|
3004 /* Return nonzero if file FILENAME exists and can be executed. */
|
|
3005
|
|
3006 static int
|
|
3007 check_executable (filename)
|
|
3008 char *filename;
|
|
3009 {
|
12642
|
3010 #ifdef DOS_NT
|
|
3011 int len = strlen (filename);
|
|
3012 char *suffix;
|
|
3013 struct stat st;
|
|
3014 if (stat (filename, &st) < 0)
|
|
3015 return 0;
|
15625
|
3016 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
|
15097
|
3017 return ((st.st_mode & S_IEXEC) != 0);
|
|
3018 #else
|
12642
|
3019 return (S_ISREG (st.st_mode)
|
|
3020 && len >= 5
|
|
3021 && (stricmp ((suffix = filename + len-4), ".com") == 0
|
|
3022 || stricmp (suffix, ".exe") == 0
|
13541
|
3023 || stricmp (suffix, ".bat") == 0)
|
|
3024 || (st.st_mode & S_IFMT) == S_IFDIR);
|
15097
|
3025 #endif /* not WINDOWSNT */
|
12642
|
3026 #else /* not DOS_NT */
|
15533
|
3027 #ifdef HAVE_EUIDACCESS
|
|
3028 return (euidaccess (filename, 1) >= 0);
|
9078
|
3029 #else
|
|
3030 /* Access isn't quite right because it uses the real uid
|
|
3031 and we really want to test with the effective uid.
|
|
3032 But Unix doesn't give us a right way to do it. */
|
|
3033 return (access (filename, 1) >= 0);
|
|
3034 #endif
|
12642
|
3035 #endif /* not DOS_NT */
|
9078
|
3036 }
|
|
3037
|
|
3038 /* Return nonzero if file FILENAME exists and can be written. */
|
|
3039
|
|
3040 static int
|
|
3041 check_writable (filename)
|
|
3042 char *filename;
|
|
3043 {
|
12642
|
3044 #ifdef MSDOS
|
|
3045 struct stat st;
|
|
3046 if (stat (filename, &st) < 0)
|
|
3047 return 0;
|
|
3048 return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR);
|
|
3049 #else /* not MSDOS */
|
15738
|
3050 #ifdef HAVE_EUIDACCESS
|
|
3051 return (euidaccess (filename, 2) >= 0);
|
9078
|
3052 #else
|
|
3053 /* Access isn't quite right because it uses the real uid
|
|
3054 and we really want to test with the effective uid.
|
|
3055 But Unix doesn't give us a right way to do it.
|
|
3056 Opening with O_WRONLY could work for an ordinary file,
|
|
3057 but would lose for directories. */
|
|
3058 return (access (filename, 2) >= 0);
|
|
3059 #endif
|
12642
|
3060 #endif /* not MSDOS */
|
9078
|
3061 }
|
230
|
3062
|
|
3063 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
|
62296
|
3064 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
|
|
3065 See also `file-readable-p' and `file-attributes'.
|
|
3066 This returns nil for a symlink to a nonexistent file.
|
|
3067 Use `file-symlink-p' to test for such links. */)
|
40123
|
3068 (filename)
|
230
|
3069 Lisp_Object filename;
|
|
3070 {
|
15097
|
3071 Lisp_Object absname;
|
843
|
3072 Lisp_Object handler;
|
8597
|
3073 struct stat statbuf;
|
230
|
3074
|
40656
|
3075 CHECK_STRING (filename);
|
15097
|
3076 absname = Fexpand_file_name (filename, Qnil);
|
843
|
3077
|
|
3078 /* If the file name has special constructs in it,
|
|
3079 call the corresponding file handler. */
|
15097
|
3080 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
|
843
|
3081 if (!NILP (handler))
|
15097
|
3082 return call2 (handler, Qfile_exists_p, absname);
|
|
3083
|
19861
|
3084 absname = ENCODE_FILE (absname);
|
|
3085
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3086 return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
|
230
|
3087 }
|
|
3088
|
|
3089 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
|
40123
|
3090 doc: /* Return t if FILENAME can be executed by you.
|
|
3091 For a directory, this means you can access files in that directory. */)
|
|
3092 (filename)
|
|
3093 Lisp_Object filename;
|
230
|
3094 {
|
15097
|
3095 Lisp_Object absname;
|
843
|
3096 Lisp_Object handler;
|
230
|
3097
|
40656
|
3098 CHECK_STRING (filename);
|
15097
|
3099 absname = Fexpand_file_name (filename, Qnil);
|
843
|
3100
|
|
3101 /* If the file name has special constructs in it,
|
|
3102 call the corresponding file handler. */
|
15097
|
3103 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
|
843
|
3104 if (!NILP (handler))
|
15097
|
3105 return call2 (handler, Qfile_executable_p, absname);
|
|
3106
|
19861
|
3107 absname = ENCODE_FILE (absname);
|
|
3108
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3109 return (check_executable (SDATA (absname)) ? Qt : Qnil);
|
230
|
3110 }
|
|
3111
|
|
3112 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
|
40123
|
3113 doc: /* Return t if file FILENAME exists and you can read it.
|
|
3114 See also `file-exists-p' and `file-attributes'. */)
|
|
3115 (filename)
|
230
|
3116 Lisp_Object filename;
|
|
3117 {
|
15097
|
3118 Lisp_Object absname;
|
843
|
3119 Lisp_Object handler;
|
8597
|
3120 int desc;
|
16534
|
3121 int flags;
|
|
3122 struct stat statbuf;
|
230
|
3123
|
40656
|
3124 CHECK_STRING (filename);
|
15097
|
3125 absname = Fexpand_file_name (filename, Qnil);
|
843
|
3126
|
|
3127 /* If the file name has special constructs in it,
|
|
3128 call the corresponding file handler. */
|
15097
|
3129 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
|
843
|
3130 if (!NILP (handler))
|
15097
|
3131 return call2 (handler, Qfile_readable_p, absname);
|
|
3132
|
19861
|
3133 absname = ENCODE_FILE (absname);
|
|
3134
|
38929
|
3135 #if defined(DOS_NT) || defined(macintosh)
|
|
3136 /* Under MS-DOS, Windows, and Macintosh, open does not work for
|
|
3137 directories. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3138 if (access (SDATA (absname), 0) == 0)
|
13902
|
3139 return Qt;
|
|
3140 return Qnil;
|
38929
|
3141 #else /* not DOS_NT and not macintosh */
|
16534
|
3142 flags = O_RDONLY;
|
|
3143 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
|
|
3144 /* Opening a fifo without O_NONBLOCK can wait.
|
|
3145 We don't want to wait. But we don't want to mess wth O_NONBLOCK
|
|
3146 except in the case of a fifo, on a system which handles it. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3147 desc = stat (SDATA (absname), &statbuf);
|
16534
|
3148 if (desc < 0)
|
|
3149 return Qnil;
|
|
3150 if (S_ISFIFO (statbuf.st_mode))
|
|
3151 flags |= O_NONBLOCK;
|
|
3152 #endif
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3153 desc = emacs_open (SDATA (absname), flags, 0);
|
8597
|
3154 if (desc < 0)
|
|
3155 return Qnil;
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3156 emacs_close (desc);
|
8597
|
3157 return Qt;
|
38929
|
3158 #endif /* not DOS_NT and not macintosh */
|
230
|
3159 }
|
|
3160
|
9346
|
3161 /* Having this before file-symlink-p mysteriously caused it to be forgotten
|
|
3162 on the RT/PC. */
|
|
3163 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
|
40123
|
3164 doc: /* Return t if file FILENAME can be written or created by you. */)
|
|
3165 (filename)
|
9346
|
3166 Lisp_Object filename;
|
|
3167 {
|
19861
|
3168 Lisp_Object absname, dir, encoded;
|
9346
|
3169 Lisp_Object handler;
|
|
3170 struct stat statbuf;
|
|
3171
|
40656
|
3172 CHECK_STRING (filename);
|
15097
|
3173 absname = Fexpand_file_name (filename, Qnil);
|
9346
|
3174
|
|
3175 /* If the file name has special constructs in it,
|
|
3176 call the corresponding file handler. */
|
15097
|
3177 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
|
9346
|
3178 if (!NILP (handler))
|
15097
|
3179 return call2 (handler, Qfile_writable_p, absname);
|
|
3180
|
19861
|
3181 encoded = ENCODE_FILE (absname);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3182 if (stat (SDATA (encoded), &statbuf) >= 0)
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3183 return (check_writable (SDATA (encoded))
|
9346
|
3184 ? Qt : Qnil);
|
19861
|
3185
|
15097
|
3186 dir = Ffile_name_directory (absname);
|
9346
|
3187 #ifdef VMS
|
|
3188 if (!NILP (dir))
|
|
3189 dir = Fdirectory_file_name (dir);
|
|
3190 #endif /* VMS */
|
|
3191 #ifdef MSDOS
|
|
3192 if (!NILP (dir))
|
|
3193 dir = Fdirectory_file_name (dir);
|
|
3194 #endif /* MSDOS */
|
19861
|
3195
|
|
3196 dir = ENCODE_FILE (dir);
|
28673
|
3197 #ifdef WINDOWSNT
|
|
3198 /* The read-only attribute of the parent directory doesn't affect
|
|
3199 whether a file or directory can be created within it. Some day we
|
|
3200 should check ACLs though, which do affect this. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3201 if (stat (SDATA (dir), &statbuf) < 0)
|
28673
|
3202 return Qnil;
|
|
3203 return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
|
|
3204 #else
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3205 return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
|
9346
|
3206 ? Qt : Qnil);
|
28673
|
3207 #endif
|
9346
|
3208 }
|
|
3209
|
16155
|
3210 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
|
40123
|
3211 doc: /* Access file FILENAME, and get an error if that does not work.
|
|
3212 The second argument STRING is used in the error message.
|
62188
a89a98d0bb8c
(Fexpand_file_name, Frename_file, Fadd_name_to_file, Fmake_symbolic_link,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3213 If there is no error, returns nil. */)
|
40123
|
3214 (filename, string)
|
16155
|
3215 Lisp_Object filename, string;
|
|
3216 {
|
40354
|
3217 Lisp_Object handler, encoded_filename, absname;
|
16155
|
3218 int fd;
|
|
3219
|
40656
|
3220 CHECK_STRING (filename);
|
40354
|
3221 absname = Fexpand_file_name (filename, Qnil);
|
|
3222
|
40656
|
3223 CHECK_STRING (string);
|
16155
|
3224
|
|
3225 /* If the file name has special constructs in it,
|
|
3226 call the corresponding file handler. */
|
40354
|
3227 handler = Ffind_file_name_handler (absname, Qaccess_file);
|
16155
|
3228 if (!NILP (handler))
|
40354
|
3229 return call3 (handler, Qaccess_file, absname, string);
|
|
3230
|
|
3231 encoded_filename = ENCODE_FILE (absname);
|
19861
|
3232
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3233 fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
|
16155
|
3234 if (fd < 0)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3235 report_file_error (SDATA (string), Fcons (filename, Qnil));
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3236 emacs_close (fd);
|
16155
|
3237
|
|
3238 return Qnil;
|
|
3239 }
|
|
3240
|
230
|
3241 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
|
40123
|
3242 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
|
50500
|
3243 The value is the link target, as a string.
|
62296
|
3244 Otherwise it returns nil.
|
|
3245
|
|
3246 This function returns t when given the name of a symlink that
|
|
3247 points to a nonexistent file. */)
|
40123
|
3248 (filename)
|
230
|
3249 Lisp_Object filename;
|
|
3250 {
|
843
|
3251 Lisp_Object handler;
|
230
|
3252
|
40656
|
3253 CHECK_STRING (filename);
|
230
|
3254 filename = Fexpand_file_name (filename, Qnil);
|
|
3255
|
843
|
3256 /* If the file name has special constructs in it,
|
|
3257 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3258 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
|
843
|
3259 if (!NILP (handler))
|
|
3260 return call2 (handler, Qfile_symlink_p, filename);
|
|
3261
|
50886
|
3262 #ifdef S_IFLNK
|
|
3263 {
|
|
3264 char *buf;
|
|
3265 int bufsize;
|
|
3266 int valsize;
|
|
3267 Lisp_Object val;
|
|
3268
|
19861
|
3269 filename = ENCODE_FILE (filename);
|
|
3270
|
39281
|
3271 bufsize = 50;
|
|
3272 buf = NULL;
|
|
3273 do
|
230
|
3274 {
|
39281
|
3275 bufsize *= 2;
|
|
3276 buf = (char *) xrealloc (buf, bufsize);
|
230
|
3277 bzero (buf, bufsize);
|
49207
|
3278
|
39281
|
3279 errno = 0;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3280 valsize = readlink (SDATA (filename), buf, bufsize);
|
39291
|
3281 if (valsize == -1)
|
|
3282 {
|
39281
|
3283 #ifdef ERANGE
|
|
3284 /* HP-UX reports ERANGE if buffer is too small. */
|
39291
|
3285 if (errno == ERANGE)
|
|
3286 valsize = bufsize;
|
|
3287 else
|
39281
|
3288 #endif
|
39291
|
3289 {
|
|
3290 xfree (buf);
|
|
3291 return Qnil;
|
|
3292 }
|
39281
|
3293 }
|
230
|
3294 }
|
39281
|
3295 while (valsize >= bufsize);
|
49207
|
3296
|
230
|
3297 val = make_string (buf, valsize);
|
27870
|
3298 if (buf[0] == '/' && index (buf, ':'))
|
|
3299 val = concat2 (build_string ("/:"), val);
|
2439
|
3300 xfree (buf);
|
21048
|
3301 val = DECODE_FILE (val);
|
|
3302 return val;
|
50886
|
3303 }
|
230
|
3304 #else /* not S_IFLNK */
|
|
3305 return Qnil;
|
|
3306 #endif /* not S_IFLNK */
|
|
3307 }
|
|
3308
|
|
3309 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
|
40123
|
3310 doc: /* Return t if FILENAME names an existing directory.
|
|
3311 Symbolic links to directories count as directories.
|
|
3312 See `file-symlink-p' to distinguish symlinks. */)
|
|
3313 (filename)
|
230
|
3314 Lisp_Object filename;
|
|
3315 {
|
15097
|
3316 register Lisp_Object absname;
|
230
|
3317 struct stat st;
|
843
|
3318 Lisp_Object handler;
|
230
|
3319
|
15097
|
3320 absname = expand_and_dir_to_file (filename, current_buffer->directory);
|
230
|
3321
|
843
|
3322 /* If the file name has special constructs in it,
|
|
3323 call the corresponding file handler. */
|
15097
|
3324 handler = Ffind_file_name_handler (absname, Qfile_directory_p);
|
843
|
3325 if (!NILP (handler))
|
15097
|
3326 return call2 (handler, Qfile_directory_p, absname);
|
|
3327
|
19861
|
3328 absname = ENCODE_FILE (absname);
|
|
3329
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3330 if (stat (SDATA (absname), &st) < 0)
|
230
|
3331 return Qnil;
|
|
3332 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
|
|
3333 }
|
|
3334
|
536
|
3335 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
|
41032
|
3336 doc: /* Return t if file FILENAME names a directory you can open.
|
|
3337 For the value to be t, FILENAME must specify the name of a directory as a file,
|
|
3338 and the directory must allow you to open files in it. In order to use a
|
40123
|
3339 directory as a buffer's current directory, this predicate must return true.
|
|
3340 A directory name spec may be given instead; then the value is t
|
|
3341 if the directory so specified exists and really is a readable and
|
|
3342 searchable directory. */)
|
|
3343 (filename)
|
536
|
3344 Lisp_Object filename;
|
|
3345 {
|
843
|
3346 Lisp_Object handler;
|
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3347 int tem;
|
8703
|
3348 struct gcpro gcpro1;
|
843
|
3349
|
|
3350 /* If the file name has special constructs in it,
|
|
3351 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3352 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
|
843
|
3353 if (!NILP (handler))
|
|
3354 return call2 (handler, Qfile_accessible_directory_p, filename);
|
|
3355
|
8703
|
3356 GCPRO1 (filename);
|
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3357 tem = (NILP (Ffile_directory_p (filename))
|
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3358 || NILP (Ffile_executable_p (filename)));
|
8703
|
3359 UNGCPRO;
|
8602
99f6ae4160f5
(Fmake_symbolic_link, Ffile_accessible_directory_p, Finsert_file_contents,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3360 return tem ? Qnil : Qt;
|
536
|
3361 }
|
|
3362
|
9346
|
3363 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
|
66795
|
3364 doc: /* Return t if FILENAME names a regular file.
|
|
3365 This is the sort of file that holds an ordinary stream of data bytes.
|
|
3366 Symbolic links to regular files count as regular files.
|
|
3367 See `file-symlink-p' to distinguish symlinks. */)
|
40123
|
3368 (filename)
|
9346
|
3369 Lisp_Object filename;
|
|
3370 {
|
15097
|
3371 register Lisp_Object absname;
|
9346
|
3372 struct stat st;
|
|
3373 Lisp_Object handler;
|
|
3374
|
15097
|
3375 absname = expand_and_dir_to_file (filename, current_buffer->directory);
|
9346
|
3376
|
|
3377 /* If the file name has special constructs in it,
|
|
3378 call the corresponding file handler. */
|
15097
|
3379 handler = Ffind_file_name_handler (absname, Qfile_regular_p);
|
9346
|
3380 if (!NILP (handler))
|
15097
|
3381 return call2 (handler, Qfile_regular_p, absname);
|
|
3382
|
19861
|
3383 absname = ENCODE_FILE (absname);
|
|
3384
|
22681
|
3385 #ifdef WINDOWSNT
|
|
3386 {
|
|
3387 int result;
|
|
3388 Lisp_Object tem = Vw32_get_true_file_attributes;
|
|
3389
|
|
3390 /* Tell stat to use expensive method to get accurate info. */
|
|
3391 Vw32_get_true_file_attributes = Qt;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3392 result = stat (SDATA (absname), &st);
|
22681
|
3393 Vw32_get_true_file_attributes = tem;
|
|
3394
|
|
3395 if (result < 0)
|
|
3396 return Qnil;
|
|
3397 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
|
|
3398 }
|
|
3399 #else
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3400 if (stat (SDATA (absname), &st) < 0)
|
9346
|
3401 return Qnil;
|
|
3402 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
|
22681
|
3403 #endif
|
9346
|
3404 }
|
|
3405
|
230
|
3406 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
|
57955
|
3407 doc: /* Return mode bits of file named FILENAME, as an integer.
|
|
3408 Return nil, if file does not exist or is not accessible. */)
|
40123
|
3409 (filename)
|
230
|
3410 Lisp_Object filename;
|
|
3411 {
|
15097
|
3412 Lisp_Object absname;
|
230
|
3413 struct stat st;
|
843
|
3414 Lisp_Object handler;
|
230
|
3415
|
15097
|
3416 absname = expand_and_dir_to_file (filename, current_buffer->directory);
|
230
|
3417
|
843
|
3418 /* If the file name has special constructs in it,
|
|
3419 call the corresponding file handler. */
|
15097
|
3420 handler = Ffind_file_name_handler (absname, Qfile_modes);
|
843
|
3421 if (!NILP (handler))
|
15097
|
3422 return call2 (handler, Qfile_modes, absname);
|
|
3423
|
19861
|
3424 absname = ENCODE_FILE (absname);
|
|
3425
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3426 if (stat (SDATA (absname), &st) < 0)
|
230
|
3427 return Qnil;
|
15625
|
3428 #if defined (MSDOS) && __DJGPP__ < 2
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3429 if (check_executable (SDATA (absname)))
|
12642
|
3430 st.st_mode |= S_IEXEC;
|
15625
|
3431 #endif /* MSDOS && __DJGPP__ < 2 */
|
6383
|
3432
|
230
|
3433 return make_number (st.st_mode & 07777);
|
|
3434 }
|
|
3435
|
|
3436 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
|
40123
|
3437 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
|
|
3438 Only the 12 low bits of MODE are used. */)
|
230
|
3439 (filename, mode)
|
|
3440 Lisp_Object filename, mode;
|
|
3441 {
|
19861
|
3442 Lisp_Object absname, encoded_absname;
|
843
|
3443 Lisp_Object handler;
|
230
|
3444
|
15097
|
3445 absname = Fexpand_file_name (filename, current_buffer->directory);
|
40656
|
3446 CHECK_NUMBER (mode);
|
230
|
3447
|
843
|
3448 /* If the file name has special constructs in it,
|
|
3449 call the corresponding file handler. */
|
15097
|
3450 handler = Ffind_file_name_handler (absname, Qset_file_modes);
|
843
|
3451 if (!NILP (handler))
|
15097
|
3452 return call3 (handler, Qset_file_modes, absname, mode);
|
|
3453
|
19861
|
3454 encoded_absname = ENCODE_FILE (absname);
|
|
3455
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3456 if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
|
15097
|
3457 report_file_error ("Doing chmod", Fcons (absname, Qnil));
|
230
|
3458
|
|
3459 return Qnil;
|
|
3460 }
|
|
3461
|
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3462 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
|
40123
|
3463 doc: /* Set the file permission bits for newly created files.
|
|
3464 The argument MODE should be an integer; only the low 9 bits are used.
|
|
3465 This setting is inherited by subprocesses. */)
|
|
3466 (mode)
|
1762
|
3467 Lisp_Object mode;
|
550
|
3468 {
|
40656
|
3469 CHECK_NUMBER (mode);
|
15097
|
3470
|
1762
|
3471 umask ((~ XINT (mode)) & 0777);
|
550
|
3472
|
|
3473 return Qnil;
|
|
3474 }
|
|
3475
|
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3476 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
|
40123
|
3477 doc: /* Return the default file protection for created files.
|
|
3478 The value is an integer. */)
|
|
3479 ()
|
550
|
3480 {
|
1762
|
3481 int realmask;
|
|
3482 Lisp_Object value;
|
|
3483
|
|
3484 realmask = umask (0);
|
|
3485 umask (realmask);
|
|
3486
|
9266
811ad893828b
(Fdefault_file_modes, Finsert_file_contents, Fdo_auto_save): Use new accessor
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3487 XSETINT (value, (~ realmask) & 0777);
|
1762
|
3488 return value;
|
550
|
3489 }
|
55194
|
3490
|
|
3491 extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
|
|
3492
|
|
3493 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
|
|
3494 doc: /* Set times of file FILENAME to TIME.
|
|
3495 Set both access and modification times.
|
|
3496 Return t on success, else nil.
|
|
3497 Use the current time if TIME is nil. TIME is in the format of
|
|
3498 `current-time'. */)
|
|
3499 (filename, time)
|
|
3500 Lisp_Object filename, time;
|
|
3501 {
|
|
3502 Lisp_Object absname, encoded_absname;
|
|
3503 Lisp_Object handler;
|
|
3504 time_t sec;
|
|
3505 int usec;
|
|
3506
|
|
3507 if (! lisp_time_argument (time, &sec, &usec))
|
|
3508 error ("Invalid time specification");
|
|
3509
|
|
3510 absname = Fexpand_file_name (filename, current_buffer->directory);
|
|
3511
|
|
3512 /* If the file name has special constructs in it,
|
|
3513 call the corresponding file handler. */
|
|
3514 handler = Ffind_file_name_handler (absname, Qset_file_times);
|
|
3515 if (!NILP (handler))
|
|
3516 return call3 (handler, Qset_file_times, absname, time);
|
|
3517
|
|
3518 encoded_absname = ENCODE_FILE (absname);
|
|
3519
|
|
3520 {
|
|
3521 EMACS_TIME t;
|
|
3522
|
|
3523 EMACS_SET_SECS (t, sec);
|
|
3524 EMACS_SET_USECS (t, usec);
|
|
3525
|
|
3526 if (set_file_times (SDATA (encoded_absname), t, t))
|
|
3527 {
|
|
3528 #ifdef DOS_NT
|
|
3529 struct stat st;
|
|
3530
|
|
3531 /* Setting times on a directory always fails. */
|
|
3532 if (stat (SDATA (encoded_absname), &st) == 0
|
|
3533 && (st.st_mode & S_IFMT) == S_IFDIR)
|
|
3534 return Qnil;
|
|
3535 #endif
|
|
3536 report_file_error ("Setting file times", Fcons (absname, Qnil));
|
|
3537 return Qnil;
|
|
3538 }
|
|
3539 }
|
|
3540
|
|
3541 return Qt;
|
|
3542 }
|
9346
|
3543
|
74398
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
3544 #ifdef HAVE_SYNC
|
689
|
3545 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
|
40123
|
3546 doc: /* Tell Unix to finish all pending disk updates. */)
|
|
3547 ()
|
689
|
3548 {
|
|
3549 sync ();
|
|
3550 return Qnil;
|
|
3551 }
|
|
3552
|
74398
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
3553 #endif /* HAVE_SYNC */
|
689
|
3554
|
230
|
3555 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
|
40123
|
3556 doc: /* Return t if file FILE1 is newer than file FILE2.
|
|
3557 If FILE1 does not exist, the answer is nil;
|
|
3558 otherwise, if FILE2 does not exist, the answer is t. */)
|
|
3559 (file1, file2)
|
230
|
3560 Lisp_Object file1, file2;
|
|
3561 {
|
15097
|
3562 Lisp_Object absname1, absname2;
|
230
|
3563 struct stat st;
|
|
3564 int mtime1;
|
843
|
3565 Lisp_Object handler;
|
1178
|
3566 struct gcpro gcpro1, gcpro2;
|
230
|
3567
|
40656
|
3568 CHECK_STRING (file1);
|
|
3569 CHECK_STRING (file2);
|
230
|
3570
|
15097
|
3571 absname1 = Qnil;
|
|
3572 GCPRO2 (absname1, file2);
|
|
3573 absname1 = expand_and_dir_to_file (file1, current_buffer->directory);
|
|
3574 absname2 = expand_and_dir_to_file (file2, current_buffer->directory);
|
1178
|
3575 UNGCPRO;
|
843
|
3576
|
|
3577 /* If the file name has special constructs in it,
|
|
3578 call the corresponding file handler. */
|
15097
|
3579 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
|
3705
|
3580 if (NILP (handler))
|
15097
|
3581 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
|
843
|
3582 if (!NILP (handler))
|
15097
|
3583 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
|
|
3584
|
19861
|
3585 GCPRO2 (absname1, absname2);
|
|
3586 absname1 = ENCODE_FILE (absname1);
|
|
3587 absname2 = ENCODE_FILE (absname2);
|
|
3588 UNGCPRO;
|
|
3589
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3590 if (stat (SDATA (absname1), &st) < 0)
|
230
|
3591 return Qnil;
|
|
3592
|
|
3593 mtime1 = st.st_mtime;
|
|
3594
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3595 if (stat (SDATA (absname2), &st) < 0)
|
230
|
3596 return Qt;
|
|
3597
|
|
3598 return (mtime1 > st.st_mtime) ? Qt : Qnil;
|
|
3599 }
|
|
3600
|
9789
|
3601 #ifdef DOS_NT
|
5494
|
3602 Lisp_Object Qfind_buffer_file_type;
|
9789
|
3603 #endif /* DOS_NT */
|
5494
|
3604
|
17062
|
3605 #ifndef READ_BUF_SIZE
|
|
3606 #define READ_BUF_SIZE (64 << 10)
|
|
3607 #endif
|
|
3608
|
26714
|
3609 extern void adjust_markers_for_delete P_ ((int, int, int, int));
|
|
3610
|
|
3611 /* This function is called after Lisp functions to decide a coding
|
|
3612 system are called, or when they cause an error. Before they are
|
|
3613 called, the current buffer is set unibyte and it contains only a
|
|
3614 newly inserted text (thus the buffer was empty before the
|
|
3615 insertion).
|
|
3616
|
|
3617 The functions may set markers, overlays, text properties, or even
|
|
3618 alter the buffer contents, change the current buffer.
|
|
3619
|
|
3620 Here, we reset all those changes by:
|
|
3621 o set back the current buffer.
|
|
3622 o move all markers and overlays to BEG.
|
|
3623 o remove all text properties.
|
|
3624 o set back the buffer multibyteness. */
|
22492
|
3625
|
|
3626 static Lisp_Object
|
26714
|
3627 decide_coding_unwind (unwind_data)
|
|
3628 Lisp_Object unwind_data;
|
22492
|
3629 {
|
26714
|
3630 Lisp_Object multibyte, undo_list, buffer;
|
|
3631
|
|
3632 multibyte = XCAR (unwind_data);
|
|
3633 unwind_data = XCDR (unwind_data);
|
|
3634 undo_list = XCAR (unwind_data);
|
|
3635 buffer = XCDR (unwind_data);
|
|
3636
|
|
3637 if (current_buffer != XBUFFER (buffer))
|
|
3638 set_buffer_internal (XBUFFER (buffer));
|
|
3639 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
|
|
3640 adjust_overlays_for_delete (BEG, Z - BEG);
|
|
3641 BUF_INTERVALS (current_buffer) = 0;
|
|
3642 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
|
|
3643
|
|
3644 /* Now we are safe to change the buffer's multibyteness directly. */
|
|
3645 current_buffer->enable_multibyte_characters = multibyte;
|
|
3646 current_buffer->undo_list = undo_list;
|
22492
|
3647
|
|
3648 return Qnil;
|
|
3649 }
|
|
3650
|
38364
|
3651
|
38450
|
3652 /* Used to pass values from insert-file-contents to read_non_regular. */
|
|
3653
|
|
3654 static int non_regular_fd;
|
|
3655 static int non_regular_inserted;
|
|
3656 static int non_regular_nbytes;
|
|
3657
|
|
3658
|
|
3659 /* Read from a non-regular file.
|
|
3660 Read non_regular_trytry bytes max from non_regular_fd.
|
|
3661 Non_regular_inserted specifies where to put the read bytes.
|
|
3662 Value is the number of bytes read. */
|
38364
|
3663
|
|
3664 static Lisp_Object
|
38450
|
3665 read_non_regular ()
|
38364
|
3666 {
|
38450
|
3667 int nbytes;
|
49207
|
3668
|
38450
|
3669 immediate_quit = 1;
|
|
3670 QUIT;
|
|
3671 nbytes = emacs_read (non_regular_fd,
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
3672 BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
|
38450
|
3673 non_regular_nbytes);
|
|
3674 immediate_quit = 0;
|
|
3675 return make_number (nbytes);
|
|
3676 }
|
|
3677
|
|
3678
|
|
3679 /* Condition-case handler used when reading from non-regular files
|
|
3680 in insert-file-contents. */
|
|
3681
|
|
3682 static Lisp_Object
|
|
3683 read_non_regular_quit ()
|
|
3684 {
|
38364
|
3685 return Qnil;
|
|
3686 }
|
|
3687
|
|
3688
|
230
|
3689 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
|
40123
|
3690 1, 5, 0,
|
|
3691 doc: /* Insert contents of file FILENAME after point.
|
50491
|
3692 Returns list of absolute file name and number of characters inserted.
|
40123
|
3693 If second argument VISIT is non-nil, the buffer's visited filename
|
|
3694 and last save file modtime are set, and it is marked unmodified.
|
|
3695 If visiting and the file does not exist, visiting is completed
|
|
3696 before the error is signaled.
|
|
3697 The optional third and fourth arguments BEG and END
|
|
3698 specify what portion of the file to insert.
|
|
3699 These arguments count bytes in the file, not characters in the buffer.
|
|
3700 If VISIT is non-nil, BEG and END must be nil.
|
|
3701
|
|
3702 If optional fifth argument REPLACE is non-nil,
|
|
3703 it means replace the current buffer contents (in the accessible portion)
|
|
3704 with the file contents. This is better than simply deleting and inserting
|
|
3705 the whole thing because (1) it preserves some marker positions
|
|
3706 and (2) it puts less data in the undo list.
|
|
3707 When REPLACE is non-nil, the value is the number of characters actually read,
|
|
3708 which is often less than the number of characters to be read.
|
|
3709
|
|
3710 This does code conversion according to the value of
|
|
3711 `coding-system-for-read' or `file-coding-system-alist',
|
|
3712 and sets the variable `last-coding-system-used' to the coding system
|
|
3713 actually used. */)
|
|
3714 (filename, visit, beg, end, replace)
|
5975
|
3715 Lisp_Object filename, visit, beg, end, replace;
|
230
|
3716 {
|
|
3717 struct stat st;
|
|
3718 register int fd;
|
20533
|
3719 int inserted = 0;
|
230
|
3720 register int how_much;
|
17062
|
3721 register int unprocessed;
|
46285
|
3722 int count = SPECPDL_INDEX ();
|
19861
|
3723 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
3724 Lisp_Object handler, val, insval, orig_filename;
|
4841
|
3725 Lisp_Object p;
|
31829
|
3726 int total = 0;
|
9921
|
3727 int not_regular = 0;
|
22053
|
3728 unsigned char read_buf[READ_BUF_SIZE];
|
17062
|
3729 struct coding_system coding;
|
17273
|
3730 unsigned char buffer[1 << 14];
|
17285
|
3731 int replace_handled = 0;
|
20533
|
3732 int set_coding_system = 0;
|
22492
|
3733 int coding_system_decided = 0;
|
38450
|
3734 int read_quit = 0;
|
62937
|
3735 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
|
62296
|
3736 int we_locked_file = 0;
|
843
|
3737
|
10304
|
3738 if (current_buffer->base_buffer && ! NILP (visit))
|
|
3739 error ("Cannot do file visiting in an indirect buffer");
|
|
3740
|
|
3741 if (!NILP (current_buffer->read_only))
|
|
3742 Fbarf_if_buffer_read_only ();
|
|
3743
|
843
|
3744 val = Qnil;
|
4841
|
3745 p = Qnil;
|
19861
|
3746 orig_filename = Qnil;
|
|
3747
|
|
3748 GCPRO4 (filename, val, p, orig_filename);
|
230
|
3749
|
40656
|
3750 CHECK_STRING (filename);
|
230
|
3751 filename = Fexpand_file_name (filename, Qnil);
|
|
3752
|
843
|
3753 /* If the file name has special constructs in it,
|
|
3754 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3755 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
|
843
|
3756 if (!NILP (handler))
|
|
3757 {
|
5975
|
3758 val = call6 (handler, Qinsert_file_contents, filename,
|
|
3759 visit, beg, end, replace);
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3760 if (CONSP (val) && CONSP (XCDR (val)))
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3761 inserted = XINT (XCAR (XCDR (val)));
|
843
|
3762 goto handled;
|
|
3763 }
|
|
3764
|
19861
|
3765 orig_filename = filename;
|
|
3766 filename = ENCODE_FILE (filename);
|
|
3767
|
230
|
3768 fd = -1;
|
|
3769
|
22681
|
3770 #ifdef WINDOWSNT
|
|
3771 {
|
|
3772 Lisp_Object tem = Vw32_get_true_file_attributes;
|
|
3773
|
|
3774 /* Tell stat to use expensive method to get accurate info. */
|
|
3775 Vw32_get_true_file_attributes = Qt;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3776 total = stat (SDATA (filename), &st);
|
22681
|
3777 Vw32_get_true_file_attributes = tem;
|
|
3778 }
|
|
3779 if (total < 0)
|
|
3780 #else
|
230
|
3781 #ifndef APOLLO
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3782 if (stat (SDATA (filename), &st) < 0)
|
230
|
3783 #else
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3784 if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0
|
230
|
3785 || fstat (fd, &st) < 0)
|
|
3786 #endif /* not APOLLO */
|
22681
|
3787 #endif /* WINDOWSNT */
|
230
|
3788 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3789 if (fd >= 0) emacs_close (fd);
|
8047
|
3790 badopen:
|
485
|
3791 if (NILP (visit))
|
19861
|
3792 report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
|
230
|
3793 st.st_mtime = -1;
|
|
3794 how_much = 0;
|
19925
|
3795 if (!NILP (Vcoding_system_for_read))
|
26587
|
3796 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
|
230
|
3797 goto notfound;
|
|
3798 }
|
|
3799
|
8047
|
3800 #ifdef S_IFREG
|
|
3801 /* This code will need to be changed in order to work on named
|
|
3802 pipes, and it's probably just not worth it. So we should at
|
|
3803 least signal an error. */
|
|
3804 if (!S_ISREG (st.st_mode))
|
9915
|
3805 {
|
17286
|
3806 not_regular = 1;
|
|
3807
|
|
3808 if (! NILP (visit))
|
|
3809 goto notfound;
|
|
3810
|
|
3811 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
|
71977
|
3812 xsignal2 (Qfile_error,
|
|
3813 build_string ("not a regular file"), orig_filename);
|
9915
|
3814 }
|
8047
|
3815 #endif
|
|
3816
|
|
3817 if (fd < 0)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3818 if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
|
8047
|
3819 goto badopen;
|
|
3820
|
6036
|
3821 /* Replacement should preserve point as it preserves markers. */
|
|
3822 if (!NILP (replace))
|
|
3823 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
|
|
3824
|
230
|
3825 record_unwind_protect (close_file_unwind, make_number (fd));
|
|
3826
|
|
3827 /* Supposedly happens on VMS. */
|
48562
|
3828 /* Can happen on any platform that uses long as type of off_t, but allows
|
|
3829 file sizes to exceed 2Gb. VMS is no longer officially supported, so
|
|
3830 give a message suitable for the latter case. */
|
17286
|
3831 if (! not_regular && st.st_size < 0)
|
48562
|
3832 error ("Maximum buffer size exceeded");
|
752
|
3833
|
25006
|
3834 /* Prevent redisplay optimizations. */
|
|
3835 current_buffer->clip_changed = 1;
|
|
3836
|
27134
|
3837 if (!NILP (visit))
|
|
3838 {
|
|
3839 if (!NILP (beg) || !NILP (end))
|
|
3840 error ("Attempt to visit less than an entire file");
|
|
3841 if (BEG < Z && NILP (replace))
|
|
3842 error ("Cannot do file visiting in a non-empty buffer");
|
|
3843 }
|
3787
|
3844
|
|
3845 if (!NILP (beg))
|
40656
|
3846 CHECK_NUMBER (beg);
|
3787
|
3847 else
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
3848 XSETFASTINT (beg, 0);
|
3787
|
3849
|
|
3850 if (!NILP (end))
|
40656
|
3851 CHECK_NUMBER (end);
|
3787
|
3852 else
|
|
3853 {
|
17286
|
3854 if (! not_regular)
|
|
3855 {
|
|
3856 XSETINT (end, st.st_size);
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3857
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3858 /* Arithmetic overflow can occur if an Emacs integer cannot
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3859 represent the file size, or if the calculations below
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3860 overflow. The calculations below double the file size
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3861 twice, so check that it can be multiplied by 4 safely. */
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3862 if (XINT (end) != st.st_size
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3863 || ((int) st.st_size * 4) / 4 != st.st_size)
|
17286
|
3864 error ("Maximum buffer size exceeded");
|
37390
|
3865
|
|
3866 /* The file size returned from stat may be zero, but data
|
|
3867 may be readable nonetheless, for example when this is a
|
|
3868 file in the /proc filesystem. */
|
|
3869 if (st.st_size == 0)
|
|
3870 XSETINT (end, READ_BUF_SIZE);
|
17286
|
3871 }
|
3787
|
3872 }
|
|
3873
|
51357
|
3874 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
|
|
3875 {
|
|
3876 /* We use emacs-mule for auto saving... */
|
|
3877 setup_coding_system (Qemacs_mule, &coding);
|
|
3878 /* ... but with the special flag to indicate to read in a
|
|
3879 multibyte sequence for eight-bit-control char as is. */
|
|
3880 coding.flags = 1;
|
|
3881 coding.src_multibyte = 0;
|
|
3882 coding.dst_multibyte
|
|
3883 = !NILP (current_buffer->enable_multibyte_characters);
|
|
3884 coding.eol_type = CODING_EOL_LF;
|
|
3885 coding_system_decided = 1;
|
|
3886 }
|
|
3887 else if (BEG < Z)
|
22492
|
3888 {
|
|
3889 /* Decide the coding system to use for reading the file now
|
|
3890 because we can't use an optimized method for handling
|
|
3891 `coding:' tag if the current buffer is not empty. */
|
|
3892 Lisp_Object val;
|
|
3893 val = Qnil;
|
|
3894
|
|
3895 if (!NILP (Vcoding_system_for_read))
|
|
3896 val = Vcoding_system_for_read;
|
|
3897 else
|
|
3898 {
|
|
3899 /* Don't try looking inside a file for a coding system
|
|
3900 specification if it is not seekable. */
|
|
3901 if (! not_regular && ! NILP (Vset_auto_coding_function))
|
|
3902 {
|
|
3903 /* Find a coding system specified in the heading two
|
|
3904 lines or in the tailing several lines of the file.
|
|
3905 We assume that the 1K-byte and 3K-byte for heading
|
24651
|
3906 and tailing respectively are sufficient for this
|
22492
|
3907 purpose. */
|
27613
|
3908 int nread;
|
22492
|
3909
|
|
3910 if (st.st_size <= (1024 * 4))
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3911 nread = emacs_read (fd, read_buf, 1024 * 4);
|
22492
|
3912 else
|
|
3913 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3914 nread = emacs_read (fd, read_buf, 1024);
|
22492
|
3915 if (nread >= 0)
|
|
3916 {
|
|
3917 if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
|
|
3918 report_file_error ("Setting file position",
|
|
3919 Fcons (orig_filename, Qnil));
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
3920 nread += emacs_read (fd, read_buf + nread, 1024 * 3);
|
22492
|
3921 }
|
|
3922 }
|
|
3923
|
|
3924 if (nread < 0)
|
|
3925 error ("IO error reading %s: %s",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3926 SDATA (orig_filename), emacs_strerror (errno));
|
22492
|
3927 else if (nread > 0)
|
|
3928 {
|
|
3929 struct buffer *prev = current_buffer;
|
44563
|
3930 Lisp_Object buffer;
|
|
3931 struct buffer *buf;
|
22492
|
3932
|
|
3933 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
|
27789
|
3934
|
44563
|
3935 buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
|
|
3936 buf = XBUFFER (buffer);
|
|
3937
|
52018
|
3938 delete_all_overlays (buf);
|
44563
|
3939 buf->directory = current_buffer->directory;
|
|
3940 buf->read_only = Qnil;
|
|
3941 buf->filename = Qnil;
|
|
3942 buf->undo_list = Qt;
|
52018
|
3943 eassert (buf->overlays_before == NULL);
|
|
3944 eassert (buf->overlays_after == NULL);
|
49207
|
3945
|
44563
|
3946 set_buffer_internal (buf);
|
|
3947 Ferase_buffer ();
|
|
3948 buf->enable_multibyte_characters = Qnil;
|
|
3949
|
22492
|
3950 insert_1_both (read_buf, nread, nread, 0, 0, 0);
|
|
3951 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
|
22811
|
3952 val = call2 (Vset_auto_coding_function,
|
|
3953 filename, make_number (nread));
|
22492
|
3954 set_buffer_internal (prev);
|
49207
|
3955
|
22492
|
3956 /* Discard the unwind protect for recovering the
|
|
3957 current buffer. */
|
|
3958 specpdl_ptr--;
|
|
3959
|
|
3960 /* Rewind the file for the actual read done later. */
|
|
3961 if (lseek (fd, 0, 0) < 0)
|
|
3962 report_file_error ("Setting file position",
|
|
3963 Fcons (orig_filename, Qnil));
|
|
3964 }
|
|
3965 }
|
|
3966
|
|
3967 if (NILP (val))
|
|
3968 {
|
|
3969 /* If we have not yet decided a coding system, check
|
|
3970 file-coding-system-alist. */
|
|
3971 Lisp_Object args[6], coding_systems;
|
|
3972
|
|
3973 args[0] = Qinsert_file_contents, args[1] = orig_filename;
|
|
3974 args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
|
|
3975 coding_systems = Ffind_operation_coding_system (6, args);
|
|
3976 if (CONSP (coding_systems))
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
3977 val = XCAR (coding_systems);
|
22492
|
3978 }
|
|
3979 }
|
|
3980
|
20713
|
3981 setup_coding_system (Fcheck_coding_system (val), &coding);
|
29152
|
3982 /* Ensure we set Vlast_coding_system_used. */
|
|
3983 set_coding_system = 1;
|
22362
|
3984
|
24932
|
3985 if (NILP (current_buffer->enable_multibyte_characters)
|
|
3986 && ! NILP (val))
|
|
3987 /* We must suppress all character code conversion except for
|
|
3988 end-of-line conversion. */
|
22613
|
3989 setup_raw_text_coding_system (&coding);
|
22492
|
3990
|
29009
|
3991 coding.src_multibyte = 0;
|
|
3992 coding.dst_multibyte
|
|
3993 = !NILP (current_buffer->enable_multibyte_characters);
|
22492
|
3994 coding_system_decided = 1;
|
|
3995 }
|
|
3996
|
5975
|
3997 /* If requested, replace the accessible part of the buffer
|
|
3998 with the file contents. Avoid replacing text at the
|
|
3999 beginning or end of the buffer that matches the file contents;
|
17273
|
4000 that preserves markers pointing to the unchanged parts.
|
|
4001
|
|
4002 Here we implement this feature in an optimized way
|
|
4003 for the case where code conversion is NOT needed.
|
|
4004 The following if-statement handles the case of conversion
|
17285
|
4005 in a less optimal way.
|
|
4006
|
|
4007 If the code conversion is "automatic" then we try using this
|
|
4008 method and hope for the best.
|
|
4009 But if we discover the need for conversion, we give up on this method
|
|
4010 and let the following if-statement handle the replace job. */
|
17273
|
4011 if (!NILP (replace)
|
22492
|
4012 && BEGV < ZV
|
29009
|
4013 && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK))
|
7445
|
4014 {
|
20533
|
4015 /* same_at_start and same_at_end count bytes,
|
|
4016 because file access counts bytes
|
|
4017 and BEG and END count bytes. */
|
|
4018 int same_at_start = BEGV_BYTE;
|
|
4019 int same_at_end = ZV_BYTE;
|
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4020 int overlap;
|
17062
|
4021 /* There is still a possibility we will find the need to do code
|
|
4022 conversion. If that happens, we set this variable to 1 to
|
17285
|
4023 give up on handling REPLACE in the optimized way. */
|
17062
|
4024 int giveup_match_end = 0;
|
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4025
|
16695
|
4026 if (XINT (beg) != 0)
|
|
4027 {
|
|
4028 if (lseek (fd, XINT (beg), 0) < 0)
|
|
4029 report_file_error ("Setting file position",
|
19861
|
4030 Fcons (orig_filename, Qnil));
|
16695
|
4031 }
|
|
4032
|
5975
|
4033 immediate_quit = 1;
|
|
4034 QUIT;
|
|
4035 /* Count how many chars at the start of the file
|
|
4036 match the text at the beginning of the buffer. */
|
|
4037 while (1)
|
|
4038 {
|
|
4039 int nread, bufpos;
|
|
4040
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4041 nread = emacs_read (fd, buffer, sizeof buffer);
|
5975
|
4042 if (nread < 0)
|
|
4043 error ("IO error reading %s: %s",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4044 SDATA (orig_filename), emacs_strerror (errno));
|
5975
|
4045 else if (nread == 0)
|
|
4046 break;
|
17062
|
4047
|
17835
|
4048 if (coding.type == coding_type_undecided)
|
17285
|
4049 detect_coding (&coding, buffer, nread);
|
29009
|
4050 if (coding.common_flags & CODING_REQUIRE_DECODING_MASK)
|
17285
|
4051 /* We found that the file should be decoded somehow.
|
|
4052 Let's give up here. */
|
|
4053 {
|
|
4054 giveup_match_end = 1;
|
|
4055 break;
|
|
4056 }
|
|
4057
|
17835
|
4058 if (coding.eol_type == CODING_EOL_UNDECIDED)
|
17285
|
4059 detect_eol (&coding, buffer, nread);
|
18270
|
4060 if (coding.eol_type != CODING_EOL_UNDECIDED
|
18973
|
4061 && coding.eol_type != CODING_EOL_LF)
|
17285
|
4062 /* We found that the format of eol should be decoded.
|
|
4063 Let's give up here. */
|
|
4064 {
|
|
4065 giveup_match_end = 1;
|
|
4066 break;
|
|
4067 }
|
|
4068
|
5975
|
4069 bufpos = 0;
|
20533
|
4070 while (bufpos < nread && same_at_start < ZV_BYTE
|
17062
|
4071 && FETCH_BYTE (same_at_start) == buffer[bufpos])
|
5975
|
4072 same_at_start++, bufpos++;
|
|
4073 /* If we found a discrepancy, stop the scan.
|
14036
|
4074 Otherwise loop around and scan the next bufferful. */
|
5975
|
4075 if (bufpos != nread)
|
|
4076 break;
|
|
4077 }
|
|
4078 immediate_quit = 0;
|
|
4079 /* If the file matches the buffer completely,
|
|
4080 there's no need to replace anything. */
|
20533
|
4081 if (same_at_start - BEGV_BYTE == XINT (end))
|
5975
|
4082 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4083 emacs_close (fd);
|
6036
|
4084 specpdl_ptr--;
|
7595
|
4085 /* Truncate the buffer to the size of the file. */
|
26742
936b39bd05b4
* editfns.c (Fdelete_and_extract_region): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4086 del_range_1 (same_at_start, same_at_end, 0, 0);
|
5975
|
4087 goto handled;
|
|
4088 }
|
|
4089 immediate_quit = 1;
|
|
4090 QUIT;
|
|
4091 /* Count how many chars at the end of the file
|
17062
|
4092 match the text at the end of the buffer. But, if we have
|
|
4093 already found that decoding is necessary, don't waste time. */
|
|
4094 while (!giveup_match_end)
|
5975
|
4095 {
|
|
4096 int total_read, nread, bufpos, curpos, trial;
|
|
4097
|
|
4098 /* At what file position are we now scanning? */
|
20533
|
4099 curpos = XINT (end) - (ZV_BYTE - same_at_end);
|
7695
|
4100 /* If the entire file matches the buffer tail, stop the scan. */
|
|
4101 if (curpos == 0)
|
|
4102 break;
|
5975
|
4103 /* How much can we scan in the next step? */
|
|
4104 trial = min (curpos, sizeof buffer);
|
|
4105 if (lseek (fd, curpos - trial, 0) < 0)
|
|
4106 report_file_error ("Setting file position",
|
19861
|
4107 Fcons (orig_filename, Qnil));
|
5975
|
4108
|
39457
|
4109 total_read = nread = 0;
|
5975
|
4110 while (total_read < trial)
|
|
4111 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4112 nread = emacs_read (fd, buffer + total_read, trial - total_read);
|
38619
|
4113 if (nread < 0)
|
5975
|
4114 error ("IO error reading %s: %s",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4115 SDATA (orig_filename), emacs_strerror (errno));
|
38619
|
4116 else if (nread == 0)
|
|
4117 break;
|
5975
|
4118 total_read += nread;
|
|
4119 }
|
49207
|
4120
|
14036
|
4121 /* Scan this bufferful from the end, comparing with
|
5975
|
4122 the Emacs buffer. */
|
|
4123 bufpos = total_read;
|
49207
|
4124
|
5975
|
4125 /* Compare with same_at_start to avoid counting some buffer text
|
|
4126 as matching both at the file's beginning and at the end. */
|
|
4127 while (bufpos > 0 && same_at_end > same_at_start
|
17062
|
4128 && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1])
|
5975
|
4129 same_at_end--, bufpos--;
|
17285
|
4130
|
5975
|
4131 /* If we found a discrepancy, stop the scan.
|
14036
|
4132 Otherwise loop around and scan the preceding bufferful. */
|
5975
|
4133 if (bufpos != 0)
|
17285
|
4134 {
|
|
4135 /* If this discrepancy is because of code conversion,
|
|
4136 we cannot use this method; giveup and try the other. */
|
|
4137 if (same_at_end > same_at_start
|
|
4138 && FETCH_BYTE (same_at_end - 1) >= 0200
|
18679
|
4139 && ! NILP (current_buffer->enable_multibyte_characters)
|
20713
|
4140 && (CODING_MAY_REQUIRE_DECODING (&coding)))
|
17285
|
4141 giveup_match_end = 1;
|
|
4142 break;
|
|
4143 }
|
39457
|
4144
|
|
4145 if (nread == 0)
|
|
4146 break;
|
5975
|
4147 }
|
|
4148 immediate_quit = 0;
|
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4149
|
17285
|
4150 if (! giveup_match_end)
|
|
4151 {
|
20533
|
4152 int temp;
|
|
4153
|
17285
|
4154 /* We win! We can handle REPLACE the optimized way. */
|
|
4155
|
22753
|
4156 /* Extend the start of non-matching text area to multibyte
|
|
4157 character boundary. */
|
|
4158 if (! NILP (current_buffer->enable_multibyte_characters))
|
|
4159 while (same_at_start > BEGV_BYTE
|
|
4160 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
|
|
4161 same_at_start--;
|
|
4162
|
|
4163 /* Extend the end of non-matching text area to multibyte
|
18679
|
4164 character boundary. */
|
|
4165 if (! NILP (current_buffer->enable_multibyte_characters))
|
20533
|
4166 while (same_at_end < ZV_BYTE
|
|
4167 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
|
18679
|
4168 same_at_end++;
|
|
4169
|
17285
|
4170 /* Don't try to reuse the same piece of text twice. */
|
20533
|
4171 overlap = (same_at_start - BEGV_BYTE
|
|
4172 - (same_at_end + st.st_size - ZV));
|
17285
|
4173 if (overlap > 0)
|
|
4174 same_at_end += overlap;
|
|
4175
|
|
4176 /* Arrange to read only the nonmatching middle part of the file. */
|
20533
|
4177 XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE));
|
|
4178 XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end));
|
|
4179
|
|
4180 del_range_byte (same_at_start, same_at_end, 0);
|
17285
|
4181 /* Insert from the file at the proper position. */
|
20533
|
4182 temp = BYTE_TO_CHAR (same_at_start);
|
|
4183 SET_PT_BOTH (temp, same_at_start);
|
17285
|
4184
|
|
4185 /* If display currently starts at beginning of line,
|
|
4186 keep it that way. */
|
|
4187 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
|
|
4188 XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
|
|
4189
|
|
4190 replace_handled = 1;
|
|
4191 }
|
17273
|
4192 }
|
|
4193
|
|
4194 /* If requested, replace the accessible part of the buffer
|
|
4195 with the file contents. Avoid replacing text at the
|
|
4196 beginning or end of the buffer that matches the file contents;
|
|
4197 that preserves markers pointing to the unchanged parts.
|
|
4198
|
|
4199 Here we implement this feature for the case where code conversion
|
|
4200 is needed, in a simple way that needs a lot of memory.
|
|
4201 The preceding if-statement handles the case of no conversion
|
|
4202 in a more optimized way. */
|
22492
|
4203 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
|
17273
|
4204 {
|
20533
|
4205 int same_at_start = BEGV_BYTE;
|
|
4206 int same_at_end = ZV_BYTE;
|
17273
|
4207 int overlap;
|
|
4208 int bufpos;
|
|
4209 /* Make sure that the gap is large enough. */
|
|
4210 int bufsize = 2 * st.st_size;
|
17820
|
4211 unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize);
|
20533
|
4212 int temp;
|
17273
|
4213
|
|
4214 /* First read the whole file, performing code conversion into
|
|
4215 CONVERSION_BUFFER. */
|
|
4216
|
17285
|
4217 if (lseek (fd, XINT (beg), 0) < 0)
|
|
4218 {
|
24451
|
4219 xfree (conversion_buffer);
|
17285
|
4220 report_file_error ("Setting file position",
|
19861
|
4221 Fcons (orig_filename, Qnil));
|
17285
|
4222 }
|
|
4223
|
17273
|
4224 total = st.st_size; /* Total bytes in the file. */
|
|
4225 how_much = 0; /* Bytes read from file so far. */
|
|
4226 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
|
|
4227 unprocessed = 0; /* Bytes not processed in previous loop. */
|
|
4228
|
|
4229 while (how_much < total)
|
|
4230 {
|
|
4231 /* try is reserved in some compilers (Microsoft C) */
|
|
4232 int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
|
22311
|
4233 unsigned char *destination = read_buf + unprocessed;
|
17273
|
4234 int this;
|
|
4235
|
|
4236 /* Allow quitting out of the actual I/O. */
|
|
4237 immediate_quit = 1;
|
|
4238 QUIT;
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4239 this = emacs_read (fd, destination, trytry);
|
17273
|
4240 immediate_quit = 0;
|
|
4241
|
|
4242 if (this < 0 || this + unprocessed == 0)
|
|
4243 {
|
|
4244 how_much = this;
|
|
4245 break;
|
|
4246 }
|
|
4247
|
|
4248 how_much += this;
|
|
4249
|
20713
|
4250 if (CODING_MAY_REQUIRE_DECODING (&coding))
|
17273
|
4251 {
|
20713
|
4252 int require, result;
|
17273
|
4253
|
|
4254 this += unprocessed;
|
|
4255
|
|
4256 /* If we are using more space than estimated,
|
|
4257 make CONVERSION_BUFFER bigger. */
|
|
4258 require = decoding_buffer_size (&coding, this);
|
|
4259 if (inserted + require + 2 * (total - how_much) > bufsize)
|
|
4260 {
|
|
4261 bufsize = inserted + require + 2 * (total - how_much);
|
17823
|
4262 conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize);
|
17273
|
4263 }
|
|
4264
|
|
4265 /* Convert this batch with results in CONVERSION_BUFFER. */
|
|
4266 if (how_much >= total) /* This is the last block. */
|
20713
|
4267 coding.mode |= CODING_MODE_LAST_BLOCK;
|
38973
|
4268 if (coding.composing != COMPOSITION_DISABLED)
|
|
4269 coding_allocate_composition_data (&coding, BEGV);
|
20713
|
4270 result = decode_coding (&coding, read_buf,
|
|
4271 conversion_buffer + inserted,
|
|
4272 this, bufsize - inserted);
|
17273
|
4273
|
|
4274 /* Save for next iteration whatever we didn't convert. */
|
20713
|
4275 unprocessed = this - coding.consumed;
|
|
4276 bcopy (read_buf + coding.consumed, read_buf, unprocessed);
|
29009
|
4277 if (!NILP (current_buffer->enable_multibyte_characters))
|
|
4278 this = coding.produced;
|
|
4279 else
|
|
4280 this = str_as_unibyte (conversion_buffer + inserted,
|
|
4281 coding.produced);
|
17273
|
4282 }
|
|
4283
|
|
4284 inserted += this;
|
|
4285 }
|
|
4286
|
20713
|
4287 /* At this point, INSERTED is how many characters (i.e. bytes)
|
17273
|
4288 are present in CONVERSION_BUFFER.
|
|
4289 HOW_MUCH should equal TOTAL,
|
|
4290 or should be <= 0 if we couldn't read the file. */
|
|
4291
|
|
4292 if (how_much < 0)
|
|
4293 {
|
25321
|
4294 xfree (conversion_buffer);
|
57286
|
4295 coding_free_composition_data (&coding);
|
70578
|
4296 error ("IO error reading %s: %s",
|
|
4297 SDATA (orig_filename), emacs_strerror (errno));
|
17273
|
4298 }
|
|
4299
|
|
4300 /* Compare the beginning of the converted file
|
|
4301 with the buffer text. */
|
|
4302
|
|
4303 bufpos = 0;
|
|
4304 while (bufpos < inserted && same_at_start < same_at_end
|
|
4305 && FETCH_BYTE (same_at_start) == conversion_buffer[bufpos])
|
|
4306 same_at_start++, bufpos++;
|
|
4307
|
|
4308 /* If the file matches the buffer completely,
|
|
4309 there's no need to replace anything. */
|
|
4310
|
|
4311 if (bufpos == inserted)
|
|
4312 {
|
25321
|
4313 xfree (conversion_buffer);
|
57286
|
4314 coding_free_composition_data (&coding);
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4315 emacs_close (fd);
|
17273
|
4316 specpdl_ptr--;
|
|
4317 /* Truncate the buffer to the size of the file. */
|
24877
|
4318 del_range_byte (same_at_start, same_at_end, 0);
|
|
4319 inserted = 0;
|
17273
|
4320 goto handled;
|
|
4321 }
|
|
4322
|
22753
|
4323 /* Extend the start of non-matching text area to multibyte
|
|
4324 character boundary. */
|
|
4325 if (! NILP (current_buffer->enable_multibyte_characters))
|
|
4326 while (same_at_start > BEGV_BYTE
|
|
4327 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
|
|
4328 same_at_start--;
|
|
4329
|
17273
|
4330 /* Scan this bufferful from the end, comparing with
|
|
4331 the Emacs buffer. */
|
|
4332 bufpos = inserted;
|
|
4333
|
|
4334 /* Compare with same_at_start to avoid counting some buffer text
|
|
4335 as matching both at the file's beginning and at the end. */
|
|
4336 while (bufpos > 0 && same_at_end > same_at_start
|
|
4337 && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
|
|
4338 same_at_end--, bufpos--;
|
|
4339
|
22753
|
4340 /* Extend the end of non-matching text area to multibyte
|
|
4341 character boundary. */
|
|
4342 if (! NILP (current_buffer->enable_multibyte_characters))
|
|
4343 while (same_at_end < ZV_BYTE
|
|
4344 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
|
|
4345 same_at_end++;
|
|
4346
|
17273
|
4347 /* Don't try to reuse the same piece of text twice. */
|
20533
|
4348 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
|
17273
|
4349 if (overlap > 0)
|
|
4350 same_at_end += overlap;
|
|
4351
|
17285
|
4352 /* If display currently starts at beginning of line,
|
|
4353 keep it that way. */
|
|
4354 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
|
|
4355 XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
|
|
4356
|
17273
|
4357 /* Replace the chars that we need to replace,
|
|
4358 and update INSERTED to equal the number of bytes
|
|
4359 we are taking from the file. */
|
57112
4c14357ffc27
(Finsert_file_contents): Fix case of replacement in a narrowed buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4360 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
|
24877
|
4361
|
21949
|
4362 if (same_at_end != same_at_start)
|
24877
|
4363 {
|
|
4364 del_range_byte (same_at_start, same_at_end, 0);
|
|
4365 temp = GPT;
|
|
4366 same_at_start = GPT_BYTE;
|
|
4367 }
|
21949
|
4368 else
|
|
4369 {
|
|
4370 temp = BYTE_TO_CHAR (same_at_start);
|
|
4371 }
|
24877
|
4372 /* Insert from the file at the proper position. */
|
|
4373 SET_PT_BOTH (temp, same_at_start);
|
57112
4c14357ffc27
(Finsert_file_contents): Fix case of replacement in a narrowed buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4374 insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted,
|
20533
|
4375 0, 0, 0);
|
38973
|
4376 if (coding.cmp_data && coding.cmp_data->used)
|
|
4377 coding_restore_composition (&coding, Fcurrent_buffer ());
|
|
4378 coding_free_composition_data (&coding);
|
49207
|
4379
|
24877
|
4380 /* Set `inserted' to the number of inserted characters. */
|
|
4381 inserted = PT - temp;
|
69136
|
4382 /* Set point before the inserted characters. */
|
|
4383 SET_PT_BOTH (temp, same_at_start);
|
17273
|
4384
|
30605
|
4385 xfree (conversion_buffer);
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4386 emacs_close (fd);
|
17273
|
4387 specpdl_ptr--;
|
|
4388
|
|
4389 goto handled;
|
5975
|
4390 }
|
|
4391
|
17286
|
4392 if (! not_regular)
|
|
4393 {
|
|
4394 register Lisp_Object temp;
|
|
4395
|
|
4396 total = XINT (end) - XINT (beg);
|
|
4397
|
|
4398 /* Make sure point-max won't overflow after this insertion. */
|
|
4399 XSETINT (temp, total);
|
|
4400 if (total != XINT (temp))
|
|
4401 error ("Maximum buffer size exceeded");
|
|
4402 }
|
|
4403 else
|
|
4404 /* For a special file, all we can do is guess. */
|
|
4405 total = READ_BUF_SIZE;
|
230
|
4406
|
62296
|
4407 if (NILP (visit) && inserted > 0)
|
|
4408 {
|
|
4409 #ifdef CLASH_DETECTION
|
|
4410 if (!NILP (current_buffer->file_truename)
|
|
4411 /* Make binding buffer-file-name to nil effective. */
|
|
4412 && !NILP (current_buffer->filename)
|
|
4413 && SAVE_MODIFF >= MODIFF)
|
|
4414 we_locked_file = 1;
|
|
4415 #endif /* CLASH_DETECTION */
|
|
4416 prepare_to_modify_buffer (GPT, GPT, NULL);
|
|
4417 }
|
16167
|
4418
|
|
4419 move_gap (PT);
|
3787
|
4420 if (GAP_SIZE < total)
|
|
4421 make_gap (total - GAP_SIZE);
|
|
4422
|
6036
|
4423 if (XINT (beg) != 0 || !NILP (replace))
|
3787
|
4424 {
|
|
4425 if (lseek (fd, XINT (beg), 0) < 0)
|
19861
|
4426 report_file_error ("Setting file position",
|
|
4427 Fcons (orig_filename, Qnil));
|
3787
|
4428 }
|
|
4429
|
17062
|
4430 /* In the following loop, HOW_MUCH contains the total bytes read so
|
20713
|
4431 far for a regular file, and not changed for a special file. But,
|
|
4432 before exiting the loop, it is set to a negative value if I/O
|
|
4433 error occurs. */
|
6036
|
4434 how_much = 0;
|
49207
|
4435
|
17062
|
4436 /* Total bytes inserted. */
|
|
4437 inserted = 0;
|
49207
|
4438
|
20713
|
4439 /* Here, we don't do code conversion in the loop. It is done by
|
|
4440 code_convert_region after all data are read into the buffer. */
|
38450
|
4441 {
|
|
4442 int gap_size = GAP_SIZE;
|
49207
|
4443
|
38450
|
4444 while (how_much < total)
|
|
4445 {
|
9789
|
4446 /* try is reserved in some compilers (Microsoft C) */
|
38450
|
4447 int trytry = min (total - how_much, READ_BUF_SIZE);
|
|
4448 int this;
|
|
4449
|
|
4450 if (not_regular)
|
|
4451 {
|
|
4452 Lisp_Object val;
|
|
4453
|
|
4454 /* Maybe make more room. */
|
|
4455 if (gap_size < trytry)
|
|
4456 {
|
|
4457 make_gap (total - gap_size);
|
|
4458 gap_size = GAP_SIZE;
|
|
4459 }
|
|
4460
|
|
4461 /* Read from the file, capturing `quit'. When an
|
|
4462 error occurs, end the loop, and arrange for a quit
|
|
4463 to be signaled after decoding the text we read. */
|
|
4464 non_regular_fd = fd;
|
|
4465 non_regular_inserted = inserted;
|
|
4466 non_regular_nbytes = trytry;
|
|
4467 val = internal_condition_case_1 (read_non_regular, Qnil, Qerror,
|
|
4468 read_non_regular_quit);
|
|
4469 if (NILP (val))
|
|
4470 {
|
|
4471 read_quit = 1;
|
|
4472 break;
|
|
4473 }
|
|
4474
|
|
4475 this = XINT (val);
|
|
4476 }
|
|
4477 else
|
|
4478 {
|
|
4479 /* Allow quitting out of the actual I/O. We don't make text
|
|
4480 part of the buffer until all the reading is done, so a C-g
|
|
4481 here doesn't do any harm. */
|
|
4482 immediate_quit = 1;
|
|
4483 QUIT;
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4484 this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
|
38450
|
4485 immediate_quit = 0;
|
|
4486 }
|
49207
|
4487
|
38450
|
4488 if (this <= 0)
|
|
4489 {
|
|
4490 how_much = this;
|
|
4491 break;
|
|
4492 }
|
|
4493
|
|
4494 gap_size -= this;
|
|
4495
|
|
4496 /* For a regular file, where TOTAL is the real size,
|
|
4497 count HOW_MUCH to compare with it.
|
|
4498 For a special file, where TOTAL is just a buffer size,
|
|
4499 so don't bother counting in HOW_MUCH.
|
|
4500 (INSERTED is where we count the number of characters inserted.) */
|
|
4501 if (! not_regular)
|
|
4502 how_much += this;
|
|
4503 inserted += this;
|
|
4504 }
|
|
4505 }
|
|
4506
|
62296
|
4507 /* Now we have read all the file data into the gap.
|
|
4508 If it was empty, undo marking the buffer modified. */
|
|
4509
|
|
4510 if (inserted == 0)
|
|
4511 {
|
62299
|
4512 #ifdef CLASH_DETECTION
|
62296
|
4513 if (we_locked_file)
|
|
4514 unlock_file (current_buffer->file_truename);
|
62299
|
4515 #endif
|
62296
|
4516 Vdeactivate_mark = old_Vdeactivate_mark;
|
|
4517 }
|
67495
5a3907cc23fc
(Finsert_file_contents): Set Vdeactivate_mark when we change the buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4518 else
|
5a3907cc23fc
(Finsert_file_contents): Set Vdeactivate_mark when we change the buffer.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4519 Vdeactivate_mark = Qt;
|
62296
|
4520
|
38450
|
4521 /* Make the text read part of the buffer. */
|
|
4522 GAP_SIZE -= inserted;
|
|
4523 GPT += inserted;
|
|
4524 GPT_BYTE += inserted;
|
|
4525 ZV += inserted;
|
|
4526 ZV_BYTE += inserted;
|
|
4527 Z += inserted;
|
|
4528 Z_BYTE += inserted;
|
230
|
4529
|
20713
|
4530 if (GAP_SIZE > 0)
|
|
4531 /* Put an anchor to ensure multi-byte form ends at gap. */
|
|
4532 *GPT_ADDR = 0;
|
|
4533
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
4534 emacs_close (fd);
|
20713
|
4535
|
|
4536 /* Discard the unwind protect for closing the file. */
|
|
4537 specpdl_ptr--;
|
|
4538
|
|
4539 if (how_much < 0)
|
|
4540 error ("IO error reading %s: %s",
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4541 SDATA (orig_filename), emacs_strerror (errno));
|
19399
|
4542
|
29152
|
4543 notfound:
|
|
4544
|
22697
|
4545 if (! coding_system_decided)
|
|
4546 {
|
|
4547 /* The coding system is not yet decided. Decide it by an
|
26638
|
4548 optimized method for handling `coding:' tag.
|
|
4549
|
|
4550 Note that we can get here only if the buffer was empty
|
|
4551 before the insertion. */
|
22697
|
4552 Lisp_Object val;
|
|
4553 val = Qnil;
|
|
4554
|
|
4555 if (!NILP (Vcoding_system_for_read))
|
|
4556 val = Vcoding_system_for_read;
|
|
4557 else
|
|
4558 {
|
26714
|
4559 /* Since we are sure that the current buffer was empty
|
|
4560 before the insertion, we can toggle
|
|
4561 enable-multibyte-characters directly here without taking
|
|
4562 care of marker adjustment and byte combining problem. By
|
|
4563 this way, we can run Lisp program safely before decoding
|
|
4564 the inserted text. */
|
|
4565 Lisp_Object unwind_data;
|
60563
|
4566 int count = SPECPDL_INDEX ();
|
26714
|
4567
|
|
4568 unwind_data = Fcons (current_buffer->enable_multibyte_characters,
|
|
4569 Fcons (current_buffer->undo_list,
|
|
4570 Fcurrent_buffer ()));
|
60563
|
4571 current_buffer->enable_multibyte_characters = Qnil;
|
26714
|
4572 current_buffer->undo_list = Qt;
|
|
4573 record_unwind_protect (decide_coding_unwind, unwind_data);
|
|
4574
|
22697
|
4575 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
|
|
4576 {
|
22811
|
4577 val = call2 (Vset_auto_coding_function,
|
|
4578 filename, make_number (inserted));
|
22697
|
4579 }
|
|
4580
|
|
4581 if (NILP (val))
|
|
4582 {
|
|
4583 /* If the coding system is not yet decided, check
|
|
4584 file-coding-system-alist. */
|
|
4585 Lisp_Object args[6], coding_systems;
|
|
4586
|
|
4587 args[0] = Qinsert_file_contents, args[1] = orig_filename;
|
|
4588 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
|
|
4589 coding_systems = Ffind_operation_coding_system (6, args);
|
|
4590 if (CONSP (coding_systems))
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4591 val = XCAR (coding_systems);
|
22697
|
4592 }
|
26714
|
4593 unbind_to (count, Qnil);
|
|
4594 inserted = Z_BYTE - BEG_BYTE;
|
22697
|
4595 }
|
|
4596
|
|
4597 /* The following kludgy code is to avoid some compiler bug.
|
|
4598 We can't simply do
|
|
4599 setup_coding_system (val, &coding);
|
|
4600 on some system. */
|
|
4601 {
|
|
4602 struct coding_system temp_coding;
|
60563
|
4603 setup_coding_system (Fcheck_coding_system (val), &temp_coding);
|
22697
|
4604 bcopy (&temp_coding, &coding, sizeof coding);
|
|
4605 }
|
29152
|
4606 /* Ensure we set Vlast_coding_system_used. */
|
|
4607 set_coding_system = 1;
|
22697
|
4608
|
24932
|
4609 if (NILP (current_buffer->enable_multibyte_characters)
|
|
4610 && ! NILP (val))
|
|
4611 /* We must suppress all character code conversion except for
|
22697
|
4612 end-of-line conversion. */
|
|
4613 setup_raw_text_coding_system (&coding);
|
29540
|
4614 coding.src_multibyte = 0;
|
|
4615 coding.dst_multibyte
|
|
4616 = !NILP (current_buffer->enable_multibyte_characters);
|
22697
|
4617 }
|
|
4618
|
29009
|
4619 if (!NILP (visit)
|
39023
|
4620 /* Can't do this if part of the buffer might be preserved. */
|
|
4621 && NILP (replace)
|
29009
|
4622 && (coding.type == coding_type_no_conversion
|
|
4623 || coding.type == coding_type_raw_text))
|
|
4624 {
|
39023
|
4625 /* Visiting a file with these coding system makes the buffer
|
|
4626 unibyte. */
|
|
4627 current_buffer->enable_multibyte_characters = Qnil;
|
38932
|
4628 coding.dst_multibyte = 0;
|
29009
|
4629 }
|
|
4630
|
23878
|
4631 if (inserted > 0 || coding.type == coding_type_ccl)
|
1240
|
4632 {
|
20713
|
4633 if (CODING_MAY_REQUIRE_DECODING (&coding))
|
20929
|
4634 {
|
|
4635 code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
|
|
4636 &coding, 0, 0);
|
29009
|
4637 inserted = coding.produced_char;
|
21138
|
4638 }
|
21504
|
4639 else
|
|
4640 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
|
29009
|
4641 inserted);
|
22697
|
4642 }
|
20713
|
4643
|
50491
|
4644 /* Now INSERTED is measured in characters. */
|
|
4645
|
20713
|
4646 #ifdef DOS_NT
|
22697
|
4647 /* Use the conversion type to determine buffer-file-type
|
|
4648 (find-buffer-file-type is now used to help determine the
|
|
4649 conversion). */
|
49207
|
4650 if ((coding.eol_type == CODING_EOL_UNDECIDED
|
22697
|
4651 || coding.eol_type == CODING_EOL_LF)
|
|
4652 && ! CODING_REQUIRE_DECODING (&coding))
|
|
4653 current_buffer->buffer_file_type = Qt;
|
|
4654 else
|
|
4655 current_buffer->buffer_file_type = Qnil;
|
20713
|
4656 #endif
|
230
|
4657
|
843
|
4658 handled:
|
230
|
4659
|
485
|
4660 if (!NILP (visit))
|
230
|
4661 {
|
6177
|
4662 if (!EQ (current_buffer->undo_list, Qt))
|
|
4663 current_buffer->undo_list = Qnil;
|
230
|
4664 #ifdef APOLLO
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
4665 stat (SDATA (filename), &st);
|
230
|
4666 #endif
|
5390
|
4667
|
5395
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4668 if (NILP (handler))
|
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4669 {
|
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4670 current_buffer->modtime = st.st_mtime;
|
19861
|
4671 current_buffer->filename = orig_filename;
|
5395
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4672 }
|
5390
|
4673
|
10304
|
4674 SAVE_MODIFF = MODIFF;
|
230
|
4675 current_buffer->auto_save_modified = MODIFF;
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
4676 XSETFASTINT (current_buffer->save_length, Z - BEG);
|
230
|
4677 #ifdef CLASH_DETECTION
|
843
|
4678 if (NILP (handler))
|
|
4679 {
|
11658
|
4680 if (!NILP (current_buffer->file_truename))
|
|
4681 unlock_file (current_buffer->file_truename);
|
843
|
4682 unlock_file (filename);
|
|
4683 }
|
230
|
4684 #endif /* CLASH_DETECTION */
|
9915
|
4685 if (not_regular)
|
71977
|
4686 xsignal2 (Qfile_error,
|
|
4687 build_string ("not a regular file"), orig_filename);
|
230
|
4688 }
|
|
4689
|
50530
|
4690 if (set_coding_system)
|
|
4691 Vlast_coding_system_used = coding.symbol;
|
|
4692
|
50546
|
4693 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
|
50530
|
4694 {
|
59207
|
4695 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
|
|
4696 visit);
|
50530
|
4697 if (! NILP (insval))
|
|
4698 {
|
|
4699 CHECK_NUMBER (insval);
|
|
4700 inserted = XFASTINT (insval);
|
|
4701 }
|
|
4702 }
|
|
4703
|
11053
|
4704 /* Decode file format */
|
20713
|
4705 if (inserted > 0)
|
11053
|
4706 {
|
34167
|
4707 int empty_undo_list_p = 0;
|
49207
|
4708
|
34167
|
4709 /* If we're anyway going to discard undo information, don't
|
|
4710 record it in the first place. The buffer's undo list at this
|
|
4711 point is either nil or t when visiting a file. */
|
|
4712 if (!NILP (visit))
|
|
4713 {
|
|
4714 empty_undo_list_p = NILP (current_buffer->undo_list);
|
|
4715 current_buffer->undo_list = Qt;
|
|
4716 }
|
49207
|
4717
|
15097
|
4718 insval = call3 (Qformat_decode,
|
20713
|
4719 Qnil, make_number (inserted), visit);
|
40656
|
4720 CHECK_NUMBER (insval);
|
20713
|
4721 inserted = XFASTINT (insval);
|
49207
|
4722
|
34167
|
4723 if (!NILP (visit))
|
|
4724 current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
|
11053
|
4725 }
|
|
4726
|
17396
|
4727 /* Call after-change hooks for the inserted text, aside from the case
|
|
4728 of normal visiting (not with REPLACE), which is done in a new buffer
|
|
4729 "before" the buffer is changed. */
|
20713
|
4730 if (inserted > 0 && total > 0
|
17396
|
4731 && (NILP (visit) || !NILP (replace)))
|
26855
|
4732 {
|
|
4733 signal_after_change (PT, 0, inserted);
|
|
4734 update_compositions (PT, PT, CHECK_BORDER);
|
|
4735 }
|
20432
|
4736
|
29152
|
4737 p = Vafter_insert_file_functions;
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4738 while (CONSP (p))
|
4841
|
4739 {
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4740 insval = call1 (XCAR (p), make_number (inserted));
|
29152
|
4741 if (!NILP (insval))
|
4841
|
4742 {
|
40656
|
4743 CHECK_NUMBER (insval);
|
29152
|
4744 inserted = XFASTINT (insval);
|
4841
|
4745 }
|
29152
|
4746 QUIT;
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4747 p = XCDR (p);
|
29152
|
4748 }
|
|
4749
|
|
4750 if (!NILP (visit)
|
|
4751 && current_buffer->modtime == -1)
|
|
4752 {
|
|
4753 /* If visiting nonexistent file, return nil. */
|
|
4754 report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
|
4841
|
4755 }
|
|
4756
|
38450
|
4757 if (read_quit)
|
|
4758 Fsignal (Qquit, Qnil);
|
|
4759
|
20533
|
4760 /* ??? Retval needs to be dealt with in all cases consistently. */
|
6036
|
4761 if (NILP (val))
|
19861
|
4762 val = Fcons (orig_filename,
|
6036
|
4763 Fcons (make_number (inserted),
|
|
4764 Qnil));
|
|
4765
|
|
4766 RETURN_UNGCPRO (unbind_to (count, val));
|
230
|
4767 }
|
3787
|
4768
|
41181
|
4769 static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
|
|
4770 static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object,
|
|
4771 Lisp_Object, Lisp_Object));
|
4841
|
4772
|
8317
|
4773 /* If build_annotations switched buffers, switch back to BUF.
|
17062
|
4774 Kill the temporary buffer that was selected in the meantime.
|
|
4775
|
|
4776 Since this kill only the last temporary buffer, some buffers remain
|
|
4777 not killed if build_annotations switched buffers more than once.
|
|
4778 -- K.Handa */
|
8317
|
4779
|
15097
|
4780 static Lisp_Object
|
8317
|
4781 build_annotations_unwind (buf)
|
|
4782 Lisp_Object buf;
|
|
4783 {
|
|
4784 Lisp_Object tembuf;
|
|
4785
|
|
4786 if (XBUFFER (buf) == current_buffer)
|
|
4787 return Qnil;
|
|
4788 tembuf = Fcurrent_buffer ();
|
|
4789 Fset_buffer (buf);
|
|
4790 Fkill_buffer (tembuf);
|
|
4791 return Qnil;
|
|
4792 }
|
|
4793
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4794 /* Decide the coding-system to encode the data with. */
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4795
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4796 void
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4797 choose_write_coding_system (start, end, filename,
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4798 append, visit, lockname, coding)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4799 Lisp_Object start, end, filename, append, visit, lockname;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4800 struct coding_system *coding;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4801 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4802 Lisp_Object val;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4803
|
53363
|
4804 if (auto_saving
|
|
4805 && NILP (Fstring_equal (current_buffer->filename,
|
|
4806 current_buffer->auto_save_file_name)))
|
51357
|
4807 {
|
|
4808 /* We use emacs-mule for auto saving... */
|
|
4809 setup_coding_system (Qemacs_mule, coding);
|
|
4810 /* ... but with the special flag to indicate not to strip off
|
|
4811 leading code of eight-bit-control chars. */
|
|
4812 coding->flags = 1;
|
72405
|
4813 /* We force LF for end-of-line because that is faster. */
|
|
4814 coding->eol_type = CODING_EOL_LF;
|
51357
|
4815 goto done_setup_coding;
|
|
4816 }
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4817 else if (!NILP (Vcoding_system_for_write))
|
48876
|
4818 {
|
|
4819 val = Vcoding_system_for_write;
|
|
4820 if (coding_system_require_warning
|
|
4821 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
|
|
4822 /* Confirm that VAL can surely encode the current region. */
|
|
4823 val = call5 (Vselect_safe_coding_system_function,
|
|
4824 start, end, Fcons (Qt, Fcons (val, Qnil)),
|
|
4825 Qnil, filename);
|
|
4826 }
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4827 else
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4828 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4829 /* If the variable `buffer-file-coding-system' is set locally,
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4830 it means that the file was read with some kind of code
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4831 conversion or the variable is explicitly set by users. We
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4832 had better write it out with the same coding system even if
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4833 `enable-multibyte-characters' is nil.
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4834
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4835 If it is not set locally, we anyway have to convert EOL
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4836 format if the default value of `buffer-file-coding-system'
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4837 tells that it is not Unix-like (LF only) format. */
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4838 int using_default_coding = 0;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4839 int force_raw_text = 0;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4840
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4841 val = current_buffer->buffer_file_coding_system;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4842 if (NILP (val)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4843 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4844 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4845 val = Qnil;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4846 if (NILP (current_buffer->enable_multibyte_characters))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4847 force_raw_text = 1;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4848 }
|
49207
|
4849
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4850 if (NILP (val))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4851 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4852 /* Check file-coding-system-alist. */
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4853 Lisp_Object args[7], coding_systems;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4854
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4855 args[0] = Qwrite_region; args[1] = start; args[2] = end;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4856 args[3] = filename; args[4] = append; args[5] = visit;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4857 args[6] = lockname;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4858 coding_systems = Ffind_operation_coding_system (7, args);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4859 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4860 val = XCDR (coding_systems);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4861 }
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4862
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4863 if (NILP (val)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4864 && !NILP (current_buffer->buffer_file_coding_system))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4865 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4866 /* If we still have not decided a coding system, use the
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4867 default value of buffer-file-coding-system. */
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4868 val = current_buffer->buffer_file_coding_system;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4869 using_default_coding = 1;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4870 }
|
49207
|
4871
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4872 if (!force_raw_text
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4873 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4874 /* Confirm that VAL can surely encode the current region. */
|
45640
a181c1d41a78
(choose_write_coding_system): Call select-safe-coding-system properly.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4875 val = call5 (Vselect_safe_coding_system_function,
|
a181c1d41a78
(choose_write_coding_system): Call select-safe-coding-system properly.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
4876 start, end, val, Qnil, filename);
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4877
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4878 setup_coding_system (Fcheck_coding_system (val), coding);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4879 if (coding->eol_type == CODING_EOL_UNDECIDED
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4880 && !using_default_coding)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4881 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4882 if (! EQ (default_buffer_file_coding.symbol,
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4883 buffer_defaults.buffer_file_coding_system))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4884 setup_coding_system (buffer_defaults.buffer_file_coding_system,
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4885 &default_buffer_file_coding);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4886 if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4887 {
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4888 Lisp_Object subsidiaries;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4889
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4890 coding->eol_type = default_buffer_file_coding.eol_type;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4891 subsidiaries = Fget (coding->symbol, Qeol_type);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4892 if (VECTORP (subsidiaries)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4893 && XVECTOR (subsidiaries)->size == 3)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4894 coding->symbol
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4895 = XVECTOR (subsidiaries)->contents[coding->eol_type];
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4896 }
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4897 }
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4898
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4899 if (force_raw_text)
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4900 setup_raw_text_coding_system (coding);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4901 goto done_setup_coding;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4902 }
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4903
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4904 setup_coding_system (Fcheck_coding_system (val), coding);
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4905
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4906 done_setup_coding:
|
70518
|
4907 if (coding->eol_type == CODING_EOL_UNDECIDED)
|
|
4908 coding->eol_type = system_eol_type;
|
41151
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4909 if (!STRINGP (start) && !NILP (current_buffer->selective_display))
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4910 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4911 }
|
02fcac02955b
(choose_write_coding_system): New fun, extracted from Fwrite_region.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4912
|
21020
|
4913 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
|
40123
|
4914 "r\nFWrite region to file: \ni\ni\ni\np",
|
|
4915 doc: /* Write current region into specified file.
|
41993
|
4916 When called from a program, requires three arguments:
|
|
4917 START, END and FILENAME. START and END are normally buffer positions
|
|
4918 specifying the part of the buffer to write.
|
|
4919 If START is nil, that means to use the entire buffer contents.
|
|
4920 If START is a string, then output that string to the file
|
|
4921 instead of any buffer contents; END is ignored.
|
|
4922
|
40123
|
4923 Optional fourth argument APPEND if non-nil means
|
|
4924 append to existing file contents (if any). If it is an integer,
|
|
4925 seek to that offset in the file before writing.
|
56525
|
4926 Optional fifth argument VISIT, if t or a string, means
|
40123
|
4927 set the last-save-file-modtime of buffer to this file's modtime
|
|
4928 and mark buffer not modified.
|
|
4929 If VISIT is a string, it is a second file name;
|
|
4930 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
|
|
4931 VISIT is also the file name to lock and unlock for clash detection.
|
|
4932 If VISIT is neither t nor nil nor a string,
|
46323
|
4933 that means do not display the \"Wrote file\" message.
|
40123
|
4934 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
|
|
4935 use for locking and unlocking, overriding FILENAME and VISIT.
|
|
4936 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
|
|
4937 for an existing file with the same name. If MUSTBENEW is `excl',
|
|
4938 that means to get an error if the file already exists; never overwrite.
|
|
4939 If MUSTBENEW is neither nil nor `excl', that means ask for
|
|
4940 confirmation before overwriting, but do go ahead and overwrite the file
|
|
4941 if the user confirms.
|
|
4942
|
|
4943 This does code conversion according to the value of
|
|
4944 `coding-system-for-write', `buffer-file-coding-system', or
|
|
4945 `file-coding-system-alist', and sets the variable
|
|
4946 `last-coding-system-used' to the coding system actually used. */)
|
|
4947 (start, end, filename, append, visit, lockname, mustbenew)
|
25597
|
4948 Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
|
230
|
4949 {
|
|
4950 register int desc;
|
|
4951 int failure;
|
31829
|
4952 int save_errno = 0;
|
46465
|
4953 const unsigned char *fn;
|
230
|
4954 struct stat st;
|
4950
|
4955 int tem;
|
46293
|
4956 int count = SPECPDL_INDEX ();
|
8317
|
4957 int count1;
|
230
|
4958 #ifdef VMS
|
9789
|
4959 unsigned char *fname = 0; /* If non-0, original filename (must rename) */
|
230
|
4960 #endif /* VMS */
|
848
|
4961 Lisp_Object handler;
|
2407
|
4962 Lisp_Object visit_file;
|
41211
|
4963 Lisp_Object annotations;
|
19861
|
4964 Lisp_Object encoded_filename;
|
33249
|
4965 int visiting = (EQ (visit, Qt) || STRINGP (visit));
|
|
4966 int quietly = !NILP (visit);
|
12853
|
4967 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|
8317
|
4968 struct buffer *given_buffer;
|
9789
|
4969 #ifdef DOS_NT
|
18764
|
4970 int buffer_file_type = O_BINARY;
|
9789
|
4971 #endif /* DOS_NT */
|
17062
|
4972 struct coding_system coding;
|
230
|
4973
|
33249
|
4974 if (current_buffer->base_buffer && visiting)
|
10304
|
4975 error ("Cannot do file visiting in an indirect buffer");
|
|
4976
|
5410
|
4977 if (!NILP (start) && !STRINGP (start))
|
230
|
4978 validate_region (&start, &end);
|
|
4979
|
69597
|
4980 visit_file = Qnil;
|
41288
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
4981 GCPRO5 (start, filename, visit, visit_file, lockname);
|
20432
|
4982
|
2407
|
4983 filename = Fexpand_file_name (filename, Qnil);
|
21020
|
4984
|
41181
|
4985 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
|
21304
1c2b68b607c8
(barf_or_query_if_file_exists): New arg QUICK. All calls changed.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
4986 barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
|
21020
|
4987
|
5410
|
4988 if (STRINGP (visit))
|
2435
|
4989 visit_file = Fexpand_file_name (visit, Qnil);
|
2407
|
4990 else
|
|
4991 visit_file = filename;
|
|
4992
|
12853
|
4993 if (NILP (lockname))
|
|
4994 lockname = visit_file;
|
|
4995
|
41211
|
4996 annotations = Qnil;
|
|
4997
|
843
|
4998 /* If the file name has special constructs in it,
|
|
4999 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5000 handler = Ffind_file_name_handler (filename, Qwrite_region);
|
5758
23821c197271
(Fwrite_region): If FILENAME has no handler, see if VISIT has one.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5001 /* If FILENAME has no handler, see if VISIT has one. */
|
9131
|
5002 if (NILP (handler) && STRINGP (visit))
|
15097
|
5003 handler = Ffind_file_name_handler (visit, Qwrite_region);
|
848
|
5004
|
843
|
5005 if (!NILP (handler))
|
|
5006 {
|
|
5007 Lisp_Object val;
|
3705
|
5008 val = call6 (handler, Qwrite_region, start, end,
|
|
5009 filename, append, visit);
|
843
|
5010
|
4841
|
5011 if (visiting)
|
843
|
5012 {
|
10304
|
5013 SAVE_MODIFF = MODIFF;
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5014 XSETFASTINT (current_buffer->save_length, Z - BEG);
|
1377
|
5015 current_buffer->filename = visit_file;
|
843
|
5016 }
|
1178
|
5017 UNGCPRO;
|
843
|
5018 return val;
|
|
5019 }
|
|
5020
|
51557
|
5021 record_unwind_protect (save_restriction_restore, save_restriction_save ());
|
|
5022
|
5410
|
5023 /* Special kludge to simplify auto-saving. */
|
|
5024 if (NILP (start))
|
|
5025 {
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5026 XSETFASTINT (start, BEG);
|
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5027 XSETFASTINT (end, Z);
|
51557
|
5028 Fwiden ();
|
5410
|
5029 }
|
|
5030
|
8317
|
5031 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
|
46293
|
5032 count1 = SPECPDL_INDEX ();
|
8317
|
5033
|
|
5034 given_buffer = current_buffer;
|
45561
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5035
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5036 if (!STRINGP (start))
|
41181
|
5037 {
|
45561
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5038 annotations = build_annotations (start, end);
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5039
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5040 if (current_buffer != given_buffer)
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5041 {
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5042 XSETFASTINT (start, BEGV);
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5043 XSETFASTINT (end, ZV);
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5044 }
|
41181
|
5045 }
|
|
5046
|
|
5047 UNGCPRO;
|
|
5048
|
|
5049 GCPRO5 (start, filename, annotations, visit_file, lockname);
|
|
5050
|
41288
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5051 /* Decide the coding-system to encode the data with.
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5052 We used to make this choice before calling build_annotations, but that
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5053 leads to problems when a write-annotate-function takes care of
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5054 unsavable chars (as was the case with X-Symbol). */
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5055 choose_write_coding_system (start, end, filename,
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5056 append, visit, lockname, &coding);
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5057 Vlast_coding_system_used = coding.symbol;
|
1d1183771c4f
(Fwrite_region): Move choose_write_coding_system to after build_annotations.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5058
|
41181
|
5059 given_buffer = current_buffer;
|
45561
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5060 if (! STRINGP (start))
|
8317
|
5061 {
|
45561
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5062 annotations = build_annotations_2 (start, end,
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5063 coding.pre_write_conversion, annotations);
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5064 if (current_buffer != given_buffer)
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5065 {
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5066 XSETFASTINT (start, BEGV);
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5067 XSETFASTINT (end, ZV);
|
54b933234eb4
(Fwrite_region): If START is a string, don't make any annotations.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5068 }
|
8317
|
5069 }
|
4841
|
5070
|
230
|
5071 #ifdef CLASH_DETECTION
|
|
5072 if (!auto_saving)
|
16317
|
5073 {
|
19206
|
5074 #if 0 /* This causes trouble for GNUS. */
|
16317
|
5075 /* If we've locked this file for some other buffer,
|
|
5076 query before proceeding. */
|
|
5077 if (!visiting && EQ (Ffile_locked_p (lockname), Qt))
|
18744
|
5078 call2 (intern ("ask-user-about-lock"), filename, Vuser_login_name);
|
19206
|
5079 #endif
|
16317
|
5080
|
|
5081 lock_file (lockname);
|
|
5082 }
|
230
|
5083 #endif /* CLASH_DETECTION */
|
|
5084
|
19861
|
5085 encoded_filename = ENCODE_FILE (filename);
|
|
5086
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5087 fn = SDATA (encoded_filename);
|
230
|
5088 desc = -1;
|
485
|
5089 if (!NILP (append))
|
9789
|
5090 #ifdef DOS_NT
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5091 desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
|
9789
|
5092 #else /* not DOS_NT */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5093 desc = emacs_open (fn, O_WRONLY, 0);
|
9789
|
5094 #endif /* not DOS_NT */
|
230
|
5095
|
19861
|
5096 if (desc < 0 && (NILP (append) || errno == ENOENT))
|
230
|
5097 #ifdef VMS
|
9789
|
5098 if (auto_saving) /* Overwrite any previous version of autosave file */
|
230
|
5099 {
|
9789
|
5100 vms_truncate (fn); /* if fn exists, truncate to zero length */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5101 desc = emacs_open (fn, O_RDWR, 0);
|
230
|
5102 if (desc < 0)
|
5410
|
5103 desc = creat_copy_attrs (STRINGP (current_buffer->filename)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5104 ? SDATA (current_buffer->filename) : 0,
|
536
|
5105 fn);
|
230
|
5106 }
|
9789
|
5107 else /* Write to temporary name and rename if no errors */
|
230
|
5108 {
|
|
5109 Lisp_Object temp_name;
|
|
5110 temp_name = Ffile_name_directory (filename);
|
|
5111
|
485
|
5112 if (!NILP (temp_name))
|
230
|
5113 {
|
|
5114 temp_name = Fmake_temp_name (concat2 (temp_name,
|
|
5115 build_string ("$$SAVE$$")));
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5116 fname = SDATA (filename);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5117 fn = SDATA (temp_name);
|
230
|
5118 desc = creat_copy_attrs (fname, fn);
|
|
5119 if (desc < 0)
|
|
5120 {
|
|
5121 /* If we can't open the temporary file, try creating a new
|
|
5122 version of the original file. VMS "creat" creates a
|
|
5123 new version rather than truncating an existing file. */
|
|
5124 fn = fname;
|
|
5125 fname = 0;
|
|
5126 desc = creat (fn, 0666);
|
|
5127 #if 0 /* This can clobber an existing file and fail to replace it,
|
|
5128 if the user runs out of space. */
|
|
5129 if (desc < 0)
|
|
5130 {
|
|
5131 /* We can't make a new version;
|
|
5132 try to truncate and rewrite existing version if any. */
|
|
5133 vms_truncate (fn);
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5134 desc = emacs_open (fn, O_RDWR, 0);
|
230
|
5135 }
|
|
5136 #endif
|
|
5137 }
|
|
5138 }
|
|
5139 else
|
|
5140 desc = creat (fn, 0666);
|
|
5141 }
|
|
5142 #else /* not VMS */
|
9789
|
5143 #ifdef DOS_NT
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5144 desc = emacs_open (fn,
|
36693
|
5145 O_WRONLY | O_CREAT | buffer_file_type
|
|
5146 | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5147 S_IREAD | S_IWRITE);
|
9789
|
5148 #else /* not DOS_NT */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5149 desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
|
28507
b6f06a755c7d
make_number/XINT/XUINT conversions; EQ/== fixes; ==Qnil -> NILP
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5150 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5151 auto_saving ? auto_save_mode_bits : 0666);
|
9789
|
5152 #endif /* not DOS_NT */
|
230
|
5153 #endif /* not VMS */
|
|
5154
|
|
5155 if (desc < 0)
|
|
5156 {
|
|
5157 #ifdef CLASH_DETECTION
|
|
5158 save_errno = errno;
|
12853
|
5159 if (!auto_saving) unlock_file (lockname);
|
230
|
5160 errno = save_errno;
|
|
5161 #endif /* CLASH_DETECTION */
|
28846
|
5162 UNGCPRO;
|
230
|
5163 report_file_error ("Opening output file", Fcons (filename, Qnil));
|
|
5164 }
|
|
5165
|
|
5166 record_unwind_protect (close_file_unwind, make_number (desc));
|
|
5167
|
22681
|
5168 if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
|
28846
|
5169 {
|
|
5170 long ret;
|
49207
|
5171
|
28846
|
5172 if (NUMBERP (append))
|
|
5173 ret = lseek (desc, XINT (append), 1);
|
|
5174 else
|
|
5175 ret = lseek (desc, 0, 2);
|
|
5176 if (ret < 0)
|
|
5177 {
|
230
|
5178 #ifdef CLASH_DETECTION
|
28846
|
5179 if (!auto_saving) unlock_file (lockname);
|
230
|
5180 #endif /* CLASH_DETECTION */
|
28846
|
5181 UNGCPRO;
|
|
5182 report_file_error ("Lseek error", Fcons (filename, Qnil));
|
|
5183 }
|
|
5184 }
|
49207
|
5185
|
28846
|
5186 UNGCPRO;
|
230
|
5187
|
|
5188 #ifdef VMS
|
|
5189 /*
|
|
5190 * Kludge Warning: The VMS C RTL likes to insert carriage returns
|
|
5191 * if we do writes that don't end with a carriage return. Furthermore
|
|
5192 * it cannot handle writes of more then 16K. The modified
|
|
5193 * version of "sys_write" in SYSDEP.C (see comment there) copes with
|
|
5194 * this EXCEPT for the last record (iff it doesn't end with a carriage
|
|
5195 * return). This implies that if your buffer doesn't end with a carriage
|
|
5196 * return, you get one free... tough. However it also means that if
|
|
5197 * we make two calls to sys_write (a la the following code) you can
|
|
5198 * get one at the gap as well. The easiest way to fix this (honest)
|
|
5199 * is to move the gap to the next newline (or the end of the buffer).
|
|
5200 * Thus this change.
|
|
5201 *
|
|
5202 * Yech!
|
|
5203 */
|
|
5204 if (GPT > BEG && GPT_ADDR[-1] != '\n')
|
|
5205 move_gap (find_next_newline (GPT, 1));
|
17723
|
5206 #else
|
|
5207 /* Whether VMS or not, we must move the gap to the next of newline
|
|
5208 when we must put designation sequences at beginning of line. */
|
|
5209 if (INTEGERP (start)
|
|
5210 && coding.type == coding_type_iso2022
|
|
5211 && coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
|
|
5212 && GPT > BEG && GPT_ADDR[-1] != '\n')
|
20533
|
5213 {
|
|
5214 int opoint = PT, opoint_byte = PT_BYTE;
|
|
5215 scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0);
|
|
5216 move_gap_both (PT, PT_BYTE);
|
|
5217 SET_PT_BOTH (opoint, opoint_byte);
|
|
5218 }
|
230
|
5219 #endif
|
|
5220
|
|
5221 failure = 0;
|
|
5222 immediate_quit = 1;
|
|
5223
|
5410
|
5224 if (STRINGP (start))
|
230
|
5225 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5226 failure = 0 > a_write (desc, start, 0, SCHARS (start),
|
26855
|
5227 &annotations, &coding);
|
230
|
5228 save_errno = errno;
|
|
5229 }
|
|
5230 else if (XINT (start) != XINT (end))
|
|
5231 {
|
20533
|
5232 tem = CHAR_TO_BYTE (XINT (start));
|
|
5233
|
230
|
5234 if (XINT (start) < GPT)
|
|
5235 {
|
26855
|
5236 failure = 0 > a_write (desc, Qnil, XINT (start),
|
|
5237 min (GPT, XINT (end)) - XINT (start),
|
|
5238 &annotations, &coding);
|
230
|
5239 save_errno = errno;
|
|
5240 }
|
|
5241
|
|
5242 if (XINT (end) > GPT && !failure)
|
|
5243 {
|
26855
|
5244 tem = max (XINT (start), GPT);
|
|
5245 failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem,
|
|
5246 &annotations, &coding);
|
4841
|
5247 save_errno = errno;
|
|
5248 }
|
13451
3a69848f7892
(Fwrite_region): Move the code that writes annotations for empty files.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5249 }
|
3a69848f7892
(Fwrite_region): Move the code that writes annotations for empty files.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5250 else
|
3a69848f7892
(Fwrite_region): Move the code that writes annotations for empty files.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5251 {
|
3a69848f7892
(Fwrite_region): Move the code that writes annotations for empty files.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5252 /* If file was empty, still need to write the annotations */
|
20713
|
5253 coding.mode |= CODING_MODE_LAST_BLOCK;
|
26855
|
5254 failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
|
17062
|
5255 save_errno = errno;
|
|
5256 }
|
|
5257
|
20713
|
5258 if (CODING_REQUIRE_FLUSHING (&coding)
|
|
5259 && !(coding.mode & CODING_MODE_LAST_BLOCK)
|
20651
|
5260 && ! failure)
|
17062
|
5261 {
|
|
5262 /* We have to flush out a data. */
|
20713
|
5263 coding.mode |= CODING_MODE_LAST_BLOCK;
|
26855
|
5264 failure = 0 > e_write (desc, Qnil, 0, 0, &coding);
|
13451
3a69848f7892
(Fwrite_region): Move the code that writes annotations for empty files.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5265 save_errno = errno;
|
230
|
5266 }
|
|
5267
|
|
5268 immediate_quit = 0;
|
|
5269
|
2280
|
5270 #ifdef HAVE_FSYNC
|
230
|
5271 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
|
|
5272 Disk full in NFS may be reported here. */
|
3415
|
5273 /* mib says that closing the file will try to write as fast as NFS can do
|
|
5274 it, and that means the fsync here is not crucial for autosave files. */
|
65513
|
5275 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
|
12540
|
5276 {
|
|
5277 /* If fsync fails with EINTR, don't treat that as serious. */
|
|
5278 if (errno != EINTR)
|
|
5279 failure = 1, save_errno = errno;
|
|
5280 }
|
230
|
5281 #endif
|
|
5282
|
15097
|
5283 /* Spurious "file has changed on disk" warnings have been
|
230
|
5284 observed on Suns as well.
|
|
5285 It seems that `close' can change the modtime, under nfs.
|
|
5286
|
|
5287 (This has supposedly been fixed in Sunos 4,
|
|
5288 but who knows about all the other machines with NFS?) */
|
|
5289 #if 0
|
|
5290
|
|
5291 /* On VMS and APOLLO, must do the stat after the close
|
|
5292 since closing changes the modtime. */
|
|
5293 #ifndef VMS
|
|
5294 #ifndef APOLLO
|
|
5295 /* Recall that #if defined does not work on VMS. */
|
|
5296 #define FOO
|
|
5297 fstat (desc, &st);
|
|
5298 #endif
|
|
5299 #endif
|
|
5300 #endif
|
|
5301
|
|
5302 /* NFS can report a write failure now. */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5303 if (emacs_close (desc) < 0)
|
230
|
5304 failure = 1, save_errno = errno;
|
|
5305
|
|
5306 #ifdef VMS
|
|
5307 /* If we wrote to a temporary name and had no errors, rename to real name. */
|
|
5308 if (fname)
|
|
5309 {
|
|
5310 if (!failure)
|
|
5311 failure = (rename (fn, fname) != 0), save_errno = errno;
|
|
5312 fn = fname;
|
|
5313 }
|
|
5314 #endif /* VMS */
|
|
5315
|
|
5316 #ifndef FOO
|
|
5317 stat (fn, &st);
|
|
5318 #endif
|
8317
|
5319 /* Discard the unwind protect for close_file_unwind. */
|
|
5320 specpdl_ptr = specpdl + count1;
|
|
5321 /* Restore the original current buffer. */
|
8662
|
5322 visit_file = unbind_to (count, visit_file);
|
230
|
5323
|
|
5324 #ifdef CLASH_DETECTION
|
|
5325 if (!auto_saving)
|
12853
|
5326 unlock_file (lockname);
|
230
|
5327 #endif /* CLASH_DETECTION */
|
|
5328
|
|
5329 /* Do this before reporting IO error
|
|
5330 to avoid a "file has changed on disk" warning on
|
|
5331 next attempt to save. */
|
4841
|
5332 if (visiting)
|
230
|
5333 current_buffer->modtime = st.st_mtime;
|
|
5334
|
|
5335 if (failure)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5336 error ("IO error writing %s: %s", SDATA (filename),
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5337 emacs_strerror (save_errno));
|
230
|
5338
|
4841
|
5339 if (visiting)
|
230
|
5340 {
|
10304
|
5341 SAVE_MODIFF = MODIFF;
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5342 XSETFASTINT (current_buffer->save_length, Z - BEG);
|
1377
|
5343 current_buffer->filename = visit_file;
|
7551
|
5344 update_mode_lines++;
|
230
|
5345 }
|
4841
|
5346 else if (quietly)
|
53363
|
5347 {
|
|
5348 if (auto_saving
|
|
5349 && ! NILP (Fstring_equal (current_buffer->filename,
|
|
5350 current_buffer->auto_save_file_name)))
|
|
5351 SAVE_MODIFF = MODIFF;
|
|
5352
|
|
5353 return Qnil;
|
|
5354 }
|
230
|
5355
|
|
5356 if (!auto_saving)
|
52212
db86c36d5abf
(Fwrite_region): Fix conditional expression to issue the right message.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5357 message_with_string ((INTEGERP (append)
|
51636
758b45c47650
(Fwrite_region): Alternate messages for append and partial write.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5358 ? "Updated %s"
|
758b45c47650
(Fwrite_region): Alternate messages for append and partial write.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5359 : ! NILP (append)
|
758b45c47650
(Fwrite_region): Alternate messages for append and partial write.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5360 ? "Added to %s"
|
758b45c47650
(Fwrite_region): Alternate messages for append and partial write.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5361 : "Wrote %s"),
|
758b45c47650
(Fwrite_region): Alternate messages for append and partial write.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5362 visit_file, 1);
|
230
|
5363
|
|
5364 return Qnil;
|
|
5365 }
|
20533
|
5366
|
4841
|
5367 Lisp_Object merge ();
|
|
5368
|
|
5369 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
|
40123
|
5370 doc: /* Return t if (car A) is numerically less than (car B). */)
|
|
5371 (a, b)
|
4841
|
5372 Lisp_Object a, b;
|
|
5373 {
|
|
5374 return Flss (Fcar (a), Fcar (b));
|
|
5375 }
|
|
5376
|
|
5377 /* Build the complete list of annotations appropriate for writing out
|
|
5378 the text between START and END, by calling all the functions in
|
8317
|
5379 write-region-annotate-functions and merging the lists they return.
|
|
5380 If one of these functions switches to a different buffer, we assume
|
|
5381 that buffer contains altered text. Therefore, the caller must
|
|
5382 make sure to restore the current buffer in all cases,
|
|
5383 as save-excursion would do. */
|
4841
|
5384
|
|
5385 static Lisp_Object
|
41181
|
5386 build_annotations (start, end)
|
|
5387 Lisp_Object start, end;
|
4841
|
5388 {
|
|
5389 Lisp_Object annotations;
|
|
5390 Lisp_Object p, res;
|
|
5391 struct gcpro gcpro1, gcpro2;
|
16044
|
5392 Lisp_Object original_buffer;
|
50829
|
5393 int i, used_global = 0;
|
16044
|
5394
|
|
5395 XSETBUFFER (original_buffer, current_buffer);
|
4841
|
5396
|
|
5397 annotations = Qnil;
|
|
5398 p = Vwrite_region_annotate_functions;
|
|
5399 GCPRO2 (annotations, p);
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5400 while (CONSP (p))
|
4841
|
5401 {
|
8317
|
5402 struct buffer *given_buffer = current_buffer;
|
50829
|
5403 if (EQ (Qt, XCAR (p)) && !used_global)
|
|
5404 { /* Use the global value of the hook. */
|
|
5405 Lisp_Object arg[2];
|
|
5406 used_global = 1;
|
|
5407 arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
|
|
5408 arg[1] = XCDR (p);
|
|
5409 p = Fappend (2, arg);
|
|
5410 continue;
|
|
5411 }
|
8317
|
5412 Vwrite_region_annotations_so_far = annotations;
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5413 res = call2 (XCAR (p), start, end);
|
8317
|
5414 /* If the function makes a different buffer current,
|
|
5415 assume that means this buffer contains altered text to be output.
|
|
5416 Reset START and END from the buffer bounds
|
|
5417 and discard all previous annotations because they should have
|
|
5418 been dealt with by this function. */
|
|
5419 if (current_buffer != given_buffer)
|
|
5420 {
|
18107
|
5421 XSETFASTINT (start, BEGV);
|
|
5422 XSETFASTINT (end, ZV);
|
8317
|
5423 annotations = Qnil;
|
|
5424 }
|
4841
|
5425 Flength (res); /* Check basic validity of return value */
|
|
5426 annotations = merge (annotations, res, Qcar_less_than_car);
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5427 p = XCDR (p);
|
4841
|
5428 }
|
11053
|
5429
|
|
5430 /* Now do the same for annotation functions implied by the file-format */
|
56977
|
5431 if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
|
|
5432 p = current_buffer->auto_save_file_format;
|
11053
|
5433 else
|
|
5434 p = current_buffer->file_format;
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5435 for (i = 0; CONSP (p); p = XCDR (p), ++i)
|
11053
|
5436 {
|
|
5437 struct buffer *given_buffer = current_buffer;
|
49207
|
5438
|
11053
|
5439 Vwrite_region_annotations_so_far = annotations;
|
30927
|
5440
|
|
5441 /* Value is either a list of annotations or nil if the function
|
|
5442 has written annotations to a temporary buffer, which is now
|
|
5443 current. */
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
5444 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
|
30927
|
5445 original_buffer, make_number (i));
|
11053
|
5446 if (current_buffer != given_buffer)
|
|
5447 {
|
18107
|
5448 XSETFASTINT (start, BEGV);
|
|
5449 XSETFASTINT (end, ZV);
|
11053
|
5450 annotations = Qnil;
|
|
5451 }
|
49207
|
5452
|
30927
|
5453 if (CONSP (res))
|
|
5454 annotations = merge (annotations, res, Qcar_less_than_car);
|
11053
|
5455 }
|
17062
|
5456
|
41181
|
5457 UNGCPRO;
|
|
5458 return annotations;
|
|
5459 }
|
|
5460
|
|
5461 static Lisp_Object
|
|
5462 build_annotations_2 (start, end, pre_write_conversion, annotations)
|
|
5463 Lisp_Object start, end, pre_write_conversion, annotations;
|
|
5464 {
|
|
5465 struct gcpro gcpro1;
|
|
5466 Lisp_Object res;
|
|
5467
|
|
5468 GCPRO1 (annotations);
|
17062
|
5469 /* At last, do the same for the function PRE_WRITE_CONVERSION
|
|
5470 implied by the current coding-system. */
|
|
5471 if (!NILP (pre_write_conversion))
|
|
5472 {
|
|
5473 struct buffer *given_buffer = current_buffer;
|
|
5474 Vwrite_region_annotations_so_far = annotations;
|
|
5475 res = call2 (pre_write_conversion, start, end);
|
|
5476 Flength (res);
|
17723
|
5477 annotations = (current_buffer != given_buffer
|
|
5478 ? res
|
|
5479 : merge (annotations, res, Qcar_less_than_car));
|
17062
|
5480 }
|
|
5481
|
4841
|
5482 UNGCPRO;
|
|
5483 return annotations;
|
|
5484 }
|
20533
|
5485
|
26855
|
5486 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
|
|
5487 If STRING is nil, POS is the character position in the current buffer.
|
4841
|
5488 Intersperse with them the annotations from *ANNOT
|
26855
|
5489 which fall within the range of POS to POS + NCHARS,
|
4841
|
5490 each at its appropriate position.
|
|
5491
|
20533
|
5492 We modify *ANNOT by discarding elements as we use them up.
|
|
5493
|
4841
|
5494 The return value is negative in case of system call failure. */
|
|
5495
|
20533
|
5496 static int
|
26855
|
5497 a_write (desc, string, pos, nchars, annot, coding)
|
4841
|
5498 int desc;
|
26855
|
5499 Lisp_Object string;
|
|
5500 register int nchars;
|
|
5501 int pos;
|
4841
|
5502 Lisp_Object *annot;
|
17062
|
5503 struct coding_system *coding;
|
4841
|
5504 {
|
|
5505 Lisp_Object tem;
|
|
5506 int nextpos;
|
26855
|
5507 int lastpos = pos + nchars;
|
4841
|
5508
|
8079
3f543986a45a
(a_write): Loop while *ANNOT is listp, not consp. Previous code omitted
Roland McGrath <roland@gnu.org>
diff
changeset
|
5509 while (NILP (*annot) || CONSP (*annot))
|
4841
|
5510 {
|
|
5511 tem = Fcar_safe (Fcar (*annot));
|
26855
|
5512 nextpos = pos - 1;
|
20533
|
5513 if (INTEGERP (tem))
|
26855
|
5514 nextpos = XFASTINT (tem);
|
20533
|
5515
|
|
5516 /* If there are no more annotations in this range,
|
|
5517 output the rest of the range all at once. */
|
26855
|
5518 if (! (nextpos >= pos && nextpos <= lastpos))
|
|
5519 return e_write (desc, string, pos, lastpos, coding);
|
20533
|
5520
|
|
5521 /* Output buffer text up to the next annotation's position. */
|
26855
|
5522 if (nextpos > pos)
|
4841
|
5523 {
|
28561
|
5524 if (0 > e_write (desc, string, pos, nextpos, coding))
|
4841
|
5525 return -1;
|
26855
|
5526 pos = nextpos;
|
4841
|
5527 }
|
20533
|
5528 /* Output the annotation. */
|
4841
|
5529 tem = Fcdr (Fcar (*annot));
|
|
5530 if (STRINGP (tem))
|
|
5531 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5532 if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
|
4841
|
5533 return -1;
|
|
5534 }
|
|
5535 *annot = Fcdr (*annot);
|
|
5536 }
|
21514
|
5537 return 0;
|
4841
|
5538 }
|
|
5539
|
17062
|
5540 #ifndef WRITE_BUF_SIZE
|
|
5541 #define WRITE_BUF_SIZE (16 * 1024)
|
|
5542 #endif
|
|
5543
|
26855
|
5544 /* Write text in the range START and END into descriptor DESC,
|
|
5545 encoding them with coding system CODING. If STRING is nil, START
|
|
5546 and END are character positions of the current buffer, else they
|
|
5547 are indexes to the string STRING. */
|
20533
|
5548
|
|
5549 static int
|
26855
|
5550 e_write (desc, string, start, end, coding)
|
230
|
5551 int desc;
|
26855
|
5552 Lisp_Object string;
|
|
5553 int start, end;
|
17062
|
5554 struct coding_system *coding;
|
230
|
5555 {
|
26855
|
5556 register char *addr;
|
|
5557 register int nbytes;
|
17062
|
5558 char buf[WRITE_BUF_SIZE];
|
26855
|
5559 int return_val = 0;
|
|
5560
|
|
5561 if (start >= end)
|
|
5562 coding->composing = COMPOSITION_DISABLED;
|
|
5563 if (coding->composing != COMPOSITION_DISABLED)
|
|
5564 coding_save_composition (coding, start, end, string);
|
|
5565
|
|
5566 if (STRINGP (string))
|
|
5567 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5568 addr = SDATA (string);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5569 nbytes = SBYTES (string);
|
29009
|
5570 coding->src_multibyte = STRING_MULTIBYTE (string);
|
26855
|
5571 }
|
|
5572 else if (start < end)
|
|
5573 {
|
|
5574 /* It is assured that the gap is not in the range START and END-1. */
|
|
5575 addr = CHAR_POS_ADDR (start);
|
|
5576 nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
|
29009
|
5577 coding->src_multibyte
|
|
5578 = !NILP (current_buffer->enable_multibyte_characters);
|
26855
|
5579 }
|
|
5580 else
|
|
5581 {
|
|
5582 addr = "";
|
|
5583 nbytes = 0;
|
29009
|
5584 coding->src_multibyte = 1;
|
26855
|
5585 }
|
17062
|
5586
|
|
5587 /* We used to have a code for handling selective display here. But,
|
|
5588 now it is handled within encode_coding. */
|
|
5589 while (1)
|
230
|
5590 {
|
22441
|
5591 int result;
|
|
5592
|
|
5593 result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE);
|
20713
|
5594 if (coding->produced > 0)
|
17062
|
5595 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5596 coding->produced -= emacs_write (desc, buf, coding->produced);
|
26855
|
5597 if (coding->produced)
|
|
5598 {
|
|
5599 return_val = -1;
|
|
5600 break;
|
|
5601 }
|
17062
|
5602 }
|
27564
|
5603 nbytes -= coding->consumed;
|
|
5604 addr += coding->consumed;
|
|
5605 if (result == CODING_FINISH_INSUFFICIENT_SRC
|
|
5606 && nbytes > 0)
|
22441
|
5607 {
|
|
5608 /* The source text ends by an incomplete multibyte form.
|
|
5609 There's no way other than write it out as is. */
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
5610 nbytes -= emacs_write (desc, addr, nbytes);
|
26855
|
5611 if (nbytes)
|
|
5612 {
|
|
5613 return_val = -1;
|
|
5614 break;
|
|
5615 }
|
22441
|
5616 }
|
20533
|
5617 if (nbytes <= 0)
|
17062
|
5618 break;
|
26855
|
5619 start += coding->consumed_char;
|
|
5620 if (coding->cmp_data)
|
|
5621 coding_adjust_composition_offset (coding, start);
|
230
|
5622 }
|
29478
|
5623
|
|
5624 if (coding->cmp_data)
|
|
5625 coding_free_composition_data (coding);
|
|
5626
|
28561
|
5627 return return_val;
|
230
|
5628 }
|
20533
|
5629
|
230
|
5630 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
|
40123
|
5631 Sverify_visited_file_modtime, 1, 1, 0,
|
|
5632 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
|
54895
|
5633 This means that the file has not been changed since it was visited or saved.
|
|
5634 See Info node `(elisp)Modification Time' for more details. */)
|
40123
|
5635 (buf)
|
230
|
5636 Lisp_Object buf;
|
|
5637 {
|
|
5638 struct buffer *b;
|
|
5639 struct stat st;
|
843
|
5640 Lisp_Object handler;
|
19861
|
5641 Lisp_Object filename;
|
230
|
5642
|
40656
|
5643 CHECK_BUFFER (buf);
|
230
|
5644 b = XBUFFER (buf);
|
|
5645
|
9131
|
5646 if (!STRINGP (b->filename)) return Qt;
|
230
|
5647 if (b->modtime == 0) return Qt;
|
|
5648
|
843
|
5649 /* If the file name has special constructs in it,
|
|
5650 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5651 handler = Ffind_file_name_handler (b->filename,
|
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5652 Qverify_visited_file_modtime);
|
843
|
5653 if (!NILP (handler))
|
1178
|
5654 return call2 (handler, Qverify_visited_file_modtime, buf);
|
843
|
5655
|
19861
|
5656 filename = ENCODE_FILE (b->filename);
|
|
5657
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5658 if (stat (SDATA (filename), &st) < 0)
|
230
|
5659 {
|
|
5660 /* If the file doesn't exist now and didn't exist before,
|
|
5661 we say that it isn't modified, provided the error is a tame one. */
|
|
5662 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
|
|
5663 st.st_mtime = -1;
|
|
5664 else
|
|
5665 st.st_mtime = 0;
|
|
5666 }
|
|
5667 if (st.st_mtime == b->modtime
|
|
5668 /* If both are positive, accept them if they are off by one second. */
|
|
5669 || (st.st_mtime > 0 && b->modtime > 0
|
|
5670 && (st.st_mtime == b->modtime + 1
|
|
5671 || st.st_mtime == b->modtime - 1)))
|
|
5672 return Qt;
|
|
5673 return Qnil;
|
|
5674 }
|
|
5675
|
|
5676 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
|
40123
|
5677 Sclear_visited_file_modtime, 0, 0, 0,
|
|
5678 doc: /* Clear out records of last mod time of visited file.
|
|
5679 Next attempt to save will certainly not complain of a discrepancy. */)
|
|
5680 ()
|
230
|
5681 {
|
|
5682 current_buffer->modtime = 0;
|
|
5683 return Qnil;
|
|
5684 }
|
|
5685
|
2257
|
5686 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
|
40123
|
5687 Svisited_file_modtime, 0, 0, 0,
|
|
5688 doc: /* Return the current buffer's recorded visited file modification time.
|
56422
|
5689 The value is a list of the form (HIGH LOW), like the time values
|
54895
|
5690 that `file-attributes' returns. If the current buffer has no recorded
|
|
5691 file modification time, this function returns 0.
|
|
5692 See Info node `(elisp)Modification Time' for more details. */)
|
40123
|
5693 ()
|
230
|
5694 {
|
56422
|
5695 Lisp_Object tcons;
|
|
5696 tcons = long_to_cons ((unsigned long) current_buffer->modtime);
|
|
5697 if (CONSP (tcons))
|
|
5698 return list2 (XCAR (tcons), XCDR (tcons));
|
|
5699 return tcons;
|
2257
|
5700 }
|
|
5701
|
|
5702 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
|
40123
|
5703 Sset_visited_file_modtime, 0, 1, 0,
|
|
5704 doc: /* Update buffer's recorded modification time from the visited file's time.
|
|
5705 Useful if the buffer was not read from the file normally
|
|
5706 or if the file itself has been changed for some known benign reason.
|
|
5707 An argument specifies the modification time value to use
|
|
5708 \(instead of that of the visited file), in the form of a list
|
|
5709 \(HIGH . LOW) or (HIGH LOW). */)
|
|
5710 (time_list)
|
2257
|
5711 Lisp_Object time_list;
|
|
5712 {
|
|
5713 if (!NILP (time_list))
|
|
5714 current_buffer->modtime = cons_to_long (time_list);
|
|
5715 else
|
|
5716 {
|
|
5717 register Lisp_Object filename;
|
|
5718 struct stat st;
|
|
5719 Lisp_Object handler;
|
|
5720
|
|
5721 filename = Fexpand_file_name (current_buffer->filename, Qnil);
|
|
5722
|
|
5723 /* If the file name has special constructs in it,
|
|
5724 call the corresponding file handler. */
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5725 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
|
2257
|
5726 if (!NILP (handler))
|
3721
|
5727 /* The handler can find the file name the same way we did. */
|
3829
|
5728 return call2 (handler, Qset_visited_file_modtime, Qnil);
|
19861
|
5729
|
|
5730 filename = ENCODE_FILE (filename);
|
|
5731
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5732 if (stat (SDATA (filename), &st) >= 0)
|
2257
|
5733 current_buffer->modtime = st.st_mtime;
|
|
5734 }
|
230
|
5735
|
|
5736 return Qnil;
|
|
5737 }
|
|
5738
|
|
5739 Lisp_Object
|
34176
|
5740 auto_save_error (error)
|
|
5741 Lisp_Object error;
|
230
|
5742 {
|
34176
|
5743 Lisp_Object args[3], msg;
|
|
5744 int i, nbytes;
|
|
5745 struct gcpro gcpro1;
|
65466
|
5746 char *msgbuf;
|
|
5747 USE_SAFE_ALLOCA;
|
49207
|
5748
|
230
|
5749 ring_bell ();
|
49207
|
5750
|
34176
|
5751 args[0] = build_string ("Auto-saving %s: %s");
|
|
5752 args[1] = current_buffer->name;
|
|
5753 args[2] = Ferror_message_string (error);
|
|
5754 msg = Fformat (3, args);
|
|
5755 GCPRO1 (msg);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5756 nbytes = SBYTES (msg);
|
65466
|
5757 SAFE_ALLOCA (msgbuf, char *, nbytes);
|
|
5758 bcopy (SDATA (msg), msgbuf, nbytes);
|
34176
|
5759
|
|
5760 for (i = 0; i < 3; ++i)
|
|
5761 {
|
|
5762 if (i == 0)
|
65466
|
5763 message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
|
34176
|
5764 else
|
65466
|
5765 message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
|
34176
|
5766 Fsleep_for (make_number (1), Qnil);
|
|
5767 }
|
|
5768
|
66235
|
5769 SAFE_FREE ();
|
34176
|
5770 UNGCPRO;
|
230
|
5771 return Qnil;
|
|
5772 }
|
|
5773
|
|
5774 Lisp_Object
|
|
5775 auto_save_1 ()
|
|
5776 {
|
|
5777 struct stat st;
|
57955
|
5778 Lisp_Object modes;
|
|
5779
|
|
5780 auto_save_mode_bits = 0666;
|
230
|
5781
|
|
5782 /* Get visited file's mode to become the auto save file's mode. */
|
57955
|
5783 if (! NILP (current_buffer->filename))
|
|
5784 {
|
|
5785 if (stat (SDATA (current_buffer->filename), &st) >= 0)
|
|
5786 /* But make sure we can overwrite it later! */
|
|
5787 auto_save_mode_bits = st.st_mode | 0600;
|
|
5788 else if ((modes = Ffile_modes (current_buffer->filename),
|
|
5789 INTEGERP (modes)))
|
|
5790 /* Remote files don't cooperate with stat. */
|
|
5791 auto_save_mode_bits = XINT (modes) | 0600;
|
|
5792 }
|
230
|
5793
|
|
5794 return
|
|
5795 Fwrite_region (Qnil, Qnil,
|
|
5796 current_buffer->auto_save_file_name,
|
21020
|
5797 Qnil, Qlambda, Qnil, Qnil);
|
230
|
5798 }
|
|
5799
|
7445
|
5800 static Lisp_Object
|
64535
|
5801 do_auto_save_unwind (arg) /* used as unwind-protect function */
|
|
5802 Lisp_Object arg;
|
7445
|
5803 {
|
64535
|
5804 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
|
12642
|
5805 auto_saving = 0;
|
64535
|
5806 if (stream != NULL)
|
76622
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5807 {
|
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5808 BLOCK_INPUT;
|
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5809 fclose (stream);
|
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5810 UNBLOCK_INPUT;
|
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5811 }
|
7445
|
5812 return Qnil;
|
|
5813 }
|
|
5814
|
18861
|
5815 static Lisp_Object
|
|
5816 do_auto_save_unwind_1 (value) /* used as unwind-protect function */
|
|
5817 Lisp_Object value;
|
|
5818 {
|
|
5819 minibuffer_auto_raise = XINT (value);
|
|
5820 return Qnil;
|
|
5821 }
|
|
5822
|
47394
|
5823 static Lisp_Object
|
|
5824 do_auto_save_make_dir (dir)
|
|
5825 Lisp_Object dir;
|
|
5826 {
|
71680
9e578ef3e05c
fileio.c (do_auto_save_make_dir): Make the auto-save-list-file
Stephen Gildea <gildea@stop.mail-abuse.org>
diff
changeset
|
5827 Lisp_Object mode;
|
9e578ef3e05c
fileio.c (do_auto_save_make_dir): Make the auto-save-list-file
Stephen Gildea <gildea@stop.mail-abuse.org>
diff
changeset
|
5828
|
9e578ef3e05c
fileio.c (do_auto_save_make_dir): Make the auto-save-list-file
Stephen Gildea <gildea@stop.mail-abuse.org>
diff
changeset
|
5829 call2 (Qmake_directory, dir, Qt);
|
9e578ef3e05c
fileio.c (do_auto_save_make_dir): Make the auto-save-list-file
Stephen Gildea <gildea@stop.mail-abuse.org>
diff
changeset
|
5830 XSETFASTINT (mode, 0700);
|
9e578ef3e05c
fileio.c (do_auto_save_make_dir): Make the auto-save-list-file
Stephen Gildea <gildea@stop.mail-abuse.org>
diff
changeset
|
5831 return Fset_file_modes (dir, mode);
|
47394
|
5832 }
|
|
5833
|
|
5834 static Lisp_Object
|
|
5835 do_auto_save_eh (ignore)
|
|
5836 Lisp_Object ignore;
|
|
5837 {
|
|
5838 return Qnil;
|
|
5839 }
|
|
5840
|
230
|
5841 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
|
40123
|
5842 doc: /* Auto-save all buffers that need it.
|
|
5843 This is all buffers that have auto-saving enabled
|
|
5844 and are changed since last auto-saved.
|
|
5845 Auto-saving writes the buffer into a file
|
|
5846 so that your editing is not lost if the system crashes.
|
|
5847 This file is not the file you visited; that changes only when you save.
|
|
5848 Normally we run the normal hook `auto-save-hook' before saving.
|
|
5849
|
|
5850 A non-nil NO-MESSAGE argument means do not print any message if successful.
|
|
5851 A non-nil CURRENT-ONLY argument means save only current buffer. */)
|
|
5852 (no_message, current_only)
|
1775
|
5853 Lisp_Object no_message, current_only;
|
230
|
5854 {
|
|
5855 struct buffer *old = current_buffer, *b;
|
|
5856 Lisp_Object tail, buf;
|
|
5857 int auto_saved = 0;
|
1869
|
5858 int do_handled_files;
|
4270
|
5859 Lisp_Object oquit;
|
64535
|
5860 FILE *stream = NULL;
|
46293
|
5861 int count = SPECPDL_INDEX ();
|
18861
|
5862 int orig_minibuffer_auto_raise = minibuffer_auto_raise;
|
47394
|
5863 int old_message_p = 0;
|
49191
|
5864 struct gcpro gcpro1, gcpro2;
|
42407
|
5865
|
|
5866 if (max_specpdl_size < specpdl_size + 40)
|
|
5867 max_specpdl_size = specpdl_size + 40;
|
|
5868
|
|
5869 if (minibuf_level)
|
|
5870 no_message = Qt;
|
|
5871
|
47394
|
5872 if (NILP (no_message))
|
|
5873 {
|
|
5874 old_message_p = push_message ();
|
|
5875 record_unwind_protect (pop_message_unwind, Qnil);
|
|
5876 }
|
49207
|
5877
|
4270
|
5878 /* Ordinarily don't quit within this function,
|
|
5879 but don't make it impossible to quit (in case we get hung in I/O). */
|
|
5880 oquit = Vquit_flag;
|
|
5881 Vquit_flag = Qnil;
|
230
|
5882
|
|
5883 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
|
|
5884 point to non-strings reached from Vbuffer_alist. */
|
|
5885
|
485
|
5886 if (!NILP (Vrun_hooks))
|
230
|
5887 call1 (Vrun_hooks, intern ("auto-save-hook"));
|
|
5888
|
7445
|
5889 if (STRINGP (Vauto_save_list_file_name))
|
|
5890 {
|
37961
|
5891 Lisp_Object listfile;
|
49207
|
5892
|
11632
|
5893 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
|
37961
|
5894
|
|
5895 /* Don't try to create the directory when shutting down Emacs,
|
|
5896 because creating the directory might signal an error, and
|
|
5897 that would leave Emacs in a strange state. */
|
|
5898 if (!NILP (Vrun_hooks))
|
|
5899 {
|
|
5900 Lisp_Object dir;
|
49191
|
5901 dir = Qnil;
|
|
5902 GCPRO2 (dir, listfile);
|
37961
|
5903 dir = Ffile_name_directory (listfile);
|
|
5904 if (NILP (Ffile_directory_p (dir)))
|
47394
|
5905 internal_condition_case_1 (do_auto_save_make_dir,
|
|
5906 dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
|
|
5907 do_auto_save_eh);
|
49191
|
5908 UNGCPRO;
|
37961
|
5909 }
|
49207
|
5910
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5911 stream = fopen (SDATA (listfile), "w");
|
7445
|
5912 }
|
64535
|
5913
|
|
5914 record_unwind_protect (do_auto_save_unwind,
|
|
5915 make_save_value (stream, 0));
|
18861
|
5916 record_unwind_protect (do_auto_save_unwind_1,
|
|
5917 make_number (minibuffer_auto_raise));
|
|
5918 minibuffer_auto_raise = 0;
|
12642
|
5919 auto_saving = 1;
|
|
5920
|
53363
|
5921 /* On first pass, save all files that don't have handlers.
|
|
5922 On second pass, save all files that do have handlers.
|
|
5923
|
|
5924 If Emacs is crashing, the handlers may tweak what is causing
|
|
5925 Emacs to crash in the first place, and it would be a shame if
|
|
5926 Emacs failed to autosave perfectly ordinary files because it
|
|
5927 couldn't handle some ange-ftp'd file. */
|
|
5928
|
1869
|
5929 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5930 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
|
1869
|
5931 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5932 buf = XCDR (XCAR (tail));
|
1869
|
5933 b = XBUFFER (buf);
|
15097
|
5934
|
7445
|
5935 /* Record all the buffers that have auto save mode
|
11632
|
5936 in the special file that lists them. For each of these buffers,
|
|
5937 Record visited name (if any) and auto save name. */
|
9131
|
5938 if (STRINGP (b->auto_save_file_name)
|
18270
|
5939 && stream != NULL && do_handled_files == 0)
|
7445
|
5940 {
|
76622
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5941 BLOCK_INPUT;
|
11632
|
5942 if (!NILP (b->filename))
|
|
5943 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5944 fwrite (SDATA (b->filename), 1,
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5945 SBYTES (b->filename), stream);
|
11632
|
5946 }
|
18270
|
5947 putc ('\n', stream);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5948 fwrite (SDATA (b->auto_save_file_name), 1,
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
5949 SBYTES (b->auto_save_file_name), stream);
|
18270
|
5950 putc ('\n', stream);
|
76622
e0b9cd18e1b6
(do_auto_save_unwind): Add BLOCK_INPUT around fclose.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
5951 UNBLOCK_INPUT;
|
7445
|
5952 }
|
1869
|
5953
|
|
5954 if (!NILP (current_only)
|
|
5955 && b != current_buffer)
|
|
5956 continue;
|
7445
|
5957
|
10304
|
5958 /* Don't auto-save indirect buffers.
|
|
5959 The base buffer takes care of it. */
|
|
5960 if (b->base_buffer)
|
|
5961 continue;
|
|
5962
|
1869
|
5963 /* Check for auto save enabled
|
|
5964 and file changed since last auto save
|
|
5965 and file changed since last real save. */
|
9131
|
5966 if (STRINGP (b->auto_save_file_name)
|
10304
|
5967 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
|
1869
|
5968 && b->auto_save_modified < BUF_MODIFF (b)
|
6678
|
5969 /* -1 means we've turned off autosaving for a while--see below. */
|
|
5970 && XINT (b->save_length) >= 0
|
1869
|
5971 && (do_handled_files
|
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5972 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
|
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
5973 Qwrite_region))))
|
1869
|
5974 {
|
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5975 EMACS_TIME before_time, after_time;
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5976
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5977 EMACS_GET_TIME (before_time);
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5978
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5979 /* If we had a failure, don't try again for 20 minutes. */
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5980 if (b->auto_save_failure_time >= 0
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5981 && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200)
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5982 continue;
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
5983
|
1869
|
5984 if ((XFASTINT (b->save_length) * 10
|
|
5985 > (BUF_Z (b) - BUF_BEG (b)) * 13)
|
|
5986 /* A short file is likely to change a large fraction;
|
|
5987 spare the user annoying messages. */
|
|
5988 && XFASTINT (b->save_length) > 5000
|
|
5989 /* These messages are frequent and annoying for `*mail*'. */
|
|
5990 && !EQ (b->filename, Qnil)
|
|
5991 && NILP (no_message))
|
|
5992 {
|
|
5993 /* It has shrunk too much; turn off auto-saving here. */
|
18861
|
5994 minibuffer_auto_raise = orig_minibuffer_auto_raise;
|
43081
|
5995 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
|
20621
|
5996 b->name, 1);
|
18861
|
5997 minibuffer_auto_raise = 0;
|
6678
|
5998 /* Turn off auto-saving until there's a real save,
|
|
5999 and prevent any more warnings. */
|
9266
811ad893828b
(Fdefault_file_modes, Finsert_file_contents, Fdo_auto_save): Use new accessor
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
6000 XSETINT (b->save_length, -1);
|
1869
|
6001 Fsleep_for (make_number (1), Qnil);
|
|
6002 continue;
|
|
6003 }
|
|
6004 set_buffer_internal (b);
|
|
6005 if (!auto_saved && NILP (no_message))
|
|
6006 message1 ("Auto-saving...");
|
|
6007 internal_condition_case (auto_save_1, Qt, auto_save_error);
|
|
6008 auto_saved++;
|
|
6009 b->auto_save_modified = BUF_MODIFF (b);
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
6010 XSETFASTINT (current_buffer->save_length, Z - BEG);
|
1869
|
6011 set_buffer_internal (old);
|
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6012
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6013 EMACS_GET_TIME (after_time);
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6014
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6015 /* If auto-save took more than 60 seconds,
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6016 assume it was an NFS failure that got a timeout. */
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6017 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6018 b->auto_save_failure_time = EMACS_SECS (after_time);
|
1869
|
6019 }
|
|
6020 }
|
230
|
6021
|
1059
|
6022 /* Prevent another auto save till enough input events come in. */
|
|
6023 record_auto_save ();
|
230
|
6024
|
1775
|
6025 if (auto_saved && NILP (no_message))
|
5875
|
6026 {
|
47394
|
6027 if (old_message_p)
|
25006
|
6028 {
|
47394
|
6029 /* If we are going to restore an old message,
|
|
6030 give time to read ours. */
|
71799
|
6031 sit_for (make_number (1), 0, 0);
|
25348
|
6032 restore_message ();
|
14616
|
6033 }
|
5875
|
6034 else
|
47394
|
6035 /* If we displayed a message and then restored a state
|
|
6036 with no message, leave a "done" message on the screen. */
|
5875
|
6037 message1 ("Auto-saving...done");
|
|
6038 }
|
230
|
6039
|
4270
|
6040 Vquit_flag = oquit;
|
|
6041
|
47394
|
6042 /* This restores the message-stack status. */
|
7445
|
6043 unbind_to (count, Qnil);
|
230
|
6044 return Qnil;
|
|
6045 }
|
|
6046
|
|
6047 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
|
40123
|
6048 Sset_buffer_auto_saved, 0, 0, 0,
|
|
6049 doc: /* Mark current buffer as auto-saved with its current text.
|
|
6050 No auto-save file will be written until the buffer changes again. */)
|
|
6051 ()
|
230
|
6052 {
|
|
6053 current_buffer->auto_save_modified = MODIFF;
|
9307
44d6fc4b638b
(Finsert_file_contents, Fwrite_region, Fdo_auto_save, Fset_buffer_auto_saved):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
6054 XSETFASTINT (current_buffer->save_length, Z - BEG);
|
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6055 current_buffer->auto_save_failure_time = -1;
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6056 return Qnil;
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6057 }
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6058
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6059 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
|
40123
|
6060 Sclear_buffer_auto_save_failure, 0, 0, 0,
|
|
6061 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
|
|
6062 ()
|
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6063 {
|
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6064 current_buffer->auto_save_failure_time = -1;
|
230
|
6065 return Qnil;
|
|
6066 }
|
|
6067
|
|
6068 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
|
40123
|
6069 0, 0, 0,
|
62296
|
6070 doc: /* Return t if current buffer has been auto-saved recently.
|
|
6071 More precisely, if it has been auto-saved since last read from or saved
|
|
6072 in the visited file. If the buffer has no visited file,
|
|
6073 then any auto-save counts as "recent". */)
|
40123
|
6074 ()
|
230
|
6075 {
|
10304
|
6076 return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil;
|
230
|
6077 }
|
|
6078
|
|
6079 /* Reading and completing file names */
|
|
6080 extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
|
|
6081
|
5647
|
6082 /* In the string VAL, change each $ to $$ and return the result. */
|
|
6083
|
|
6084 static Lisp_Object
|
|
6085 double_dollars (val)
|
|
6086 Lisp_Object val;
|
|
6087 {
|
46465
|
6088 register const unsigned char *old;
|
|
6089 register unsigned char *new;
|
5647
|
6090 register int n;
|
|
6091 int osize, count;
|
|
6092
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6093 osize = SBYTES (val);
|
20621
|
6094
|
|
6095 /* Count the number of $ characters. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6096 for (n = osize, count = 0, old = SDATA (val); n > 0; n--)
|
5647
|
6097 if (*old++ == '$') count++;
|
|
6098 if (count > 0)
|
|
6099 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6100 old = SDATA (val);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6101 val = make_uninit_multibyte_string (SCHARS (val) + count,
|
20621
|
6102 osize + count);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6103 new = SDATA (val);
|
5647
|
6104 for (n = osize; n > 0; n--)
|
|
6105 if (*old != '$')
|
|
6106 *new++ = *old++;
|
|
6107 else
|
|
6108 {
|
|
6109 *new++ = '$';
|
|
6110 *new++ = '$';
|
|
6111 old++;
|
|
6112 }
|
|
6113 }
|
|
6114 return val;
|
|
6115 }
|
|
6116
|
45544
|
6117 static Lisp_Object
|
|
6118 read_file_name_cleanup (arg)
|
|
6119 Lisp_Object arg;
|
|
6120 {
|
46020
|
6121 return (current_buffer->directory = arg);
|
45544
|
6122 }
|
|
6123
|
230
|
6124 DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
|
40123
|
6125 3, 3, 0,
|
|
6126 doc: /* Internal subroutine for read-file-name. Do not call this. */)
|
|
6127 (string, dir, action)
|
230
|
6128 Lisp_Object string, dir, action;
|
|
6129 /* action is nil for complete, t for return list of completions,
|
|
6130 lambda for verify final value */
|
|
6131 {
|
|
6132 Lisp_Object name, specdir, realdir, val, orig_string;
|
1178
|
6133 int changed;
|
9955
|
6134 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|
1178
|
6135
|
40656
|
6136 CHECK_STRING (string);
|
16651
|
6137
|
1178
|
6138 realdir = dir;
|
|
6139 name = string;
|
|
6140 orig_string = Qnil;
|
|
6141 specdir = Qnil;
|
|
6142 changed = 0;
|
|
6143 /* No need to protect ACTION--we only compare it with t and nil. */
|
9955
|
6144 GCPRO5 (string, realdir, name, specdir, orig_string);
|
230
|
6145
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6146 if (SCHARS (string) == 0)
|
230
|
6147 {
|
|
6148 if (EQ (action, Qlambda))
|
1178
|
6149 {
|
|
6150 UNGCPRO;
|
|
6151 return Qnil;
|
|
6152 }
|
230
|
6153 }
|
|
6154 else
|
|
6155 {
|
|
6156 orig_string = string;
|
|
6157 string = Fsubstitute_in_file_name (string);
|
1178
|
6158 changed = NILP (Fstring_equal (string, orig_string));
|
230
|
6159 name = Ffile_name_nondirectory (string);
|
1178
|
6160 val = Ffile_name_directory (string);
|
|
6161 if (! NILP (val))
|
|
6162 realdir = Fexpand_file_name (val, realdir);
|
230
|
6163 }
|
|
6164
|
485
|
6165 if (NILP (action))
|
230
|
6166 {
|
|
6167 specdir = Ffile_name_directory (string);
|
74687
|
6168 val = Ffile_name_completion (name, realdir, Vread_file_name_predicate);
|
1178
|
6169 UNGCPRO;
|
9131
|
6170 if (!STRINGP (val))
|
230
|
6171 {
|
1178
|
6172 if (changed)
|
8454
b09c4b7a4729
(Fread_file_name_internal): Call double_dollars when `changed' is set.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6173 return double_dollars (string);
|
1178
|
6174 return val;
|
230
|
6175 }
|
|
6176
|
485
|
6177 if (!NILP (specdir))
|
230
|
6178 val = concat2 (specdir, val);
|
|
6179 #ifndef VMS
|
5647
|
6180 return double_dollars (val);
|
|
6181 #else /* not VMS */
|
1178
|
6182 return val;
|
5647
|
6183 #endif /* not VMS */
|
230
|
6184 }
|
1178
|
6185 UNGCPRO;
|
230
|
6186
|
|
6187 if (EQ (action, Qt))
|
45544
|
6188 {
|
|
6189 Lisp_Object all = Ffile_name_all_completions (name, realdir);
|
|
6190 Lisp_Object comp;
|
|
6191 int count;
|
|
6192
|
|
6193 if (NILP (Vread_file_name_predicate)
|
|
6194 || EQ (Vread_file_name_predicate, Qfile_exists_p))
|
|
6195 return all;
|
45551
|
6196
|
|
6197 #ifndef VMS
|
|
6198 if (EQ (Vread_file_name_predicate, Qfile_directory_p))
|
|
6199 {
|
49207
|
6200 /* Brute-force speed up for directory checking:
|
45551
|
6201 Discard strings which don't end in a slash. */
|
|
6202 for (comp = Qnil; CONSP (all); all = XCDR (all))
|
|
6203 {
|
|
6204 Lisp_Object tem = XCAR (all);
|
|
6205 int len;
|
74108
|
6206 if (STRINGP (tem)
|
|
6207 && (len = SBYTES (tem), len > 0)
|
|
6208 && IS_DIRECTORY_SEP (SREF (tem, len-1)))
|
45551
|
6209 comp = Fcons (tem, comp);
|
|
6210 }
|
|
6211 }
|
|
6212 else
|
|
6213 #endif
|
|
6214 {
|
|
6215 /* Must do it the hard (and slow) way. */
|
67337
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6216 Lisp_Object tem;
|
45551
|
6217 GCPRO3 (all, comp, specdir);
|
46293
|
6218 count = SPECPDL_INDEX ();
|
45551
|
6219 record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
|
|
6220 current_buffer->directory = realdir;
|
|
6221 for (comp = Qnil; CONSP (all); all = XCDR (all))
|
67337
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6222 {
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6223 tem = call1 (Vread_file_name_predicate, XCAR (all));
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6224 if (!NILP (tem))
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6225 comp = Fcons (XCAR (all), comp);
|
2fdf240a514d
(internal_delete_file, Fread_file_name_internal): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6226 }
|
45551
|
6227 unbind_to (count, Qnil);
|
|
6228 UNGCPRO;
|
|
6229 }
|
45544
|
6230 return Fnreverse (comp);
|
|
6231 }
|
|
6232
|
230
|
6233 /* Only other case actually used is ACTION = lambda */
|
|
6234 #ifdef VMS
|
|
6235 /* Supposedly this helps commands such as `cd' that read directory names,
|
|
6236 but can someone explain how it helps them? -- RMS */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6237 if (SCHARS (name) == 0)
|
230
|
6238 return Qt;
|
|
6239 #endif /* VMS */
|
53764
|
6240 string = Fexpand_file_name (string, dir);
|
45544
|
6241 if (!NILP (Vread_file_name_predicate))
|
|
6242 return call1 (Vread_file_name_predicate, string);
|
230
|
6243 return Ffile_exists_p (string);
|
|
6244 }
|
|
6245
|
57942
|
6246 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
|
|
6247 Snext_read_file_uses_dialog_p, 0, 0, 0,
|
|
6248 doc: /* Return t if a call to `read-file-name' will use a dialog.
|
|
6249 The return value is only relevant for a call to `read-file-name' that happens
|
|
6250 before any other event (mouse or keypress) is handeled. */)
|
|
6251 ()
|
|
6252 {
|
59146
|
6253 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
|
57942
|
6254 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
|
|
6255 && use_dialog_box
|
|
6256 && use_file_dialog
|
|
6257 && have_menus_p ())
|
|
6258 return Qt;
|
|
6259 #endif
|
|
6260 return Qnil;
|
|
6261 }
|
57955
|
6262
|
45544
|
6263 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
|
40123
|
6264 doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
|
|
6265 Value is not expanded---you must call `expand-file-name' yourself.
|
53764
|
6266 Default name to DEFAULT-FILENAME if user exits the minibuffer with
|
|
6267 the same non-empty string that was inserted by this function.
|
40123
|
6268 (If DEFAULT-FILENAME is omitted, the visited file name is used,
|
|
6269 except that if INITIAL is specified, that combined with DIR is used.)
|
53764
|
6270 If the user exits with an empty minibuffer, this function returns
|
|
6271 an empty string. (This can only happen if the user erased the
|
|
6272 pre-inserted contents or if `insert-default-directory' is nil.)
|
40123
|
6273 Fourth arg MUSTMATCH non-nil means require existing file's name.
|
|
6274 Non-nil and non-t means also require confirmation after completion.
|
|
6275 Fifth arg INITIAL specifies text to start with.
|
53764
|
6276 If optional sixth arg PREDICATE is non-nil, possible completions and
|
|
6277 the resulting file name must satisfy (funcall PREDICATE NAME).
|
|
6278 DIR should be an absolute directory name. It defaults to the value of
|
|
6279 `default-directory'.
|
40123
|
6280
|
|
6281 If this command was invoked with the mouse, use a file dialog box if
|
|
6282 `use-dialog-box' is non-nil, and the window system or X toolkit in use
|
56667
|
6283 provides a file dialog box.
|
|
6284
|
|
6285 See also `read-file-name-completion-ignore-case'
|
|
6286 and `read-file-name-function'. */)
|
45544
|
6287 (prompt, dir, default_filename, mustmatch, initial, predicate)
|
|
6288 Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
|
230
|
6289 {
|
24712
|
6290 Lisp_Object val, insdef, tem;
|
230
|
6291 struct gcpro gcpro1, gcpro2;
|
|
6292 register char *homedir;
|
50196
|
6293 Lisp_Object decoded_homedir;
|
20897
|
6294 int replace_in_history = 0;
|
|
6295 int add_to_history = 0;
|
230
|
6296 int count;
|
|
6297
|
485
|
6298 if (NILP (dir))
|
230
|
6299 dir = current_buffer->directory;
|
55741
|
6300 if (NILP (Ffile_name_absolute_p (dir)))
|
|
6301 dir = Fexpand_file_name (dir, Qnil);
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
6302 if (NILP (default_filename))
|
55741
|
6303 default_filename
|
|
6304 = (!NILP (initial)
|
|
6305 ? Fexpand_file_name (initial, dir)
|
|
6306 : current_buffer->filename);
|
230
|
6307
|
|
6308 /* If dir starts with user's homedir, change that to ~. */
|
|
6309 homedir = (char *) egetenv ("HOME");
|
15097
|
6310 #ifdef DOS_NT
|
34104
|
6311 /* homedir can be NULL in temacs, since Vprocess_environment is not
|
|
6312 yet set up. We shouldn't crash in that case. */
|
|
6313 if (homedir != 0)
|
|
6314 {
|
|
6315 homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
|
|
6316 CORRECT_DIR_SEPS (homedir);
|
|
6317 }
|
15097
|
6318 #endif
|
50196
|
6319 if (homedir != 0)
|
|
6320 decoded_homedir
|
|
6321 = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir)));
|
230
|
6322 if (homedir != 0
|
9131
|
6323 && STRINGP (dir)
|
50196
|
6324 && !strncmp (SDATA (decoded_homedir), SDATA (dir),
|
|
6325 SBYTES (decoded_homedir))
|
|
6326 && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir))))
|
230
|
6327 {
|
50199
|
6328 dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil);
|
50196
|
6329 dir = concat2 (build_string ("~"), dir);
|
230
|
6330 }
|
24712
|
6331 /* Likewise for default_filename. */
|
|
6332 if (homedir != 0
|
|
6333 && STRINGP (default_filename)
|
50196
|
6334 && !strncmp (SDATA (decoded_homedir), SDATA (default_filename),
|
|
6335 SBYTES (decoded_homedir))
|
|
6336 && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir))))
|
24712
|
6337 {
|
|
6338 default_filename
|
50196
|
6339 = Fsubstring (default_filename,
|
50199
|
6340 make_number (SCHARS (decoded_homedir)), Qnil);
|
50196
|
6341 default_filename = concat2 (build_string ("~"), default_filename);
|
24712
|
6342 }
|
|
6343 if (!NILP (default_filename))
|
24909
|
6344 {
|
40656
|
6345 CHECK_STRING (default_filename);
|
24909
|
6346 default_filename = double_dollars (default_filename);
|
|
6347 }
|
230
|
6348
|
16651
|
6349 if (insert_default_directory && STRINGP (dir))
|
230
|
6350 {
|
|
6351 insdef = dir;
|
485
|
6352 if (!NILP (initial))
|
230
|
6353 {
|
863
|
6354 Lisp_Object args[2], pos;
|
230
|
6355
|
|
6356 args[0] = insdef;
|
|
6357 args[1] = initial;
|
|
6358 insdef = Fconcat (2, args);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6359 pos = make_number (SCHARS (double_dollars (dir)));
|
24712
|
6360 insdef = Fcons (double_dollars (insdef), pos);
|
230
|
6361 }
|
5647
|
6362 else
|
24712
|
6363 insdef = double_dollars (insdef);
|
230
|
6364 }
|
16651
|
6365 else if (STRINGP (initial))
|
24712
|
6366 insdef = Fcons (double_dollars (initial), make_number (0));
|
230
|
6367 else
|
24712
|
6368 insdef = Qnil;
|
230
|
6369
|
45544
|
6370 if (!NILP (Vread_file_name_function))
|
|
6371 {
|
|
6372 Lisp_Object args[7];
|
|
6373
|
|
6374 GCPRO2 (insdef, default_filename);
|
|
6375 args[0] = Vread_file_name_function;
|
|
6376 args[1] = prompt;
|
|
6377 args[2] = dir;
|
|
6378 args[3] = default_filename;
|
|
6379 args[4] = mustmatch;
|
|
6380 args[5] = initial;
|
|
6381 args[6] = predicate;
|
|
6382 RETURN_UNGCPRO (Ffuncall (7, args));
|
|
6383 }
|
|
6384
|
46293
|
6385 count = SPECPDL_INDEX ();
|
56340
|
6386 specbind (intern ("completion-ignore-case"),
|
|
6387 read_file_name_completion_ignore_case ? Qt : Qnil);
|
22658
|
6388 specbind (intern ("minibuffer-completing-file-name"), Qt);
|
49207
|
6389 specbind (intern ("read-file-name-predicate"),
|
45544
|
6390 (NILP (predicate) ? Qfile_exists_p : predicate));
|
22658
|
6391
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
6392 GCPRO2 (insdef, default_filename);
|
49549
|
6393
|
59146
|
6394 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
|
57942
|
6395 if (! NILP (Fnext_read_file_uses_dialog_p ()))
|
25006
|
6396 {
|
28117
|
6397 /* If DIR contains a file name, split it. */
|
|
6398 Lisp_Object file;
|
|
6399 file = Ffile_name_nondirectory (dir);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6400 if (SCHARS (file) && NILP (default_filename))
|
28117
|
6401 {
|
|
6402 default_filename = file;
|
|
6403 dir = Ffile_name_directory (dir);
|
|
6404 }
|
29312
|
6405 if (!NILP(default_filename))
|
|
6406 default_filename = Fexpand_file_name (default_filename, dir);
|
57868
|
6407 val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
|
|
6408 EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
|
25006
|
6409 add_to_history = 1;
|
|
6410 }
|
|
6411 else
|
|
6412 #endif
|
|
6413 val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
|
|
6414 dir, mustmatch, insdef,
|
|
6415 Qfile_name_history, default_filename, Qnil);
|
20897
|
6416
|
|
6417 tem = Fsymbol_value (Qfile_name_history);
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6418 if (CONSP (tem) && EQ (XCAR (tem), val))
|
20897
|
6419 replace_in_history = 1;
|
|
6420
|
|
6421 /* If Fcompleting_read returned the inserted default string itself
|
18861
|
6422 (rather than a new string with the same contents),
|
|
6423 it has to mean that the user typed RET with the minibuffer empty.
|
|
6424 In that case, we really want to return ""
|
|
6425 so that commands such as set-visited-file-name can distinguish. */
|
|
6426 if (EQ (val, default_filename))
|
20897
|
6427 {
|
|
6428 /* In this case, Fcompleting_read has not added an element
|
|
6429 to the history. Maybe we should. */
|
|
6430 if (! replace_in_history)
|
|
6431 add_to_history = 1;
|
|
6432
|
81284
|
6433 val = empty_unibyte_string;
|
20897
|
6434 }
|
230
|
6435
|
|
6436 unbind_to (count, Qnil);
|
|
6437 UNGCPRO;
|
485
|
6438 if (NILP (val))
|
230
|
6439 error ("No file name specified");
|
20897
|
6440
|
24712
|
6441 tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
|
20897
|
6442
|
14074
f15db8536fdd
(Ffile_name_directory, Ffile_name_nondirectory, Ffile_name_as_directory,
Erik Naggum <erik@naggum.no>
diff
changeset
|
6443 if (!NILP (tem) && !NILP (default_filename))
|
20897
|
6444 val = default_filename;
|
|
6445 val = Fsubstitute_in_file_name (val);
|
|
6446
|
|
6447 if (replace_in_history)
|
|
6448 /* Replace what Fcompleting_read added to the history
|
|
6449 with what we will actually return. */
|
59050
|
6450 {
|
|
6451 Lisp_Object val1 = double_dollars (val);
|
|
6452 tem = Fsymbol_value (Qfile_name_history);
|
60354
|
6453 if (history_delete_duplicates)
|
59050
|
6454 XSETCDR (tem, Fdelete (val1, XCDR(tem)));
|
|
6455 XSETCAR (tem, val1);
|
|
6456 }
|
20897
|
6457 else if (add_to_history)
|
230
|
6458 {
|
20897
|
6459 /* Add the value to the history--but not if it matches
|
|
6460 the last value already there. */
|
24712
|
6461 Lisp_Object val1 = double_dollars (val);
|
20897
|
6462 tem = Fsymbol_value (Qfile_name_history);
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
6463 if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
|
59050
|
6464 {
|
|
6465 if (history_delete_duplicates) tem = Fdelete (val1, tem);
|
|
6466 Fset (Qfile_name_history, Fcons (val1, tem));
|
|
6467 }
|
230
|
6468 }
|
49207
|
6469
|
20897
|
6470 return val;
|
230
|
6471 }
|
25006
|
6472
|
230
|
6473
|
21514
|
6474 void
|
23569
|
6475 init_fileio_once ()
|
|
6476 {
|
|
6477 /* Must be set before any path manipulation is performed. */
|
|
6478 XSETFASTINT (Vdirectory_sep_char, '/');
|
|
6479 }
|
|
6480
|
25006
|
6481
|
23569
|
6482 void
|
230
|
6483 syms_of_fileio ()
|
|
6484 {
|
61942
|
6485 Qoperations = intern ("operations");
|
1105
|
6486 Qexpand_file_name = intern ("expand-file-name");
|
10719
|
6487 Qsubstitute_in_file_name = intern ("substitute-in-file-name");
|
1105
|
6488 Qdirectory_file_name = intern ("directory-file-name");
|
|
6489 Qfile_name_directory = intern ("file-name-directory");
|
|
6490 Qfile_name_nondirectory = intern ("file-name-nondirectory");
|
1679
|
6491 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
|
1105
|
6492 Qfile_name_as_directory = intern ("file-name-as-directory");
|
843
|
6493 Qcopy_file = intern ("copy-file");
|
8227
|
6494 Qmake_directory_internal = intern ("make-directory-internal");
|
28697
|
6495 Qmake_directory = intern ("make-directory");
|
843
|
6496 Qdelete_directory = intern ("delete-directory");
|
|
6497 Qdelete_file = intern ("delete-file");
|
|
6498 Qrename_file = intern ("rename-file");
|
|
6499 Qadd_name_to_file = intern ("add-name-to-file");
|
|
6500 Qmake_symbolic_link = intern ("make-symbolic-link");
|
|
6501 Qfile_exists_p = intern ("file-exists-p");
|
|
6502 Qfile_executable_p = intern ("file-executable-p");
|
|
6503 Qfile_readable_p = intern ("file-readable-p");
|
16155
|
6504 Qfile_writable_p = intern ("file-writable-p");
|
843
|
6505 Qfile_symlink_p = intern ("file-symlink-p");
|
16155
|
6506 Qaccess_file = intern ("access-file");
|
843
|
6507 Qfile_directory_p = intern ("file-directory-p");
|
11599
|
6508 Qfile_regular_p = intern ("file-regular-p");
|
843
|
6509 Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
|
|
6510 Qfile_modes = intern ("file-modes");
|
|
6511 Qset_file_modes = intern ("set-file-modes");
|
55194
|
6512 Qset_file_times = intern ("set-file-times");
|
843
|
6513 Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
|
|
6514 Qinsert_file_contents = intern ("insert-file-contents");
|
|
6515 Qwrite_region = intern ("write-region");
|
|
6516 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
|
3560
|
6517 Qset_visited_file_modtime = intern ("set-visited-file-modtime");
|
51357
|
6518 Qauto_save_coding = intern ("auto-save-coding");
|
843
|
6519
|
61942
|
6520 staticpro (&Qoperations);
|
1679
|
6521 staticpro (&Qexpand_file_name);
|
10719
|
6522 staticpro (&Qsubstitute_in_file_name);
|
1679
|
6523 staticpro (&Qdirectory_file_name);
|
|
6524 staticpro (&Qfile_name_directory);
|
|
6525 staticpro (&Qfile_name_nondirectory);
|
|
6526 staticpro (&Qunhandled_file_name_directory);
|
|
6527 staticpro (&Qfile_name_as_directory);
|
863
|
6528 staticpro (&Qcopy_file);
|
8243
|
6529 staticpro (&Qmake_directory_internal);
|
28697
|
6530 staticpro (&Qmake_directory);
|
863
|
6531 staticpro (&Qdelete_directory);
|
|
6532 staticpro (&Qdelete_file);
|
|
6533 staticpro (&Qrename_file);
|
|
6534 staticpro (&Qadd_name_to_file);
|
|
6535 staticpro (&Qmake_symbolic_link);
|
|
6536 staticpro (&Qfile_exists_p);
|
|
6537 staticpro (&Qfile_executable_p);
|
|
6538 staticpro (&Qfile_readable_p);
|
16155
|
6539 staticpro (&Qfile_writable_p);
|
|
6540 staticpro (&Qaccess_file);
|
863
|
6541 staticpro (&Qfile_symlink_p);
|
|
6542 staticpro (&Qfile_directory_p);
|
11599
|
6543 staticpro (&Qfile_regular_p);
|
863
|
6544 staticpro (&Qfile_accessible_directory_p);
|
|
6545 staticpro (&Qfile_modes);
|
|
6546 staticpro (&Qset_file_modes);
|
55194
|
6547 staticpro (&Qset_file_times);
|
863
|
6548 staticpro (&Qfile_newer_than_file_p);
|
|
6549 staticpro (&Qinsert_file_contents);
|
|
6550 staticpro (&Qwrite_region);
|
|
6551 staticpro (&Qverify_visited_file_modtime);
|
16226
|
6552 staticpro (&Qset_visited_file_modtime);
|
51357
|
6553 staticpro (&Qauto_save_coding);
|
1679
|
6554
|
|
6555 Qfile_name_history = intern ("file-name-history");
|
|
6556 Fset (Qfile_name_history, Qnil);
|
863
|
6557 staticpro (&Qfile_name_history);
|
|
6558
|
230
|
6559 Qfile_error = intern ("file-error");
|
|
6560 staticpro (&Qfile_error);
|
15097
|
6561 Qfile_already_exists = intern ("file-already-exists");
|
230
|
6562 staticpro (&Qfile_already_exists);
|
17271
|
6563 Qfile_date_error = intern ("file-date-error");
|
|
6564 staticpro (&Qfile_date_error);
|
25595
|
6565 Qexcl = intern ("excl");
|
|
6566 staticpro (&Qexcl);
|
230
|
6567
|
9789
|
6568 #ifdef DOS_NT
|
5494
|
6569 Qfind_buffer_file_type = intern ("find-buffer-file-type");
|
|
6570 staticpro (&Qfind_buffer_file_type);
|
9789
|
6571 #endif /* DOS_NT */
|
5494
|
6572
|
19861
|
6573 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
|
40123
|
6574 doc: /* *Coding system for encoding file names.
|
41661
8151a2b431d0
(file-name-coding-system, default-file-name-coding-system): Doc fix (links
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
6575 If it is nil, `default-file-name-coding-system' (which see) is used. */);
|
19861
|
6576 Vfile_name_coding_system = Qnil;
|
|
6577
|
21048
|
6578 DEFVAR_LISP ("default-file-name-coding-system",
|
|
6579 &Vdefault_file_name_coding_system,
|
40123
|
6580 doc: /* Default coding system for encoding file names.
|
41661
8151a2b431d0
(file-name-coding-system, default-file-name-coding-system): Doc fix (links
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
6581 This variable is used only when `file-name-coding-system' is nil.
|
8151a2b431d0
(file-name-coding-system, default-file-name-coding-system): Doc fix (links
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
6582
|
8151a2b431d0
(file-name-coding-system, default-file-name-coding-system): Doc fix (links
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
6583 This variable is set/changed by the command `set-language-environment'.
|
40123
|
6584 User should not set this variable manually,
|
41661
8151a2b431d0
(file-name-coding-system, default-file-name-coding-system): Doc fix (links
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
6585 instead use `file-name-coding-system' to get a constant encoding
|
40123
|
6586 of file names regardless of the current language environment. */);
|
21048
|
6587 Vdefault_file_name_coding_system = Qnil;
|
|
6588
|
11053
|
6589 Qformat_decode = intern ("format-decode");
|
|
6590 staticpro (&Qformat_decode);
|
|
6591 Qformat_annotate_function = intern ("format-annotate-function");
|
|
6592 staticpro (&Qformat_annotate_function);
|
50546
|
6593 Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding");
|
|
6594 staticpro (&Qafter_insert_file_set_coding);
|
49207
|
6595
|
4841
|
6596 Qcar_less_than_car = intern ("car-less-than-car");
|
|
6597 staticpro (&Qcar_less_than_car);
|
|
6598
|
230
|
6599 Fput (Qfile_error, Qerror_conditions,
|
71977
|
6600 list2 (Qfile_error, Qerror));
|
230
|
6601 Fput (Qfile_error, Qerror_message,
|
|
6602 build_string ("File error"));
|
|
6603
|
|
6604 Fput (Qfile_already_exists, Qerror_conditions,
|
71977
|
6605 list3 (Qfile_already_exists, Qfile_error, Qerror));
|
230
|
6606 Fput (Qfile_already_exists, Qerror_message,
|
|
6607 build_string ("File already exists"));
|
|
6608
|
17271
|
6609 Fput (Qfile_date_error, Qerror_conditions,
|
71977
|
6610 list3 (Qfile_date_error, Qfile_error, Qerror));
|
17271
|
6611 Fput (Qfile_date_error, Qerror_message,
|
|
6612 build_string ("Cannot set file date"));
|
|
6613
|
45544
|
6614 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function,
|
|
6615 doc: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
|
|
6616 Vread_file_name_function = Qnil;
|
|
6617
|
|
6618 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate,
|
|
6619 doc: /* Current predicate used by `read-file-name-internal'. */);
|
|
6620 Vread_file_name_predicate = Qnil;
|
|
6621
|
56340
|
6622 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case,
|
|
6623 doc: /* *Non-nil means when reading a file name completion ignores case. */);
|
|
6624 #if defined VMS || defined DOS_NT || defined MAC_OS
|
|
6625 read_file_name_completion_ignore_case = 1;
|
|
6626 #else
|
|
6627 read_file_name_completion_ignore_case = 0;
|
|
6628 #endif
|
|
6629
|
230
|
6630 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
|
53764
|
6631 doc: /* *Non-nil means when reading a filename start with default dir in minibuffer.
|
|
6632 If the initial minibuffer contents are non-empty, you can usually
|
|
6633 request a default filename by typing RETURN without editing. For some
|
|
6634 commands, exiting with an empty minibuffer has a special meaning,
|
|
6635 such as making the current buffer visit no file in the case of
|
|
6636 `set-visited-file-name'.
|
|
6637 If this variable is non-nil, the minibuffer contents are always
|
|
6638 initially non-empty and typing RETURN without editing will fetch the
|
|
6639 default name, if one is provided. Note however that this default name
|
|
6640 is not necessarily the name originally inserted in the minibuffer, if
|
|
6641 that is just the default directory.
|
|
6642 If this variable is nil, the minibuffer often starts out empty. In
|
|
6643 that case you may have to explicitly fetch the next history element to
|
|
6644 request the default name. */);
|
230
|
6645 insert_default_directory = 1;
|
|
6646
|
|
6647 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm,
|
40123
|
6648 doc: /* *Non-nil means write new files with record format `stmlf'.
|
|
6649 nil means use format `var'. This variable is meaningful only on VMS. */);
|
230
|
6650 vms_stmlf_recfm = 0;
|
|
6651
|
15097
|
6652 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
|
40123
|
6653 doc: /* Directory separator character for built-in functions that return file names.
|
49191
|
6654 The value is always ?/. Don't use this variable, just use `/'. */);
|
15097
|
6655
|
850
|
6656 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
|
40123
|
6657 doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
|
|
6658 If a file name matches REGEXP, then all I/O on that file is done by calling
|
|
6659 HANDLER.
|
|
6660
|
|
6661 The first argument given to HANDLER is the name of the I/O primitive
|
|
6662 to be handled; the remaining arguments are the arguments that were
|
|
6663 passed to that primitive. For example, if you do
|
|
6664 (file-exists-p FILENAME)
|
|
6665 and FILENAME is handled by HANDLER, then HANDLER is called like this:
|
|
6666 (funcall HANDLER 'file-exists-p FILENAME)
|
|
6667 The function `find-file-name-handler' checks this list for a handler
|
|
6668 for its argument. */);
|
1178
|
6669 Vfile_name_handler_alist = Qnil;
|
|
6670
|
19641
|
6671 DEFVAR_LISP ("set-auto-coding-function",
|
|
6672 &Vset_auto_coding_function,
|
40123
|
6673 doc: /* If non-nil, a function to call to decide a coding system of file.
|
|
6674 Two arguments are passed to this function: the file name
|
|
6675 and the length of a file contents following the point.
|
|
6676 This function should return a coding system to decode the file contents.
|
|
6677 It should check the file name against `auto-coding-alist'.
|
|
6678 If no coding system is decided, it should check a coding system
|
|
6679 specified in the heading lines with the format:
|
|
6680 -*- ... coding: CODING-SYSTEM; ... -*-
|
|
6681 or local variable spec of the tailing lines with `coding:' tag. */);
|
19641
|
6682 Vset_auto_coding_function = Qnil;
|
19448
|
6683
|
4841
|
6684 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
|
40123
|
6685 doc: /* A list of functions to be called at the end of `insert-file-contents'.
|
50491
|
6686 Each is passed one argument, the number of characters inserted.
|
|
6687 It should return the new character count, and leave point the same.
|
|
6688 If `insert-file-contents' is intercepted by a handler from
|
|
6689 `file-name-handler-alist', that handler is responsible for calling the
|
|
6690 functions in `after-insert-file-functions' if appropriate. */);
|
4841
|
6691 Vafter_insert_file_functions = Qnil;
|
|
6692
|
|
6693 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
|
40123
|
6694 doc: /* A list of functions to be called at the start of `write-region'.
|
|
6695 Each is passed two arguments, START and END as for `write-region'.
|
|
6696 These are usually two numbers but not always; see the documentation
|
|
6697 for `write-region'. The function should return a list of pairs
|
|
6698 of the form (POSITION . STRING), consisting of strings to be effectively
|
|
6699 inserted at the specified positions of the file being written (1 means to
|
|
6700 insert before the first byte written). The POSITIONs must be sorted into
|
|
6701 increasing order. If there are several functions in the list, the several
|
45485
08b14b8f7bc2
(read_non_regular, Finsert_file_contents): Use BEG_BYTE.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
6702 lists are merged destructively. Alternatively, the function can return
|
50829
|
6703 with a different buffer current; in that case it should pay attention
|
|
6704 to the annotations returned by previous functions and listed in
|
|
6705 `write-region-annotations-so-far'.*/);
|
4841
|
6706 Vwrite_region_annotate_functions = Qnil;
|
50829
|
6707 staticpro (&Qwrite_region_annotate_functions);
|
|
6708 Qwrite_region_annotate_functions
|
|
6709 = intern ("write-region-annotate-functions");
|
4841
|
6710
|
8317
|
6711 DEFVAR_LISP ("write-region-annotations-so-far",
|
|
6712 &Vwrite_region_annotations_so_far,
|
40123
|
6713 doc: /* When an annotation function is called, this holds the previous annotations.
|
|
6714 These are the annotations made by other annotation functions
|
|
6715 that were already called. See also `write-region-annotate-functions'. */);
|
8317
|
6716 Vwrite_region_annotations_so_far = Qnil;
|
|
6717
|
6678
|
6718 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
|
40123
|
6719 doc: /* A list of file name handlers that temporarily should not be used.
|
|
6720 This applies only to the operation `inhibit-file-name-operation'. */);
|
6678
|
6721 Vinhibit_file_name_handlers = Qnil;
|
|
6722
|
7041
|
6723 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
|
40123
|
6724 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
|
7041
|
6725 Vinhibit_file_name_operation = Qnil;
|
|
6726
|
7445
|
6727 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
|
40123
|
6728 doc: /* File name in which we write a list of all auto save file names.
|
|
6729 This variable is initialized automatically from `auto-save-list-file-prefix'
|
|
6730 shortly after Emacs reads your `.emacs' file, if you have not yet given it
|
|
6731 a non-nil value. */);
|
7445
|
6732 Vauto_save_list_file_name = Qnil;
|
|
6733
|
65513
|
6734 #ifdef HAVE_FSYNC
|
|
6735 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
|
65547
da6fcded2062
(syms_of_fileio): Clarify docstring of `write-region-inhibit-fsync'.
Romain Francoise <romain@orebokech.com>
diff
changeset
|
6736 doc: /* *Non-nil means don't call fsync in `write-region'.
|
da6fcded2062
(syms_of_fileio): Clarify docstring of `write-region-inhibit-fsync'.
Romain Francoise <romain@orebokech.com>
diff
changeset
|
6737 This variable affects calls to `write-region' as well as save commands.
|
da6fcded2062
(syms_of_fileio): Clarify docstring of `write-region-inhibit-fsync'.
Romain Francoise <romain@orebokech.com>
diff
changeset
|
6738 A non-nil value may result in data loss! */);
|
65513
|
6739 write_region_inhibit_fsync = 0;
|
|
6740 #endif
|
|
6741
|
1679
|
6742 defsubr (&Sfind_file_name_handler);
|
230
|
6743 defsubr (&Sfile_name_directory);
|
|
6744 defsubr (&Sfile_name_nondirectory);
|
1679
|
6745 defsubr (&Sunhandled_file_name_directory);
|
230
|
6746 defsubr (&Sfile_name_as_directory);
|
|
6747 defsubr (&Sdirectory_file_name);
|
|
6748 defsubr (&Smake_temp_name);
|
|
6749 defsubr (&Sexpand_file_name);
|
|
6750 defsubr (&Ssubstitute_in_file_name);
|
|
6751 defsubr (&Scopy_file);
|
1533
|
6752 defsubr (&Smake_directory_internal);
|
686
|
6753 defsubr (&Sdelete_directory);
|
230
|
6754 defsubr (&Sdelete_file);
|
|
6755 defsubr (&Srename_file);
|
|
6756 defsubr (&Sadd_name_to_file);
|
|
6757 #ifdef S_IFLNK
|
|
6758 defsubr (&Smake_symbolic_link);
|
|
6759 #endif /* S_IFLNK */
|
|
6760 #ifdef VMS
|
|
6761 defsubr (&Sdefine_logical_name);
|
|
6762 #endif /* VMS */
|
|
6763 #ifdef HPUX_NET
|
|
6764 defsubr (&Ssysnetunam);
|
|
6765 #endif /* HPUX_NET */
|
|
6766 defsubr (&Sfile_name_absolute_p);
|
|
6767 defsubr (&Sfile_exists_p);
|
|
6768 defsubr (&Sfile_executable_p);
|
|
6769 defsubr (&Sfile_readable_p);
|
|
6770 defsubr (&Sfile_writable_p);
|
16155
|
6771 defsubr (&Saccess_file);
|
230
|
6772 defsubr (&Sfile_symlink_p);
|
|
6773 defsubr (&Sfile_directory_p);
|
536
|
6774 defsubr (&Sfile_accessible_directory_p);
|
9346
|
6775 defsubr (&Sfile_regular_p);
|
230
|
6776 defsubr (&Sfile_modes);
|
|
6777 defsubr (&Sset_file_modes);
|
55194
|
6778 defsubr (&Sset_file_times);
|
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6779 defsubr (&Sset_default_file_modes);
|
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6780 defsubr (&Sdefault_file_modes);
|
230
|
6781 defsubr (&Sfile_newer_than_file_p);
|
|
6782 defsubr (&Sinsert_file_contents);
|
|
6783 defsubr (&Swrite_region);
|
4841
|
6784 defsubr (&Scar_less_than_car);
|
230
|
6785 defsubr (&Sverify_visited_file_modtime);
|
|
6786 defsubr (&Sclear_visited_file_modtime);
|
2257
|
6787 defsubr (&Svisited_file_modtime);
|
230
|
6788 defsubr (&Sset_visited_file_modtime);
|
|
6789 defsubr (&Sdo_auto_save);
|
|
6790 defsubr (&Sset_buffer_auto_saved);
|
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
6791 defsubr (&Sclear_buffer_auto_save_failure);
|
230
|
6792 defsubr (&Srecent_auto_save_p);
|
|
6793
|
|
6794 defsubr (&Sread_file_name_internal);
|
|
6795 defsubr (&Sread_file_name);
|
57942
|
6796 defsubr (&Snext_read_file_uses_dialog_p);
|
689
|
6797
|
74398
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
6798 #ifdef HAVE_SYNC
|
689
|
6799 defsubr (&Sunix_sync);
|
1204
|
6800 #endif
|
230
|
6801 }
|
52401
|
6802
|
|
6803 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
|
|
6804 (do not change this comment) */
|