Mercurial > emacs
annotate src/fileio.c @ 7894:d385199b26b6
(Fsingle_key_description): Allow strings as keys.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 15 Jun 1994 01:09:17 +0000 |
parents | aba3ffcc8f51 |
children | fb950b66d754 |
rev | line source |
---|---|
230 | 1 /* File IO for GNU Emacs. |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc. |
230 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
621 | 8 the Free Software Foundation; either version 2, or (at your option) |
230 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4483
diff
changeset
|
20 #include <config.h> |
230 | 21 |
22 #include <sys/types.h> | |
23 #include <sys/stat.h> | |
372 | 24 |
6862
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
25 #ifdef HAVE_UNISTD_H |
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
26 #include <unistd.h> |
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
27 #endif |
653504b6b5dd
[HAVE_UNISTD_H]: Include unistd.h.
Richard M. Stallman <rms@gnu.org>
parents:
6678
diff
changeset
|
28 |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
29 #if !defined (S_ISLNK) && defined (S_IFLNK) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
31 #endif |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
32 |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
33 #if !defined (S_ISREG) && defined (S_IFREG) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
35 #endif |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
36 |
372 | 37 #ifdef VMS |
564 | 38 #include "vms-pwd.h" |
372 | 39 #else |
230 | 40 #include <pwd.h> |
372 | 41 #endif |
42 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
43 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
44 #include "msdos.h" |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
45 #include <sys/param.h> |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
46 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
47 |
230 | 48 #include <ctype.h> |
372 | 49 |
50 #ifdef VMS | |
5877 | 51 #include "vmsdir.h" |
372 | 52 #include <perror.h> |
53 #include <stddef.h> | |
54 #include <string.h> | |
55 #endif | |
56 | |
230 | 57 #include <errno.h> |
58 | |
372 | 59 #ifndef vax11c |
230 | 60 extern int errno; |
61 #endif | |
62 | |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
63 extern char *strerror (); |
230 | 64 |
65 #ifdef APOLLO | |
66 #include <sys/time.h> | |
67 #endif | |
68 | |
2280
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
69 #ifndef USG |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
70 #ifndef VMS |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
71 #ifndef BSD4_1 |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
72 #define HAVE_FSYNC |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
73 #endif |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
74 #endif |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
75 #endif |
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
76 |
230 | 77 #include "lisp.h" |
1299
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
78 #include "intervals.h" |
230 | 79 #include "buffer.h" |
80 #include "window.h" | |
81 | |
82 #ifdef VMS | |
83 #include <file.h> | |
84 #include <rmsdef.h> | |
85 #include <fab.h> | |
86 #include <nam.h> | |
87 #endif | |
88 | |
564 | 89 #include "systime.h" |
230 | 90 |
91 #ifdef HPUX | |
92 #include <netio.h> | |
350 | 93 #ifndef HPUX8 |
3410
47b51faf6c4e
[HPUX9]: Don't include errnet.h.
Richard M. Stallman <rms@gnu.org>
parents:
3032
diff
changeset
|
94 #ifndef HPUX9 |
230 | 95 #include <errnet.h> |
96 #endif | |
350 | 97 #endif |
3410
47b51faf6c4e
[HPUX9]: Don't include errnet.h.
Richard M. Stallman <rms@gnu.org>
parents:
3032
diff
changeset
|
98 #endif |
230 | 99 |
100 #ifndef O_WRONLY | |
101 #define O_WRONLY 1 | |
102 #endif | |
103 | |
104 #define min(a, b) ((a) < (b) ? (a) : (b)) | |
105 #define max(a, b) ((a) > (b) ? (a) : (b)) | |
106 | |
107 /* Nonzero during writing of auto-save files */ | |
108 int auto_saving; | |
109 | |
110 /* Set by auto_save_1 to mode of original file so Fwrite_region will create | |
111 a new file with the same mode as the original */ | |
112 int auto_save_mode_bits; | |
113 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
114 /* Alist of elements (REGEXP . HANDLER) for file names |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
115 whose I/O is done with a special handler. */ |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
116 Lisp_Object Vfile_name_handler_alist; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
117 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
118 /* Functions to be called to process text properties in inserted file. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
119 Lisp_Object Vafter_insert_file_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
120 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
121 /* Functions to be called to create text property annotations for file. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
122 Lisp_Object Vwrite_region_annotate_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
123 |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
124 /* File name in which we write a list of all our auto save files. */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
125 Lisp_Object Vauto_save_list_file_name; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
126 |
230 | 127 /* Nonzero means, when reading a filename in the minibuffer, |
128 start out by inserting the default directory into the minibuffer. */ | |
129 int insert_default_directory; | |
130 | |
131 /* On VMS, nonzero means write new files with record format stmlf. | |
132 Zero means use var format. */ | |
133 int vms_stmlf_recfm; | |
134 | |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
135 /* These variables describe handlers that have "already" had a chance |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
136 to handle the current operation. |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
137 |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
138 Vinhibit_file_name_handlers is a list of file name handlers. |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
139 Vinhibit_file_name_operation is the operation being handled. |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
140 If we try to handle that operation, we ignore those handlers. */ |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
141 |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
142 static Lisp_Object Vinhibit_file_name_handlers; |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
143 static Lisp_Object Vinhibit_file_name_operation; |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
144 |
230 | 145 Lisp_Object Qfile_error, Qfile_already_exists; |
146 | |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
147 Lisp_Object Qfile_name_history; |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
148 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
149 Lisp_Object Qcar_less_than_car; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
150 |
230 | 151 report_file_error (string, data) |
152 char *string; | |
153 Lisp_Object data; | |
154 { | |
155 Lisp_Object errstring; | |
156 | |
5529
708b422cf8df
(report_file_error): Use strerror instead of sys_errlist.
Roland McGrath <roland@gnu.org>
parents:
5517
diff
changeset
|
157 errstring = build_string (strerror (errno)); |
230 | 158 |
159 /* System error messages are capitalized. Downcase the initial | |
160 unless it is followed by a slash. */ | |
161 if (XSTRING (errstring)->data[1] != '/') | |
162 XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]); | |
163 | |
164 while (1) | |
165 Fsignal (Qfile_error, | |
166 Fcons (build_string (string), Fcons (errstring, data))); | |
167 } | |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
168 |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
169 close_file_unwind (fd) |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
170 Lisp_Object fd; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
171 { |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
172 close (XFASTINT (fd)); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
173 } |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
174 |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
175 /* Restore point, having saved it as a marker. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
176 |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
177 restore_point_unwind (location) |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
178 Lisp_Object location; |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
179 { |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
180 SET_PT (marker_position (location)); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
181 Fset_marker (location, Qnil, Qnil); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
182 } |
230 | 183 |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
184 Lisp_Object Qexpand_file_name; |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
185 Lisp_Object Qdirectory_file_name; |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
186 Lisp_Object Qfile_name_directory; |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
187 Lisp_Object Qfile_name_nondirectory; |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
188 Lisp_Object Qunhandled_file_name_directory; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
189 Lisp_Object Qfile_name_as_directory; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
190 Lisp_Object Qcopy_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
191 Lisp_Object Qmake_directory; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
192 Lisp_Object Qdelete_directory; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
193 Lisp_Object Qdelete_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
194 Lisp_Object Qrename_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
195 Lisp_Object Qadd_name_to_file; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
196 Lisp_Object Qmake_symbolic_link; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
197 Lisp_Object Qfile_exists_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
198 Lisp_Object Qfile_executable_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
199 Lisp_Object Qfile_readable_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
200 Lisp_Object Qfile_symlink_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
201 Lisp_Object Qfile_writable_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
202 Lisp_Object Qfile_directory_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
203 Lisp_Object Qfile_accessible_directory_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
204 Lisp_Object Qfile_modes; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
205 Lisp_Object Qset_file_modes; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
206 Lisp_Object Qfile_newer_than_file_p; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
207 Lisp_Object Qinsert_file_contents; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
208 Lisp_Object Qwrite_region; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
209 Lisp_Object Qverify_visited_file_modtime; |
3560
95021dcb923b
(syms_of_fileio): Set up Qset_visited_file_modtime.
Richard M. Stallman <rms@gnu.org>
parents:
3415
diff
changeset
|
210 Lisp_Object Qset_visited_file_modtime; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
211 |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
212 DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0, |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
213 "Return FILENAME's handler function for OPERATION, if it has one.\n\ |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
214 Otherwise, return nil.\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
215 A file name is handled if one of the regular expressions in\n\ |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
216 `file-name-handler-alist' matches it.\n\n\ |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
217 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\ |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
218 any handlers that are members of `inhibit-file-name-handlers',\n\ |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
219 but we still do run any other handlers. This lets handlers\n\ |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
220 use the standard functions without calling themselves recursively.") |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
221 (filename, operation) |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
222 Lisp_Object filename, operation; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
223 { |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
224 /* This function must not munge the match data. */ |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
225 Lisp_Object chain, inhibited_handlers; |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
226 |
2895
1ed91566882a
* fileio.c (Ffind_file_name_handler): Check that FILENAME is a
Jim Blandy <jimb@redhat.com>
parents:
2741
diff
changeset
|
227 CHECK_STRING (filename, 0); |
1ed91566882a
* fileio.c (Ffind_file_name_handler): Check that FILENAME is a
Jim Blandy <jimb@redhat.com>
parents:
2741
diff
changeset
|
228 |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
229 if (EQ (operation, Vinhibit_file_name_operation)) |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
230 inhibited_handlers = Vinhibit_file_name_handlers; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
231 else |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
232 inhibited_handlers = Qnil; |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
233 |
848 | 234 for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
235 chain = XCONS (chain)->cdr) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
236 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
237 Lisp_Object elt; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
238 elt = XCONS (chain)->car; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
239 if (XTYPE (elt) == Lisp_Cons) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
240 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
241 Lisp_Object string; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
242 string = XCONS (elt)->car; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
243 if (XTYPE (string) == Lisp_String |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
244 && fast_string_match (string, filename) >= 0) |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
245 { |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
246 Lisp_Object handler, tem; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
247 |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
248 handler = XCONS (elt)->cdr; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
249 tem = Fmemq (handler, inhibited_handlers); |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
250 if (NILP (tem)) |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
251 return handler; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
252 } |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
253 } |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
254 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
255 QUIT; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
256 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
257 return Qnil; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
258 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
259 |
230 | 260 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, |
261 1, 1, 0, | |
262 "Return the directory component in file name NAME.\n\ | |
263 Return nil if NAME does not include a directory.\n\ | |
264 Otherwise return a directory spec.\n\ | |
265 Given a Unix syntax file name, returns a string ending in slash;\n\ | |
266 on VMS, perhaps instead a string ending in `:', `]' or `>'.") | |
267 (file) | |
268 Lisp_Object file; | |
269 { | |
270 register unsigned char *beg; | |
271 register unsigned char *p; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
272 Lisp_Object handler; |
230 | 273 |
274 CHECK_STRING (file, 0); | |
275 | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
276 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
277 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
278 handler = Ffind_file_name_handler (file, Qfile_name_directory); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
279 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
280 return call2 (handler, Qfile_name_directory, file); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
281 |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
282 #ifdef FILE_SYSTEM_CASE |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
283 file = FILE_SYSTEM_CASE (file); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
284 #endif |
230 | 285 beg = XSTRING (file)->data; |
286 p = beg + XSTRING (file)->size; | |
287 | |
288 while (p != beg && p[-1] != '/' | |
289 #ifdef VMS | |
290 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' | |
291 #endif /* VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
292 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
293 && p[-1] != ':' |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
294 #endif |
230 | 295 ) p--; |
296 | |
297 if (p == beg) | |
298 return Qnil; | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
299 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
300 /* Expansion of "c:" to drive and default directory. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
301 if (p == beg + 2 && beg[1] == ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
302 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
303 int drive = (*beg) - 'a'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
304 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
305 unsigned char *res = alloca (MAXPATHLEN + 5); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
306 if (getdefdir (drive + 1, res + 2)) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
307 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
308 res[0] = drive + 'a'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
309 res[1] = ':'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
310 if (res[strlen (res) - 1] != '/') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
311 strcat (res, "/"); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
312 beg = res; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
313 p = beg + strlen (beg); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
314 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
315 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
316 #endif |
230 | 317 return make_string (beg, p - beg); |
318 } | |
319 | |
320 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory, | |
321 1, 1, 0, | |
322 "Return file name NAME sans its directory.\n\ | |
323 For example, in a Unix-syntax file name,\n\ | |
324 this is everything after the last slash,\n\ | |
325 or the entire name if it contains no slash.") | |
326 (file) | |
327 Lisp_Object file; | |
328 { | |
329 register unsigned char *beg, *p, *end; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
330 Lisp_Object handler; |
230 | 331 |
332 CHECK_STRING (file, 0); | |
333 | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
334 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
335 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
336 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
337 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
338 return call2 (handler, Qfile_name_nondirectory, file); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
339 |
230 | 340 beg = XSTRING (file)->data; |
341 end = p = beg + XSTRING (file)->size; | |
342 | |
343 while (p != beg && p[-1] != '/' | |
344 #ifdef VMS | |
345 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' | |
346 #endif /* VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
347 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
348 && p[-1] != ':' |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
349 #endif |
230 | 350 ) p--; |
351 | |
352 return make_string (p, end - p); | |
353 } | |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
354 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
355 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0, |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
356 "Return a directly usable directory name somehow associated with FILENAME.\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
357 A `directly usable' directory name is one that may be used without the\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
358 intervention of any file handler.\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
359 If FILENAME is a directly usable file itself, return\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
360 (file-name-directory FILENAME).\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
361 The `call-process' and `start-process' functions use this function to\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
362 get a current directory to run processes in.") |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
363 (filename) |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
364 Lisp_Object filename; |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
365 { |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
366 Lisp_Object handler; |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
367 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
368 /* If the file name has special constructs in it, |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
369 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
370 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
371 if (!NILP (handler)) |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
372 return call2 (handler, Qunhandled_file_name_directory, filename); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
373 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
374 return Ffile_name_directory (filename); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
375 } |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
376 |
230 | 377 |
378 char * | |
379 file_name_as_directory (out, in) | |
380 char *out, *in; | |
381 { | |
382 int size = strlen (in) - 1; | |
383 | |
384 strcpy (out, in); | |
385 | |
386 #ifdef VMS | |
387 /* Is it already a directory string? */ | |
388 if (in[size] == ':' || in[size] == ']' || in[size] == '>') | |
389 return out; | |
390 /* Is it a VMS directory file name? If so, hack VMS syntax. */ | |
391 else if (! index (in, '/') | |
392 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR")) | |
393 || (size > 3 && ! strcmp (&in[size - 3], ".dir")) | |
394 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4) | |
395 || ! strncmp (&in[size - 5], ".dir", 4)) | |
396 && (in[size - 1] == '.' || in[size - 1] == ';') | |
397 && in[size] == '1'))) | |
398 { | |
399 register char *p, *dot; | |
400 char brack; | |
401 | |
402 /* x.dir -> [.x] | |
403 dir:x.dir --> dir:[x] | |
404 dir:[x]y.dir --> dir:[x.y] */ | |
405 p = in + size; | |
406 while (p != in && *p != ':' && *p != '>' && *p != ']') p--; | |
407 if (p != in) | |
408 { | |
409 strncpy (out, in, p - in); | |
410 out[p - in] = '\0'; | |
411 if (*p == ':') | |
412 { | |
413 brack = ']'; | |
414 strcat (out, ":["); | |
415 } | |
416 else | |
417 { | |
418 brack = *p; | |
419 strcat (out, "."); | |
420 } | |
421 p++; | |
422 } | |
423 else | |
424 { | |
425 brack = ']'; | |
426 strcpy (out, "[."); | |
427 } | |
372 | 428 dot = index (p, '.'); |
429 if (dot) | |
230 | 430 { |
431 /* blindly remove any extension */ | |
432 size = strlen (out) + (dot - p); | |
433 strncat (out, p, dot - p); | |
434 } | |
435 else | |
436 { | |
437 strcat (out, p); | |
438 size = strlen (out); | |
439 } | |
440 out[size++] = brack; | |
441 out[size] = '\0'; | |
442 } | |
443 #else /* not VMS */ | |
444 /* For Unix syntax, Append a slash if necessary */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
445 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
446 if (out[size] != ':' && out[size] != '/') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
447 #else |
230 | 448 if (out[size] != '/') |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
449 #endif |
230 | 450 strcat (out, "/"); |
451 #endif /* not VMS */ | |
452 return out; | |
453 } | |
454 | |
455 DEFUN ("file-name-as-directory", Ffile_name_as_directory, | |
456 Sfile_name_as_directory, 1, 1, 0, | |
457 "Return a string representing file FILENAME interpreted as a directory.\n\ | |
458 This operation exists because a directory is also a file, but its name as\n\ | |
459 a directory is different from its name as a file.\n\ | |
460 The result can be used as the value of `default-directory'\n\ | |
461 or passed as second argument to `expand-file-name'.\n\ | |
462 For a Unix-syntax file name, just appends a slash.\n\ | |
463 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") | |
464 (file) | |
465 Lisp_Object file; | |
466 { | |
467 char *buf; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
468 Lisp_Object handler; |
230 | 469 |
470 CHECK_STRING (file, 0); | |
485 | 471 if (NILP (file)) |
230 | 472 return Qnil; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
473 |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
474 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
475 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
476 handler = Ffind_file_name_handler (file, Qfile_name_as_directory); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
477 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
478 return call2 (handler, Qfile_name_as_directory, file); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
479 |
230 | 480 buf = (char *) alloca (XSTRING (file)->size + 10); |
481 return build_string (file_name_as_directory (buf, XSTRING (file)->data)); | |
482 } | |
483 | |
484 /* | |
485 * Convert from directory name to filename. | |
486 * On VMS: | |
487 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1 | |
488 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1 | |
489 * On UNIX, it's simple: just make sure there is a terminating / | |
490 | |
491 * Value is nonzero if the string output is different from the input. | |
492 */ | |
493 | |
494 directory_file_name (src, dst) | |
495 char *src, *dst; | |
496 { | |
497 long slen; | |
498 #ifdef VMS | |
499 long rlen; | |
500 char * ptr, * rptr; | |
501 char bracket; | |
502 struct FAB fab = cc$rms_fab; | |
503 struct NAM nam = cc$rms_nam; | |
504 char esa[NAM$C_MAXRSS]; | |
505 #endif /* VMS */ | |
506 | |
507 slen = strlen (src); | |
508 #ifdef VMS | |
509 if (! index (src, '/') | |
510 && (src[slen - 1] == ']' | |
511 || src[slen - 1] == ':' | |
512 || src[slen - 1] == '>')) | |
513 { | |
514 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */ | |
515 fab.fab$l_fna = src; | |
516 fab.fab$b_fns = slen; | |
517 fab.fab$l_nam = &nam; | |
518 fab.fab$l_fop = FAB$M_NAM; | |
519 | |
520 nam.nam$l_esa = esa; | |
521 nam.nam$b_ess = sizeof esa; | |
522 nam.nam$b_nop |= NAM$M_SYNCHK; | |
523 | |
524 /* We call SYS$PARSE to handle such things as [--] for us. */ | |
525 if (SYS$PARSE(&fab, 0, 0) == RMS$_NORMAL) | |
526 { | |
527 slen = nam.nam$b_esl; | |
528 if (esa[slen - 1] == ';' && esa[slen - 2] == '.') | |
529 slen -= 2; | |
530 esa[slen] = '\0'; | |
531 src = esa; | |
532 } | |
533 if (src[slen - 1] != ']' && src[slen - 1] != '>') | |
534 { | |
535 /* what about when we have logical_name:???? */ | |
536 if (src[slen - 1] == ':') | |
537 { /* Xlate logical name and see what we get */ | |
538 ptr = strcpy (dst, src); /* upper case for getenv */ | |
539 while (*ptr) | |
540 { | |
541 if ('a' <= *ptr && *ptr <= 'z') | |
542 *ptr -= 040; | |
543 ptr++; | |
544 } | |
545 dst[slen - 1] = 0; /* remove colon */ | |
546 if (!(src = egetenv (dst))) | |
547 return 0; | |
548 /* should we jump to the beginning of this procedure? | |
549 Good points: allows us to use logical names that xlate | |
550 to Unix names, | |
551 Bad points: can be a problem if we just translated to a device | |
552 name... | |
553 For now, I'll punt and always expect VMS names, and hope for | |
554 the best! */ | |
555 slen = strlen (src); | |
556 if (src[slen - 1] != ']' && src[slen - 1] != '>') | |
557 { /* no recursion here! */ | |
558 strcpy (dst, src); | |
559 return 0; | |
560 } | |
561 } | |
562 else | |
563 { /* not a directory spec */ | |
564 strcpy (dst, src); | |
565 return 0; | |
566 } | |
567 } | |
568 bracket = src[slen - 1]; | |
569 | |
570 /* If bracket is ']' or '>', bracket - 2 is the corresponding | |
571 opening bracket. */ | |
372 | 572 ptr = index (src, bracket - 2); |
573 if (ptr == 0) | |
230 | 574 { /* no opening bracket */ |
575 strcpy (dst, src); | |
576 return 0; | |
577 } | |
578 if (!(rptr = rindex (src, '.'))) | |
579 rptr = ptr; | |
580 slen = rptr - src; | |
581 strncpy (dst, src, slen); | |
582 dst[slen] = '\0'; | |
583 if (*rptr == '.') | |
584 { | |
585 dst[slen++] = bracket; | |
586 dst[slen] = '\0'; | |
587 } | |
588 else | |
589 { | |
590 /* If we have the top-level of a rooted directory (i.e. xx:[000000]), | |
591 then translate the device and recurse. */ | |
592 if (dst[slen - 1] == ':' | |
593 && dst[slen - 2] != ':' /* skip decnet nodes */ | |
594 && strcmp(src + slen, "[000000]") == 0) | |
595 { | |
596 dst[slen - 1] = '\0'; | |
597 if ((ptr = egetenv (dst)) | |
598 && (rlen = strlen (ptr) - 1) > 0 | |
599 && (ptr[rlen] == ']' || ptr[rlen] == '>') | |
600 && ptr[rlen - 1] == '.') | |
601 { | |
1358
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
602 char * buf = (char *) alloca (strlen (ptr) + 1); |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
603 strcpy (buf, ptr); |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
604 buf[rlen - 1] = ']'; |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
605 buf[rlen] = '\0'; |
aa32c275cbf9
(directory_file_name): Don't clobber the envvar
Richard M. Stallman <rms@gnu.org>
parents:
1299
diff
changeset
|
606 return directory_file_name (buf, dst); |
230 | 607 } |
608 else | |
609 dst[slen - 1] = ':'; | |
610 } | |
611 strcat (dst, "[000000]"); | |
612 slen += 8; | |
613 } | |
614 rptr++; | |
615 rlen = strlen (rptr) - 1; | |
616 strncat (dst, rptr, rlen); | |
617 dst[slen + rlen] = '\0'; | |
618 strcat (dst, ".DIR.1"); | |
619 return 1; | |
620 } | |
621 #endif /* VMS */ | |
622 /* Process as Unix format: just remove any final slash. | |
623 But leave "/" unchanged; do not change it to "". */ | |
624 strcpy (dst, src); | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
625 if (slen > 1 |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
626 && dst[slen - 1] == '/' |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
627 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
628 && dst[slen - 2] != ':' |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
629 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
630 ) |
230 | 631 dst[slen - 1] = 0; |
632 return 1; | |
633 } | |
634 | |
635 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, | |
636 1, 1, 0, | |
637 "Returns the file name of the directory named DIR.\n\ | |
638 This is the name of the file that holds the data for the directory DIR.\n\ | |
639 This operation exists because a directory is also a file, but its name as\n\ | |
640 a directory is different from its name as a file.\n\ | |
641 In Unix-syntax, this function just removes the final slash.\n\ | |
642 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\ | |
643 it returns a file name such as \"[X]Y.DIR.1\".") | |
644 (directory) | |
645 Lisp_Object directory; | |
646 { | |
647 char *buf; | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
648 Lisp_Object handler; |
230 | 649 |
650 CHECK_STRING (directory, 0); | |
651 | |
485 | 652 if (NILP (directory)) |
230 | 653 return Qnil; |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
654 |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
655 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
656 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
657 handler = Ffind_file_name_handler (directory, Qdirectory_file_name); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
658 if (!NILP (handler)) |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
659 return call2 (handler, Qdirectory_file_name, directory); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
660 |
230 | 661 #ifdef VMS |
662 /* 20 extra chars is insufficient for VMS, since we might perform a | |
663 logical name translation. an equivalence string can be up to 255 | |
664 chars long, so grab that much extra space... - sss */ | |
665 buf = (char *) alloca (XSTRING (directory)->size + 20 + 255); | |
666 #else | |
667 buf = (char *) alloca (XSTRING (directory)->size + 20); | |
668 #endif | |
669 directory_file_name (XSTRING (directory)->data, buf); | |
670 return build_string (buf); | |
671 } | |
672 | |
673 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, | |
674 "Generate temporary file name (string) starting with PREFIX (a string).\n\ | |
675 The Emacs process number forms part of the result,\n\ | |
676 so there is no danger of generating a name being used by another process.") | |
677 (prefix) | |
678 Lisp_Object prefix; | |
679 { | |
680 Lisp_Object val; | |
681 val = concat2 (prefix, build_string ("XXXXXX")); | |
682 mktemp (XSTRING (val)->data); | |
683 return val; | |
684 } | |
685 | |
686 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, | |
687 "Convert FILENAME to absolute, and canonicalize it.\n\ | |
688 Second arg DEFAULT is directory to start with if FILENAME is relative\n\ | |
689 (does not start with slash); if DEFAULT is nil or missing,\n\ | |
690 the current buffer's value of default-directory is used.\n\ | |
536 | 691 Path components that are `.' are removed, and \n\ |
692 path components followed by `..' are removed, along with the `..' itself;\n\ | |
693 note that these simplifications are done without checking the resulting\n\ | |
694 paths in the file system.\n\ | |
695 An initial `~/' expands to your home directory.\n\ | |
696 An initial `~USER/' expands to USER's home directory.\n\ | |
230 | 697 See also the function `substitute-in-file-name'.") |
698 (name, defalt) | |
699 Lisp_Object name, defalt; | |
700 { | |
701 unsigned char *nm; | |
702 | |
703 register unsigned char *newdir, *p, *o; | |
704 int tlen; | |
705 unsigned char *target; | |
706 struct passwd *pw; | |
707 #ifdef VMS | |
708 unsigned char * colon = 0; | |
709 unsigned char * close = 0; | |
710 unsigned char * slash = 0; | |
711 unsigned char * brack = 0; | |
712 int lbrack = 0, rbrack = 0; | |
713 int dots = 0; | |
714 #endif /* VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
715 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
716 int drive = -1; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
717 int relpath = 0; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
718 unsigned char *tmp, *defdir; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
719 #endif |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
720 Lisp_Object handler; |
230 | 721 |
722 CHECK_STRING (name, 0); | |
723 | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
724 /* If the file name has special constructs in it, |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
725 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
726 handler = Ffind_file_name_handler (name, Qexpand_file_name); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
727 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
728 return call3 (handler, Qexpand_file_name, name, defalt); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
729 |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
730 /* Use the buffer's default-directory if DEFALT is omitted. */ |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
731 if (NILP (defalt)) |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
732 defalt = current_buffer->directory; |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
733 CHECK_STRING (defalt, 1); |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
734 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
735 /* Make sure DEFALT is properly expanded. |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
736 It would be better to do this down below where we actually use |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
737 defalt. Unfortunately, calling Fexpand_file_name recursively |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
738 could invoke GC, and the strings might be relocated. This would |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
739 be annoying because we have pointers into strings lying around |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
740 that would need adjusting, and people would add new pointers to |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
741 the code and forget to adjust them, resulting in intermittent bugs. |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
742 Putting this call here avoids all that crud. |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
743 |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
744 The EQ test avoids infinite recursion. */ |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
745 if (! NILP (defalt) && !EQ (defalt, name) |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
746 /* This saves time in a common case. */ |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
747 && XSTRING (defalt)->data[0] != '/') |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
748 { |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
749 struct gcpro gcpro1; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
750 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
751 GCPRO1 (name); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
752 defalt = Fexpand_file_name (defalt, Qnil); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
753 UNGCPRO; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
754 } |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
755 |
230 | 756 #ifdef VMS |
757 /* Filenames on VMS are always upper case. */ | |
758 name = Fupcase (name); | |
759 #endif | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
760 #ifdef FILE_SYSTEM_CASE |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
761 name = FILE_SYSTEM_CASE (name); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
762 #endif |
230 | 763 |
764 nm = XSTRING (name)->data; | |
765 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
766 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
767 /* firstly, strip drive name. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
768 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
769 unsigned char *colon = rindex (nm, ':'); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
770 if (colon) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
771 if (nm == colon) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
772 nm++; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
773 else |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
774 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
775 drive = tolower (colon[-1]) - 'a'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
776 nm = colon + 1; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
777 if (*nm != '/') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
778 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
779 defdir = alloca (MAXPATHLEN + 1); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
780 relpath = getdefdir (drive + 1, defdir); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
781 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
782 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
783 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
784 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
785 |
230 | 786 /* If nm is absolute, flush ...// and detect /./ and /../. |
787 If no /./ or /../ we can return right away. */ | |
788 if ( | |
789 nm[0] == '/' | |
790 #ifdef VMS | |
791 || index (nm, ':') | |
792 #endif /* VMS */ | |
793 ) | |
794 { | |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
795 /* If it turns out that the filename we want to return is just a |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
796 suffix of FILENAME, we don't need to go through and edit |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
797 things; we just need to construct a new string using data |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
798 starting at the middle of FILENAME. If we set lose to a |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
799 non-zero value, that means we've discovered that we can't do |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
800 that cool trick. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
801 int lose = 0; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
802 |
230 | 803 p = nm; |
804 while (*p) | |
805 { | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
806 /* Since we know the path is absolute, we can assume that each |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
807 element starts with a "/". */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
808 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
809 /* "//" anywhere isn't necessarily hairy; we just start afresh |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
810 with the second slash. */ |
230 | 811 if (p[0] == '/' && p[1] == '/' |
812 #ifdef APOLLO | |
813 /* // at start of filename is meaningful on Apollo system */ | |
814 && nm != p | |
815 #endif /* APOLLO */ | |
816 ) | |
817 nm = p + 1; | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
818 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
819 /* "~" is hairy as the start of any path element. */ |
230 | 820 if (p[0] == '/' && p[1] == '~') |
821 nm = p + 1, lose = 1; | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
822 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
823 /* "." and ".." are hairy. */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
824 if (p[0] == '/' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
825 && p[1] == '.' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
826 && (p[2] == '/' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
827 || p[2] == 0 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
828 || (p[2] == '.' && (p[3] == '/' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
829 || p[3] == 0)))) |
230 | 830 lose = 1; |
831 #ifdef VMS | |
832 if (p[0] == '\\') | |
833 lose = 1; | |
834 if (p[0] == '/') { | |
835 /* if dev:[dir]/, move nm to / */ | |
836 if (!slash && p > nm && (brack || colon)) { | |
837 nm = (brack ? brack + 1 : colon + 1); | |
838 lbrack = rbrack = 0; | |
839 brack = 0; | |
840 colon = 0; | |
841 } | |
842 slash = p; | |
843 } | |
844 if (p[0] == '-') | |
845 #ifndef VMS4_4 | |
846 /* VMS pre V4.4,convert '-'s in filenames. */ | |
847 if (lbrack == rbrack) | |
848 { | |
849 if (dots < 2) /* this is to allow negative version numbers */ | |
850 p[0] = '_'; | |
851 } | |
852 else | |
853 #endif /* VMS4_4 */ | |
854 if (lbrack > rbrack && | |
855 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && | |
856 (p[1] == '.' || p[1] == ']' || p[1] == '>'))) | |
857 lose = 1; | |
858 #ifndef VMS4_4 | |
859 else | |
860 p[0] = '_'; | |
861 #endif /* VMS4_4 */ | |
862 /* count open brackets, reset close bracket pointer */ | |
863 if (p[0] == '[' || p[0] == '<') | |
864 lbrack++, brack = 0; | |
865 /* count close brackets, set close bracket pointer */ | |
866 if (p[0] == ']' || p[0] == '>') | |
867 rbrack++, brack = p; | |
868 /* detect ][ or >< */ | |
869 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) | |
870 lose = 1; | |
871 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') | |
872 nm = p + 1, lose = 1; | |
873 if (p[0] == ':' && (colon || slash)) | |
874 /* if dev1:[dir]dev2:, move nm to dev2: */ | |
875 if (brack) | |
876 { | |
877 nm = brack + 1; | |
878 brack = 0; | |
879 } | |
880 /* if /pathname/dev:, move nm to dev: */ | |
881 else if (slash) | |
882 nm = slash + 1; | |
883 /* if node::dev:, move colon following dev */ | |
884 else if (colon && colon[-1] == ':') | |
885 colon = p; | |
886 /* if dev1:dev2:, move nm to dev2: */ | |
887 else if (colon && colon[-1] != ':') | |
888 { | |
889 nm = colon + 1; | |
890 colon = 0; | |
891 } | |
892 if (p[0] == ':' && !colon) | |
893 { | |
894 if (p[1] == ':') | |
895 p++; | |
896 colon = p; | |
897 } | |
898 if (lbrack == rbrack) | |
899 if (p[0] == ';') | |
900 dots = 2; | |
901 else if (p[0] == '.') | |
902 dots++; | |
903 #endif /* VMS */ | |
904 p++; | |
905 } | |
906 if (!lose) | |
907 { | |
908 #ifdef VMS | |
909 if (index (nm, '/')) | |
910 return build_string (sys_translate_unix (nm)); | |
911 #endif /* VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
912 #ifndef MSDOS |
230 | 913 if (nm == XSTRING (name)->data) |
914 return name; | |
915 return build_string (nm); | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
916 #endif |
230 | 917 } |
918 } | |
919 | |
920 /* Now determine directory to start with and put it in newdir */ | |
921 | |
922 newdir = 0; | |
923 | |
924 if (nm[0] == '~') /* prefix ~ */ | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
925 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
926 if (nm[1] == '/' |
230 | 927 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
928 || nm[1] == ':' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
929 #endif /* VMS */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
930 || nm[1] == 0) /* ~ by itself */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
931 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
932 if (!(newdir = (unsigned char *) egetenv ("HOME"))) |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
933 newdir = (unsigned char *) ""; |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
934 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
935 dostounix_filename (newdir); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
936 #endif |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
937 nm++; |
230 | 938 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
939 nm++; /* Don't leave the slash in nm. */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
940 #endif /* VMS */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
941 } |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
942 else /* ~user/filename */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
943 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
944 for (p = nm; *p && (*p != '/' |
230 | 945 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
946 && *p != ':' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
947 #endif /* VMS */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
948 ); p++); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
949 o = (unsigned char *) alloca (p - nm + 1); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
950 bcopy ((char *) nm, o, p - nm); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
951 o [p - nm] = 0; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
952 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
953 pw = (struct passwd *) getpwnam (o + 1); |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
954 if (pw) |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
955 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
956 newdir = (unsigned char *) pw -> pw_dir; |
230 | 957 #ifdef VMS |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
958 nm = p + 1; /* skip the terminator */ |
230 | 959 #else |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
960 nm = p; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
961 #endif /* VMS */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
962 } |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
963 |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
964 /* If we don't find a user of that name, leave the name |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
965 unchanged; don't move nm forward to p. */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
966 } |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
967 } |
230 | 968 |
969 if (nm[0] != '/' | |
970 #ifdef VMS | |
971 && !index (nm, ':') | |
972 #endif /* not VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
973 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
974 && drive == -1 |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
975 #endif |
230 | 976 && !newdir) |
977 { | |
978 newdir = XSTRING (defalt)->data; | |
979 } | |
980 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
981 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
982 if (newdir == 0 && relpath) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
983 newdir = defdir; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
984 #endif |
372 | 985 if (newdir != 0) |
986 { | |
987 /* Get rid of any slash at the end of newdir. */ | |
988 int length = strlen (newdir); | |
2607
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
989 /* Adding `length > 1 &&' makes ~ expand into / when homedir |
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
990 is the root dir. People disagree about whether that is right. |
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
991 Anyway, we can't take the risk of this change now. */ |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
992 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
993 if (newdir[1] != ':' && length > 1) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
994 #endif |
2607
fcf578723758
(Fexpand_file_name): Undo last change--too risky for now.
Richard M. Stallman <rms@gnu.org>
parents:
2591
diff
changeset
|
995 if (newdir[length - 1] == '/') |
372 | 996 { |
997 unsigned char *temp = (unsigned char *) alloca (length); | |
998 bcopy (newdir, temp, length - 1); | |
999 temp[length - 1] = 0; | |
1000 newdir = temp; | |
1001 } | |
1002 tlen = length + 1; | |
1003 } | |
1004 else | |
1005 tlen = 0; | |
230 | 1006 |
372 | 1007 /* Now concatenate the directory and name to new space in the stack frame */ |
1008 tlen += strlen (nm) + 1; | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1009 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1010 /* Add reserved space for drive name. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1011 target = (unsigned char *) alloca (tlen + 2) + 2; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1012 #else |
230 | 1013 target = (unsigned char *) alloca (tlen); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1014 #endif |
230 | 1015 *target = 0; |
1016 | |
1017 if (newdir) | |
1018 { | |
1019 #ifndef VMS | |
1020 if (nm[0] == 0 || nm[0] == '/') | |
1021 strcpy (target, newdir); | |
1022 else | |
1023 #endif | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1024 file_name_as_directory (target, newdir); |
230 | 1025 } |
1026 | |
1027 strcat (target, nm); | |
1028 #ifdef VMS | |
1029 if (index (target, '/')) | |
1030 strcpy (target, sys_translate_unix (target)); | |
1031 #endif /* VMS */ | |
1032 | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1033 /* Now canonicalize by removing /. and /foo/.. if they appear. */ |
230 | 1034 |
1035 p = target; | |
1036 o = target; | |
1037 | |
1038 while (*p) | |
1039 { | |
1040 #ifdef VMS | |
1041 if (*p != ']' && *p != '>' && *p != '-') | |
1042 { | |
1043 if (*p == '\\') | |
1044 p++; | |
1045 *o++ = *p++; | |
1046 } | |
1047 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) | |
1048 /* brackets are offset from each other by 2 */ | |
1049 { | |
1050 p += 2; | |
1051 if (*p != '.' && *p != '-' && o[-1] != '.') | |
1052 /* convert [foo][bar] to [bar] */ | |
1053 while (o[-1] != '[' && o[-1] != '<') | |
1054 o--; | |
1055 else if (*p == '-' && *o != '.') | |
1056 *--p = '.'; | |
1057 } | |
1058 else if (p[0] == '-' && o[-1] == '.' && | |
1059 (p[1] == '.' || p[1] == ']' || p[1] == '>')) | |
1060 /* flush .foo.- ; leave - if stopped by '[' or '<' */ | |
1061 { | |
1062 do | |
1063 o--; | |
1064 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); | |
1065 if (p[1] == '.') /* foo.-.bar ==> bar*/ | |
1066 p += 2; | |
1067 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ | |
1068 p++, o--; | |
1069 /* else [foo.-] ==> [-] */ | |
1070 } | |
1071 else | |
1072 { | |
1073 #ifndef VMS4_4 | |
1074 if (*p == '-' && | |
1075 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && | |
1076 p[1] != ']' && p[1] != '>' && p[1] != '.') | |
1077 *p = '_'; | |
1078 #endif /* VMS4_4 */ | |
1079 *o++ = *p++; | |
1080 } | |
1081 #else /* not VMS */ | |
1082 if (*p != '/') | |
1083 { | |
1084 *o++ = *p++; | |
1085 } | |
1086 else if (!strncmp (p, "//", 2) | |
1087 #ifdef APOLLO | |
1088 /* // at start of filename is meaningful in Apollo system */ | |
1089 && o != target | |
1090 #endif /* APOLLO */ | |
1091 ) | |
1092 { | |
1093 o = target; | |
1094 p++; | |
1095 } | |
1589
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1096 else if (p[0] == '/' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1097 && p[1] == '.' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1098 && (p[2] == '/' |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1099 || p[2] == 0)) |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1100 { |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1101 /* If "/." is the entire filename, keep the "/". Otherwise, |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1102 just delete the whole "/.". */ |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1103 if (o == target && p[2] == '\0') |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1104 *o++ = *p; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1105 p += 2; |
6168f42d716c
* fileio.c (Fexpand_file_name): Don't fiddle with "/." if it's the
Jim Blandy <jimb@redhat.com>
parents:
1536
diff
changeset
|
1106 } |
230 | 1107 else if (!strncmp (p, "/..", 3) |
1108 /* `/../' is the "superroot" on certain file systems. */ | |
1109 && o != target | |
1110 && (p[3] == '/' || p[3] == 0)) | |
1111 { | |
1112 while (o != target && *--o != '/') | |
1113 ; | |
1114 #ifdef APOLLO | |
1115 if (o == target + 1 && o[-1] == '/' && o[0] == '/') | |
1116 ++o; | |
1117 else | |
1118 #endif /* APOLLO */ | |
1119 if (o == target && *o == '/') | |
1120 ++o; | |
1121 p += 3; | |
1122 } | |
1123 else | |
1124 { | |
1125 *o++ = *p++; | |
1126 } | |
1127 #endif /* not VMS */ | |
1128 } | |
1129 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1130 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1131 /* at last, set drive name. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1132 if (target[1] != ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1133 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1134 target -= 2; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1135 target[0] = (drive < 0 ? getdisk () : drive) + 'a'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1136 target[1] = ':'; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1137 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1138 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1139 |
230 | 1140 return make_string (target, o - target); |
1141 } | |
1142 #if 0 | |
732 | 1143 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. |
1144 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, | |
230 | 1145 "Convert FILENAME to absolute, and canonicalize it.\n\ |
1146 Second arg DEFAULT is directory to start with if FILENAME is relative\n\ | |
1147 (does not start with slash); if DEFAULT is nil or missing,\n\ | |
1148 the current buffer's value of default-directory is used.\n\ | |
1149 Filenames containing `.' or `..' as components are simplified;\n\ | |
1150 initial `~/' expands to your home directory.\n\ | |
1151 See also the function `substitute-in-file-name'.") | |
1152 (name, defalt) | |
1153 Lisp_Object name, defalt; | |
1154 { | |
1155 unsigned char *nm; | |
1156 | |
1157 register unsigned char *newdir, *p, *o; | |
1158 int tlen; | |
1159 unsigned char *target; | |
1160 struct passwd *pw; | |
1161 int lose; | |
1162 #ifdef VMS | |
1163 unsigned char * colon = 0; | |
1164 unsigned char * close = 0; | |
1165 unsigned char * slash = 0; | |
1166 unsigned char * brack = 0; | |
1167 int lbrack = 0, rbrack = 0; | |
1168 int dots = 0; | |
1169 #endif /* VMS */ | |
1170 | |
1171 CHECK_STRING (name, 0); | |
1172 | |
1173 #ifdef VMS | |
1174 /* Filenames on VMS are always upper case. */ | |
1175 name = Fupcase (name); | |
1176 #endif | |
1177 | |
1178 nm = XSTRING (name)->data; | |
1179 | |
1180 /* If nm is absolute, flush ...// and detect /./ and /../. | |
1181 If no /./ or /../ we can return right away. */ | |
1182 if ( | |
1183 nm[0] == '/' | |
1184 #ifdef VMS | |
1185 || index (nm, ':') | |
1186 #endif /* VMS */ | |
1187 ) | |
1188 { | |
1189 p = nm; | |
1190 lose = 0; | |
1191 while (*p) | |
1192 { | |
1193 if (p[0] == '/' && p[1] == '/' | |
1194 #ifdef APOLLO | |
1195 /* // at start of filename is meaningful on Apollo system */ | |
1196 && nm != p | |
1197 #endif /* APOLLO */ | |
1198 ) | |
1199 nm = p + 1; | |
1200 if (p[0] == '/' && p[1] == '~') | |
1201 nm = p + 1, lose = 1; | |
1202 if (p[0] == '/' && p[1] == '.' | |
1203 && (p[2] == '/' || p[2] == 0 | |
1204 || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) | |
1205 lose = 1; | |
1206 #ifdef VMS | |
1207 if (p[0] == '\\') | |
1208 lose = 1; | |
1209 if (p[0] == '/') { | |
1210 /* if dev:[dir]/, move nm to / */ | |
1211 if (!slash && p > nm && (brack || colon)) { | |
1212 nm = (brack ? brack + 1 : colon + 1); | |
1213 lbrack = rbrack = 0; | |
1214 brack = 0; | |
1215 colon = 0; | |
1216 } | |
1217 slash = p; | |
1218 } | |
1219 if (p[0] == '-') | |
1220 #ifndef VMS4_4 | |
1221 /* VMS pre V4.4,convert '-'s in filenames. */ | |
1222 if (lbrack == rbrack) | |
1223 { | |
1224 if (dots < 2) /* this is to allow negative version numbers */ | |
1225 p[0] = '_'; | |
1226 } | |
1227 else | |
1228 #endif /* VMS4_4 */ | |
1229 if (lbrack > rbrack && | |
1230 ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') && | |
1231 (p[1] == '.' || p[1] == ']' || p[1] == '>'))) | |
1232 lose = 1; | |
1233 #ifndef VMS4_4 | |
1234 else | |
1235 p[0] = '_'; | |
1236 #endif /* VMS4_4 */ | |
1237 /* count open brackets, reset close bracket pointer */ | |
1238 if (p[0] == '[' || p[0] == '<') | |
1239 lbrack++, brack = 0; | |
1240 /* count close brackets, set close bracket pointer */ | |
1241 if (p[0] == ']' || p[0] == '>') | |
1242 rbrack++, brack = p; | |
1243 /* detect ][ or >< */ | |
1244 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) | |
1245 lose = 1; | |
1246 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') | |
1247 nm = p + 1, lose = 1; | |
1248 if (p[0] == ':' && (colon || slash)) | |
1249 /* if dev1:[dir]dev2:, move nm to dev2: */ | |
1250 if (brack) | |
1251 { | |
1252 nm = brack + 1; | |
1253 brack = 0; | |
1254 } | |
1255 /* if /pathname/dev:, move nm to dev: */ | |
1256 else if (slash) | |
1257 nm = slash + 1; | |
1258 /* if node::dev:, move colon following dev */ | |
1259 else if (colon && colon[-1] == ':') | |
1260 colon = p; | |
1261 /* if dev1:dev2:, move nm to dev2: */ | |
1262 else if (colon && colon[-1] != ':') | |
1263 { | |
1264 nm = colon + 1; | |
1265 colon = 0; | |
1266 } | |
1267 if (p[0] == ':' && !colon) | |
1268 { | |
1269 if (p[1] == ':') | |
1270 p++; | |
1271 colon = p; | |
1272 } | |
1273 if (lbrack == rbrack) | |
1274 if (p[0] == ';') | |
1275 dots = 2; | |
1276 else if (p[0] == '.') | |
1277 dots++; | |
1278 #endif /* VMS */ | |
1279 p++; | |
1280 } | |
1281 if (!lose) | |
1282 { | |
1283 #ifdef VMS | |
1284 if (index (nm, '/')) | |
1285 return build_string (sys_translate_unix (nm)); | |
1286 #endif /* VMS */ | |
1287 if (nm == XSTRING (name)->data) | |
1288 return name; | |
1289 return build_string (nm); | |
1290 } | |
1291 } | |
1292 | |
1293 /* Now determine directory to start with and put it in NEWDIR */ | |
1294 | |
1295 newdir = 0; | |
1296 | |
1297 if (nm[0] == '~') /* prefix ~ */ | |
1298 if (nm[1] == '/' | |
1299 #ifdef VMS | |
1300 || nm[1] == ':' | |
1301 #endif /* VMS */ | |
1302 || nm[1] == 0)/* ~/filename */ | |
1303 { | |
1304 if (!(newdir = (unsigned char *) egetenv ("HOME"))) | |
1305 newdir = (unsigned char *) ""; | |
1306 nm++; | |
1307 #ifdef VMS | |
1308 nm++; /* Don't leave the slash in nm. */ | |
1309 #endif /* VMS */ | |
1310 } | |
1311 else /* ~user/filename */ | |
1312 { | |
1313 /* Get past ~ to user */ | |
1314 unsigned char *user = nm + 1; | |
1315 /* Find end of name. */ | |
1316 unsigned char *ptr = (unsigned char *) index (user, '/'); | |
1317 int len = ptr ? ptr - user : strlen (user); | |
1318 #ifdef VMS | |
1319 unsigned char *ptr1 = index (user, ':'); | |
1320 if (ptr1 != 0 && ptr1 - user < len) | |
1321 len = ptr1 - user; | |
1322 #endif /* VMS */ | |
1323 /* Copy the user name into temp storage. */ | |
1324 o = (unsigned char *) alloca (len + 1); | |
1325 bcopy ((char *) user, o, len); | |
1326 o[len] = 0; | |
1327 | |
1328 /* Look up the user name. */ | |
1329 pw = (struct passwd *) getpwnam (o + 1); | |
1330 if (!pw) | |
1331 error ("\"%s\" isn't a registered user", o + 1); | |
1332 | |
1333 newdir = (unsigned char *) pw->pw_dir; | |
1334 | |
1335 /* Discard the user name from NM. */ | |
1336 nm += len; | |
1337 } | |
1338 | |
1339 if (nm[0] != '/' | |
1340 #ifdef VMS | |
1341 && !index (nm, ':') | |
1342 #endif /* not VMS */ | |
1343 && !newdir) | |
1344 { | |
485 | 1345 if (NILP (defalt)) |
230 | 1346 defalt = current_buffer->directory; |
1347 CHECK_STRING (defalt, 1); | |
1348 newdir = XSTRING (defalt)->data; | |
1349 } | |
1350 | |
1351 /* Now concatenate the directory and name to new space in the stack frame */ | |
1352 | |
1353 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1; | |
1354 target = (unsigned char *) alloca (tlen); | |
1355 *target = 0; | |
1356 | |
1357 if (newdir) | |
1358 { | |
1359 #ifndef VMS | |
1360 if (nm[0] == 0 || nm[0] == '/') | |
1361 strcpy (target, newdir); | |
1362 else | |
1363 #endif | |
1364 file_name_as_directory (target, newdir); | |
1365 } | |
1366 | |
1367 strcat (target, nm); | |
1368 #ifdef VMS | |
1369 if (index (target, '/')) | |
1370 strcpy (target, sys_translate_unix (target)); | |
1371 #endif /* VMS */ | |
1372 | |
1373 /* Now canonicalize by removing /. and /foo/.. if they appear */ | |
1374 | |
1375 p = target; | |
1376 o = target; | |
1377 | |
1378 while (*p) | |
1379 { | |
1380 #ifdef VMS | |
1381 if (*p != ']' && *p != '>' && *p != '-') | |
1382 { | |
1383 if (*p == '\\') | |
1384 p++; | |
1385 *o++ = *p++; | |
1386 } | |
1387 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) | |
1388 /* brackets are offset from each other by 2 */ | |
1389 { | |
1390 p += 2; | |
1391 if (*p != '.' && *p != '-' && o[-1] != '.') | |
1392 /* convert [foo][bar] to [bar] */ | |
1393 while (o[-1] != '[' && o[-1] != '<') | |
1394 o--; | |
1395 else if (*p == '-' && *o != '.') | |
1396 *--p = '.'; | |
1397 } | |
1398 else if (p[0] == '-' && o[-1] == '.' && | |
1399 (p[1] == '.' || p[1] == ']' || p[1] == '>')) | |
1400 /* flush .foo.- ; leave - if stopped by '[' or '<' */ | |
1401 { | |
1402 do | |
1403 o--; | |
1404 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); | |
1405 if (p[1] == '.') /* foo.-.bar ==> bar*/ | |
1406 p += 2; | |
1407 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ | |
1408 p++, o--; | |
1409 /* else [foo.-] ==> [-] */ | |
1410 } | |
1411 else | |
1412 { | |
1413 #ifndef VMS4_4 | |
1414 if (*p == '-' && | |
1415 o[-1] != '[' && o[-1] != '<' && o[-1] != '.' && | |
1416 p[1] != ']' && p[1] != '>' && p[1] != '.') | |
1417 *p = '_'; | |
1418 #endif /* VMS4_4 */ | |
1419 *o++ = *p++; | |
1420 } | |
1421 #else /* not VMS */ | |
1422 if (*p != '/') | |
1423 { | |
1424 *o++ = *p++; | |
1425 } | |
1426 else if (!strncmp (p, "//", 2) | |
1427 #ifdef APOLLO | |
1428 /* // at start of filename is meaningful in Apollo system */ | |
1429 && o != target | |
1430 #endif /* APOLLO */ | |
1431 ) | |
1432 { | |
1433 o = target; | |
1434 p++; | |
1435 } | |
1436 else if (p[0] == '/' && p[1] == '.' && | |
1437 (p[2] == '/' || p[2] == 0)) | |
1438 p += 2; | |
1439 else if (!strncmp (p, "/..", 3) | |
1440 /* `/../' is the "superroot" on certain file systems. */ | |
1441 && o != target | |
1442 && (p[3] == '/' || p[3] == 0)) | |
1443 { | |
1444 while (o != target && *--o != '/') | |
1445 ; | |
1446 #ifdef APOLLO | |
1447 if (o == target + 1 && o[-1] == '/' && o[0] == '/') | |
1448 ++o; | |
1449 else | |
1450 #endif /* APOLLO */ | |
1451 if (o == target && *o == '/') | |
1452 ++o; | |
1453 p += 3; | |
1454 } | |
1455 else | |
1456 { | |
1457 *o++ = *p++; | |
1458 } | |
1459 #endif /* not VMS */ | |
1460 } | |
1461 | |
1462 return make_string (target, o - target); | |
1463 } | |
1464 #endif | |
1465 | |
1466 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, | |
1467 Ssubstitute_in_file_name, 1, 1, 0, | |
1468 "Substitute environment variables referred to in FILENAME.\n\ | |
1469 `$FOO' where FOO is an environment variable name means to substitute\n\ | |
1470 the value of that variable. The variable name should be terminated\n\ | |
1471 with a character not a letter, digit or underscore; otherwise, enclose\n\ | |
1472 the entire variable name in braces.\n\ | |
1473 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\ | |
1474 On VMS, `$' substitution is not done; this function does little and only\n\ | |
1475 duplicates what `expand-file-name' does.") | |
1476 (string) | |
1477 Lisp_Object string; | |
1478 { | |
1479 unsigned char *nm; | |
1480 | |
1481 register unsigned char *s, *p, *o, *x, *endp; | |
1482 unsigned char *target; | |
1483 int total = 0; | |
1484 int substituted = 0; | |
1485 unsigned char *xnm; | |
1486 | |
1487 CHECK_STRING (string, 0); | |
1488 | |
1489 nm = XSTRING (string)->data; | |
1490 endp = nm + XSTRING (string)->size; | |
1491 | |
1492 /* If /~ or // appears, discard everything through first slash. */ | |
1493 | |
1494 for (p = nm; p != endp; p++) | |
1495 { | |
1496 if ((p[0] == '~' || | |
1497 #ifdef APOLLO | |
1498 /* // at start of file name is meaningful in Apollo system */ | |
1499 (p[0] == '/' && p - 1 != nm) | |
1500 #else /* not APOLLO */ | |
1501 p[0] == '/' | |
1502 #endif /* not APOLLO */ | |
1503 ) | |
1504 && p != nm && | |
1505 #ifdef VMS | |
1506 (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' || | |
1507 #endif /* VMS */ | |
1508 p[-1] == '/') | |
1509 #ifdef VMS | |
1510 ) | |
1511 #endif /* VMS */ | |
1512 { | |
1513 nm = p; | |
1514 substituted = 1; | |
1515 } | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1516 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1517 if (p[0] && p[1] == ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1518 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1519 nm = p; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1520 substituted = 1; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1521 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1522 #endif /* MSDOS */ |
230 | 1523 } |
1524 | |
1525 #ifdef VMS | |
1526 return build_string (nm); | |
1527 #else | |
1528 | |
1529 /* See if any variables are substituted into the string | |
1530 and find the total length of their values in `total' */ | |
1531 | |
1532 for (p = nm; p != endp;) | |
1533 if (*p != '$') | |
1534 p++; | |
1535 else | |
1536 { | |
1537 p++; | |
1538 if (p == endp) | |
1539 goto badsubst; | |
1540 else if (*p == '$') | |
1541 { | |
1542 /* "$$" means a single "$" */ | |
1543 p++; | |
1544 total -= 1; | |
1545 substituted = 1; | |
1546 continue; | |
1547 } | |
1548 else if (*p == '{') | |
1549 { | |
1550 o = ++p; | |
1551 while (p != endp && *p != '}') p++; | |
1552 if (*p != '}') goto missingclose; | |
1553 s = p; | |
1554 } | |
1555 else | |
1556 { | |
1557 o = p; | |
1558 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
1559 s = p; | |
1560 } | |
1561 | |
1562 /* Copy out the variable name */ | |
1563 target = (unsigned char *) alloca (s - o + 1); | |
1564 strncpy (target, o, s - o); | |
1565 target[s - o] = 0; | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1566 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1567 strupr (target); /* $home == $HOME etc. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1568 #endif |
230 | 1569 |
1570 /* Get variable value */ | |
1571 o = (unsigned char *) egetenv (target); | |
1572 if (!o) goto badvar; | |
1573 total += strlen (o); | |
1574 substituted = 1; | |
1575 } | |
1576 | |
1577 if (!substituted) | |
1578 return string; | |
1579 | |
1580 /* If substitution required, recopy the string and do it */ | |
1581 /* Make space in stack frame for the new copy */ | |
1582 xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1); | |
1583 x = xnm; | |
1584 | |
1585 /* Copy the rest of the name through, replacing $ constructs with values */ | |
1586 for (p = nm; *p;) | |
1587 if (*p != '$') | |
1588 *x++ = *p++; | |
1589 else | |
1590 { | |
1591 p++; | |
1592 if (p == endp) | |
1593 goto badsubst; | |
1594 else if (*p == '$') | |
1595 { | |
1596 *x++ = *p++; | |
1597 continue; | |
1598 } | |
1599 else if (*p == '{') | |
1600 { | |
1601 o = ++p; | |
1602 while (p != endp && *p != '}') p++; | |
1603 if (*p != '}') goto missingclose; | |
1604 s = p++; | |
1605 } | |
1606 else | |
1607 { | |
1608 o = p; | |
1609 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
1610 s = p; | |
1611 } | |
1612 | |
1613 /* Copy out the variable name */ | |
1614 target = (unsigned char *) alloca (s - o + 1); | |
1615 strncpy (target, o, s - o); | |
1616 target[s - o] = 0; | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1617 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1618 strupr (target); /* $home == $HOME etc. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1619 #endif |
230 | 1620 |
1621 /* Get variable value */ | |
1622 o = (unsigned char *) egetenv (target); | |
1623 if (!o) | |
1624 goto badvar; | |
1625 | |
1626 strcpy (x, o); | |
1627 x += strlen (o); | |
1628 } | |
1629 | |
1630 *x = 0; | |
1631 | |
1632 /* If /~ or // appears, discard everything through first slash. */ | |
1633 | |
1634 for (p = xnm; p != x; p++) | |
1635 if ((p[0] == '~' || | |
1636 #ifdef APOLLO | |
1637 /* // at start of file name is meaningful in Apollo system */ | |
1638 (p[0] == '/' && p - 1 != xnm) | |
1639 #else /* not APOLLO */ | |
1640 p[0] == '/' | |
1641 #endif /* not APOLLO */ | |
1642 ) | |
1643 && p != nm && p[-1] == '/') | |
1644 xnm = p; | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1645 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1646 else if (p[0] && p[1] == ':') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1647 xnm = p; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1648 #endif |
230 | 1649 |
1650 return make_string (xnm, x - xnm); | |
1651 | |
1652 badsubst: | |
1653 error ("Bad format environment-variable substitution"); | |
1654 missingclose: | |
1655 error ("Missing \"}\" in environment-variable substitution"); | |
1656 badvar: | |
1657 error ("Substituting nonexistent environment variable \"%s\"", target); | |
1658 | |
1659 /* NOTREACHED */ | |
1660 #endif /* not VMS */ | |
1661 } | |
1662 | |
853 | 1663 /* A slightly faster and more convenient way to get |
4451
73b91cd2c55e
(expand_and_dir_to_file): Remove final / by copying abspath.
Richard M. Stallman <rms@gnu.org>
parents:
4395
diff
changeset
|
1664 (directory-file-name (expand-file-name FOO)). */ |
853 | 1665 |
230 | 1666 Lisp_Object |
1667 expand_and_dir_to_file (filename, defdir) | |
1668 Lisp_Object filename, defdir; | |
1669 { | |
1670 register Lisp_Object abspath; | |
1671 | |
1672 abspath = Fexpand_file_name (filename, defdir); | |
1673 #ifdef VMS | |
1674 { | |
1675 register int c = XSTRING (abspath)->data[XSTRING (abspath)->size - 1]; | |
1676 if (c == ':' || c == ']' || c == '>') | |
1677 abspath = Fdirectory_file_name (abspath); | |
1678 } | |
1679 #else | |
1680 /* Remove final slash, if any (unless path is root). | |
1681 stat behaves differently depending! */ | |
1682 if (XSTRING (abspath)->size > 1 | |
1683 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/') | |
4483
6894dd27c9ec
(expand_and_dir_to_file): Use Fdirectory_file_name.
Richard M. Stallman <rms@gnu.org>
parents:
4451
diff
changeset
|
1684 /* We cannot take shortcuts; they might be wrong for magic file names. */ |
6894dd27c9ec
(expand_and_dir_to_file): Use Fdirectory_file_name.
Richard M. Stallman <rms@gnu.org>
parents:
4451
diff
changeset
|
1685 abspath = Fdirectory_file_name (abspath); |
230 | 1686 #endif |
1687 return abspath; | |
1688 } | |
1689 | |
1690 barf_or_query_if_file_exists (absname, querystring, interactive) | |
1691 Lisp_Object absname; | |
1692 unsigned char *querystring; | |
1693 int interactive; | |
1694 { | |
1695 register Lisp_Object tem; | |
1696 struct gcpro gcpro1; | |
1697 | |
1698 if (access (XSTRING (absname)->data, 4) >= 0) | |
1699 { | |
1700 if (! interactive) | |
1701 Fsignal (Qfile_already_exists, | |
1702 Fcons (build_string ("File already exists"), | |
1703 Fcons (absname, Qnil))); | |
1704 GCPRO1 (absname); | |
1705 tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ", | |
1706 XSTRING (absname)->data, querystring)); | |
1707 UNGCPRO; | |
485 | 1708 if (NILP (tem)) |
230 | 1709 Fsignal (Qfile_already_exists, |
1710 Fcons (build_string ("File already exists"), | |
1711 Fcons (absname, Qnil))); | |
1712 } | |
1713 return; | |
1714 } | |
1715 | |
1716 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4, | |
410 | 1717 "fCopy file: \nFCopy %s to file: \np\nP", |
230 | 1718 "Copy FILE to NEWNAME. Both args must be strings.\n\ |
1719 Signals a `file-already-exists' error if file NEWNAME already exists,\n\ | |
1720 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\ | |
1721 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
1722 This is what happens in interactive use with M-x.\n\ | |
410 | 1723 Fourth arg KEEP-TIME non-nil means give the new file the same\n\ |
1724 last-modified time as the old one. (This works on only some systems.)\n\ | |
1725 A prefix arg makes KEEP-TIME non-nil.") | |
230 | 1726 (filename, newname, ok_if_already_exists, keep_date) |
1727 Lisp_Object filename, newname, ok_if_already_exists, keep_date; | |
1728 { | |
1729 int ifd, ofd, n; | |
1730 char buf[16 * 1024]; | |
1731 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1732 Lisp_Object handler; |
230 | 1733 struct gcpro gcpro1, gcpro2; |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1734 int count = specpdl_ptr - specpdl; |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
1735 Lisp_Object args[6]; |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1736 int input_file_statable_p; |
230 | 1737 |
1738 GCPRO2 (filename, newname); | |
1739 CHECK_STRING (filename, 0); | |
1740 CHECK_STRING (newname, 1); | |
1741 filename = Fexpand_file_name (filename, Qnil); | |
1742 newname = Fexpand_file_name (newname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1743 |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
1744 /* If the input file name has special constructs in it, |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1745 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1746 handler = Ffind_file_name_handler (filename, Qcopy_file); |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
1747 /* Likewise for output file name. */ |
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
1748 if (NILP (handler)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1749 handler = Ffind_file_name_handler (newname, Qcopy_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1750 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1751 RETURN_UNGCPRO (call5 (handler, Qcopy_file, filename, newname, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1752 ok_if_already_exists, keep_date)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1753 |
485 | 1754 if (NILP (ok_if_already_exists) |
230 | 1755 || XTYPE (ok_if_already_exists) == Lisp_Int) |
1756 barf_or_query_if_file_exists (newname, "copy to it", | |
1757 XTYPE (ok_if_already_exists) == Lisp_Int); | |
1758 | |
1759 ifd = open (XSTRING (filename)->data, 0); | |
1760 if (ifd < 0) | |
1761 report_file_error ("Opening input file", Fcons (filename, Qnil)); | |
1762 | |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1763 record_unwind_protect (close_file_unwind, make_number (ifd)); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1764 |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1765 /* We can only copy regular files and symbolic links. Other files are not |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1766 copyable by us. */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1767 input_file_statable_p = (fstat (ifd, &st) >= 0); |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1768 |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1769 #if defined (S_ISREG) && defined (S_ISLNK) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1770 if (input_file_statable_p) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1771 { |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1772 if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode))) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1773 { |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1774 #if defined (EISDIR) |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1775 /* Get a better looking error message. */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1776 errno = EISDIR; |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1777 #endif /* EISDIR */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1778 report_file_error ("Non-regular file", Fcons (filename, Qnil)); |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1779 } |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1780 } |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1781 #endif /* S_ISREG && S_ISLNK */ |
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1782 |
230 | 1783 #ifdef VMS |
1784 /* Create the copy file with the same record format as the input file */ | |
1785 ofd = sys_creat (XSTRING (newname)->data, 0666, ifd); | |
1786 #else | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1787 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1788 /* System's default file type was set to binary by _fmode in emacs.c. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1789 ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1790 #else /* not MSDOS */ |
230 | 1791 ofd = creat (XSTRING (newname)->data, 0666); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
1792 #endif /* not MSDOS */ |
230 | 1793 #endif /* VMS */ |
1794 if (ofd < 0) | |
595 | 1795 report_file_error ("Opening output file", Fcons (newname, Qnil)); |
230 | 1796 |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1797 record_unwind_protect (close_file_unwind, make_number (ofd)); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1798 |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1799 immediate_quit = 1; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1800 QUIT; |
230 | 1801 while ((n = read (ifd, buf, sizeof buf)) > 0) |
1802 if (write (ofd, buf, n) != n) | |
595 | 1803 report_file_error ("I/O error", Fcons (newname, Qnil)); |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1804 immediate_quit = 0; |
230 | 1805 |
7493
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1806 /* Closing the output clobbers the file times on some systems. */ |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1807 if (close (ofd) < 0) |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1808 report_file_error ("I/O error", Fcons (newname, Qnil)); |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1809 |
4879
1774c84aca2e
(Fcopy_file): Don't allow the copying of anything other than regular
Brian Fox <bfox@gnu.org>
parents:
4853
diff
changeset
|
1810 if (input_file_statable_p) |
230 | 1811 { |
485 | 1812 if (!NILP (keep_date)) |
230 | 1813 { |
564 | 1814 EMACS_TIME atime, mtime; |
1815 EMACS_SET_SECS_USECS (atime, st.st_atime, 0); | |
1816 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); | |
1817 EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime); | |
230 | 1818 } |
1819 #ifdef APOLLO | |
1820 if (!egetenv ("USE_DOMAIN_ACLS")) | |
1821 #endif | |
564 | 1822 chmod (XSTRING (newname)->data, st.st_mode & 07777); |
230 | 1823 } |
1824 | |
7493
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1825 close (ifd); |
f4fb8b913c5d
(Fcopy_file): Close output before setting its times.
Richard M. Stallman <rms@gnu.org>
parents:
7445
diff
changeset
|
1826 |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1827 /* Discard the unwind protects. */ |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1828 specpdl_ptr = specpdl + count; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
1829 |
230 | 1830 UNGCPRO; |
1831 return Qnil; | |
1832 } | |
1833 | |
1533
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
1834 DEFUN ("make-directory-internal", Fmake_directory_internal, |
1536
0877009e6324
* fileio.c (Fmake_directory_internal): Remove extra paren before the
Jim Blandy <jimb@redhat.com>
parents:
1533
diff
changeset
|
1835 Smake_directory_internal, 1, 1, 0, |
230 | 1836 "Create a directory. One argument, a file name string.") |
1837 (dirname) | |
1838 Lisp_Object dirname; | |
1839 { | |
1840 unsigned char *dir; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1841 Lisp_Object handler; |
230 | 1842 |
1843 CHECK_STRING (dirname, 0); | |
1844 dirname = Fexpand_file_name (dirname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1845 |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1846 handler = Ffind_file_name_handler (dirname, Qmake_directory); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1847 if (!NILP (handler)) |
1533
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
1848 return call3 (handler, Qmake_directory, dirname, Qnil); |
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
1849 |
230 | 1850 dir = XSTRING (dirname)->data; |
1851 | |
1852 if (mkdir (dir, 0777) != 0) | |
1853 report_file_error ("Creating directory", Flist (1, &dirname)); | |
1854 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1855 return Qnil; |
230 | 1856 } |
1857 | |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
648
diff
changeset
|
1858 DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", |
7611
f93e2ddcf8c2
(Fdelete_directory): Allow dir names as well as file names.
Richard M. Stallman <rms@gnu.org>
parents:
7595
diff
changeset
|
1859 "Delete a directory. One argument, a file name or directory name string.") |
230 | 1860 (dirname) |
1861 Lisp_Object dirname; | |
1862 { | |
1863 unsigned char *dir; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1864 Lisp_Object handler; |
230 | 1865 |
1866 CHECK_STRING (dirname, 0); | |
7611
f93e2ddcf8c2
(Fdelete_directory): Allow dir names as well as file names.
Richard M. Stallman <rms@gnu.org>
parents:
7595
diff
changeset
|
1867 dirname = Fdirectory_file_name (Fexpand_file_name (dirname, Qnil)); |
230 | 1868 dir = XSTRING (dirname)->data; |
1869 | |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1870 handler = Ffind_file_name_handler (dirname, Qdelete_directory); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1871 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1872 return call2 (handler, Qdelete_directory, dirname); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1873 |
230 | 1874 if (rmdir (dir) != 0) |
1875 report_file_error ("Removing directory", Flist (1, &dirname)); | |
1876 | |
1877 return Qnil; | |
1878 } | |
1879 | |
1880 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", | |
1881 "Delete specified file. One argument, a file name string.\n\ | |
1882 If file has multiple names, it continues to exist with the other names.") | |
1883 (filename) | |
1884 Lisp_Object filename; | |
1885 { | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1886 Lisp_Object handler; |
230 | 1887 CHECK_STRING (filename, 0); |
1888 filename = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1889 |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1890 handler = Ffind_file_name_handler (filename, Qdelete_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1891 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1892 return call2 (handler, Qdelete_file, filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1893 |
230 | 1894 if (0 > unlink (XSTRING (filename)->data)) |
1895 report_file_error ("Removing old name", Flist (1, &filename)); | |
1896 return Qnil; | |
1897 } | |
1898 | |
1899 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, | |
1900 "fRename file: \nFRename %s to file: \np", | |
1901 "Rename FILE as NEWNAME. Both args strings.\n\ | |
1902 If file has names other than FILE, it continues to have those names.\n\ | |
1903 Signals a `file-already-exists' error if a file NEWNAME already exists\n\ | |
1904 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ | |
1905 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
1906 This is what happens in interactive use with M-x.") | |
1907 (filename, newname, ok_if_already_exists) | |
1908 Lisp_Object filename, newname, ok_if_already_exists; | |
1909 { | |
1910 #ifdef NO_ARG_ARRAY | |
1911 Lisp_Object args[2]; | |
1912 #endif | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1913 Lisp_Object handler; |
230 | 1914 struct gcpro gcpro1, gcpro2; |
1915 | |
1916 GCPRO2 (filename, newname); | |
1917 CHECK_STRING (filename, 0); | |
1918 CHECK_STRING (newname, 1); | |
1919 filename = Fexpand_file_name (filename, Qnil); | |
1920 newname = Fexpand_file_name (newname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1921 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1922 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1923 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1924 handler = Ffind_file_name_handler (filename, Qrename_file); |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
1925 if (NILP (handler)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1926 handler = Ffind_file_name_handler (newname, Qrename_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1927 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1928 RETURN_UNGCPRO (call4 (handler, Qrename_file, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1929 filename, newname, ok_if_already_exists)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1930 |
485 | 1931 if (NILP (ok_if_already_exists) |
230 | 1932 || XTYPE (ok_if_already_exists) == Lisp_Int) |
1933 barf_or_query_if_file_exists (newname, "rename to it", | |
1934 XTYPE (ok_if_already_exists) == Lisp_Int); | |
1935 #ifndef BSD4_1 | |
1936 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data)) | |
1937 #else | |
1938 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data) | |
1939 || 0 > unlink (XSTRING (filename)->data)) | |
1940 #endif | |
1941 { | |
1942 if (errno == EXDEV) | |
1943 { | |
3963
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
1944 Fcopy_file (filename, newname, |
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
1945 /* We have already prompted if it was an integer, |
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
1946 so don't have copy-file prompt again. */ |
39caef7a70c2
(Frename_file): After prompting for ok-if-already-exists, pass only nil or
Roland McGrath <roland@gnu.org>
parents:
3829
diff
changeset
|
1947 NILP (ok_if_already_exists) ? Qnil : Qt, Qt); |
230 | 1948 Fdelete_file (filename); |
1949 } | |
1950 else | |
1951 #ifdef NO_ARG_ARRAY | |
1952 { | |
1953 args[0] = filename; | |
1954 args[1] = newname; | |
1955 report_file_error ("Renaming", Flist (2, args)); | |
1956 } | |
1957 #else | |
1958 report_file_error ("Renaming", Flist (2, &filename)); | |
1959 #endif | |
1960 } | |
1961 UNGCPRO; | |
1962 return Qnil; | |
1963 } | |
1964 | |
1965 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, | |
1966 "fAdd name to file: \nFName to add to %s: \np", | |
1967 "Give FILE additional name NEWNAME. Both args strings.\n\ | |
1968 Signals a `file-already-exists' error if a file NEWNAME already exists\n\ | |
1969 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ | |
1970 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
1971 This is what happens in interactive use with M-x.") | |
1972 (filename, newname, ok_if_already_exists) | |
1973 Lisp_Object filename, newname, ok_if_already_exists; | |
1974 { | |
1975 #ifdef NO_ARG_ARRAY | |
1976 Lisp_Object args[2]; | |
1977 #endif | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1978 Lisp_Object handler; |
230 | 1979 struct gcpro gcpro1, gcpro2; |
1980 | |
1981 GCPRO2 (filename, newname); | |
1982 CHECK_STRING (filename, 0); | |
1983 CHECK_STRING (newname, 1); | |
1984 filename = Fexpand_file_name (filename, Qnil); | |
1985 newname = Fexpand_file_name (newname, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1986 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1987 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1988 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
1989 handler = Ffind_file_name_handler (filename, Qadd_name_to_file); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1990 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1991 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, |
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
1992 newname, ok_if_already_exists)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
1993 |
485 | 1994 if (NILP (ok_if_already_exists) |
230 | 1995 || XTYPE (ok_if_already_exists) == Lisp_Int) |
1996 barf_or_query_if_file_exists (newname, "make it a new name", | |
1997 XTYPE (ok_if_already_exists) == Lisp_Int); | |
1998 unlink (XSTRING (newname)->data); | |
1999 if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)) | |
2000 { | |
2001 #ifdef NO_ARG_ARRAY | |
2002 args[0] = filename; | |
2003 args[1] = newname; | |
2004 report_file_error ("Adding new name", Flist (2, args)); | |
2005 #else | |
2006 report_file_error ("Adding new name", Flist (2, &filename)); | |
2007 #endif | |
2008 } | |
2009 | |
2010 UNGCPRO; | |
2011 return Qnil; | |
2012 } | |
2013 | |
2014 #ifdef S_IFLNK | |
2015 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, | |
2016 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", | |
2017 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\ | |
2018 Signals a `file-already-exists' error if a file NEWNAME already exists\n\ | |
2019 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\ | |
2020 A number as third arg means request confirmation if NEWNAME already exists.\n\ | |
2021 This happens for interactive use with M-x.") | |
732 | 2022 (filename, linkname, ok_if_already_exists) |
2023 Lisp_Object filename, linkname, ok_if_already_exists; | |
230 | 2024 { |
2025 #ifdef NO_ARG_ARRAY | |
2026 Lisp_Object args[2]; | |
2027 #endif | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2028 Lisp_Object handler; |
230 | 2029 struct gcpro gcpro1, gcpro2; |
2030 | |
732 | 2031 GCPRO2 (filename, linkname); |
230 | 2032 CHECK_STRING (filename, 0); |
732 | 2033 CHECK_STRING (linkname, 1); |
5245
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2034 /* If the link target has a ~, we must expand it to get |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2035 a truly valid file name. Otherwise, do not expand; |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2036 we want to permit links to relative file names. */ |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2037 if (XSTRING (filename)->data[0] == '~') |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
2038 filename = Fexpand_file_name (filename, Qnil); |
732 | 2039 linkname = Fexpand_file_name (linkname, Qnil); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2040 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2041 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2042 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2043 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2044 if (!NILP (handler)) |
6370
51a014b7c656
(Frename_file, Fcopy_file, Fadd_name_to_file, Fmake_symbolic_link): Fix typo
Karl Heuer <kwzh@gnu.org>
parents:
6367
diff
changeset
|
2045 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>
parents:
6367
diff
changeset
|
2046 linkname, ok_if_already_exists)); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2047 |
485 | 2048 if (NILP (ok_if_already_exists) |
230 | 2049 || XTYPE (ok_if_already_exists) == Lisp_Int) |
732 | 2050 barf_or_query_if_file_exists (linkname, "make it a link", |
230 | 2051 XTYPE (ok_if_already_exists) == Lisp_Int); |
732 | 2052 if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) |
230 | 2053 { |
2054 /* If we didn't complain already, silently delete existing file. */ | |
2055 if (errno == EEXIST) | |
2056 { | |
2650
f378d89945e1
* fileio.c (Fmake_symbolic_link): If a file already exists under
Jim Blandy <jimb@redhat.com>
parents:
2607
diff
changeset
|
2057 unlink (XSTRING (linkname)->data); |
732 | 2058 if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) |
230 | 2059 return Qnil; |
2060 } | |
2061 | |
2062 #ifdef NO_ARG_ARRAY | |
2063 args[0] = filename; | |
732 | 2064 args[1] = linkname; |
230 | 2065 report_file_error ("Making symbolic link", Flist (2, args)); |
2066 #else | |
2067 report_file_error ("Making symbolic link", Flist (2, &filename)); | |
2068 #endif | |
2069 } | |
2070 UNGCPRO; | |
2071 return Qnil; | |
2072 } | |
2073 #endif /* S_IFLNK */ | |
2074 | |
2075 #ifdef VMS | |
2076 | |
2077 DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, | |
2078 2, 2, "sDefine logical name: \nsDefine logical name %s as: ", | |
2079 "Define the job-wide logical name NAME to have the value STRING.\n\ | |
2080 If STRING is nil or a null string, the logical name NAME is deleted.") | |
2081 (varname, string) | |
2082 Lisp_Object varname; | |
2083 Lisp_Object string; | |
2084 { | |
2085 CHECK_STRING (varname, 0); | |
485 | 2086 if (NILP (string)) |
230 | 2087 delete_logical_name (XSTRING (varname)->data); |
2088 else | |
2089 { | |
2090 CHECK_STRING (string, 1); | |
2091 | |
2092 if (XSTRING (string)->size == 0) | |
2093 delete_logical_name (XSTRING (varname)->data); | |
2094 else | |
2095 define_logical_name (XSTRING (varname)->data, XSTRING (string)->data); | |
2096 } | |
2097 | |
2098 return string; | |
2099 } | |
2100 #endif /* VMS */ | |
2101 | |
2102 #ifdef HPUX_NET | |
2103 | |
2104 DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, | |
2105 "Open a network connection to PATH using LOGIN as the login string.") | |
2106 (path, login) | |
2107 Lisp_Object path, login; | |
2108 { | |
2109 int netresult; | |
2110 | |
2111 CHECK_STRING (path, 0); | |
2112 CHECK_STRING (login, 0); | |
2113 | |
2114 netresult = netunam (XSTRING (path)->data, XSTRING (login)->data); | |
2115 | |
2116 if (netresult == -1) | |
2117 return Qnil; | |
2118 else | |
2119 return Qt; | |
2120 } | |
2121 #endif /* HPUX_NET */ | |
2122 | |
2123 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, | |
2124 1, 1, 0, | |
2125 "Return t if file FILENAME specifies an absolute path name.\n\ | |
2126 On Unix, this is a name starting with a `/' or a `~'.") | |
2127 (filename) | |
2128 Lisp_Object filename; | |
2129 { | |
2130 unsigned char *ptr; | |
2131 | |
2132 CHECK_STRING (filename, 0); | |
2133 ptr = XSTRING (filename)->data; | |
2134 if (*ptr == '/' || *ptr == '~' | |
2135 #ifdef VMS | |
2136 /* ??? This criterion is probably wrong for '<'. */ | |
2137 || index (ptr, ':') || index (ptr, '<') | |
2138 || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']')) | |
2139 && ptr[1] != '.') | |
2140 #endif /* VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2141 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2142 || (*ptr != 0 && ptr[1] == ':' && ptr[2] == '/') |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2143 #endif |
230 | 2144 ) |
2145 return Qt; | |
2146 else | |
2147 return Qnil; | |
2148 } | |
2149 | |
2150 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, | |
2151 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\ | |
2152 See also `file-readable-p' and `file-attributes'.") | |
2153 (filename) | |
2154 Lisp_Object filename; | |
2155 { | |
2156 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2157 Lisp_Object handler; |
230 | 2158 |
2159 CHECK_STRING (filename, 0); | |
2160 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2161 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2162 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2163 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2164 handler = Ffind_file_name_handler (abspath, Qfile_exists_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2165 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2166 return call2 (handler, Qfile_exists_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2167 |
230 | 2168 return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil; |
2169 } | |
2170 | |
2171 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, | |
2172 "Return t if FILENAME can be executed by you.\n\ | |
2236 | 2173 For a directory, this means you can access files in that directory.") |
230 | 2174 (filename) |
2175 Lisp_Object filename; | |
2176 | |
2177 { | |
2178 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2179 Lisp_Object handler; |
230 | 2180 |
2181 CHECK_STRING (filename, 0); | |
2182 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2183 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2184 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2185 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2186 handler = Ffind_file_name_handler (abspath, Qfile_executable_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2187 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2188 return call2 (handler, Qfile_executable_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2189 |
230 | 2190 return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil; |
2191 } | |
2192 | |
2193 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, | |
2194 "Return t if file FILENAME exists and you can read it.\n\ | |
2195 See also `file-exists-p' and `file-attributes'.") | |
2196 (filename) | |
2197 Lisp_Object filename; | |
2198 { | |
2199 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2200 Lisp_Object handler; |
230 | 2201 |
2202 CHECK_STRING (filename, 0); | |
2203 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2204 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2205 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2206 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2207 handler = Ffind_file_name_handler (abspath, Qfile_readable_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2208 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2209 return call2 (handler, Qfile_readable_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2210 |
230 | 2211 return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil; |
2212 } | |
2213 | |
2214 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, | |
5616
67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5553
diff
changeset
|
2215 "Return non-nil if file FILENAME is the name of a symbolic link.\n\ |
67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5553
diff
changeset
|
2216 The value is the name of the file to which it is linked.\n\ |
67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5553
diff
changeset
|
2217 Otherwise returns nil.") |
230 | 2218 (filename) |
2219 Lisp_Object filename; | |
2220 { | |
2221 #ifdef S_IFLNK | |
2222 char *buf; | |
2223 int bufsize; | |
2224 int valsize; | |
2225 Lisp_Object val; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2226 Lisp_Object handler; |
230 | 2227 |
2228 CHECK_STRING (filename, 0); | |
2229 filename = Fexpand_file_name (filename, Qnil); | |
2230 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2231 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2232 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2233 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2234 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2235 return call2 (handler, Qfile_symlink_p, filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2236 |
230 | 2237 bufsize = 100; |
2238 while (1) | |
2239 { | |
2240 buf = (char *) xmalloc (bufsize); | |
2241 bzero (buf, bufsize); | |
2242 valsize = readlink (XSTRING (filename)->data, buf, bufsize); | |
2243 if (valsize < bufsize) break; | |
2244 /* Buffer was not long enough */ | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2435
diff
changeset
|
2245 xfree (buf); |
230 | 2246 bufsize *= 2; |
2247 } | |
2248 if (valsize == -1) | |
2249 { | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2435
diff
changeset
|
2250 xfree (buf); |
230 | 2251 return Qnil; |
2252 } | |
2253 val = make_string (buf, valsize); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2435
diff
changeset
|
2254 xfree (buf); |
230 | 2255 return val; |
2256 #else /* not S_IFLNK */ | |
2257 return Qnil; | |
2258 #endif /* not S_IFLNK */ | |
2259 } | |
2260 | |
2741
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2261 #ifdef SOLARIS_BROKEN_ACCESS |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2262 /* In Solaris 2.1, the readonly-ness of the filesystem is not |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2263 considered by the access system call. This is Sun's bug, but we |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2264 still have to make Emacs work. */ |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2265 |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2266 #include <sys/statvfs.h> |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2267 |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2268 static int |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2269 ro_fsys (path) |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2270 char *path; |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2271 { |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2272 struct statvfs statvfsb; |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2273 |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2274 if (statvfs(path, &statvfsb)) |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2275 return 1; /* error from statvfs, be conservative and say not wrtable */ |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2276 else |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2277 /* Otherwise, fsys is ro if bit is set. */ |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2278 return statvfsb.f_flag & ST_RDONLY; |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2279 } |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2280 #else |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2281 /* But on every other os, access has already done the right thing. */ |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2282 #define ro_fsys(path) 0 |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2283 #endif |
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2284 |
230 | 2285 /* Having this before file-symlink-p mysteriously caused it to be forgotten |
2286 on the RT/PC. */ | |
2287 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, | |
2288 "Return t if file FILENAME can be written or created by you.") | |
2289 (filename) | |
2290 Lisp_Object filename; | |
2291 { | |
2292 Lisp_Object abspath, dir; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2293 Lisp_Object handler; |
230 | 2294 |
2295 CHECK_STRING (filename, 0); | |
2296 abspath = Fexpand_file_name (filename, Qnil); | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2297 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2298 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2299 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2300 handler = Ffind_file_name_handler (abspath, Qfile_writable_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2301 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2302 return call2 (handler, Qfile_writable_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2303 |
230 | 2304 if (access (XSTRING (abspath)->data, 0) >= 0) |
2741
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2305 return ((access (XSTRING (abspath)->data, 2) >= 0 |
3017
3afba65e22fa
* fileio.c (Ffile_writable_p): Pass XSTRING (foo)->data to
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
2306 && ! ro_fsys ((char *) XSTRING (abspath)->data)) |
2741
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2307 ? Qt : Qnil); |
230 | 2308 dir = Ffile_name_directory (abspath); |
2309 #ifdef VMS | |
485 | 2310 if (!NILP (dir)) |
230 | 2311 dir = Fdirectory_file_name (dir); |
2312 #endif /* VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2313 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2314 if (!NILP (dir)) |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2315 dir = Fdirectory_file_name (dir); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2316 #endif /* MSDOS */ |
2741
1d72336294c6
* fileio.c (ro_fsys) [SOLARIS_BROKEN_ACCESS]: Check for the
Jim Blandy <jimb@redhat.com>
parents:
2650
diff
changeset
|
2317 return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0 |
3017
3afba65e22fa
* fileio.c (Ffile_writable_p): Pass XSTRING (foo)->data to
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
2318 && ! ro_fsys ((char *) XSTRING (dir)->data)) |
230 | 2319 ? Qt : Qnil); |
2320 } | |
2321 | |
2322 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, | |
2323 "Return t if file FILENAME is the name of a directory as a file.\n\ | |
2324 A directory name spec may be given instead; then the value is t\n\ | |
2325 if the directory so specified exists and really is a directory.") | |
2326 (filename) | |
2327 Lisp_Object filename; | |
2328 { | |
2329 register Lisp_Object abspath; | |
2330 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2331 Lisp_Object handler; |
230 | 2332 |
2333 abspath = expand_and_dir_to_file (filename, current_buffer->directory); | |
2334 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2335 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2336 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2337 handler = Ffind_file_name_handler (abspath, Qfile_directory_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2338 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2339 return call2 (handler, Qfile_directory_p, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2340 |
230 | 2341 if (stat (XSTRING (abspath)->data, &st) < 0) |
2342 return Qnil; | |
2343 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; | |
2344 } | |
2345 | |
536 | 2346 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, |
2347 "Return t if file FILENAME is the name of a directory as a file,\n\ | |
2348 and files in that directory can be opened by you. In order to use a\n\ | |
2349 directory as a buffer's current directory, this predicate must return true.\n\ | |
2350 A directory name spec may be given instead; then the value is t\n\ | |
2351 if the directory so specified exists and really is a readable and\n\ | |
2352 searchable directory.") | |
2353 (filename) | |
2354 Lisp_Object filename; | |
2355 { | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2356 Lisp_Object handler; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2357 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2358 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2359 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2360 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2361 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2362 return call2 (handler, Qfile_accessible_directory_p, filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2363 |
536 | 2364 if (NILP (Ffile_directory_p (filename)) |
2365 || NILP (Ffile_executable_p (filename))) | |
2366 return Qnil; | |
2367 else | |
2368 return Qt; | |
2369 } | |
2370 | |
230 | 2371 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, |
2372 "Return mode bits of FILE, as an integer.") | |
2373 (filename) | |
2374 Lisp_Object filename; | |
2375 { | |
2376 Lisp_Object abspath; | |
2377 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2378 Lisp_Object handler; |
230 | 2379 |
2380 abspath = expand_and_dir_to_file (filename, current_buffer->directory); | |
2381 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2382 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2383 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2384 handler = Ffind_file_name_handler (abspath, Qfile_modes); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2385 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2386 return call2 (handler, Qfile_modes, abspath); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2387 |
230 | 2388 if (stat (XSTRING (abspath)->data, &st) < 0) |
2389 return Qnil; | |
6383
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2390 #ifdef MSDOS |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2391 { |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2392 int len; |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2393 char *suffix; |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2394 if (S_ISREG (st.st_mode) |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2395 && (len = XSTRING (abspath)->size) >= 5 |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2396 && (stricmp ((suffix = XSTRING (abspath)->data + len-4), ".com") == 0 |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2397 || stricmp (suffix, ".exe") == 0 |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2398 || stricmp (suffix, ".bat") == 0)) |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2399 st.st_mode |= S_IEXEC; |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2400 } |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2401 #endif /* MSDOS */ |
62db5566c287
(Ffile_modes) [MSDOS]: set exec-bit based on file suffix.
Karl Heuer <kwzh@gnu.org>
parents:
6370
diff
changeset
|
2402 |
230 | 2403 return make_number (st.st_mode & 07777); |
2404 } | |
2405 | |
2406 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, | |
2407 "Set mode bits of FILE to MODE (an integer).\n\ | |
2408 Only the 12 low bits of MODE are used.") | |
2409 (filename, mode) | |
2410 Lisp_Object filename, mode; | |
2411 { | |
2412 Lisp_Object abspath; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2413 Lisp_Object handler; |
230 | 2414 |
2415 abspath = Fexpand_file_name (filename, current_buffer->directory); | |
2416 CHECK_NUMBER (mode, 1); | |
2417 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2418 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2419 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2420 handler = Ffind_file_name_handler (abspath, Qset_file_modes); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2421 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2422 return call3 (handler, Qset_file_modes, abspath, mode); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2423 |
230 | 2424 #ifndef APOLLO |
2425 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) | |
2426 report_file_error ("Doing chmod", Fcons (abspath, Qnil)); | |
2427 #else /* APOLLO */ | |
2428 if (!egetenv ("USE_DOMAIN_ACLS")) | |
2429 { | |
2430 struct stat st; | |
2431 struct timeval tvp[2]; | |
2432 | |
2433 /* chmod on apollo also change the file's modtime; need to save the | |
2434 modtime and then restore it. */ | |
2435 if (stat (XSTRING (abspath)->data, &st) < 0) | |
2436 { | |
2437 report_file_error ("Doing chmod", Fcons (abspath, Qnil)); | |
2438 return (Qnil); | |
2439 } | |
2440 | |
2441 if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) | |
2442 report_file_error ("Doing chmod", Fcons (abspath, Qnil)); | |
2443 | |
2444 /* reset the old accessed and modified times. */ | |
2445 tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */ | |
2446 tvp[0].tv_usec = 0; | |
2447 tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */ | |
2448 tvp[1].tv_usec = 0; | |
2449 | |
2450 if (utimes (XSTRING (abspath)->data, tvp) < 0) | |
2451 report_file_error ("Doing utimes", Fcons (abspath, Qnil)); | |
2452 } | |
2453 #endif /* APOLLO */ | |
2454 | |
2455 return Qnil; | |
2456 } | |
2457 | |
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
2458 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2459 "Set the file permission bits for newly created files.\n\ |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2460 The argument MODE should be an integer; only the low 9 bits are used.\n\ |
550 | 2461 This setting is inherited by subprocesses.") |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2462 (mode) |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2463 Lisp_Object mode; |
550 | 2464 { |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2465 CHECK_NUMBER (mode, 0); |
550 | 2466 |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2467 umask ((~ XINT (mode)) & 0777); |
550 | 2468 |
2469 return Qnil; | |
2470 } | |
2471 | |
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
2472 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2473 "Return the default file protection for created files.\n\ |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2474 The value is an integer.") |
550 | 2475 () |
2476 { | |
1762
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2477 int realmask; |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2478 Lisp_Object value; |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2479 |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2480 realmask = umask (0); |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2481 umask (realmask); |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2482 |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2483 XSET (value, Lisp_Int, (~ realmask) & 0777); |
d70878f22be4
(Fset_default_file_mode, Fdefault_file_mode):
Richard M. Stallman <rms@gnu.org>
parents:
1761
diff
changeset
|
2484 return value; |
550 | 2485 } |
2486 | |
689
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2487 #ifdef unix |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2488 |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2489 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2490 "Tell Unix to finish all pending disk updates.") |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2491 () |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2492 { |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2493 sync (); |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2494 return Qnil; |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2495 } |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2496 |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2497 #endif /* unix */ |
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
2498 |
230 | 2499 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, |
2500 "Return t if file FILE1 is newer than file FILE2.\n\ | |
2501 If FILE1 does not exist, the answer is nil;\n\ | |
2502 otherwise, if FILE2 does not exist, the answer is t.") | |
2503 (file1, file2) | |
2504 Lisp_Object file1, file2; | |
2505 { | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2506 Lisp_Object abspath1, abspath2; |
230 | 2507 struct stat st; |
2508 int mtime1; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2509 Lisp_Object handler; |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2510 struct gcpro gcpro1, gcpro2; |
230 | 2511 |
2512 CHECK_STRING (file1, 0); | |
2513 CHECK_STRING (file2, 0); | |
2514 | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2515 abspath1 = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2516 GCPRO2 (abspath1, file2); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2517 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2518 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2519 UNGCPRO; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2520 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2521 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2522 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2523 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
2524 if (NILP (handler)) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2525 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2526 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2527 return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2528 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2529 if (stat (XSTRING (abspath1)->data, &st) < 0) |
230 | 2530 return Qnil; |
2531 | |
2532 mtime1 = st.st_mtime; | |
2533 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2534 if (stat (XSTRING (abspath2)->data, &st) < 0) |
230 | 2535 return Qt; |
2536 | |
2537 return (mtime1 > st.st_mtime) ? Qt : Qnil; | |
2538 } | |
2539 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2540 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2541 Lisp_Object Qfind_buffer_file_type; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2542 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2543 |
230 | 2544 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2545 1, 5, 0, |
230 | 2546 "Insert contents of file FILENAME after point.\n\ |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2547 Returns list of absolute file name and length of data inserted.\n\ |
230 | 2548 If second argument VISIT is non-nil, the buffer's visited filename\n\ |
2549 and last save file modtime are set, and it is marked unmodified.\n\ | |
2550 If visiting and the file does not exist, visiting is completed\n\ | |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2551 before the error is signaled.\n\n\ |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2552 The optional third and fourth arguments BEG and END\n\ |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2553 specify what portion of the file to insert.\n\ |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2554 If VISIT is non-nil, BEG and END must be nil.\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2555 If optional fifth argument REPLACE is non-nil,\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2556 it means replace the current buffer contents (in the accessible portion)\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2557 with the file contents. This is better than simply deleting and inserting\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2558 the whole thing because (1) it preserves some marker positions\n\ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2559 and (2) it puts less data in the undo list.") |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2560 (filename, visit, beg, end, replace) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2561 Lisp_Object filename, visit, beg, end, replace; |
230 | 2562 { |
2563 struct stat st; | |
2564 register int fd; | |
2565 register int inserted = 0; | |
2566 register int how_much; | |
2567 int count = specpdl_ptr - specpdl; | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2568 struct gcpro gcpro1, gcpro2; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2569 Lisp_Object handler, val, insval; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2570 Lisp_Object p; |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2571 int total; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2572 |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2573 val = Qnil; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2574 p = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2575 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2576 GCPRO2 (filename, p); |
485 | 2577 if (!NILP (current_buffer->read_only)) |
230 | 2578 Fbarf_if_buffer_read_only(); |
2579 | |
2580 CHECK_STRING (filename, 0); | |
2581 filename = Fexpand_file_name (filename, Qnil); | |
2582 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2583 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2584 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2585 handler = Ffind_file_name_handler (filename, Qinsert_file_contents); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2586 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2587 { |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2588 val = call6 (handler, Qinsert_file_contents, filename, |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2589 visit, beg, end, replace); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2590 goto handled; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2591 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2592 |
230 | 2593 fd = -1; |
2594 | |
2595 #ifndef APOLLO | |
2596 if (stat (XSTRING (filename)->data, &st) < 0 | |
410 | 2597 || (fd = open (XSTRING (filename)->data, 0)) < 0) |
230 | 2598 #else |
2599 if ((fd = open (XSTRING (filename)->data, 0)) < 0 | |
2600 || fstat (fd, &st) < 0) | |
2601 #endif /* not APOLLO */ | |
2602 { | |
2603 if (fd >= 0) close (fd); | |
485 | 2604 if (NILP (visit)) |
230 | 2605 report_file_error ("Opening input file", Fcons (filename, Qnil)); |
2606 st.st_mtime = -1; | |
2607 how_much = 0; | |
2608 goto notfound; | |
2609 } | |
2610 | |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2611 /* Replacement should preserve point as it preserves markers. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2612 if (!NILP (replace)) |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2613 record_unwind_protect (restore_point_unwind, Fpoint_marker ()); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2614 |
230 | 2615 record_unwind_protect (close_file_unwind, make_number (fd)); |
2616 | |
752 | 2617 #ifdef S_IFSOCK |
2618 /* This code will need to be changed in order to work on named | |
2619 pipes, and it's probably just not worth it. So we should at | |
2620 least signal an error. */ | |
2621 if ((st.st_mode & S_IFMT) == S_IFSOCK) | |
2622 Fsignal (Qfile_error, | |
2623 Fcons (build_string ("reading from named pipe"), | |
2624 Fcons (filename, Qnil))); | |
2625 #endif | |
2626 | |
230 | 2627 /* Supposedly happens on VMS. */ |
2628 if (st.st_size < 0) | |
2629 error ("File size is negative"); | |
752 | 2630 |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2631 if (!NILP (beg) || !NILP (end)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2632 if (!NILP (visit)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2633 error ("Attempt to visit less than an entire file"); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2634 |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2635 if (!NILP (beg)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2636 CHECK_NUMBER (beg, 0); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2637 else |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2638 XFASTINT (beg) = 0; |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2639 |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2640 if (!NILP (end)) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2641 CHECK_NUMBER (end, 0); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2642 else |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2643 { |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2644 XSETINT (end, st.st_size); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2645 if (XINT (end) != st.st_size) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2646 error ("maximum buffer size exceeded"); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2647 } |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2648 |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2649 /* If requested, replace the accessible part of the buffer |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2650 with the file contents. Avoid replacing text at the |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2651 beginning or end of the buffer that matches the file contents; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2652 that preserves markers pointing to the unchanged parts. */ |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2653 #ifdef MSDOS |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2654 /* On MSDOS, replace mode doesn't really work, except for binary files, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2655 and it's not worth supporting just for them. */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2656 if (!NILP (replace)) |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2657 { |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2658 replace = Qnil; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2659 XFASTINT (beg) = 0; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2660 XFASTINT (end) = st.st_size; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2661 del_range_1 (BEGV, ZV, 0); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2662 } |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2663 #else /* MSDOS */ |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2664 if (!NILP (replace)) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2665 { |
7549
ccb8b7f8dce7
(syms_of_fileio): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
7526
diff
changeset
|
2666 unsigned char buffer[1 << 14]; |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2667 int same_at_start = BEGV; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2668 int same_at_end = ZV; |
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2669 int overlap; |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2670 |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2671 immediate_quit = 1; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2672 QUIT; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2673 /* Count how many chars at the start of the file |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2674 match the text at the beginning of the buffer. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2675 while (1) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2676 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2677 int nread, bufpos; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2678 |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2679 nread = read (fd, buffer, sizeof buffer); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2680 if (nread < 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2681 error ("IO error reading %s: %s", |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2682 XSTRING (filename)->data, strerror (errno)); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2683 else if (nread == 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2684 break; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2685 bufpos = 0; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2686 while (bufpos < nread && same_at_start < ZV |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2687 && FETCH_CHAR (same_at_start) == buffer[bufpos]) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2688 same_at_start++, bufpos++; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2689 /* If we found a discrepancy, stop the scan. |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2690 Otherwise loop around and scan the next bufferfull. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2691 if (bufpos != nread) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2692 break; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2693 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2694 immediate_quit = 0; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2695 /* If the file matches the buffer completely, |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2696 there's no need to replace anything. */ |
7595
9f0893928a4d
(Finsert_file_contents): Declare buffer as unsigned
Richard M. Stallman <rms@gnu.org>
parents:
7551
diff
changeset
|
2697 if (same_at_start - BEGV == st.st_size) |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2698 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2699 close (fd); |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2700 specpdl_ptr--; |
7595
9f0893928a4d
(Finsert_file_contents): Declare buffer as unsigned
Richard M. Stallman <rms@gnu.org>
parents:
7551
diff
changeset
|
2701 /* Truncate the buffer to the size of the file. */ |
9f0893928a4d
(Finsert_file_contents): Declare buffer as unsigned
Richard M. Stallman <rms@gnu.org>
parents:
7551
diff
changeset
|
2702 del_range_1 (same_at_start, same_at_end, 0); |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2703 goto handled; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2704 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2705 immediate_quit = 1; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2706 QUIT; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2707 /* Count how many chars at the end of the file |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2708 match the text at the end of the buffer. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2709 while (1) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2710 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2711 int total_read, nread, bufpos, curpos, trial; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2712 |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2713 /* At what file position are we now scanning? */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2714 curpos = st.st_size - (ZV - same_at_end); |
7695
aba3ffcc8f51
(Finsert_file_contents): Check for beginning of file.
Karl Heuer <kwzh@gnu.org>
parents:
7611
diff
changeset
|
2715 /* If the entire file matches the buffer tail, stop the scan. */ |
aba3ffcc8f51
(Finsert_file_contents): Check for beginning of file.
Karl Heuer <kwzh@gnu.org>
parents:
7611
diff
changeset
|
2716 if (curpos == 0) |
aba3ffcc8f51
(Finsert_file_contents): Check for beginning of file.
Karl Heuer <kwzh@gnu.org>
parents:
7611
diff
changeset
|
2717 break; |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2718 /* How much can we scan in the next step? */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2719 trial = min (curpos, sizeof buffer); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2720 if (lseek (fd, curpos - trial, 0) < 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2721 report_file_error ("Setting file position", |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2722 Fcons (filename, Qnil)); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2723 |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2724 total_read = 0; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2725 while (total_read < trial) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2726 { |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2727 nread = read (fd, buffer + total_read, trial - total_read); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2728 if (nread <= 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2729 error ("IO error reading %s: %s", |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2730 XSTRING (filename)->data, strerror (errno)); |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2731 total_read += nread; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2732 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2733 /* Scan this bufferfull from the end, comparing with |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2734 the Emacs buffer. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2735 bufpos = total_read; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2736 /* Compare with same_at_start to avoid counting some buffer text |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2737 as matching both at the file's beginning and at the end. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2738 while (bufpos > 0 && same_at_end > same_at_start |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2739 && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1]) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2740 same_at_end--, bufpos--; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2741 /* If we found a discrepancy, stop the scan. |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2742 Otherwise loop around and scan the preceding bufferfull. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2743 if (bufpos != 0) |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2744 break; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2745 } |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2746 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>
parents:
6209
diff
changeset
|
2747 |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2748 /* Don't try to reuse the same piece of text twice. */ |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2749 overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV); |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2750 if (overlap > 0) |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2751 same_at_end += overlap; |
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2752 |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2753 /* Arrange to read only the nonmatching middle part of the file. */ |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2754 XFASTINT (beg) = same_at_start - BEGV; |
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2755 XFASTINT (end) = st.st_size - (ZV - same_at_end); |
6328
e97a1cc44be8
(Finsert_file_contents): Don't let same_at_end be less than same_at_start.
Richard M. Stallman <rms@gnu.org>
parents:
6209
diff
changeset
|
2756 |
6194
b094b321b4a6
(Finsert_file_contents): Pass del_range_1 two ends, not a length.
Richard M. Stallman <rms@gnu.org>
parents:
6181
diff
changeset
|
2757 del_range_1 (same_at_start, same_at_end, 0); |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2758 /* Insert from the file at the proper position. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2759 SET_PT (same_at_start); |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2760 } |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
2761 #endif /* MSDOS */ |
5975
c766d816b07e
(Finsert_file_contents): New arg REPLACE.
Richard M. Stallman <rms@gnu.org>
parents:
5908
diff
changeset
|
2762 |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2763 total = XINT (end) - XINT (beg); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2764 |
230 | 2765 { |
2766 register Lisp_Object temp; | |
2767 | |
2768 /* Make sure point-max won't overflow after this insertion. */ | |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2769 XSET (temp, Lisp_Int, total); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2770 if (total != XINT (temp)) |
230 | 2771 error ("maximum buffer size exceeded"); |
2772 } | |
2773 | |
4395
76b24be40a57
(Finsert_file_contents): Don't call prepare_to_modify_buffer
Richard M. Stallman <rms@gnu.org>
parents:
4270
diff
changeset
|
2774 if (NILP (visit) && total > 0) |
230 | 2775 prepare_to_modify_buffer (point, point); |
2776 | |
2777 move_gap (point); | |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2778 if (GAP_SIZE < total) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2779 make_gap (total - GAP_SIZE); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2780 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2781 if (XINT (beg) != 0 || !NILP (replace)) |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2782 { |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2783 if (lseek (fd, XINT (beg), 0) < 0) |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2784 report_file_error ("Setting file position", Fcons (filename, Qnil)); |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2785 } |
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2786 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2787 how_much = 0; |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2788 while (inserted < total) |
230 | 2789 { |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2790 int try = min (total - inserted, 64 << 10); |
592
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2791 int this; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2792 |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2793 /* Allow quitting out of the actual I/O. */ |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2794 immediate_quit = 1; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2795 QUIT; |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2796 this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try); |
e65af468dcc2
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
564
diff
changeset
|
2797 immediate_quit = 0; |
230 | 2798 |
2799 if (this <= 0) | |
2800 { | |
2801 how_much = this; | |
2802 break; | |
2803 } | |
2804 | |
2805 GPT += this; | |
2806 GAP_SIZE -= this; | |
2807 ZV += this; | |
2808 Z += this; | |
2809 inserted += this; | |
2810 } | |
2811 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2812 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2813 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2814 /* Determine file type from name and remove LFs from CR-LFs if the file |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2815 is deemed to be a text file. */ |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2816 { |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2817 struct gcpro gcpro1; |
6498
676612edbafe
(Finsert_file_contents): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents:
6383
diff
changeset
|
2818 Lisp_Object code; |
676612edbafe
(Finsert_file_contents): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents:
6383
diff
changeset
|
2819 code = Qnil; |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2820 GCPRO1 (filename); |
7130
b3e9a76134d2
(Finsert_file_contents): Fix accessing buffer_file_type
Richard M. Stallman <rms@gnu.org>
parents:
7041
diff
changeset
|
2821 current_buffer->buffer_file_type |
b3e9a76134d2
(Finsert_file_contents): Fix accessing buffer_file_type
Richard M. Stallman <rms@gnu.org>
parents:
7041
diff
changeset
|
2822 = call1 (Qfind_buffer_file_type, filename); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2823 UNGCPRO; |
7130
b3e9a76134d2
(Finsert_file_contents): Fix accessing buffer_file_type
Richard M. Stallman <rms@gnu.org>
parents:
7041
diff
changeset
|
2824 if (NILP (current_buffer->buffer_file_type)) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2825 { |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2826 int reduced_size |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2827 = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2828 ZV -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2829 Z -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2830 GPT -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2831 GAP_SIZE += reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2832 inserted -= reduced_size; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2833 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2834 } |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2835 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2836 |
230 | 2837 if (inserted > 0) |
1240
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
2838 { |
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
2839 record_insert (point, inserted); |
1299
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
2840 |
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
2841 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ |
b8337cdf2e8b
* fileio.c (Finsert_file_contents): Call offset_intervals() if
Joseph Arceneaux <jla@gnu.org>
parents:
1240
diff
changeset
|
2842 offset_intervals (current_buffer, point, inserted); |
1240
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
2843 MODIFF++; |
7365d006d0a0
(Finsert_file_contents): Do record_insert, then inc MODIFF.
Richard M. Stallman <rms@gnu.org>
parents:
1204
diff
changeset
|
2844 } |
230 | 2845 |
2846 close (fd); | |
2847 | |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2848 /* Discard the unwind protect for closing the file. */ |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2849 specpdl_ptr--; |
230 | 2850 |
2851 if (how_much < 0) | |
2852 error ("IO error reading %s: %s", | |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
2853 XSTRING (filename)->data, strerror (errno)); |
230 | 2854 |
2855 notfound: | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2856 handled: |
230 | 2857 |
485 | 2858 if (!NILP (visit)) |
230 | 2859 { |
6177
ac2ef13dca1b
(Finsert_file_contents): If undo_list was t, leave it t.
Richard M. Stallman <rms@gnu.org>
parents:
6036
diff
changeset
|
2860 if (!EQ (current_buffer->undo_list, Qt)) |
ac2ef13dca1b
(Finsert_file_contents): If undo_list was t, leave it t.
Richard M. Stallman <rms@gnu.org>
parents:
6036
diff
changeset
|
2861 current_buffer->undo_list = Qnil; |
230 | 2862 #ifdef APOLLO |
2863 stat (XSTRING (filename)->data, &st); | |
2864 #endif | |
5390
d9c81d7079f3
(Finsert_file_contents): Don't run after change hook
Richard M. Stallman <rms@gnu.org>
parents:
5351
diff
changeset
|
2865 |
5395
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
2866 if (NILP (handler)) |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
2867 { |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
2868 current_buffer->modtime = st.st_mtime; |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
2869 current_buffer->filename = filename; |
e11486a64dab
(Finsert_file_contents): Avoid setting buffer-file-name field if ran a handler.
Richard M. Stallman <rms@gnu.org>
parents:
5390
diff
changeset
|
2870 } |
5390
d9c81d7079f3
(Finsert_file_contents): Don't run after change hook
Richard M. Stallman <rms@gnu.org>
parents:
5351
diff
changeset
|
2871 |
230 | 2872 current_buffer->save_modified = MODIFF; |
2873 current_buffer->auto_save_modified = MODIFF; | |
2874 XFASTINT (current_buffer->save_length) = Z - BEG; | |
2875 #ifdef CLASH_DETECTION | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2876 if (NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2877 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2878 if (!NILP (current_buffer->filename)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2879 unlock_file (current_buffer->filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2880 unlock_file (filename); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2881 } |
230 | 2882 #endif /* CLASH_DETECTION */ |
2883 /* If visiting nonexistent file, return nil. */ | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2884 if (current_buffer->modtime == -1) |
230 | 2885 report_file_error ("Opening input file", Fcons (filename, Qnil)); |
2886 } | |
2887 | |
5390
d9c81d7079f3
(Finsert_file_contents): Don't run after change hook
Richard M. Stallman <rms@gnu.org>
parents:
5351
diff
changeset
|
2888 if (inserted > 0 && NILP (visit) && total > 0) |
5129
d48d18e20316
(Finsert_file_contents): Don't call signal_after_change
Richard M. Stallman <rms@gnu.org>
parents:
4989
diff
changeset
|
2889 signal_after_change (point, 0, inserted); |
230 | 2890 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2891 if (inserted > 0) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2892 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2893 p = Vafter_insert_file_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2894 while (!NILP (p)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2895 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2896 insval = call1 (Fcar (p), make_number (inserted)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2897 if (!NILP (insval)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2898 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2899 CHECK_NUMBER (insval, 0); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2900 inserted = XFASTINT (insval); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2901 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2902 QUIT; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2903 p = Fcdr (p); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2904 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2905 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2906 |
6036
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2907 if (NILP (val)) |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2908 val = Fcons (filename, |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2909 Fcons (make_number (inserted), |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2910 Qnil)); |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2911 |
7e9984c9a36e
(Finsert_file_contents): If REPLACE, always do lseek.
Richard M. Stallman <rms@gnu.org>
parents:
5978
diff
changeset
|
2912 RETURN_UNGCPRO (unbind_to (count, val)); |
230 | 2913 } |
3787
04b741620a50
* fileio.c (Finsert_file_contents): Two new args, BEG and END.
Jim Blandy <jimb@redhat.com>
parents:
3721
diff
changeset
|
2914 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2915 static Lisp_Object build_annotations (); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2916 |
230 | 2917 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, |
2918 "r\nFWrite region to file: ", | |
2919 "Write current region into specified file.\n\ | |
2920 When called from a program, takes three arguments:\n\ | |
2921 START, END and FILENAME. START and END are buffer positions.\n\ | |
2922 Optional fourth argument APPEND if non-nil means\n\ | |
2923 append to existing file contents (if any).\n\ | |
2924 Optional fifth argument VISIT if t means\n\ | |
2925 set the last-save-file-modtime of buffer to this file's modtime\n\ | |
2926 and mark buffer not modified.\n\ | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
2927 If VISIT is a string, it is a second file name;\n\ |
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
2928 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\ |
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
2929 VISIT is also the file name to lock and unlock for clash detection.\n\ |
1761
b9ef55b0df4a
(Fwrite_region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
1679
diff
changeset
|
2930 If VISIT is neither t nor nil nor a string,\n\ |
b9ef55b0df4a
(Fwrite_region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
1679
diff
changeset
|
2931 that means do not print the \"Wrote file\" message.\n\ |
230 | 2932 Kludgy feature: if START is a string, then that string is written\n\ |
2933 to the file, instead of any buffer contents, and END is ignored.") | |
2934 (start, end, filename, append, visit) | |
2935 Lisp_Object start, end, filename, append, visit; | |
2936 { | |
2937 register int desc; | |
2938 int failure; | |
2939 int save_errno; | |
2940 unsigned char *fn; | |
2941 struct stat st; | |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
2942 int tem; |
230 | 2943 int count = specpdl_ptr - specpdl; |
2944 #ifdef VMS | |
2945 unsigned char *fname = 0; /* If non-0, original filename (must rename) */ | |
2946 #endif /* VMS */ | |
848 | 2947 Lisp_Object handler; |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
2948 Lisp_Object visit_file; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2949 Lisp_Object annotations; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2950 int visiting, quietly; |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
2951 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2952 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2953 int buffer_file_type |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2954 = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
2955 #endif |
230 | 2956 |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2957 if (!NILP (start) && !STRINGP (start)) |
230 | 2958 validate_region (&start, &end); |
2959 | |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
2960 filename = Fexpand_file_name (filename, Qnil); |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2961 if (STRINGP (visit)) |
2435
b72453ad92ae
(Fwrite_region): Don't fail to set visit_file.
Richard M. Stallman <rms@gnu.org>
parents:
2407
diff
changeset
|
2962 visit_file = Fexpand_file_name (visit, Qnil); |
2407
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
2963 else |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
2964 visit_file = filename; |
1c590cd84ab3
(Fexpand_file_name): Default DEFALT at beginning,
Richard M. Stallman <rms@gnu.org>
parents:
2280
diff
changeset
|
2965 |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2966 visiting = (EQ (visit, Qt) || STRINGP (visit)); |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2967 quietly = !NILP (visit); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2968 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2969 annotations = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2970 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2971 GCPRO4 (start, filename, annotations, visit_file); |
230 | 2972 |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2973 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2974 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2975 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>
parents:
5647
diff
changeset
|
2976 /* If FILENAME has no handler, see if VISIT has one. */ |
23821c197271
(Fwrite_region): If FILENAME has no handler, see if VISIT has one.
Richard M. Stallman <rms@gnu.org>
parents:
5647
diff
changeset
|
2977 if (NILP (handler) && XTYPE (visit) == Lisp_String) |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
2978 handler = Ffind_file_name_handler (visit, Qwrite_region); |
848 | 2979 |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2980 if (!NILP (handler)) |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2981 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2982 Lisp_Object val; |
3705
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
2983 val = call6 (handler, Qwrite_region, start, end, |
309c27256ceb
(Fcopy_file): Pass all the args to the handler.
Richard M. Stallman <rms@gnu.org>
parents:
3598
diff
changeset
|
2984 filename, append, visit); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2985 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
2986 if (visiting) |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2987 { |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2988 current_buffer->save_modified = MODIFF; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2989 XFASTINT (current_buffer->save_length) = Z - BEG; |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
2990 current_buffer->filename = visit_file; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2991 } |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
2992 UNGCPRO; |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2993 return val; |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2994 } |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
2995 |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2996 /* Special kludge to simplify auto-saving. */ |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2997 if (NILP (start)) |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2998 { |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
2999 XFASTINT (start) = BEG; |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3000 XFASTINT (end) = Z; |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3001 } |
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3002 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3003 annotations = build_annotations (start, end); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3004 |
230 | 3005 #ifdef CLASH_DETECTION |
3006 if (!auto_saving) | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3007 lock_file (visit_file); |
230 | 3008 #endif /* CLASH_DETECTION */ |
3009 | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3010 fn = XSTRING (filename)->data; |
230 | 3011 desc = -1; |
485 | 3012 if (!NILP (append)) |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3013 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3014 desc = open (fn, O_WRONLY | buffer_file_type); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3015 #else |
230 | 3016 desc = open (fn, O_WRONLY); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3017 #endif |
230 | 3018 |
3019 if (desc < 0) | |
3020 #ifdef VMS | |
3021 if (auto_saving) /* Overwrite any previous version of autosave file */ | |
3022 { | |
3023 vms_truncate (fn); /* if fn exists, truncate to zero length */ | |
3024 desc = open (fn, O_RDWR); | |
3025 if (desc < 0) | |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3026 desc = creat_copy_attrs (STRINGP (current_buffer->filename) |
536 | 3027 ? XSTRING (current_buffer->filename)->data : 0, |
3028 fn); | |
230 | 3029 } |
3030 else /* Write to temporary name and rename if no errors */ | |
3031 { | |
3032 Lisp_Object temp_name; | |
3033 temp_name = Ffile_name_directory (filename); | |
3034 | |
485 | 3035 if (!NILP (temp_name)) |
230 | 3036 { |
3037 temp_name = Fmake_temp_name (concat2 (temp_name, | |
3038 build_string ("$$SAVE$$"))); | |
3039 fname = XSTRING (filename)->data; | |
3040 fn = XSTRING (temp_name)->data; | |
3041 desc = creat_copy_attrs (fname, fn); | |
3042 if (desc < 0) | |
3043 { | |
3044 /* If we can't open the temporary file, try creating a new | |
3045 version of the original file. VMS "creat" creates a | |
3046 new version rather than truncating an existing file. */ | |
3047 fn = fname; | |
3048 fname = 0; | |
3049 desc = creat (fn, 0666); | |
3050 #if 0 /* This can clobber an existing file and fail to replace it, | |
3051 if the user runs out of space. */ | |
3052 if (desc < 0) | |
3053 { | |
3054 /* We can't make a new version; | |
3055 try to truncate and rewrite existing version if any. */ | |
3056 vms_truncate (fn); | |
3057 desc = open (fn, O_RDWR); | |
3058 } | |
3059 #endif | |
3060 } | |
3061 } | |
3062 else | |
3063 desc = creat (fn, 0666); | |
3064 } | |
3065 #else /* not VMS */ | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3066 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3067 desc = open (fn, |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3068 O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type, |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3069 S_IREAD | S_IWRITE); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3070 #else /* not MSDOS */ |
230 | 3071 desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
3072 #endif /* not MSDOS */ |
230 | 3073 #endif /* not VMS */ |
3074 | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3075 UNGCPRO; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3076 |
230 | 3077 if (desc < 0) |
3078 { | |
3079 #ifdef CLASH_DETECTION | |
3080 save_errno = errno; | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3081 if (!auto_saving) unlock_file (visit_file); |
230 | 3082 errno = save_errno; |
3083 #endif /* CLASH_DETECTION */ | |
3084 report_file_error ("Opening output file", Fcons (filename, Qnil)); | |
3085 } | |
3086 | |
3087 record_unwind_protect (close_file_unwind, make_number (desc)); | |
3088 | |
485 | 3089 if (!NILP (append)) |
230 | 3090 if (lseek (desc, 0, 2) < 0) |
3091 { | |
3092 #ifdef CLASH_DETECTION | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3093 if (!auto_saving) unlock_file (visit_file); |
230 | 3094 #endif /* CLASH_DETECTION */ |
3095 report_file_error ("Lseek error", Fcons (filename, Qnil)); | |
3096 } | |
3097 | |
3098 #ifdef VMS | |
3099 /* | |
3100 * Kludge Warning: The VMS C RTL likes to insert carriage returns | |
3101 * if we do writes that don't end with a carriage return. Furthermore | |
3102 * it cannot handle writes of more then 16K. The modified | |
3103 * version of "sys_write" in SYSDEP.C (see comment there) copes with | |
3104 * this EXCEPT for the last record (iff it doesn't end with a carriage | |
3105 * return). This implies that if your buffer doesn't end with a carriage | |
3106 * return, you get one free... tough. However it also means that if | |
3107 * we make two calls to sys_write (a la the following code) you can | |
3108 * get one at the gap as well. The easiest way to fix this (honest) | |
3109 * is to move the gap to the next newline (or the end of the buffer). | |
3110 * Thus this change. | |
3111 * | |
3112 * Yech! | |
3113 */ | |
3114 if (GPT > BEG && GPT_ADDR[-1] != '\n') | |
3115 move_gap (find_next_newline (GPT, 1)); | |
3116 #endif | |
3117 | |
3118 failure = 0; | |
3119 immediate_quit = 1; | |
3120 | |
5410
c96b98efb5b4
(Fwrite_region): Don't change START and END from nil
Richard M. Stallman <rms@gnu.org>
parents:
5395
diff
changeset
|
3121 if (STRINGP (start)) |
230 | 3122 { |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3123 failure = 0 > a_write (desc, XSTRING (start)->data, |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3124 XSTRING (start)->size, 0, &annotations); |
230 | 3125 save_errno = errno; |
3126 } | |
3127 else if (XINT (start) != XINT (end)) | |
3128 { | |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3129 int nwritten = 0; |
230 | 3130 if (XINT (start) < GPT) |
3131 { | |
3132 register int end1 = XINT (end); | |
3133 tem = XINT (start); | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3134 failure = 0 > a_write (desc, &FETCH_CHAR (tem), |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3135 min (GPT, end1) - tem, tem, &annotations); |
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3136 nwritten += min (GPT, end1) - tem; |
230 | 3137 save_errno = errno; |
3138 } | |
3139 | |
3140 if (XINT (end) > GPT && !failure) | |
3141 { | |
3142 tem = XINT (start); | |
3143 tem = max (tem, GPT); | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3144 failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3145 tem, &annotations); |
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3146 nwritten += XINT (end) - tem; |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3147 save_errno = errno; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3148 } |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3149 |
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3150 if (nwritten == 0) |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3151 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3152 /* If file was empty, still need to write the annotations */ |
4950
145c69e39666
(Fwrite_region): Fix minor bugs in POS arg to awrite.
Richard M. Stallman <rms@gnu.org>
parents:
4879
diff
changeset
|
3153 failure = 0 > a_write (desc, "", 0, XINT (start), &annotations); |
230 | 3154 save_errno = errno; |
3155 } | |
3156 } | |
3157 | |
3158 immediate_quit = 0; | |
3159 | |
2280
bd56d208ed22
* fileio.c (HAVE_FSYNC): Define, if appropriate.
Jim Blandy <jimb@redhat.com>
parents:
2257
diff
changeset
|
3160 #ifdef HAVE_FSYNC |
230 | 3161 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). |
3162 Disk full in NFS may be reported here. */ | |
3415
c37d05ce7e52
(Fwrite_region): Don't fsync if autosaving.
Richard M. Stallman <rms@gnu.org>
parents:
3410
diff
changeset
|
3163 /* mib says that closing the file will try to write as fast as NFS can do |
c37d05ce7e52
(Fwrite_region): Don't fsync if autosaving.
Richard M. Stallman <rms@gnu.org>
parents:
3410
diff
changeset
|
3164 it, and that means the fsync here is not crucial for autosave files. */ |
c37d05ce7e52
(Fwrite_region): Don't fsync if autosaving.
Richard M. Stallman <rms@gnu.org>
parents:
3410
diff
changeset
|
3165 if (!auto_saving && fsync (desc) < 0) |
230 | 3166 failure = 1, save_errno = errno; |
3167 #endif | |
3168 | |
3169 /* Spurious "file has changed on disk" warnings have been | |
3170 observed on Suns as well. | |
3171 It seems that `close' can change the modtime, under nfs. | |
3172 | |
3173 (This has supposedly been fixed in Sunos 4, | |
3174 but who knows about all the other machines with NFS?) */ | |
3175 #if 0 | |
3176 | |
3177 /* On VMS and APOLLO, must do the stat after the close | |
3178 since closing changes the modtime. */ | |
3179 #ifndef VMS | |
3180 #ifndef APOLLO | |
3181 /* Recall that #if defined does not work on VMS. */ | |
3182 #define FOO | |
3183 fstat (desc, &st); | |
3184 #endif | |
3185 #endif | |
3186 #endif | |
3187 | |
3188 /* NFS can report a write failure now. */ | |
3189 if (close (desc) < 0) | |
3190 failure = 1, save_errno = errno; | |
3191 | |
3192 #ifdef VMS | |
3193 /* If we wrote to a temporary name and had no errors, rename to real name. */ | |
3194 if (fname) | |
3195 { | |
3196 if (!failure) | |
3197 failure = (rename (fn, fname) != 0), save_errno = errno; | |
3198 fn = fname; | |
3199 } | |
3200 #endif /* VMS */ | |
3201 | |
3202 #ifndef FOO | |
3203 stat (fn, &st); | |
3204 #endif | |
3205 /* Discard the unwind protect */ | |
3206 specpdl_ptr = specpdl + count; | |
3207 | |
3208 #ifdef CLASH_DETECTION | |
3209 if (!auto_saving) | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3210 unlock_file (visit_file); |
230 | 3211 #endif /* CLASH_DETECTION */ |
3212 | |
3213 /* Do this before reporting IO error | |
3214 to avoid a "file has changed on disk" warning on | |
3215 next attempt to save. */ | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3216 if (visiting) |
230 | 3217 current_buffer->modtime = st.st_mtime; |
3218 | |
3219 if (failure) | |
5517
8b2b6a296cda
Don't declare sys_errlist; declare strerror instead.
Roland McGrath <roland@gnu.org>
parents:
5494
diff
changeset
|
3220 error ("IO error writing %s: %s", fn, strerror (save_errno)); |
230 | 3221 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3222 if (visiting) |
230 | 3223 { |
3224 current_buffer->save_modified = MODIFF; | |
3225 XFASTINT (current_buffer->save_length) = Z - BEG; | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3226 current_buffer->filename = visit_file; |
7551
69f20f10799a
(Fwrite_region): Set update_mode_lines.
Richard M. Stallman <rms@gnu.org>
parents:
7549
diff
changeset
|
3227 update_mode_lines++; |
230 | 3228 } |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3229 else if (quietly) |
230 | 3230 return Qnil; |
3231 | |
3232 if (!auto_saving) | |
1377
dcec08a3bec4
(Fwrite_region): If VISIT is a file name,
Richard M. Stallman <rms@gnu.org>
parents:
1358
diff
changeset
|
3233 message ("Wrote %s", XSTRING (visit_file)->data); |
230 | 3234 |
3235 return Qnil; | |
3236 } | |
3237 | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3238 Lisp_Object merge (); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3239 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3240 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, |
4853
3ec2205d12b5
(Fcar_less_than_car): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
4841
diff
changeset
|
3241 "Return t if (car A) is numerically less than (car B).") |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3242 (a, b) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3243 Lisp_Object a, b; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3244 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3245 return Flss (Fcar (a), Fcar (b)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3246 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3247 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3248 /* Build the complete list of annotations appropriate for writing out |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3249 the text between START and END, by calling all the functions in |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3250 write-region-annotate-functions and merging the lists they return. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3251 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3252 static Lisp_Object |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3253 build_annotations (start, end) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3254 Lisp_Object start, end; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3255 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3256 Lisp_Object annotations; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3257 Lisp_Object p, res; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3258 struct gcpro gcpro1, gcpro2; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3259 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3260 annotations = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3261 p = Vwrite_region_annotate_functions; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3262 GCPRO2 (annotations, p); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3263 while (!NILP (p)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3264 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3265 res = call2 (Fcar (p), start, end); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3266 Flength (res); /* Check basic validity of return value */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3267 annotations = merge (annotations, res, Qcar_less_than_car); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3268 p = Fcdr (p); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3269 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3270 UNGCPRO; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3271 return annotations; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3272 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3273 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3274 /* Write to descriptor DESC the LEN characters starting at ADDR, |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3275 assuming they start at position POS in the buffer. |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3276 Intersperse with them the annotations from *ANNOT |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3277 (those which fall within the range of positions POS to POS + LEN), |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3278 each at its appropriate position. |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3279 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3280 Modify *ANNOT by discarding elements as we output them. |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3281 The return value is negative in case of system call failure. */ |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3282 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3283 int |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3284 a_write (desc, addr, len, pos, annot) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3285 int desc; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3286 register char *addr; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3287 register int len; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3288 int pos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3289 Lisp_Object *annot; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3290 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3291 Lisp_Object tem; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3292 int nextpos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3293 int lastpos = pos + len; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3294 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3295 while (1) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3296 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3297 tem = Fcar_safe (Fcar (*annot)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3298 if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3299 nextpos = XFASTINT (tem); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3300 else |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3301 return e_write (desc, addr, lastpos - pos); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3302 if (nextpos > pos) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3303 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3304 if (0 > e_write (desc, addr, nextpos - pos)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3305 return -1; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3306 addr += nextpos - pos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3307 pos = nextpos; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3308 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3309 tem = Fcdr (Fcar (*annot)); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3310 if (STRINGP (tem)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3311 { |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3312 if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3313 return -1; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3314 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3315 *annot = Fcdr (*annot); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3316 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3317 } |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
3318 |
230 | 3319 int |
3320 e_write (desc, addr, len) | |
3321 int desc; | |
3322 register char *addr; | |
3323 register int len; | |
3324 { | |
3325 char buf[16 * 1024]; | |
3326 register char *p, *end; | |
3327 | |
3328 if (!EQ (current_buffer->selective_display, Qt)) | |
3329 return write (desc, addr, len) - len; | |
3330 else | |
3331 { | |
3332 p = buf; | |
3333 end = p + sizeof buf; | |
3334 while (len--) | |
3335 { | |
3336 if (p == end) | |
3337 { | |
3338 if (write (desc, buf, sizeof buf) != sizeof buf) | |
3339 return -1; | |
3340 p = buf; | |
3341 } | |
3342 *p = *addr++; | |
3343 if (*p++ == '\015') | |
3344 p[-1] = '\n'; | |
3345 } | |
3346 if (p != buf) | |
3347 if (write (desc, buf, p - buf) != p - buf) | |
3348 return -1; | |
3349 } | |
3350 return 0; | |
3351 } | |
3352 | |
3353 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, | |
3354 Sverify_visited_file_modtime, 1, 1, 0, | |
3355 "Return t if last mod time of BUF's visited file matches what BUF records.\n\ | |
3356 This means that the file has not been changed since it was visited or saved.") | |
3357 (buf) | |
3358 Lisp_Object buf; | |
3359 { | |
3360 struct buffer *b; | |
3361 struct stat st; | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3362 Lisp_Object handler; |
230 | 3363 |
3364 CHECK_BUFFER (buf, 0); | |
3365 b = XBUFFER (buf); | |
3366 | |
3367 if (XTYPE (b->filename) != Lisp_String) return Qt; | |
3368 if (b->modtime == 0) return Qt; | |
3369 | |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3370 /* If the file name has special constructs in it, |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3371 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3372 handler = Ffind_file_name_handler (b->filename, |
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3373 Qverify_visited_file_modtime); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3374 if (!NILP (handler)) |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3375 return call2 (handler, Qverify_visited_file_modtime, buf); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3376 |
230 | 3377 if (stat (XSTRING (b->filename)->data, &st) < 0) |
3378 { | |
3379 /* If the file doesn't exist now and didn't exist before, | |
3380 we say that it isn't modified, provided the error is a tame one. */ | |
3381 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) | |
3382 st.st_mtime = -1; | |
3383 else | |
3384 st.st_mtime = 0; | |
3385 } | |
3386 if (st.st_mtime == b->modtime | |
3387 /* If both are positive, accept them if they are off by one second. */ | |
3388 || (st.st_mtime > 0 && b->modtime > 0 | |
3389 && (st.st_mtime == b->modtime + 1 | |
3390 || st.st_mtime == b->modtime - 1))) | |
3391 return Qt; | |
3392 return Qnil; | |
3393 } | |
3394 | |
3395 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, | |
3396 Sclear_visited_file_modtime, 0, 0, 0, | |
3397 "Clear out records of last mod time of visited file.\n\ | |
3398 Next attempt to save will certainly not complain of a discrepancy.") | |
3399 () | |
3400 { | |
3401 current_buffer->modtime = 0; | |
3402 return Qnil; | |
3403 } | |
3404 | |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3405 DEFUN ("visited-file-modtime", Fvisited_file_modtime, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3406 Svisited_file_modtime, 0, 0, 0, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3407 "Return the current buffer's recorded visited file modification time.\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3408 The value is a list of the form (HIGH . LOW), like the time values\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3409 that `file-attributes' returns.") |
230 | 3410 () |
3411 { | |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3412 return long_to_cons (current_buffer->modtime); |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3413 } |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3414 |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3415 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3416 Sset_visited_file_modtime, 0, 1, 0, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3417 "Update buffer's recorded modification time from the visited file's time.\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3418 Useful if the buffer was not read from the file normally\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3419 or if the file itself has been changed for some known benign reason.\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3420 An argument specifies the modification time value to use\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3421 \(instead of that of the visited file), in the form of a list\n\ |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3422 \(HIGH . LOW) or (HIGH LOW).") |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3423 (time_list) |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3424 Lisp_Object time_list; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3425 { |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3426 if (!NILP (time_list)) |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3427 current_buffer->modtime = cons_to_long (time_list); |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3428 else |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3429 { |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3430 register Lisp_Object filename; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3431 struct stat st; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3432 Lisp_Object handler; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3433 |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3434 filename = Fexpand_file_name (current_buffer->filename, Qnil); |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3435 |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3436 /* If the file name has special constructs in it, |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3437 call the corresponding file handler. */ |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3438 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3439 if (!NILP (handler)) |
3721
4550c56785d8
(Fset_visited_file_modtime): Don't give the handler
Richard M. Stallman <rms@gnu.org>
parents:
3705
diff
changeset
|
3440 /* The handler can find the file name the same way we did. */ |
3829
4130587b6ffc
* fileio.c (Fset_visited_file_modtime): We're only passing two
Jim Blandy <jimb@redhat.com>
parents:
3787
diff
changeset
|
3441 return call2 (handler, Qset_visited_file_modtime, Qnil); |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3442 else if (stat (XSTRING (filename)->data, &st) >= 0) |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3443 current_buffer->modtime = st.st_mtime; |
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
3444 } |
230 | 3445 |
3446 return Qnil; | |
3447 } | |
3448 | |
3449 Lisp_Object | |
3450 auto_save_error () | |
3451 { | |
3452 unsigned char *name = XSTRING (current_buffer->name)->data; | |
3453 | |
3454 ring_bell (); | |
3455 message ("Autosaving...error for %s", name); | |
806 | 3456 Fsleep_for (make_number (1), Qnil); |
230 | 3457 message ("Autosaving...error!for %s", name); |
806 | 3458 Fsleep_for (make_number (1), Qnil); |
230 | 3459 message ("Autosaving...error for %s", name); |
806 | 3460 Fsleep_for (make_number (1), Qnil); |
230 | 3461 return Qnil; |
3462 } | |
3463 | |
3464 Lisp_Object | |
3465 auto_save_1 () | |
3466 { | |
3467 unsigned char *fn; | |
3468 struct stat st; | |
3469 | |
3470 /* Get visited file's mode to become the auto save file's mode. */ | |
3471 if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0) | |
3472 /* But make sure we can overwrite it later! */ | |
3473 auto_save_mode_bits = st.st_mode | 0600; | |
3474 else | |
3475 auto_save_mode_bits = 0666; | |
3476 | |
3477 return | |
3478 Fwrite_region (Qnil, Qnil, | |
3479 current_buffer->auto_save_file_name, | |
3480 Qnil, Qlambda); | |
3481 } | |
3482 | |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3483 static Lisp_Object |
7526
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3484 do_auto_save_unwind (desc) /* used as unwind-protect function */ |
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3485 Lisp_Object desc; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3486 { |
7526
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3487 close (XINT (desc)); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3488 return Qnil; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3489 } |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3490 |
230 | 3491 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", |
3492 "Auto-save all buffers that need it.\n\ | |
3493 This is all buffers that have auto-saving enabled\n\ | |
3494 and are changed since last auto-saved.\n\ | |
3495 Auto-saving writes the buffer into a file\n\ | |
3496 so that your editing is not lost if the system crashes.\n\ | |
6209
2a8a76b9a2fe
(Fdo_auto_save): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
6194
diff
changeset
|
3497 This file is not the file you visited; that changes only when you save.\n\ |
2a8a76b9a2fe
(Fdo_auto_save): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
6194
diff
changeset
|
3498 Normally we run the normal hook `auto-save-hook' before saving.\n\n\ |
230 | 3499 Non-nil first argument means do not print any message if successful.\n\ |
621 | 3500 Non-nil second argument means save only current buffer.") |
1775
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3501 (no_message, current_only) |
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3502 Lisp_Object no_message, current_only; |
230 | 3503 { |
3504 struct buffer *old = current_buffer, *b; | |
3505 Lisp_Object tail, buf; | |
3506 int auto_saved = 0; | |
3507 char *omessage = echo_area_glyphs; | |
5875
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3508 int omessage_length = echo_area_glyphs_length; |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3509 extern int minibuf_level; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3510 int do_handled_files; |
4270
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3511 Lisp_Object oquit; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3512 int listdesc; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3513 Lisp_Object lispstream; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3514 int count = specpdl_ptr - specpdl; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3515 int *ptr; |
4270
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3516 |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3517 /* Ordinarily don't quit within this function, |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3518 but don't make it impossible to quit (in case we get hung in I/O). */ |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3519 oquit = Vquit_flag; |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3520 Vquit_flag = Qnil; |
230 | 3521 |
3522 /* No GCPRO needed, because (when it matters) all Lisp_Object variables | |
3523 point to non-strings reached from Vbuffer_alist. */ | |
3524 | |
3525 auto_saving = 1; | |
3526 if (minibuf_level) | |
1775
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3527 no_message = Qt; |
230 | 3528 |
485 | 3529 if (!NILP (Vrun_hooks)) |
230 | 3530 call1 (Vrun_hooks, intern ("auto-save-hook")); |
3531 | |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3532 if (STRINGP (Vauto_save_list_file_name)) |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3533 { |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3534 #ifdef MSDOS |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3535 listdesc = open (XSTRING (Vauto_save_list_file_name)->data, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3536 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3537 S_IREAD | S_IWRITE); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3538 #else /* not MSDOS */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3539 listdesc = creat (XSTRING (Vauto_save_list_file_name)->data, 0666); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3540 #endif /* not MSDOS */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3541 } |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3542 else |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3543 listdesc = -1; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3544 |
7526
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3545 /* Arrange to close that file whether or not we get an error. */ |
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3546 if (listdesc >= 0) |
bf357bdc648e
(Fdo_auto_save): Save listdesc as an integer, only if open.
Richard M. Stallman <rms@gnu.org>
parents:
7493
diff
changeset
|
3547 record_unwind_protect (do_auto_save_unwind, make_number (listdesc)); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3548 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3549 /* First, save all files which don't have handlers. If Emacs is |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3550 crashing, the handlers may tweak what is causing Emacs to crash |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3551 in the first place, and it would be a shame if Emacs failed to |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3552 autosave perfectly ordinary files because it couldn't handle some |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3553 ange-ftp'd file. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3554 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3555 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3556 tail = XCONS (tail)->cdr) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3557 { |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3558 buf = XCONS (XCONS (tail)->car)->cdr; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3559 b = XBUFFER (buf); |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3560 |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3561 /* Record all the buffers that have auto save mode |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3562 in the special file that lists them. */ |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3563 if (XTYPE (b->auto_save_file_name) == Lisp_String |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3564 && listdesc >= 0 && do_handled_files == 0) |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3565 { |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3566 write (listdesc, XSTRING (b->auto_save_file_name)->data, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3567 XSTRING (b->auto_save_file_name)->size); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3568 write (listdesc, "\n", 1); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3569 } |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3570 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3571 if (!NILP (current_only) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3572 && b != current_buffer) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3573 continue; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3574 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3575 /* Check for auto save enabled |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3576 and file changed since last auto save |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3577 and file changed since last real save. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3578 if (XTYPE (b->auto_save_file_name) == Lisp_String |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3579 && b->save_modified < BUF_MODIFF (b) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3580 && b->auto_save_modified < BUF_MODIFF (b) |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3581 /* -1 means we've turned off autosaving for a while--see below. */ |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3582 && XINT (b->save_length) >= 0 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3583 && (do_handled_files |
7029
f67c02c50e2a
(Ffind_file_name_handler): New argument OPERATION. All callers changed.
Karl Heuer <kwzh@gnu.org>
parents:
6898
diff
changeset
|
3584 || 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>
parents:
6898
diff
changeset
|
3585 Qwrite_region)))) |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3586 { |
5553
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3587 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>
parents:
5529
diff
changeset
|
3588 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3589 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>
parents:
5529
diff
changeset
|
3590 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3591 /* 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>
parents:
5529
diff
changeset
|
3592 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>
parents:
5529
diff
changeset
|
3593 && 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>
parents:
5529
diff
changeset
|
3594 continue; |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3595 |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3596 if ((XFASTINT (b->save_length) * 10 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3597 > (BUF_Z (b) - BUF_BEG (b)) * 13) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3598 /* A short file is likely to change a large fraction; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3599 spare the user annoying messages. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3600 && XFASTINT (b->save_length) > 5000 |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3601 /* These messages are frequent and annoying for `*mail*'. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3602 && !EQ (b->filename, Qnil) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3603 && NILP (no_message)) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3604 { |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3605 /* It has shrunk too much; turn off auto-saving here. */ |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3606 message ("Buffer %s has shrunk a lot; auto save turned off there", |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3607 XSTRING (b->name)->data); |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3608 /* Turn off auto-saving until there's a real save, |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3609 and prevent any more warnings. */ |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
3610 XSET (b->save_length, Lisp_Int, -1); |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3611 Fsleep_for (make_number (1), Qnil); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3612 continue; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3613 } |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3614 set_buffer_internal (b); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3615 if (!auto_saved && NILP (no_message)) |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3616 message1 ("Auto-saving..."); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3617 internal_condition_case (auto_save_1, Qt, auto_save_error); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3618 auto_saved++; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3619 b->auto_save_modified = BUF_MODIFF (b); |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3620 XFASTINT (current_buffer->save_length) = Z - BEG; |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3621 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>
parents:
5529
diff
changeset
|
3622 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3623 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>
parents:
5529
diff
changeset
|
3624 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3625 /* 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>
parents:
5529
diff
changeset
|
3626 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>
parents:
5529
diff
changeset
|
3627 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>
parents:
5529
diff
changeset
|
3628 b->auto_save_failure_time = EMACS_SECS (after_time); |
1869
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3629 } |
30eb06b22ae4
* fileio.c (Fdo_auto_save): If NO_MESSAGE is non-nil, don't tell
Jim Blandy <jimb@redhat.com>
parents:
1775
diff
changeset
|
3630 } |
230 | 3631 |
1059
430923239064
(Fdo_auto_save): Always call record_auto_save.
Richard M. Stallman <rms@gnu.org>
parents:
1044
diff
changeset
|
3632 /* Prevent another auto save till enough input events come in. */ |
430923239064
(Fdo_auto_save): Always call record_auto_save.
Richard M. Stallman <rms@gnu.org>
parents:
1044
diff
changeset
|
3633 record_auto_save (); |
230 | 3634 |
1775
f9ac4c0d8b72
* fileio.c (Fdo_auto_save): Add CURRENT_ONLY argument, as
Jim Blandy <jimb@redhat.com>
parents:
1763
diff
changeset
|
3635 if (auto_saved && NILP (no_message)) |
5875
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3636 { |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3637 if (omessage) |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3638 message2 (omessage, omessage_length); |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3639 else |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3640 message1 ("Auto-saving...done"); |
6bfcd23bfa84
(Fdo_auto_save): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5758
diff
changeset
|
3641 } |
230 | 3642 |
4270
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3643 Vquit_flag = oquit; |
3ce8e11f338b
(Fdo_auto_save): Temporarily clear Vquit_flag.
Richard M. Stallman <rms@gnu.org>
parents:
3963
diff
changeset
|
3644 |
230 | 3645 auto_saving = 0; |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
3646 unbind_to (count, Qnil); |
230 | 3647 return Qnil; |
3648 } | |
3649 | |
3650 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, | |
3651 Sset_buffer_auto_saved, 0, 0, 0, | |
3652 "Mark current buffer as auto-saved with its current text.\n\ | |
3653 No auto-save file will be written until the buffer changes again.") | |
3654 () | |
3655 { | |
3656 current_buffer->auto_save_modified = MODIFF; | |
3657 XFASTINT (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>
parents:
5529
diff
changeset
|
3658 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>
parents:
5529
diff
changeset
|
3659 return Qnil; |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3660 } |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3661 |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3662 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3663 Sclear_buffer_auto_save_failure, 0, 0, 0, |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3664 "Clear any record of a recent auto-save failure in the current buffer.") |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3665 () |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3666 { |
22a65d8c0b9a
(Fdo_auto_save): If auto save times out, don't try again for 20 minutes.
Richard M. Stallman <rms@gnu.org>
parents:
5529
diff
changeset
|
3667 current_buffer->auto_save_failure_time = -1; |
230 | 3668 return Qnil; |
3669 } | |
3670 | |
3671 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, | |
3672 0, 0, 0, | |
3673 "Return t if buffer has been auto-saved since last read in or saved.") | |
3674 () | |
3675 { | |
3676 return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil; | |
3677 } | |
3678 | |
3679 /* Reading and completing file names */ | |
3680 extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions (); | |
3681 | |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3682 /* In the string VAL, change each $ to $$ and return the result. */ |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3683 |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3684 static Lisp_Object |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3685 double_dollars (val) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3686 Lisp_Object val; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3687 { |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3688 register unsigned char *old, *new; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3689 register int n; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3690 int osize, count; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3691 |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3692 osize = XSTRING (val)->size; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3693 /* Quote "$" as "$$" to get it past substitute-in-file-name */ |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3694 for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3695 if (*old++ == '$') count++; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3696 if (count > 0) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3697 { |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3698 old = XSTRING (val)->data; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3699 val = Fmake_string (make_number (osize + count), make_number (0)); |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3700 new = XSTRING (val)->data; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3701 for (n = osize; n > 0; n--) |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3702 if (*old != '$') |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3703 *new++ = *old++; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3704 else |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3705 { |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3706 *new++ = '$'; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3707 *new++ = '$'; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3708 old++; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3709 } |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3710 } |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3711 return val; |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3712 } |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3713 |
230 | 3714 DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, |
3715 3, 3, 0, | |
3716 "Internal subroutine for read-file-name. Do not call this.") | |
3717 (string, dir, action) | |
3718 Lisp_Object string, dir, action; | |
3719 /* action is nil for complete, t for return list of completions, | |
3720 lambda for verify final value */ | |
3721 { | |
3722 Lisp_Object name, specdir, realdir, val, orig_string; | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3723 int changed; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3724 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3725 |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3726 realdir = dir; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3727 name = string; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3728 orig_string = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3729 specdir = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3730 changed = 0; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3731 /* No need to protect ACTION--we only compare it with t and nil. */ |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3732 GCPRO4 (string, realdir, name, specdir); |
230 | 3733 |
3734 if (XSTRING (string)->size == 0) | |
3735 { | |
3736 if (EQ (action, Qlambda)) | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3737 { |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3738 UNGCPRO; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3739 return Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3740 } |
230 | 3741 } |
3742 else | |
3743 { | |
3744 orig_string = string; | |
3745 string = Fsubstitute_in_file_name (string); | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3746 changed = NILP (Fstring_equal (string, orig_string)); |
230 | 3747 name = Ffile_name_nondirectory (string); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3748 val = Ffile_name_directory (string); |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3749 if (! NILP (val)) |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3750 realdir = Fexpand_file_name (val, realdir); |
230 | 3751 } |
3752 | |
485 | 3753 if (NILP (action)) |
230 | 3754 { |
3755 specdir = Ffile_name_directory (string); | |
3756 val = Ffile_name_completion (name, realdir); | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3757 UNGCPRO; |
230 | 3758 if (XTYPE (val) != Lisp_String) |
3759 { | |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3760 if (changed) |
230 | 3761 return string; |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3762 return val; |
230 | 3763 } |
3764 | |
485 | 3765 if (!NILP (specdir)) |
230 | 3766 val = concat2 (specdir, val); |
3767 #ifndef VMS | |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3768 return double_dollars (val); |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3769 #else /* not VMS */ |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3770 return val; |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3771 #endif /* not VMS */ |
230 | 3772 } |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
3773 UNGCPRO; |
230 | 3774 |
3775 if (EQ (action, Qt)) | |
3776 return Ffile_name_all_completions (name, realdir); | |
3777 /* Only other case actually used is ACTION = lambda */ | |
3778 #ifdef VMS | |
3779 /* Supposedly this helps commands such as `cd' that read directory names, | |
3780 but can someone explain how it helps them? -- RMS */ | |
3781 if (XSTRING (name)->size == 0) | |
3782 return Qt; | |
3783 #endif /* VMS */ | |
3784 return Ffile_exists_p (string); | |
3785 } | |
3786 | |
3787 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, | |
3788 "Read file name, prompting with PROMPT and completing in directory DIR.\n\ | |
3789 Value is not expanded---you must call `expand-file-name' yourself.\n\ | |
3790 Default name to DEFAULT if user enters a null string.\n\ | |
3791 (If DEFAULT is omitted, the visited file name is used.)\n\ | |
3792 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\ | |
3793 Non-nil and non-t means also require confirmation after completion.\n\ | |
3794 Fifth arg INITIAL specifies text to start with.\n\ | |
3795 DIR defaults to current buffer's directory default.") | |
3796 (prompt, dir, defalt, mustmatch, initial) | |
3797 Lisp_Object prompt, dir, defalt, mustmatch, initial; | |
3798 { | |
866 | 3799 Lisp_Object val, insdef, insdef1, tem; |
230 | 3800 struct gcpro gcpro1, gcpro2; |
3801 register char *homedir; | |
3802 int count; | |
3803 | |
485 | 3804 if (NILP (dir)) |
230 | 3805 dir = current_buffer->directory; |
485 | 3806 if (NILP (defalt)) |
230 | 3807 defalt = current_buffer->filename; |
3808 | |
3809 /* If dir starts with user's homedir, change that to ~. */ | |
3810 homedir = (char *) egetenv ("HOME"); | |
3811 if (homedir != 0 | |
3812 && XTYPE (dir) == Lisp_String | |
3813 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) | |
3814 && XSTRING (dir)->data[strlen (homedir)] == '/') | |
3815 { | |
3816 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, | |
3817 XSTRING (dir)->size - strlen (homedir) + 1); | |
3818 XSTRING (dir)->data[0] = '~'; | |
3819 } | |
3820 | |
3821 if (insert_default_directory) | |
3822 { | |
3823 insdef = dir; | |
485 | 3824 if (!NILP (initial)) |
230 | 3825 { |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3826 Lisp_Object args[2], pos; |
230 | 3827 |
3828 args[0] = insdef; | |
3829 args[1] = initial; | |
3830 insdef = Fconcat (2, args); | |
6181
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
3831 pos = make_number (XSTRING (double_dollars (dir))->size); |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3832 insdef1 = Fcons (double_dollars (insdef), pos); |
230 | 3833 } |
5647
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3834 else |
7bd40f51b9e9
(double_dollars): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5616
diff
changeset
|
3835 insdef1 = double_dollars (insdef); |
230 | 3836 } |
6181
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
3837 else if (!NILP (initial)) |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
3838 { |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
3839 insdef = initial; |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
3840 insdef1 = Fcons (double_dollars (insdef), 0); |
dd271c6b4e56
(Fread_file_name): Do the right thing when insert-default-directory is nil.
Karl Heuer <kwzh@gnu.org>
parents:
6177
diff
changeset
|
3841 } |
230 | 3842 else |
866 | 3843 insdef = Qnil, insdef1 = Qnil; |
230 | 3844 |
3845 #ifdef VMS | |
3846 count = specpdl_ptr - specpdl; | |
3847 specbind (intern ("completion-ignore-case"), Qt); | |
3848 #endif | |
3849 | |
3850 GCPRO2 (insdef, defalt); | |
3851 val = Fcompleting_read (prompt, intern ("read-file-name-internal"), | |
866 | 3852 dir, mustmatch, insdef1, |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3853 Qfile_name_history); |
230 | 3854 |
3855 #ifdef VMS | |
3856 unbind_to (count, Qnil); | |
3857 #endif | |
3858 | |
3859 UNGCPRO; | |
485 | 3860 if (NILP (val)) |
230 | 3861 error ("No file name specified"); |
3862 tem = Fstring_equal (val, insdef); | |
485 | 3863 if (!NILP (tem) && !NILP (defalt)) |
230 | 3864 return defalt; |
3032
371058345c42
(Fread_file_name): If input is empty, do return the default
Richard M. Stallman <rms@gnu.org>
parents:
3017
diff
changeset
|
3865 if (XSTRING (val)->size == 0 && NILP (insdef)) |
5245
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
3866 { |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
3867 if (!NILP (defalt)) |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
3868 return defalt; |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
3869 else |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
3870 error ("No default file name"); |
4a9b93b0eac3
(Fmake_symbolic_link): Do expand FILENAME if starts with ~.
Richard M. Stallman <rms@gnu.org>
parents:
5129
diff
changeset
|
3871 } |
230 | 3872 return Fsubstitute_in_file_name (val); |
3873 } | |
3874 | |
3875 #if 0 /* Old version */ | |
3876 DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, | |
6347
c7e1f551e97a
(Fread_file_name): Delete docstring of second version of function, to avoid
Karl Heuer <kwzh@gnu.org>
parents:
6328
diff
changeset
|
3877 /* Don't confuse make-docfile by having two doc strings for this function. |
c7e1f551e97a
(Fread_file_name): Delete docstring of second version of function, to avoid
Karl Heuer <kwzh@gnu.org>
parents:
6328
diff
changeset
|
3878 make-docfile does not pay attention to #if, for good reason! */ |
c7e1f551e97a
(Fread_file_name): Delete docstring of second version of function, to avoid
Karl Heuer <kwzh@gnu.org>
parents:
6328
diff
changeset
|
3879 0) |
230 | 3880 (prompt, dir, defalt, mustmatch, initial) |
3881 Lisp_Object prompt, dir, defalt, mustmatch, initial; | |
3882 { | |
3883 Lisp_Object val, insdef, tem; | |
3884 struct gcpro gcpro1, gcpro2; | |
3885 register char *homedir; | |
3886 int count; | |
3887 | |
485 | 3888 if (NILP (dir)) |
230 | 3889 dir = current_buffer->directory; |
485 | 3890 if (NILP (defalt)) |
230 | 3891 defalt = current_buffer->filename; |
3892 | |
3893 /* If dir starts with user's homedir, change that to ~. */ | |
3894 homedir = (char *) egetenv ("HOME"); | |
3895 if (homedir != 0 | |
3896 && XTYPE (dir) == Lisp_String | |
3897 && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) | |
3898 && XSTRING (dir)->data[strlen (homedir)] == '/') | |
3899 { | |
3900 dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1, | |
3901 XSTRING (dir)->size - strlen (homedir) + 1); | |
3902 XSTRING (dir)->data[0] = '~'; | |
3903 } | |
3904 | |
485 | 3905 if (!NILP (initial)) |
230 | 3906 insdef = initial; |
3907 else if (insert_default_directory) | |
3908 insdef = dir; | |
3909 else | |
3910 insdef = build_string (""); | |
3911 | |
3912 #ifdef VMS | |
3913 count = specpdl_ptr - specpdl; | |
3914 specbind (intern ("completion-ignore-case"), Qt); | |
3915 #endif | |
3916 | |
3917 GCPRO2 (insdef, defalt); | |
3918 val = Fcompleting_read (prompt, intern ("read-file-name-internal"), | |
3919 dir, mustmatch, | |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3920 insert_default_directory ? insdef : Qnil, |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3921 Qfile_name_history); |
230 | 3922 |
3923 #ifdef VMS | |
3924 unbind_to (count, Qnil); | |
3925 #endif | |
3926 | |
3927 UNGCPRO; | |
485 | 3928 if (NILP (val)) |
230 | 3929 error ("No file name specified"); |
3930 tem = Fstring_equal (val, insdef); | |
485 | 3931 if (!NILP (tem) && !NILP (defalt)) |
230 | 3932 return defalt; |
3933 return Fsubstitute_in_file_name (val); | |
3934 } | |
3935 #endif /* Old version */ | |
3936 | |
3937 syms_of_fileio () | |
3938 { | |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
3939 Qexpand_file_name = intern ("expand-file-name"); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
3940 Qdirectory_file_name = intern ("directory-file-name"); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
3941 Qfile_name_directory = intern ("file-name-directory"); |
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
3942 Qfile_name_nondirectory = intern ("file-name-nondirectory"); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3943 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory"); |
1105
80ad8d0704ba
(Ffile_name_directory, Ffile_name_nondirectory):
Richard M. Stallman <rms@gnu.org>
parents:
1071
diff
changeset
|
3944 Qfile_name_as_directory = intern ("file-name-as-directory"); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3945 Qcopy_file = intern ("copy-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3946 Qmake_directory = intern ("make-directory"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3947 Qdelete_directory = intern ("delete-directory"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3948 Qdelete_file = intern ("delete-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3949 Qrename_file = intern ("rename-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3950 Qadd_name_to_file = intern ("add-name-to-file"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3951 Qmake_symbolic_link = intern ("make-symbolic-link"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3952 Qfile_exists_p = intern ("file-exists-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3953 Qfile_executable_p = intern ("file-executable-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3954 Qfile_readable_p = intern ("file-readable-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3955 Qfile_symlink_p = intern ("file-symlink-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3956 Qfile_writable_p = intern ("file-writable-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3957 Qfile_directory_p = intern ("file-directory-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3958 Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3959 Qfile_modes = intern ("file-modes"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3960 Qset_file_modes = intern ("set-file-modes"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3961 Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3962 Qinsert_file_contents = intern ("insert-file-contents"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3963 Qwrite_region = intern ("write-region"); |
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3964 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); |
3560
95021dcb923b
(syms_of_fileio): Set up Qset_visited_file_modtime.
Richard M. Stallman <rms@gnu.org>
parents:
3415
diff
changeset
|
3965 Qset_visited_file_modtime = intern ("set-visited-file-modtime"); |
843
8f6ea998ad0a
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
806
diff
changeset
|
3966 |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3967 staticpro (&Qexpand_file_name); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3968 staticpro (&Qdirectory_file_name); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3969 staticpro (&Qfile_name_directory); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3970 staticpro (&Qfile_name_nondirectory); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3971 staticpro (&Qunhandled_file_name_directory); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3972 staticpro (&Qfile_name_as_directory); |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3973 staticpro (&Qcopy_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3974 staticpro (&Qmake_directory); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3975 staticpro (&Qdelete_directory); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3976 staticpro (&Qdelete_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3977 staticpro (&Qrename_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3978 staticpro (&Qadd_name_to_file); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3979 staticpro (&Qmake_symbolic_link); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3980 staticpro (&Qfile_exists_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3981 staticpro (&Qfile_executable_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3982 staticpro (&Qfile_readable_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3983 staticpro (&Qfile_symlink_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3984 staticpro (&Qfile_writable_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3985 staticpro (&Qfile_directory_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3986 staticpro (&Qfile_accessible_directory_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3987 staticpro (&Qfile_modes); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3988 staticpro (&Qset_file_modes); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3989 staticpro (&Qfile_newer_than_file_p); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3990 staticpro (&Qinsert_file_contents); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3991 staticpro (&Qwrite_region); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3992 staticpro (&Qverify_visited_file_modtime); |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3993 |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3994 Qfile_name_history = intern ("file-name-history"); |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
3995 Fset (Qfile_name_history, Qnil); |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3996 staticpro (&Qfile_name_history); |
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
853
diff
changeset
|
3997 |
230 | 3998 Qfile_error = intern ("file-error"); |
3999 staticpro (&Qfile_error); | |
4000 Qfile_already_exists = intern("file-already-exists"); | |
4001 staticpro (&Qfile_already_exists); | |
4002 | |
5494
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4003 #ifdef MSDOS |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4004 Qfind_buffer_file_type = intern ("find-buffer-file-type"); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4005 staticpro (&Qfind_buffer_file_type); |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4006 #endif |
1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
Richard M. Stallman <rms@gnu.org>
parents:
5410
diff
changeset
|
4007 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4008 Qcar_less_than_car = intern ("car-less-than-car"); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4009 staticpro (&Qcar_less_than_car); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4010 |
230 | 4011 Fput (Qfile_error, Qerror_conditions, |
4012 Fcons (Qfile_error, Fcons (Qerror, Qnil))); | |
4013 Fput (Qfile_error, Qerror_message, | |
4014 build_string ("File error")); | |
4015 | |
4016 Fput (Qfile_already_exists, Qerror_conditions, | |
4017 Fcons (Qfile_already_exists, | |
4018 Fcons (Qfile_error, Fcons (Qerror, Qnil)))); | |
4019 Fput (Qfile_already_exists, Qerror_message, | |
4020 build_string ("File already exists")); | |
4021 | |
4022 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, | |
4023 "*Non-nil means when reading a filename start with default dir in minibuffer."); | |
4024 insert_default_directory = 1; | |
4025 | |
4026 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm, | |
4027 "*Non-nil means write new files with record format `stmlf'.\n\ | |
4028 nil means use format `var'. This variable is meaningful only on VMS."); | |
4029 vms_stmlf_recfm = 0; | |
4030 | |
850
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4031 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4032 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4033 If a file name matches REGEXP, then all I/O on that file is done by calling\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4034 HANDLER.\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4035 \n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4036 The first argument given to HANDLER is the name of the I/O primitive\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4037 to be handled; the remaining arguments are the arguments that were\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4038 passed to that primitive. For example, if you do\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4039 (file-exists-p FILENAME)\n\ |
0bc61321ba50
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
848
diff
changeset
|
4040 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4041 (funcall HANDLER 'file-exists-p FILENAME)\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4042 The function `find-file-name-handler' checks this list for a handler\n\ |
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4043 for its argument."); |
1178
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4044 Vfile_name_handler_alist = Qnil; |
fb4ec23ef80f
Don't include sys/dir.h.
Richard M. Stallman <rms@gnu.org>
parents:
1105
diff
changeset
|
4045 |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4046 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, |
4989
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4047 "A list of functions to be called at the end of `insert-file-contents'.\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4048 Each is passed one argument, the number of bytes inserted. It should return\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4049 the new byte count, and leave point the same. If `insert-file-contents' is\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4050 intercepted by a handler from `file-name-handler-alist', that handler is\n\ |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4051 responsible for calling the after-insert-file-functions if appropriate."); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4052 Vafter_insert_file_functions = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4053 |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4054 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, |
4989
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4055 "A list of functions to be called at the start of `write-region'.\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4056 Each is passed two arguments, START and END as for `write-region'. It should\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4057 return a list of pairs (POSITION . STRING) of strings to be effectively\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4058 inserted at the specified positions of the file being written (1 means to\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4059 insert before the first byte written). The POSITIONs must be sorted into\n\ |
9fe45f58189f
(syms_of_fileio): Fix missing \n\'s.
Richard M. Stallman <rms@gnu.org>
parents:
4950
diff
changeset
|
4060 increasing order. If there are several functions in the list, the several\n\ |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4061 lists are merged destructively."); |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4062 Vwrite_region_annotate_functions = Qnil; |
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4063 |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
4064 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, |
7549
ccb8b7f8dce7
(syms_of_fileio): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
7526
diff
changeset
|
4065 "A list of file name handlers that temporarily should not be used.\n\ |
7182
f0ecad45bb35
(inhibit-file-name-handers): Correct documentation.
Richard M. Stallman <rms@gnu.org>
parents:
7130
diff
changeset
|
4066 This applies only to the operation `inhibit-file-name-operation'."); |
6678
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
4067 Vinhibit_file_name_handlers = Qnil; |
e29adbacde1d
(Fdo_auto_save): Don't turn off auto save mode.
Richard M. Stallman <rms@gnu.org>
parents:
6498
diff
changeset
|
4068 |
7041
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4069 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation, |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4070 "The operation for which `inhibit-file-name-handlers' is applicable."); |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4071 Vinhibit_file_name_operation = Qnil; |
7b8c405c910a
(syms_of_fileio): New Lisp var inhibit-file-name-operation.
Richard M. Stallman <rms@gnu.org>
parents:
7029
diff
changeset
|
4072 |
7445
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4073 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name, |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4074 "File name in which we write a list of all auto save file names."); |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4075 Vauto_save_list_file_name = Qnil; |
c9942f71e2e9
(Finsert_file_contents) [MSDOS]: Ignore the replace feature.
Richard M. Stallman <rms@gnu.org>
parents:
7182
diff
changeset
|
4076 |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4077 defsubr (&Sfind_file_name_handler); |
230 | 4078 defsubr (&Sfile_name_directory); |
4079 defsubr (&Sfile_name_nondirectory); | |
1679
cd48b2c1a7a4
Give subprocess creation a way to find a valid current directory
Jim Blandy <jimb@redhat.com>
parents:
1589
diff
changeset
|
4080 defsubr (&Sunhandled_file_name_directory); |
230 | 4081 defsubr (&Sfile_name_as_directory); |
4082 defsubr (&Sdirectory_file_name); | |
4083 defsubr (&Smake_temp_name); | |
4084 defsubr (&Sexpand_file_name); | |
4085 defsubr (&Ssubstitute_in_file_name); | |
4086 defsubr (&Scopy_file); | |
1533
b86ef0432100
(Fmake_directory_internal): Renamed from Fmake_directory.
Richard M. Stallman <rms@gnu.org>
parents:
1377
diff
changeset
|
4087 defsubr (&Smake_directory_internal); |
686
bd3068742807
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
648
diff
changeset
|
4088 defsubr (&Sdelete_directory); |
230 | 4089 defsubr (&Sdelete_file); |
4090 defsubr (&Srename_file); | |
4091 defsubr (&Sadd_name_to_file); | |
4092 #ifdef S_IFLNK | |
4093 defsubr (&Smake_symbolic_link); | |
4094 #endif /* S_IFLNK */ | |
4095 #ifdef VMS | |
4096 defsubr (&Sdefine_logical_name); | |
4097 #endif /* VMS */ | |
4098 #ifdef HPUX_NET | |
4099 defsubr (&Ssysnetunam); | |
4100 #endif /* HPUX_NET */ | |
4101 defsubr (&Sfile_name_absolute_p); | |
4102 defsubr (&Sfile_exists_p); | |
4103 defsubr (&Sfile_executable_p); | |
4104 defsubr (&Sfile_readable_p); | |
4105 defsubr (&Sfile_writable_p); | |
4106 defsubr (&Sfile_symlink_p); | |
4107 defsubr (&Sfile_directory_p); | |
536 | 4108 defsubr (&Sfile_accessible_directory_p); |
230 | 4109 defsubr (&Sfile_modes); |
4110 defsubr (&Sset_file_modes); | |
1763
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
4111 defsubr (&Sset_default_file_modes); |
65e858c07a8b
(Fset_default_file_modes, Fdefault_file_modes): Renamed from .._mode.
Richard M. Stallman <rms@gnu.org>
parents:
1762
diff
changeset
|
4112 defsubr (&Sdefault_file_modes); |
230 | 4113 defsubr (&Sfile_newer_than_file_p); |
4114 defsubr (&Sinsert_file_contents); | |
4115 defsubr (&Swrite_region); | |
4841
8800a7377ceb
(Vafter_insert_file_functions): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
4116 defsubr (&Scar_less_than_car); |
230 | 4117 defsubr (&Sverify_visited_file_modtime); |
4118 defsubr (&Sclear_visited_file_modtime); | |
2257
668491072928
(Fvisited_file_modtime): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2236
diff
changeset
|
4119 defsubr (&Svisited_file_modtime); |
230 | 4120 defsubr (&Sset_visited_file_modtime); |
4121 defsubr (&Sdo_auto_save); | |
4122 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>
parents:
5529
diff
changeset
|
4123 defsubr (&Sclear_buffer_auto_save_failure); |
230 | 4124 defsubr (&Srecent_auto_save_p); |
4125 | |
4126 defsubr (&Sread_file_name_internal); | |
4127 defsubr (&Sread_file_name); | |
689
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
4128 |
1204
567860ca77e0
* fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync
Jim Blandy <jimb@redhat.com>
parents:
1178
diff
changeset
|
4129 #ifdef unix |
689
45401d45581d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
686
diff
changeset
|
4130 defsubr (&Sunix_sync); |
1204
567860ca77e0
* fileio.c (syms_of_fileio): Don't try to defsubr Sunix_sync
Jim Blandy <jimb@redhat.com>
parents:
1178
diff
changeset
|
4131 #endif |
230 | 4132 } |