Mercurial > hg > xemacs-beta
annotate src/fileio.c @ 5781:0853e1ec8529
Use alloca_{rawbytes,ibytes} in #'copy-file, #'insert-file-contents-internal
src/ChangeLog addition:
2014-01-20 Aidan Kehoe <kehoea@parhasard.net>
* fileio.c (Fcopy_file, Finsert_file_contents_internal):
Use alloca_{rawbytes,ibytes} here instead of the implicit alloca
on the stack; doesn't change where the buffers are allocated for
these two functions, but does mean that decisions about alloca
vs. malloc based on buffer size are made in the same place
(ultimately, the ALLOCA() macro).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 20 Jan 2014 17:53:07 +0000 |
| parents | e9d0228c5671 |
| children | 7277cf461612 |
| rev | line source |
|---|---|
| 428 | 1 /* File IO for XEmacs. |
| 2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc. | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
3 Copyright (C) 1996, 2001, 2002, 2003, 2004, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5211
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 8 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5211
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5211
diff
changeset
|
10 option) any later version. |
| 428 | 11 |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5211
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 /* Synched up with: Mule 2.0, FSF 19.30. */ | |
| 771 | 21 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> |
| 22 (Note: Sync messages from Marc Paquette may indicate | |
| 23 incomplete synching, so beware.) */ | |
| 2526 | 24 /* Some functions synched with FSF 21.0.103. */ |
| 771 | 25 /* Mule-ized completely except for the #if 0-code including decrypt-string |
| 26 and encrypt-string. --ben 7-2-00 */ | |
| 1333 | 27 /* #if 0-code Mule-ized, 2-22-03. --ben */ |
| 771 | 28 |
| 428 | 29 |
| 30 #include <config.h> | |
| 31 #include "lisp.h" | |
| 32 | |
| 33 #include "buffer.h" | |
| 800 | 34 #include "device.h" |
| 428 | 35 #include "events.h" |
| 800 | 36 #include "file-coding.h" |
| 428 | 37 #include "frame.h" |
| 38 #include "insdel.h" | |
| 39 #include "lstream.h" | |
| 2526 | 40 #include "profile.h" |
| 872 | 41 #include "process.h" |
| 428 | 42 #include "redisplay.h" |
| 43 #include "sysdep.h" | |
| 872 | 44 #include "window-impl.h" |
| 771 | 45 |
| 428 | 46 #include "sysfile.h" |
| 47 #include "sysproc.h" | |
| 48 #include "syspwd.h" | |
| 49 #include "systime.h" | |
| 50 #include "sysdir.h" | |
| 51 | |
| 52 #ifdef HPUX | |
| 53 #include <netio.h> | |
| 54 #endif /* HPUX */ | |
| 55 | |
| 1315 | 56 #ifdef WIN32_ANY |
| 657 | 57 #define WIN32_FILENAMES |
| 771 | 58 #include "syswindows.h" |
| 428 | 59 #define IS_DRIVE(x) isalpha (x) |
| 60 /* Need to lower-case the drive letter, or else expanded | |
| 61 filenames will sometimes compare inequal, because | |
| 62 `expand-file-name' doesn't always down-case the drive letter. */ | |
| 63 #define DRIVE_LETTER(x) tolower (x) | |
| 657 | 64 #endif /* WIN32_NATIVE || CYGWIN */ |
| 428 | 65 |
| 66 int lisp_to_time (Lisp_Object, time_t *); | |
| 67 Lisp_Object time_to_lisp (time_t); | |
| 68 | |
| 69 /* Nonzero during writing of auto-save files */ | |
| 70 static int auto_saving; | |
| 71 | |
| 72 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal | |
| 73 will create a new file with the same mode as the original */ | |
| 74 static int auto_save_mode_bits; | |
| 75 | |
| 76 /* Alist of elements (REGEXP . HANDLER) for file names | |
| 77 whose I/O is done with a special handler. */ | |
| 78 Lisp_Object Vfile_name_handler_alist; | |
| 79 | |
| 80 /* Format for auto-save files */ | |
| 81 Lisp_Object Vauto_save_file_format; | |
| 82 | |
| 83 /* Lisp functions for translating file formats */ | |
| 84 Lisp_Object Qformat_decode, Qformat_annotate_function; | |
| 85 | |
| 86 /* Functions to be called to process text properties in inserted file. */ | |
| 87 Lisp_Object Vafter_insert_file_functions; | |
| 88 | |
| 89 /* Functions to be called to create text property annotations for file. */ | |
| 90 Lisp_Object Vwrite_region_annotate_functions; | |
| 91 | |
| 92 /* During build_annotations, each time an annotation function is called, | |
| 93 this holds the annotations made by the previous functions. */ | |
| 94 Lisp_Object Vwrite_region_annotations_so_far; | |
| 95 | |
| 96 /* File name in which we write a list of all our auto save files. */ | |
| 97 Lisp_Object Vauto_save_list_file_name; | |
| 98 | |
| 444 | 99 /* Prefix used to construct Vauto_save_list_file_name. */ |
| 100 Lisp_Object Vauto_save_list_file_prefix; | |
| 101 | |
| 102 /* When non-nil, it prevents auto-save list file creation. */ | |
| 103 int inhibit_auto_save_session; | |
| 104 | |
| 428 | 105 int disable_auto_save_when_buffer_shrinks; |
| 106 | |
| 107 Lisp_Object Vdirectory_sep_char; | |
| 108 | |
|
5211
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
109 int default_file_system_ignore_case; |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
110 |
|
4499
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
111 #ifdef HAVE_FSYNC |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
112 /* Nonzero means skip the call to fsync in Fwrite-region. */ |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
113 int write_region_inhibit_fsync; |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
114 #endif |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
115 |
| 428 | 116 /* These variables describe handlers that have "already" had a chance |
| 117 to handle the current operation. | |
| 118 | |
| 119 Vinhibit_file_name_handlers is a list of file name handlers. | |
| 120 Vinhibit_file_name_operation is the operation being handled. | |
| 121 If we try to handle that operation, we ignore those handlers. */ | |
| 122 | |
| 123 static Lisp_Object Vinhibit_file_name_handlers; | |
| 124 static Lisp_Object Vinhibit_file_name_operation; | |
| 125 | |
| 563 | 126 Lisp_Object Qfile_already_exists; |
| 4266 | 127 Lisp_Object Qexcl; |
| 428 | 128 |
| 129 Lisp_Object Qauto_save_hook; | |
| 130 Lisp_Object Qauto_save_error; | |
| 131 Lisp_Object Qauto_saving; | |
| 132 | |
| 133 Lisp_Object Qcompute_buffer_file_truename; | |
| 134 | |
| 2526 | 135 Lisp_Object QSin_expand_file_name; |
| 136 | |
| 428 | 137 EXFUN (Frunning_temacs_p, 0); |
| 138 | |
| 563 | 139 DOESNT_RETURN |
| 140 report_error_with_errno (Lisp_Object errtype, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
141 const Ascbyte *reason, Lisp_Object data) |
| 563 | 142 { |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
143 signal_error_2 (errtype, reason, lisp_strerror (errno), data); |
| 563 | 144 } |
| 145 | |
| 428 | 146 /* signal a file error when errno contains a meaningful value. */ |
| 147 | |
| 148 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
149 report_file_error (const Ascbyte *reason, Lisp_Object data) |
| 428 | 150 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
151 report_error_with_errno (Qfile_error, reason, data); |
| 428 | 152 } |
| 153 | |
| 154 | |
| 155 /* Just like strerror(3), except return a lisp string instead of char *. | |
| 156 The string needs to be converted since it may be localized. | |
| 771 | 157 */ |
| 428 | 158 Lisp_Object |
| 159 lisp_strerror (int errnum) | |
| 160 { | |
| 771 | 161 Extbyte *ret = strerror (errnum); |
| 162 if (!ret) | |
| 163 { | |
| 867 | 164 Ibyte ffff[99]; |
| 771 | 165 qxesprintf (ffff, "Unknown error %d", errnum); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
166 return build_istring (ffff); |
| 771 | 167 } |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
168 return build_extstring (ret, Qstrerror_encoding); |
| 428 | 169 } |
| 170 | |
| 171 static Lisp_Object | |
| 172 close_file_unwind (Lisp_Object fd) | |
| 173 { | |
| 174 if (CONSP (fd)) | |
| 175 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
176 if (FIXNUMP (XCAR (fd))) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
177 retry_close (XFIXNUM (XCAR (fd))); |
| 428 | 178 |
| 853 | 179 free_cons (fd); |
| 428 | 180 } |
| 181 else | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
182 retry_close (XFIXNUM (fd)); |
| 428 | 183 |
| 184 return Qnil; | |
| 185 } | |
| 186 | |
| 187 static Lisp_Object | |
| 188 delete_stream_unwind (Lisp_Object stream) | |
| 189 { | |
| 190 Lstream_delete (XLSTREAM (stream)); | |
| 191 return Qnil; | |
| 192 } | |
| 193 | |
| 194 /* Restore point, having saved it as a marker. */ | |
| 195 | |
| 196 static Lisp_Object | |
| 197 restore_point_unwind (Lisp_Object point_marker) | |
| 198 { | |
| 199 BUF_SET_PT (current_buffer, marker_position (point_marker)); | |
| 200 return Fset_marker (point_marker, Qnil, Qnil); | |
| 201 } | |
| 202 | |
| 203 | |
| 204 Lisp_Object Qexpand_file_name; | |
| 205 Lisp_Object Qfile_truename; | |
| 206 Lisp_Object Qsubstitute_in_file_name; | |
| 207 Lisp_Object Qdirectory_file_name; | |
| 208 Lisp_Object Qfile_name_directory; | |
| 209 Lisp_Object Qfile_name_nondirectory; | |
| 996 | 210 Lisp_Object Qfile_name_sans_extension; |
| 428 | 211 Lisp_Object Qunhandled_file_name_directory; |
| 212 Lisp_Object Qfile_name_as_directory; | |
| 213 Lisp_Object Qcopy_file; | |
| 214 Lisp_Object Qmake_directory_internal; | |
| 215 Lisp_Object Qdelete_directory; | |
| 216 Lisp_Object Qdelete_file; | |
| 217 Lisp_Object Qrename_file; | |
| 218 Lisp_Object Qadd_name_to_file; | |
| 219 Lisp_Object Qmake_symbolic_link; | |
| 844 | 220 Lisp_Object Qmake_temp_name; |
| 428 | 221 Lisp_Object Qfile_exists_p; |
| 222 Lisp_Object Qfile_executable_p; | |
| 223 Lisp_Object Qfile_readable_p; | |
| 224 Lisp_Object Qfile_symlink_p; | |
| 225 Lisp_Object Qfile_writable_p; | |
| 226 Lisp_Object Qfile_directory_p; | |
| 227 Lisp_Object Qfile_regular_p; | |
| 228 Lisp_Object Qfile_accessible_directory_p; | |
| 229 Lisp_Object Qfile_modes; | |
| 230 Lisp_Object Qset_file_modes; | |
| 231 Lisp_Object Qfile_newer_than_file_p; | |
| 232 Lisp_Object Qinsert_file_contents; | |
| 233 Lisp_Object Qwrite_region; | |
| 234 Lisp_Object Qverify_visited_file_modtime; | |
| 235 Lisp_Object Qset_visited_file_modtime; | |
| 236 | |
| 237 /* If FILENAME is handled specially on account of its syntax, | |
| 238 return its handler function. Otherwise, return nil. */ | |
| 239 | |
| 240 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /* | |
| 241 Return FILENAME's handler function for OPERATION, if it has one. | |
| 242 Otherwise, return nil. | |
| 243 A file name is handled if one of the regular expressions in | |
| 244 `file-name-handler-alist' matches it. | |
| 245 | |
| 246 If OPERATION equals `inhibit-file-name-operation', then we ignore | |
| 247 any handlers that are members of `inhibit-file-name-handlers', | |
| 248 but we still do run any other handlers. This lets handlers | |
| 249 use the standard functions without calling themselves recursively. | |
| 751 | 250 |
| 251 Otherwise, OPERATION is the name of a funcall'able function. | |
| 428 | 252 */ |
| 253 (filename, operation)) | |
| 254 { | |
| 255 /* This function does not GC */ | |
| 256 /* This function can be called during GC */ | |
| 257 /* This function must not munge the match data. */ | |
| 2367 | 258 Lisp_Object inhibited_handlers; |
| 428 | 259 |
| 260 CHECK_STRING (filename); | |
| 261 | |
| 262 if (EQ (operation, Vinhibit_file_name_operation)) | |
| 263 inhibited_handlers = Vinhibit_file_name_handlers; | |
| 264 else | |
| 265 inhibited_handlers = Qnil; | |
| 266 | |
| 2367 | 267 { |
| 268 EXTERNAL_LIST_LOOP_2 (elt, Vfile_name_handler_alist) | |
| 269 { | |
| 270 if (CONSP (elt)) | |
| 271 { | |
| 272 Lisp_Object string = XCAR (elt); | |
| 273 if (STRINGP (string) | |
| 274 && (fast_lisp_string_match (string, filename) >= 0)) | |
| 275 { | |
| 276 Lisp_Object handler = XCDR (elt); | |
| 277 if (NILP (Fmemq (handler, inhibited_handlers))) | |
| 278 return handler; | |
| 279 } | |
| 280 } | |
| 281 } | |
| 282 } | |
| 428 | 283 return Qnil; |
| 284 } | |
| 285 | |
| 286 static Lisp_Object | |
| 287 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) | |
| 288 { | |
| 289 /* This function can call lisp */ | |
| 290 Lisp_Object result = call2 (fn, arg0, arg1); | |
| 291 CHECK_STRING (result); | |
| 292 return result; | |
| 293 } | |
| 294 | |
| 295 static Lisp_Object | |
| 296 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) | |
| 297 { | |
| 298 /* This function can call lisp */ | |
| 299 Lisp_Object result = call2 (fn, arg0, arg1); | |
| 300 if (!NILP (result)) | |
| 301 CHECK_STRING (result); | |
| 302 return result; | |
| 303 } | |
| 304 | |
| 305 static Lisp_Object | |
| 306 call3_check_string (Lisp_Object fn, Lisp_Object arg0, | |
| 307 Lisp_Object arg1, Lisp_Object arg2) | |
| 308 { | |
| 309 /* This function can call lisp */ | |
| 310 Lisp_Object result = call3 (fn, arg0, arg1, arg2); | |
| 311 CHECK_STRING (result); | |
| 312 return result; | |
| 313 } | |
| 314 | |
| 315 | |
| 2526 | 316 |
| 317 Ibyte * | |
| 318 find_end_of_directory_component (const Ibyte *path, Bytecount len) | |
| 319 { | |
| 320 const Ibyte *p = path + len; | |
| 321 | |
| 322 while (p != path && !IS_DIRECTORY_SEP (p[-1]) | |
| 323 #ifdef WIN32_FILENAMES | |
| 324 /* only recognise drive specifier at the beginning */ | |
| 325 && !(p[-1] == ':' | |
| 326 /* handle the "/:d:foo" and "/:foo" cases correctly */ | |
| 327 && ((p == path + 2 && !IS_DIRECTORY_SEP (*path)) | |
| 328 || (p == path + 4 && IS_DIRECTORY_SEP (*path)))) | |
| 329 #endif | |
| 330 ) p--; | |
| 331 | |
| 332 return (Ibyte *) p; | |
| 333 } | |
| 334 | |
| 428 | 335 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /* |
| 444 | 336 Return the directory component in file name FILENAME. |
| 337 Return nil if FILENAME does not include a directory. | |
| 428 | 338 Otherwise return a directory spec. |
| 339 Given a Unix syntax file name, returns a string ending in slash. | |
| 340 */ | |
| 444 | 341 (filename)) |
| 428 | 342 { |
| 442 | 343 /* This function can GC. GC checked 2000-07-28 ben */ |
| 771 | 344 /* This function synched with Emacs 21.0.103. */ |
| 867 | 345 Ibyte *beg; |
| 346 Ibyte *p; | |
| 428 | 347 Lisp_Object handler; |
| 348 | |
| 444 | 349 CHECK_STRING (filename); |
| 428 | 350 |
| 351 /* If the file name has special constructs in it, | |
| 352 call the corresponding file handler. */ | |
| 444 | 353 handler = Ffind_file_name_handler (filename, Qfile_name_directory); |
| 428 | 354 if (!NILP (handler)) |
| 444 | 355 return call2_check_string_or_nil (handler, Qfile_name_directory, filename); |
| 428 | 356 |
| 357 #ifdef FILE_SYSTEM_CASE | |
| 444 | 358 filename = FILE_SYSTEM_CASE (filename); |
| 428 | 359 #endif |
| 444 | 360 beg = XSTRING_DATA (filename); |
| 771 | 361 /* XEmacs: no need to alloca-copy here */ |
| 2526 | 362 p = find_end_of_directory_component (beg, XSTRING_LENGTH (filename)); |
| 428 | 363 |
| 364 if (p == beg) | |
| 365 return Qnil; | |
| 442 | 366 #ifdef WIN32_NATIVE |
| 428 | 367 /* Expansion of "c:" to drive and default directory. */ |
| 771 | 368 if (p[-1] == ':') |
| 428 | 369 { |
| 867 | 370 Ibyte *res; |
| 371 Ibyte *wd = mswindows_getdcwd (toupper (*beg) - 'A' + 1); | |
| 771 | 372 |
| 2367 | 373 res = alloca_ibytes ((wd ? qxestrlen (wd) : 0) + 10); /* go overboard */ |
| 1116 | 374 res[0] = '\0'; |
| 771 | 375 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':') |
| 376 { | |
| 377 qxestrncpy (res, beg, 2); | |
| 378 beg += 2; | |
| 1116 | 379 res[2] = '\0'; |
| 771 | 380 } |
| 381 | |
| 382 if (wd) | |
| 428 | 383 { |
| 3648 | 384 int size; |
| 771 | 385 qxestrcat (res, wd); |
| 3648 | 386 size = qxestrlen (res); |
| 387 if (!IS_DIRECTORY_SEP (res[size - 1])) | |
| 388 { | |
| 389 res[size] = DIRECTORY_SEP; | |
| 390 res[size + 1] = '\0'; | |
| 391 } | |
| 428 | 392 beg = res; |
| 771 | 393 p = beg + qxestrlen (beg); |
| 428 | 394 } |
| 3648 | 395 else |
| 396 { | |
| 397 return Qnil; | |
| 398 } | |
| 771 | 399 if (wd) |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
400 xfree (wd); |
| 428 | 401 } |
| 771 | 402 |
| 403 #if 0 /* No! This screws up efs, which calls file-name-directory on URL's | |
| 404 and expects the slashes to be left alone. This is here because of | |
| 405 an analogous call in FSF 21. */ | |
| 406 { | |
| 407 Bytecount len = p - beg; | |
| 867 | 408 Ibyte *newbeg = alloca_ibytes (len + 1); |
| 771 | 409 |
| 410 qxestrncpy (newbeg, beg, len); | |
| 411 newbeg[len] = '\0'; | |
| 412 newbeg = mswindows_canonicalize_filename (newbeg); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
413 return build_istring (newbeg); |
| 771 | 414 } |
| 415 #endif | |
| 416 #endif /* not WIN32_NATIVE */ | |
| 428 | 417 return make_string (beg, p - beg); |
| 418 } | |
| 419 | |
| 420 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /* | |
| 444 | 421 Return file name FILENAME sans its directory. |
| 428 | 422 For example, in a Unix-syntax file name, |
| 423 this is everything after the last slash, | |
| 424 or the entire name if it contains no slash. | |
| 425 */ | |
| 444 | 426 (filename)) |
| 428 | 427 { |
| 442 | 428 /* This function can GC. GC checked 2000-07-28 ben */ |
| 771 | 429 /* This function synched with Emacs 21.0.103. */ |
| 867 | 430 Ibyte *beg, *p, *end; |
| 428 | 431 Lisp_Object handler; |
| 432 | |
| 444 | 433 CHECK_STRING (filename); |
| 428 | 434 |
| 435 /* If the file name has special constructs in it, | |
| 436 call the corresponding file handler. */ | |
| 444 | 437 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory); |
| 428 | 438 if (!NILP (handler)) |
| 444 | 439 return call2_check_string (handler, Qfile_name_nondirectory, filename); |
| 440 | |
| 441 beg = XSTRING_DATA (filename); | |
| 442 end = p = beg + XSTRING_LENGTH (filename); | |
| 428 | 443 |
| 771 | 444 while (p != beg && !IS_DIRECTORY_SEP (p[-1]) |
| 657 | 445 #ifdef WIN32_FILENAMES |
| 771 | 446 /* only recognise drive specifier at beginning */ |
| 447 && !(p[-1] == ':' | |
| 448 /* handle the "/:d:foo" case correctly */ | |
| 449 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg)))) | |
| 428 | 450 #endif |
| 771 | 451 ) |
| 452 p--; | |
| 428 | 453 |
| 454 return make_string (p, end - p); | |
| 455 } | |
| 456 | |
| 457 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /* | |
| 458 Return a directly usable directory name somehow associated with FILENAME. | |
| 459 A `directly usable' directory name is one that may be used without the | |
| 460 intervention of any file handler. | |
| 461 If FILENAME is a directly usable file itself, return | |
| 462 \(file-name-directory FILENAME). | |
| 463 The `call-process' and `start-process' functions use this function to | |
| 464 get a current directory to run processes in. | |
| 465 */ | |
| 444 | 466 (filename)) |
| 428 | 467 { |
| 442 | 468 /* This function can GC. GC checked 2000-07-28 ben */ |
| 428 | 469 Lisp_Object handler; |
| 470 | |
| 471 /* If the file name has special constructs in it, | |
| 472 call the corresponding file handler. */ | |
| 473 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); | |
| 474 if (!NILP (handler)) | |
| 475 return call2 (handler, Qunhandled_file_name_directory, | |
| 476 filename); | |
| 477 | |
| 478 return Ffile_name_directory (filename); | |
| 479 } | |
| 480 | |
| 481 | |
| 867 | 482 static Ibyte * |
| 483 file_name_as_directory (Ibyte *out, Ibyte *in) | |
| 428 | 484 { |
| 442 | 485 /* This function cannot GC */ |
| 771 | 486 int size = qxestrlen (in); |
| 428 | 487 |
| 488 if (size == 0) | |
| 489 { | |
| 490 out[0] = '.'; | |
| 491 out[1] = DIRECTORY_SEP; | |
| 492 out[2] = '\0'; | |
| 493 } | |
| 494 else | |
| 495 { | |
| 771 | 496 qxestrcpy (out, in); |
| 428 | 497 /* Append a slash if necessary */ |
| 498 if (!IS_ANY_SEP (out[size-1])) | |
| 499 { | |
| 500 out[size] = DIRECTORY_SEP; | |
| 501 out[size + 1] = '\0'; | |
| 502 } | |
| 503 } | |
| 504 return out; | |
| 505 } | |
| 506 | |
| 507 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /* | |
| 508 Return a string representing file FILENAME interpreted as a directory. | |
| 509 This operation exists because a directory is also a file, but its name as | |
| 510 a directory is different from its name as a file. | |
| 511 The result can be used as the value of `default-directory' | |
| 512 or passed as second argument to `expand-file-name'. | |
| 513 For a Unix-syntax file name, just appends a slash, | |
| 514 except for (file-name-as-directory \"\") => \"./\". | |
| 515 */ | |
| 444 | 516 (filename)) |
| 428 | 517 { |
| 442 | 518 /* This function can GC. GC checked 2000-07-28 ben */ |
| 867 | 519 Ibyte *buf; |
| 428 | 520 Lisp_Object handler; |
| 521 | |
| 444 | 522 CHECK_STRING (filename); |
| 428 | 523 |
| 524 /* If the file name has special constructs in it, | |
| 525 call the corresponding file handler. */ | |
| 444 | 526 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory); |
| 428 | 527 if (!NILP (handler)) |
| 444 | 528 return call2_check_string (handler, Qfile_name_as_directory, filename); |
| 529 | |
| 867 | 530 buf = alloca_ibytes (XSTRING_LENGTH (filename) + 10); |
| 2526 | 531 file_name_as_directory (buf, XSTRING_DATA (filename)); |
| 532 if (qxestrcmp (buf, XSTRING_DATA (filename))) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
533 return build_istring (buf); |
| 2526 | 534 else |
| 535 return filename; | |
| 428 | 536 } |
| 537 | |
| 538 /* | |
| 539 * Convert from directory name to filename. | |
| 540 * On UNIX, it's simple: just make sure there isn't a terminating / | |
| 541 * | |
| 542 * Value is nonzero if the string output is different from the input. | |
| 543 */ | |
| 544 | |
| 545 static int | |
| 867 | 546 directory_file_name (const Ibyte *src, Ibyte *dst) |
| 428 | 547 { |
| 442 | 548 /* This function cannot GC */ |
| 771 | 549 long slen = qxestrlen (src); |
| 428 | 550 /* Process as Unix format: just remove any final slash. |
| 551 But leave "/" unchanged; do not change it to "". */ | |
| 771 | 552 qxestrcpy (dst, src); |
| 428 | 553 if (slen > 1 |
| 554 && IS_DIRECTORY_SEP (dst[slen - 1]) | |
| 657 | 555 #ifdef WIN32_FILENAMES |
| 428 | 556 && !IS_ANY_SEP (dst[slen - 2]) |
| 657 | 557 #endif /* WIN32_FILENAMES */ |
| 428 | 558 ) |
| 559 dst[slen - 1] = 0; | |
| 560 return 1; | |
| 561 } | |
| 562 | |
| 563 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /* | |
| 444 | 564 Return the file name of the directory named DIRECTORY. |
| 565 This is the name of the file that holds the data for the directory. | |
| 428 | 566 This operation exists because a directory is also a file, but its name as |
| 567 a directory is different from its name as a file. | |
| 568 In Unix-syntax, this function just removes the final slash. | |
| 569 */ | |
| 570 (directory)) | |
| 571 { | |
| 442 | 572 /* This function can GC. GC checked 2000-07-28 ben */ |
| 867 | 573 Ibyte *buf; |
| 428 | 574 Lisp_Object handler; |
| 575 | |
| 576 CHECK_STRING (directory); | |
| 577 | |
| 578 #if 0 /* #### WTF? */ | |
| 579 if (NILP (directory)) | |
| 580 return Qnil; | |
| 581 #endif | |
| 582 | |
| 583 /* If the file name has special constructs in it, | |
| 584 call the corresponding file handler. */ | |
| 585 handler = Ffind_file_name_handler (directory, Qdirectory_file_name); | |
| 586 if (!NILP (handler)) | |
| 587 return call2_check_string (handler, Qdirectory_file_name, directory); | |
| 2367 | 588 buf = alloca_ibytes (XSTRING_LENGTH (directory) + 20); |
| 771 | 589 directory_file_name (XSTRING_DATA (directory), buf); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
590 return build_istring (buf); |
| 428 | 591 } |
| 592 | |
| 593 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it | |
| 594 proved too broken for our purposes (it supported only 26 or 62 | |
| 595 unique names under some implementations). For example, this | |
| 596 arbitrary limit broke generation of Gnus Incoming* files. | |
| 597 | |
| 598 This implementation is better than what one usually finds in libc. | |
| 599 --hniksic */ | |
| 600 | |
| 442 | 601 static unsigned int temp_name_rand; |
| 602 | |
| 428 | 603 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* |
| 442 | 604 Generate a temporary file name starting with PREFIX. |
| 428 | 605 The Emacs process number forms part of the result, so there is no |
| 606 danger of generating a name being used by another process. | |
| 607 | |
| 608 In addition, this function makes an attempt to choose a name that | |
| 609 does not specify an existing file. To make this work, PREFIX should | |
| 4266 | 610 be an absolute file name. |
| 611 | |
|
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
5350
diff
changeset
|
612 This function is analogous to mktemp(3) under POSIX, and as with it, there |
| 4266 | 613 exists a race condition between the test for the existence of the new file |
|
4383
1e04b9c8125b
Correct the make-temp-name docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4324
diff
changeset
|
614 and its creation. See `make-temp-file' for a function which avoids this |
| 4266 | 615 race condition by specifying the appropriate flags to `write-region'. |
| 428 | 616 */ |
| 617 (prefix)) | |
| 618 { | |
|
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
619 static const Ascbyte tbl[64] = |
| 442 | 620 { |
| 428 | 621 'A','B','C','D','E','F','G','H', |
| 622 'I','J','K','L','M','N','O','P', | |
| 623 'Q','R','S','T','U','V','W','X', | |
| 624 'Y','Z','a','b','c','d','e','f', | |
| 625 'g','h','i','j','k','l','m','n', | |
| 626 'o','p','q','r','s','t','u','v', | |
| 627 'w','x','y','z','0','1','2','3', | |
| 442 | 628 '4','5','6','7','8','9','-','_' |
| 629 }; | |
| 428 | 630 |
| 631 Bytecount len; | |
| 867 | 632 Ibyte *p, *data; |
| 844 | 633 Lisp_Object handler; |
| 428 | 634 |
| 635 CHECK_STRING (prefix); | |
| 844 | 636 handler = Ffind_file_name_handler (prefix, Qmake_temp_name); |
| 637 if (!NILP (handler)) | |
| 638 return call2_check_string (handler, Qmake_temp_name, prefix); | |
| 428 | 639 |
| 640 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's | |
| 641 a bad idea because: | |
| 642 | |
| 643 1) It might change the prefix, so the resulting string might not | |
| 644 begin with PREFIX. This violates the principle of least | |
| 645 surprise. | |
| 646 | |
| 647 2) It breaks under many unforeseeable circumstances, such as with | |
| 648 the code that uses (make-temp-name "") instead of | |
| 649 (make-temp-name "./"). | |
| 650 | |
| 844 | 651 [[ 3) It might yield unexpected (to stat(2)) results in the presence |
| 652 of EFS and file name handlers.]] Now that we check for a handler, | |
| 653 that's less of a concern. --ben */ | |
| 428 | 654 |
| 655 len = XSTRING_LENGTH (prefix); | |
| 867 | 656 data = alloca_ibytes (len + 7); |
| 428 | 657 memcpy (data, XSTRING_DATA (prefix), len); |
| 658 p = data + len; | |
| 771 | 659 p[6] = '\0'; |
| 428 | 660 |
| 661 /* VAL is created by adding 6 characters to PREFIX. The first three | |
| 662 are the PID of this process, in base 64, and the second three are | |
| 442 | 663 a pseudo-random number seeded from process startup time. This |
| 664 ensures 262144 unique file names per PID per PREFIX per machine. */ | |
| 665 | |
| 666 { | |
| 771 | 667 unsigned int pid = (unsigned int) qxe_getpid (); |
| 442 | 668 *p++ = tbl[(pid >> 0) & 63]; |
| 669 *p++ = tbl[(pid >> 6) & 63]; | |
| 670 *p++ = tbl[(pid >> 12) & 63]; | |
| 671 } | |
| 428 | 672 |
| 673 /* Here we try to minimize useless stat'ing when this function is | |
| 674 invoked many times successively with the same PREFIX. We achieve | |
| 442 | 675 this by using a very pseudo-random number generator to generate |
| 676 file names unique to this process, with a very long cycle. */ | |
| 428 | 677 |
| 678 while (1) | |
| 679 { | |
| 680 struct stat ignored; | |
| 442 | 681 |
| 682 p[0] = tbl[(temp_name_rand >> 0) & 63]; | |
| 683 p[1] = tbl[(temp_name_rand >> 6) & 63]; | |
| 684 p[2] = tbl[(temp_name_rand >> 12) & 63]; | |
| 428 | 685 |
| 686 /* Poor man's congruential RN generator. Replace with ++count | |
| 687 for debugging. */ | |
| 442 | 688 temp_name_rand += 25229; |
| 689 temp_name_rand %= 225307; | |
| 428 | 690 |
| 691 QUIT; | |
| 692 | |
| 771 | 693 if (qxe_stat (data, &ignored) < 0) |
| 428 | 694 { |
| 695 /* We want to return only if errno is ENOENT. */ | |
| 696 if (errno == ENOENT) | |
| 771 | 697 return make_string (data, len + 6); |
| 428 | 698 |
| 699 /* The error here is dubious, but there is little else we | |
| 700 can do. The alternatives are to return nil, which is | |
| 701 as bad as (and in many cases worse than) throwing the | |
| 702 error, or to ignore the error, which will likely result | |
| 703 in inflooping. */ | |
| 704 report_file_error ("Cannot create temporary name for prefix", | |
| 563 | 705 prefix); |
| 428 | 706 return Qnil; /* not reached */ |
| 707 } | |
| 708 } | |
| 709 } | |
| 710 | |
| 711 | |
| 771 | 712 |
| 428 | 713 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /* |
| 714 Convert filename NAME to absolute, and canonicalize it. | |
| 715 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative | |
| 716 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing, | |
| 444 | 717 the current buffer's value of `default-directory' is used. |
| 428 | 718 File name components that are `.' are removed, and |
| 719 so are file name components followed by `..', along with the `..' itself; | |
| 720 note that these simplifications are done without checking the resulting | |
| 721 file names in the file system. | |
| 722 An initial `~/' expands to your home directory. | |
| 723 An initial `~USER/' expands to USER's home directory. | |
| 724 See also the function `substitute-in-file-name'. | |
| 725 */ | |
| 726 (name, default_directory)) | |
| 727 { | |
| 771 | 728 /* This function can GC. GC-checked 2000-11-18. |
| 729 This function synched with Emacs 21.0.103. */ | |
| 867 | 730 Ibyte *nm; |
| 731 | |
| 732 Ibyte *newdir, *p, *o; | |
| 428 | 733 int tlen; |
| 867 | 734 Ibyte *target; |
| 657 | 735 #ifdef WIN32_FILENAMES |
| 428 | 736 int drive = 0; |
| 737 int collapse_newdir = 1; | |
| 771 | 738 /* XEmacs note: This concerns the special '/:' syntax for preventing |
| 739 wildcards and such. We don't support this currently but I'm | |
| 740 keeping the code here in case we do. */ | |
| 741 int is_escaped = 0; | |
| 657 | 742 #endif |
| 743 #ifndef WIN32_NATIVE | |
| 428 | 744 struct passwd *pw; |
| 771 | 745 #endif |
| 428 | 746 int length; |
| 446 | 747 Lisp_Object handler = Qnil; |
| 748 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2526 | 749 PROFILE_DECLARE (); |
| 750 | |
| 751 PROFILE_RECORD_ENTERING_SECTION (QSin_expand_file_name); | |
| 442 | 752 |
| 753 /* both of these get set below */ | |
| 446 | 754 GCPRO3 (name, default_directory, handler); |
| 428 | 755 |
| 756 CHECK_STRING (name); | |
| 757 | |
| 758 /* If the file name has special constructs in it, | |
| 759 call the corresponding file handler. */ | |
| 760 handler = Ffind_file_name_handler (name, Qexpand_file_name); | |
| 761 if (!NILP (handler)) | |
| 2526 | 762 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, |
| 763 call3_check_string | |
| 764 (handler, Qexpand_file_name, | |
| 765 name, default_directory)); | |
| 428 | 766 |
| 767 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ | |
| 768 if (NILP (default_directory)) | |
| 769 default_directory = current_buffer->directory; | |
| 770 if (! STRINGP (default_directory)) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
771 default_directory = build_ascstring (DEFAULT_DIRECTORY_FALLBACK); |
| 428 | 772 |
| 773 if (!NILP (default_directory)) | |
| 774 { | |
| 775 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name); | |
| 776 if (!NILP (handler)) | |
| 2526 | 777 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, |
|
4826
780bb5441c14
use call3_check_string on all invocations of external handlers in expand-file-name
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
778 call3_check_string |
|
780bb5441c14
use call3_check_string on all invocations of external handlers in expand-file-name
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
779 (handler, Qexpand_file_name, |
|
780bb5441c14
use call3_check_string on all invocations of external handlers in expand-file-name
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
780 name, default_directory)); |
| 428 | 781 } |
| 782 | |
| 783 o = XSTRING_DATA (default_directory); | |
| 784 | |
| 785 /* Make sure DEFAULT_DIRECTORY is properly expanded. | |
| 786 It would be better to do this down below where we actually use | |
| 787 default_directory. Unfortunately, calling Fexpand_file_name recursively | |
| 788 could invoke GC, and the strings might be relocated. This would | |
| 789 be annoying because we have pointers into strings lying around | |
| 790 that would need adjusting, and people would add new pointers to | |
| 791 the code and forget to adjust them, resulting in intermittent bugs. | |
| 792 Putting this call here avoids all that crud. | |
| 793 | |
| 794 The EQ test avoids infinite recursion. */ | |
| 795 if (! NILP (default_directory) && !EQ (default_directory, name) | |
| 796 /* Save time in some common cases - as long as default_directory | |
| 797 is not relative, it can be canonicalized with name below (if it | |
| 798 is needed at all) without requiring it to be expanded now. */ | |
| 657 | 799 #ifdef WIN32_FILENAMES |
| 442 | 800 /* Detect Windows file names with drive specifiers. */ |
| 428 | 801 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) |
| 802 /* Detect Windows file names in UNC format. */ | |
| 803 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) | |
| 657 | 804 #endif /* not WIN32_FILENAMES */ |
| 805 #ifndef WIN32_NATIVE | |
| 428 | 806 /* Detect Unix absolute file names (/... alone is not absolute on |
| 442 | 807 Windows). */ |
| 428 | 808 && ! (IS_DIRECTORY_SEP (o[0])) |
| 442 | 809 #endif /* not WIN32_NATIVE */ |
| 428 | 810 ) |
| 442 | 811 |
| 812 default_directory = Fexpand_file_name (default_directory, Qnil); | |
| 428 | 813 |
| 814 #ifdef FILE_SYSTEM_CASE | |
| 815 name = FILE_SYSTEM_CASE (name); | |
| 816 #endif | |
| 817 | |
| 818 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing | |
| 819 into name should be safe during all of this, though. */ | |
| 820 nm = XSTRING_DATA (name); | |
| 821 | |
| 657 | 822 #ifdef WIN32_FILENAMES |
| 428 | 823 /* We will force directory separators to be either all \ or /, so make |
| 824 a local copy to modify, even if there ends up being no change. */ | |
| 867 | 825 nm = qxestrcpy (alloca_ibytes (qxestrlen (nm) + 1), nm); |
| 771 | 826 |
| 827 /* Note if special escape prefix is present, but remove for now. */ | |
| 828 if (nm[0] == '/' && nm[1] == ':') | |
| 829 { | |
| 830 is_escaped = 1; | |
| 831 nm += 2; | |
| 832 } | |
| 428 | 833 |
| 834 /* Find and remove drive specifier if present; this makes nm absolute | |
| 835 even if the rest of the name appears to be relative. */ | |
| 836 { | |
| 867 | 837 Ibyte *colon = qxestrrchr (nm, ':'); |
| 428 | 838 |
| 839 if (colon) | |
| 657 | 840 { |
| 428 | 841 /* Only recognize colon as part of drive specifier if there is a |
| 842 single alphabetic character preceding the colon (and if the | |
| 843 character before the drive letter, if present, is a directory | |
| 844 separator); this is to support the remote system syntax used by | |
| 845 ange-ftp, and the "po:username" syntax for POP mailboxes. */ | |
| 846 look_again: | |
| 847 if (nm == colon) | |
| 848 nm++; | |
| 849 else if (IS_DRIVE (colon[-1]) | |
| 850 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2]))) | |
| 851 { | |
| 852 drive = colon[-1]; | |
| 853 nm = colon + 1; | |
| 854 } | |
| 855 else | |
| 856 { | |
| 857 while (--colon >= nm) | |
| 858 if (colon[0] == ':') | |
| 859 goto look_again; | |
| 860 } | |
| 657 | 861 } |
| 428 | 862 } |
| 863 | |
| 864 /* If we see "c://somedir", we want to strip the first slash after the | |
| 865 colon when stripping the drive letter. Otherwise, this expands to | |
| 866 "//somedir". */ | |
| 867 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) | |
| 868 nm++; | |
| 657 | 869 #endif /* WIN32_FILENAMES */ |
| 428 | 870 |
| 771 | 871 #ifdef WIN32_FILENAMES |
| 872 /* Discard any previous drive specifier if nm is now in UNC format. */ | |
| 873 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) | |
| 874 { | |
| 875 drive = 0; | |
| 876 } | |
| 877 #endif | |
| 878 | |
| 428 | 879 /* If nm is absolute, look for /./ or /../ sequences; if none are |
| 880 found, we can probably return right away. We will avoid allocating | |
| 881 a new string if name is already fully expanded. */ | |
| 882 if ( | |
| 883 IS_DIRECTORY_SEP (nm[0]) | |
| 442 | 884 #ifdef WIN32_NATIVE |
| 771 | 885 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped |
| 428 | 886 #endif |
| 887 ) | |
| 888 { | |
| 889 /* If it turns out that the filename we want to return is just a | |
| 890 suffix of FILENAME, we don't need to go through and edit | |
| 891 things; we just need to construct a new string using data | |
| 892 starting at the middle of FILENAME. If we set lose to a | |
| 893 non-zero value, that means we've discovered that we can't do | |
| 894 that cool trick. */ | |
| 895 int lose = 0; | |
| 896 | |
| 897 p = nm; | |
| 898 while (*p) | |
| 899 { | |
| 900 /* Since we know the name is absolute, we can assume that each | |
| 901 element starts with a "/". */ | |
| 902 | |
| 903 /* "." and ".." are hairy. */ | |
| 904 if (IS_DIRECTORY_SEP (p[0]) | |
| 905 && p[1] == '.' | |
| 906 && (IS_DIRECTORY_SEP (p[2]) | |
| 907 || p[2] == 0 | |
| 908 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) | |
| 909 || p[3] == 0)))) | |
| 910 lose = 1; | |
| 771 | 911 /* We want to replace multiple `/' in a row with a single |
| 912 slash. */ | |
| 913 else if (p > nm | |
| 914 && IS_DIRECTORY_SEP (p[0]) | |
| 915 && IS_DIRECTORY_SEP (p[1])) | |
| 916 lose = 1; | |
| 428 | 917 p++; |
| 918 } | |
| 919 if (!lose) | |
| 920 { | |
| 657 | 921 #ifdef WIN32_FILENAMES |
| 922 if (drive || IS_DIRECTORY_SEP (nm[1])) | |
| 428 | 923 { |
| 867 | 924 Ibyte *newnm; |
| 771 | 925 |
| 657 | 926 if (IS_DIRECTORY_SEP (nm[1])) |
| 927 { | |
| 771 | 928 newnm = mswindows_canonicalize_filename (nm); |
| 929 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
930 name = build_istring (newnm); |
| 657 | 931 } |
| 771 | 932 else |
| 657 | 933 { |
| 771 | 934 /* drive must be set, so this is okay */ |
| 935 newnm = mswindows_canonicalize_filename (nm - 2); | |
| 936 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0) | |
| 937 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
938 name = build_istring (newnm); |
| 771 | 939 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive); |
| 940 XSTRING_DATA (name)[1] = ':'; | |
| 941 } | |
| 657 | 942 } |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
943 xfree (newnm); |
| 2526 | 944 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name); |
| 428 | 945 } |
| 771 | 946 #endif /* WIN32_FILENAMES */ |
| 657 | 947 #ifndef WIN32_NATIVE |
| 428 | 948 if (nm == XSTRING_DATA (name)) |
| 2526 | 949 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name); |
| 950 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
951 build_istring (nm)); |
| 442 | 952 #endif /* not WIN32_NATIVE */ |
| 428 | 953 } |
| 954 } | |
| 955 | |
| 956 /* At this point, nm might or might not be an absolute file name. We | |
| 957 need to expand ~ or ~user if present, otherwise prefix nm with | |
| 958 default_directory if nm is not absolute, and finally collapse /./ | |
| 959 and /foo/../ sequences. | |
| 960 | |
| 961 We set newdir to be the appropriate prefix if one is needed: | |
| 962 - the relevant user directory if nm starts with ~ or ~user | |
| 963 - the specified drive's working dir (DOS/NT only) if nm does not | |
| 964 start with / | |
| 965 - the value of default_directory. | |
| 966 | |
| 967 Note that these prefixes are not guaranteed to be absolute (except | |
| 968 for the working dir of a drive). Therefore, to ensure we always | |
| 969 return an absolute name, if the final prefix is not absolute we | |
| 970 append it to the current working directory. */ | |
| 971 | |
| 972 newdir = 0; | |
| 973 | |
| 974 if (nm[0] == '~') /* prefix ~ */ | |
| 975 { | |
| 976 if (IS_DIRECTORY_SEP (nm[1]) | |
| 977 || nm[1] == 0) /* ~ by itself */ | |
| 978 { | |
| 867 | 979 Ibyte *homedir = get_home_directory (); |
| 771 | 980 |
| 981 if (!homedir) | |
| 867 | 982 newdir = (Ibyte *) ""; |
| 428 | 983 else |
| 771 | 984 newdir = homedir; |
| 428 | 985 |
| 986 nm++; | |
| 657 | 987 #ifdef WIN32_FILENAMES |
| 428 | 988 collapse_newdir = 0; |
| 989 #endif | |
| 990 } | |
| 991 else /* ~user/filename */ | |
| 992 { | |
| 993 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++) | |
| 994 DO_NOTHING; | |
| 2367 | 995 o = alloca_ibytes (p - nm + 1); |
| 771 | 996 memcpy (o, nm, p - nm); |
| 428 | 997 o [p - nm] = 0; |
| 998 | |
| 558 | 999 /* #### While NT is single-user (for the moment) you still |
| 1000 can have multiple user profiles users defined, each with | |
| 1001 its HOME. So maybe possibly we should think about handling | |
| 1002 ~user. --ben */ | |
| 1003 #ifndef WIN32_NATIVE | |
| 442 | 1004 #ifdef CYGWIN |
| 771 | 1005 { |
| 867 | 1006 Ibyte *user; |
| 771 | 1007 |
| 1008 if ((user = user_login_name (NULL)) != NULL) | |
| 1009 { | |
| 1010 /* Does the user login name match the ~name? */ | |
| 1011 if (qxestrcmp (user, o + 1) == 0) | |
| 1012 { | |
| 1013 newdir = get_home_directory (); | |
| 1014 nm = p; | |
| 1015 } | |
| 1016 } | |
| 1017 } | |
| 1018 if (!newdir) | |
| 428 | 1019 { |
| 442 | 1020 #endif /* CYGWIN */ |
| 428 | 1021 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM |
| 1022 occurring in it. (It can call select()). */ | |
| 1023 slow_down_interrupts (); | |
| 771 | 1024 pw = (struct passwd *) qxe_getpwnam (o + 1); |
| 428 | 1025 speed_up_interrupts (); |
| 1026 if (pw) | |
| 1027 { | |
| 867 | 1028 newdir = (Ibyte *) pw->pw_dir; |
| 428 | 1029 nm = p; |
| 771 | 1030 /* FSF: if WIN32_NATIVE, collapse_newdir = 0; |
| 1031 not possible here. */ | |
| 428 | 1032 } |
| 442 | 1033 #ifdef CYGWIN |
| 428 | 1034 } |
| 1035 #endif | |
| 442 | 1036 #endif /* not WIN32_NATIVE */ |
| 428 | 1037 |
| 1038 /* If we don't find a user of that name, leave the name | |
| 1039 unchanged; don't move nm forward to p. */ | |
| 1040 } | |
| 1041 } | |
| 1042 | |
| 657 | 1043 #ifdef WIN32_FILENAMES |
| 428 | 1044 /* On DOS and Windows, nm is absolute if a drive name was specified; |
| 1045 use the drive's current directory as the prefix if needed. */ | |
| 1046 if (!newdir && drive) | |
| 1047 { | |
| 657 | 1048 #ifdef WIN32_NATIVE |
| 428 | 1049 /* Get default directory if needed to make nm absolute. */ |
| 1050 if (!IS_DIRECTORY_SEP (nm[0])) | |
| 1051 { | |
| 867 | 1052 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1); |
| 771 | 1053 if (newcwd) |
| 1054 { | |
| 867 | 1055 IBYTE_STRING_TO_ALLOCA (newcwd, newdir); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1056 xfree (newcwd); |
| 771 | 1057 } |
| 1058 else | |
| 428 | 1059 newdir = NULL; |
| 1060 } | |
| 657 | 1061 #endif /* WIN32_NATIVE */ |
| 428 | 1062 if (!newdir) |
| 1063 { | |
| 1064 /* Either nm starts with /, or drive isn't mounted. */ | |
| 2367 | 1065 newdir = alloca_ibytes (4); |
| 428 | 1066 newdir[0] = DRIVE_LETTER (drive); |
| 1067 newdir[1] = ':'; | |
| 1068 newdir[2] = '/'; | |
| 1069 newdir[3] = 0; | |
| 1070 } | |
| 1071 } | |
| 657 | 1072 #endif /* WIN32_FILENAMES */ |
| 428 | 1073 |
| 1074 /* Finally, if no prefix has been specified and nm is not absolute, | |
| 1075 then it must be expanded relative to default_directory. */ | |
| 1076 | |
| 1077 if (1 | |
| 442 | 1078 #ifndef WIN32_NATIVE |
| 428 | 1079 /* /... alone is not absolute on DOS and Windows. */ |
| 1080 && !IS_DIRECTORY_SEP (nm[0]) | |
| 657 | 1081 #endif |
| 1082 #ifdef WIN32_FILENAMES | |
| 428 | 1083 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) |
| 1084 #endif | |
| 1085 && !newdir) | |
| 1086 { | |
| 1087 newdir = XSTRING_DATA (default_directory); | |
| 771 | 1088 #ifdef WIN32_FILENAMES |
| 1089 /* Note if special escape prefix is present, but remove for now. */ | |
| 1090 if (newdir[0] == '/' && newdir[1] == ':') | |
| 1091 { | |
| 1092 is_escaped = 1; | |
| 1093 newdir += 2; | |
| 1094 } | |
| 1095 #endif | |
| 428 | 1096 } |
| 1097 | |
| 657 | 1098 #ifdef WIN32_FILENAMES |
| 428 | 1099 if (newdir) |
| 1100 { | |
| 1101 /* First ensure newdir is an absolute name. */ | |
| 1102 if ( | |
| 442 | 1103 /* Detect Windows file names with drive specifiers. */ |
| 428 | 1104 ! (IS_DRIVE (newdir[0]) |
| 1105 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) | |
| 1106 /* Detect Windows file names in UNC format. */ | |
| 1107 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) | |
| 771 | 1108 /* XEmacs: added these two lines: Detect drive spec by itself */ |
| 428 | 1109 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0) |
| 657 | 1110 /* Detect unix format. */ |
| 1111 #ifndef WIN32_NATIVE | |
| 1112 && ! (IS_DIRECTORY_SEP (newdir[0])) | |
| 1113 #endif | |
| 428 | 1114 ) |
| 1115 { | |
| 1116 /* Effectively, let newdir be (expand-file-name newdir cwd). | |
| 1117 Because of the admonition against calling expand-file-name | |
| 1118 when we have pointers into lisp strings, we accomplish this | |
| 1119 indirectly by prepending newdir to nm if necessary, and using | |
| 1120 cwd (or the wd of newdir's drive) as the new newdir. */ | |
| 1121 | |
| 1122 if (IS_DRIVE (newdir[0]) && newdir[1] == ':') | |
| 1123 { | |
| 1124 drive = newdir[0]; | |
| 1125 newdir += 2; | |
| 1126 } | |
| 1127 if (!IS_DIRECTORY_SEP (nm[0])) | |
| 1128 { | |
| 2367 | 1129 Ibyte *tmp = alloca_ibytes (qxestrlen (newdir) + |
| 1130 qxestrlen (nm) + 2); | |
| 771 | 1131 file_name_as_directory (tmp, newdir); |
| 1132 qxestrcat (tmp, nm); | |
| 428 | 1133 nm = tmp; |
| 1134 } | |
| 1135 if (drive) | |
| 1136 { | |
| 657 | 1137 #ifdef WIN32_NATIVE |
| 867 | 1138 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1); |
| 771 | 1139 if (newcwd) |
| 1140 { | |
| 867 | 1141 IBYTE_STRING_TO_ALLOCA (newcwd, newdir); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1142 xfree (newcwd); |
| 771 | 1143 } |
| 1144 else | |
| 657 | 1145 #endif |
| 867 | 1146 IBYTE_STRING_TO_ALLOCA ((Ibyte *) "/", newdir); |
| 428 | 1147 } |
| 1148 else | |
| 867 | 1149 IBYTE_STRING_TO_ALLOCA (get_initial_directory (0, 0), newdir); |
| 428 | 1150 } |
| 1151 | |
| 1152 /* Strip off drive name from prefix, if present. */ | |
| 1153 if (IS_DRIVE (newdir[0]) && newdir[1] == ':') | |
| 1154 { | |
| 1155 drive = newdir[0]; | |
| 1156 newdir += 2; | |
| 1157 } | |
| 1158 | |
| 1159 /* Keep only a prefix from newdir if nm starts with slash | |
| 771 | 1160 (//server/share for UNC, nothing otherwise). */ |
| 657 | 1161 if (IS_DIRECTORY_SEP (nm[0]) |
| 1162 #ifndef WIN32_NATIVE | |
| 1163 && IS_DIRECTORY_SEP (nm[1]) | |
| 1164 #endif | |
| 1165 && collapse_newdir) | |
| 428 | 1166 { |
| 1167 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) | |
| 1168 { | |
| 2367 | 1169 /* !!#### Use ei API */ |
| 1170 newdir = qxestrcpy (alloca_ibytes (qxestrlen (newdir) + 1), | |
| 1171 newdir); | |
| 428 | 1172 p = newdir + 2; |
| 1173 while (*p && !IS_DIRECTORY_SEP (*p)) p++; | |
| 1174 p++; | |
| 1175 while (*p && !IS_DIRECTORY_SEP (*p)) p++; | |
| 1176 *p = 0; | |
| 1177 } | |
| 1178 else | |
| 867 | 1179 newdir = (Ibyte *) ""; |
| 428 | 1180 } |
| 1181 } | |
| 657 | 1182 #endif /* WIN32_FILENAMES */ |
| 428 | 1183 |
| 1184 if (newdir) | |
| 1185 { | |
| 1186 /* Get rid of any slash at the end of newdir, unless newdir is | |
| 771 | 1187 just / or // (an incomplete UNC name). */ |
| 1188 length = qxestrlen (newdir); | |
| 428 | 1189 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) |
| 657 | 1190 #ifdef WIN32_FILENAMES |
| 428 | 1191 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) |
| 1192 #endif | |
| 1193 ) | |
| 1194 { | |
| 2367 | 1195 Ibyte *temp = alloca_ibytes (length); |
| 428 | 1196 memcpy (temp, newdir, length - 1); |
| 1197 temp[length - 1] = 0; | |
| 1198 newdir = temp; | |
| 1199 } | |
| 1200 tlen = length + 1; | |
| 1201 } | |
| 1202 else | |
| 1203 tlen = 0; | |
| 1204 | |
| 1205 /* Now concatenate the directory and name to new space in the stack frame */ | |
| 771 | 1206 tlen += qxestrlen (nm) + 1; |
| 657 | 1207 #ifdef WIN32_FILENAMES |
| 771 | 1208 /* Reserve space for drive specifier and escape prefix, since either |
| 1209 or both may need to be inserted. (The Microsoft x86 compiler | |
| 428 | 1210 produces incorrect code if the following two lines are combined.) */ |
| 2367 | 1211 target = alloca_ibytes (tlen + 4); |
| 771 | 1212 target += 4; |
| 657 | 1213 #else /* not WIN32_FILENAMES */ |
| 2367 | 1214 target = alloca_ibytes (tlen); |
| 657 | 1215 #endif /* not WIN32_FILENAMES */ |
| 428 | 1216 *target = 0; |
| 1217 | |
| 1218 if (newdir) | |
| 1219 { | |
| 1220 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) | |
| 771 | 1221 { |
| 1222 #ifdef WIN32_FILENAMES | |
| 1223 /* If newdir is effectively "C:/", then the drive letter will have | |
| 1224 been stripped and newdir will be "/". Concatenating with an | |
| 1225 absolute directory in nm produces "//", which will then be | |
| 1226 incorrectly treated as a network share. Ignore newdir in | |
| 1227 this case (keeping the drive letter). */ | |
| 1228 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) | |
| 1229 && newdir[1] == '\0')) | |
| 1230 #endif | |
| 1231 qxestrcpy (target, newdir); | |
| 1232 } | |
| 428 | 1233 else |
| 771 | 1234 file_name_as_directory (target, newdir); |
| 428 | 1235 } |
| 1236 | |
| 771 | 1237 qxestrcat (target, nm); |
| 428 | 1238 |
| 1239 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */ | |
| 1240 | |
| 771 | 1241 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they |
| 1242 appear. */ | |
| 428 | 1243 |
| 1244 p = target; | |
| 1245 o = target; | |
| 1246 | |
| 1247 while (*p) | |
| 1248 { | |
| 1249 if (!IS_DIRECTORY_SEP (*p)) | |
| 1250 { | |
| 1251 *o++ = *p++; | |
| 1252 } | |
| 1253 else if (IS_DIRECTORY_SEP (p[0]) | |
| 1254 && p[1] == '.' | |
| 1255 && (IS_DIRECTORY_SEP (p[2]) | |
| 1256 || p[2] == 0)) | |
| 1257 { | |
| 1258 /* If "/." is the entire filename, keep the "/". Otherwise, | |
| 1259 just delete the whole "/.". */ | |
| 1260 if (o == target && p[2] == '\0') | |
| 1261 *o++ = *p; | |
| 1262 p += 2; | |
| 1263 } | |
| 1264 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' | |
| 1265 /* `/../' is the "superroot" on certain file systems. */ | |
| 1266 && o != target | |
| 1267 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) | |
| 1268 { | |
| 1269 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) | |
| 1270 ; | |
| 1271 /* Keep initial / only if this is the whole name. */ | |
| 1272 if (o == target && IS_ANY_SEP (*o) && p[3] == 0) | |
| 1273 ++o; | |
| 1274 p += 3; | |
| 1275 } | |
| 771 | 1276 else if (p > target |
| 1277 && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) | |
| 1278 { | |
| 1279 /* Collapse multiple `/' in a row. */ | |
| 1280 *o++ = *p++; | |
| 1281 while (IS_DIRECTORY_SEP (*p)) | |
| 1282 ++p; | |
| 1283 } | |
| 428 | 1284 else |
| 1285 { | |
| 1286 *o++ = *p++; | |
| 1287 } | |
| 1288 } | |
| 1289 | |
| 657 | 1290 #ifdef WIN32_FILENAMES |
| 428 | 1291 /* At last, set drive name, except for network file name. */ |
| 1292 if (drive) | |
| 1293 { | |
| 1294 target -= 2; | |
| 1295 target[0] = DRIVE_LETTER (drive); | |
| 1296 target[1] = ':'; | |
| 1297 } | |
| 657 | 1298 #ifdef WIN32_NATIVE |
| 428 | 1299 else |
| 1300 { | |
| 1301 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])); | |
| 1302 } | |
| 657 | 1303 #endif |
| 771 | 1304 /* Reinsert the escape prefix if required. */ |
| 1305 if (is_escaped) | |
| 1306 { | |
| 1307 target -= 2; | |
| 1308 target[0] = '/'; | |
| 1309 target[1] = ':'; | |
| 1310 } | |
| 1311 | |
| 1312 *o = '\0'; | |
| 1313 | |
| 1314 { | |
| 867 | 1315 Ibyte *newtarget = mswindows_canonicalize_filename (target); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1316 Lisp_Object result = build_istring (newtarget); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1317 xfree (newtarget); |
| 771 | 1318 |
| 2526 | 1319 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, result); |
| 771 | 1320 } |
| 1321 #else /* not WIN32_FILENAMES */ | |
| 2526 | 1322 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, |
| 1323 make_string (target, o - target)); | |
| 771 | 1324 #endif /* not WIN32_FILENAMES */ |
| 428 | 1325 } |
| 1326 | |
| 1327 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /* | |
| 444 | 1328 Return the canonical name of FILENAME. |
| 1329 Second arg DEFAULT is directory to start with if FILENAME is relative | |
| 428 | 1330 (does not start with slash); if DEFAULT is nil or missing, |
| 444 | 1331 the current buffer's value of `default-directory' is used. |
| 428 | 1332 No component of the resulting pathname will be a symbolic link, as |
| 1333 in the realpath() function. | |
| 1334 */ | |
| 1335 (filename, default_)) | |
| 1336 { | |
| 442 | 1337 /* This function can GC. GC checked 2000-07-28 ben. */ |
| 428 | 1338 Lisp_Object expanded_name; |
| 1339 struct gcpro gcpro1; | |
| 1340 | |
| 1341 CHECK_STRING (filename); | |
| 1342 | |
| 1343 expanded_name = Fexpand_file_name (filename, default_); | |
| 1344 | |
| 1345 if (!STRINGP (expanded_name)) | |
| 1346 return Qnil; | |
| 1347 | |
| 1348 GCPRO1 (expanded_name); | |
| 442 | 1349 |
| 1350 { | |
| 1351 Lisp_Object handler = | |
| 1352 Ffind_file_name_handler (expanded_name, Qfile_truename); | |
| 1353 | |
| 1354 if (!NILP (handler)) | |
| 1355 RETURN_UNGCPRO | |
| 1356 (call2_check_string (handler, Qfile_truename, expanded_name)); | |
| 1357 } | |
| 428 | 1358 |
| 1359 { | |
| 2421 | 1360 Ibyte resolved_path[PATH_MAX_INTERNAL]; |
| 771 | 1361 Bytecount elen = XSTRING_LENGTH (expanded_name); |
| 867 | 1362 Ibyte *path; |
| 1363 Ibyte *p; | |
| 771 | 1364 |
| 1365 LISP_STRING_TO_ALLOCA (expanded_name, path); | |
| 988 | 1366 |
| 1111 | 1367 #if defined (WIN32_FILENAMES) && defined (CYGWIN) |
| 988 | 1368 /* When using win32 filenames in cygwin we want file-truename to |
| 1369 detect that c:/windows == /windows for example. */ | |
| 1111 | 1370 if (! (IS_DIRECTORY_SEP (path[0]) && IS_DIRECTORY_SEP (path[1]))) |
| 1371 { | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
1372 LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN (path, p); |
| 1111 | 1373 path = p; |
| 1374 } | |
| 988 | 1375 #endif |
| 428 | 1376 p = path; |
| 442 | 1377 |
| 428 | 1378 /* Try doing it all at once. */ |
| 2526 | 1379 if (!qxe_realpath (path, resolved_path, 0)) |
| 428 | 1380 { |
| 1381 /* Didn't resolve it -- have to do it one component at a time. */ | |
| 1382 /* "realpath" is a typically useless, stupid un*x piece of crap. | |
| 1383 It claims to return a useful value in the "error" case, but since | |
| 1384 there is no indication provided of how far along the pathname | |
| 1385 the function went before erring, there is no way to use the | |
| 442 | 1386 partial result returned. What a piece of junk. |
| 1387 | |
| 1388 The above comment refers to historical versions of | |
| 1389 realpath(). The Unix98 specs state: | |
| 1390 | |
| 1391 "On successful completion, realpath() returns a | |
| 1392 pointer to the resolved name. Otherwise, realpath() | |
| 1393 returns a null pointer and sets errno to indicate the | |
| 1394 error, and the contents of the buffer pointed to by | |
| 1395 resolved_name are undefined." | |
| 1396 | |
| 771 | 1397 Since we depend on undocumented semantics of various system |
| 2526 | 1398 realpath()s, we just use our own version in realpath.c. |
| 1399 | |
| 1400 Note also that our own version differs in its semantics from any | |
| 1401 standard version, since it accepts and returns internal-format | |
| 1402 text, not external-format. */ | |
| 428 | 1403 for (;;) |
| 1404 { | |
| 867 | 1405 Ibyte *pos; |
| 446 | 1406 |
| 657 | 1407 #ifdef WIN32_FILENAMES |
| 446 | 1408 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1]) |
| 1409 && IS_DIRECTORY_SEP (p[2])) | |
| 1410 /* don't test c: on windows */ | |
| 1411 p = p+2; | |
| 1412 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) | |
| 1413 /* start after // */ | |
| 1414 p = p+1; | |
| 1415 #endif | |
| 1416 for (pos = p + 1; pos < path + elen; pos++) | |
| 1417 if (IS_DIRECTORY_SEP (*pos)) | |
| 1418 { | |
| 1419 *(p = pos) = 0; | |
| 1420 break; | |
| 1421 } | |
| 1422 if (p != pos) | |
| 1423 p = 0; | |
| 428 | 1424 |
| 2526 | 1425 if (qxe_realpath (path, resolved_path, 0)) |
| 428 | 1426 { |
| 1427 if (p) | |
| 446 | 1428 *p = DIRECTORY_SEP; |
| 428 | 1429 else |
| 1430 break; | |
| 1431 | |
| 1432 } | |
| 1433 else if (errno == ENOENT || errno == EACCES) | |
| 1434 { | |
| 1435 /* Failed on this component. Just tack on the rest of | |
| 1436 the string and we are done. */ | |
| 771 | 1437 int rlen = qxestrlen (resolved_path); |
| 428 | 1438 |
| 1439 /* "On failure, it returns NULL, sets errno to indicate | |
| 1440 the error, and places in resolved_path the absolute pathname | |
| 1441 of the path component which could not be resolved." */ | |
| 442 | 1442 |
| 1443 if (p) | |
| 428 | 1444 { |
| 1445 int plen = elen - (p - path); | |
| 1446 | |
| 446 | 1447 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])) |
| 428 | 1448 rlen = rlen - 1; |
| 1449 | |
| 1450 if (plen + rlen + 1 > countof (resolved_path)) | |
| 1451 goto toolong; | |
| 1452 | |
| 446 | 1453 resolved_path[rlen] = DIRECTORY_SEP; |
| 428 | 1454 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1); |
| 1455 } | |
| 1456 break; | |
| 1457 } | |
| 1458 else | |
| 1459 goto lose; | |
| 1460 } | |
| 1461 } | |
| 1462 | |
| 1463 { | |
| 442 | 1464 Lisp_Object resolved_name; |
| 771 | 1465 int rlen = qxestrlen (resolved_path); |
| 826 | 1466 if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1)) |
| 446 | 1467 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))) |
| 428 | 1468 { |
| 1469 if (rlen + 1 > countof (resolved_path)) | |
| 1470 goto toolong; | |
| 446 | 1471 resolved_path[rlen++] = DIRECTORY_SEP; |
| 442 | 1472 resolved_path[rlen] = '\0'; |
| 428 | 1473 } |
| 771 | 1474 resolved_name = make_string (resolved_path, rlen); |
| 442 | 1475 RETURN_UNGCPRO (resolved_name); |
| 428 | 1476 } |
| 1477 | |
| 1478 toolong: | |
| 1479 errno = ENAMETOOLONG; | |
| 1480 goto lose; | |
| 1481 lose: | |
| 563 | 1482 report_file_error ("Finding truename", expanded_name); |
| 428 | 1483 } |
| 442 | 1484 RETURN_UNGCPRO (Qnil); |
| 428 | 1485 } |
| 1486 | |
| 1487 | |
| 1488 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* | |
| 1489 Substitute environment variables referred to in FILENAME. | |
| 1490 `$FOO' where FOO is an environment variable name means to substitute | |
| 1491 the value of that variable. The variable name should be terminated | |
| 444 | 1492 with a character, not a letter, digit or underscore; otherwise, enclose |
| 428 | 1493 the entire variable name in braces. |
| 1494 If `/~' appears, all of FILENAME through that `/' is discarded. | |
| 1495 */ | |
| 444 | 1496 (filename)) |
| 428 | 1497 { |
| 442 | 1498 /* This function can GC. GC checked 2000-07-28 ben. */ |
| 867 | 1499 Ibyte *nm; |
| 1500 | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1501 Ibyte *s, *p, *o, *x, *endp, *got; |
| 867 | 1502 Ibyte *target = 0; |
| 428 | 1503 int total = 0; |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1504 int substituted = 0, seen_braces; |
| 867 | 1505 Ibyte *xnm; |
| 428 | 1506 Lisp_Object handler; |
| 1507 | |
| 444 | 1508 CHECK_STRING (filename); |
| 428 | 1509 |
| 1510 /* If the file name has special constructs in it, | |
| 1511 call the corresponding file handler. */ | |
| 444 | 1512 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name); |
| 428 | 1513 if (!NILP (handler)) |
| 1514 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name, | |
| 444 | 1515 filename); |
| 1516 | |
| 1517 nm = XSTRING_DATA (filename); | |
| 1518 endp = nm + XSTRING_LENGTH (filename); | |
| 428 | 1519 |
| 1520 /* If /~ or // appears, discard everything through first slash. */ | |
| 1521 | |
| 1522 for (p = nm; p != endp; p++) | |
| 1523 { | |
| 1524 if ((p[0] == '~' | |
| 657 | 1525 #if defined (WIN32_FILENAMES) |
| 440 | 1526 /* // at start of file name is meaningful in WindowsNT systems */ |
| 428 | 1527 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) |
| 657 | 1528 #else /* not (WIN32_FILENAMES) */ |
| 428 | 1529 || IS_DIRECTORY_SEP (p[0]) |
| 657 | 1530 #endif /* not (WIN32_FILENAMES) */ |
| 428 | 1531 ) |
| 1532 && p != nm | |
| 1533 && (IS_DIRECTORY_SEP (p[-1]))) | |
| 1534 { | |
| 1535 nm = p; | |
| 1536 substituted = 1; | |
| 1537 } | |
| 657 | 1538 #ifdef WIN32_FILENAMES |
| 428 | 1539 /* see comment in expand-file-name about drive specifiers */ |
| 1540 else if (IS_DRIVE (p[0]) && p[1] == ':' | |
| 1541 && p > nm && IS_DIRECTORY_SEP (p[-1])) | |
| 1542 { | |
| 1543 nm = p; | |
| 1544 substituted = 1; | |
| 1545 } | |
| 657 | 1546 #endif /* WIN32_FILENAMES */ |
| 428 | 1547 } |
| 1548 | |
| 1549 /* See if any variables are substituted into the string | |
| 1550 and find the total length of their values in `total' */ | |
| 1551 | |
| 1552 for (p = nm; p != endp;) | |
| 1553 if (*p != '$') | |
| 1554 p++; | |
| 1555 else | |
| 1556 { | |
| 1557 p++; | |
| 1558 if (p == endp) | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1559 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1560 /* No substitution, no error. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1561 break; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1562 } |
| 428 | 1563 else if (*p == '$') |
| 1564 { | |
| 1565 /* "$$" means a single "$" */ | |
| 1566 p++; | |
| 1567 total -= 1; | |
| 1568 substituted = 1; | |
| 1569 continue; | |
| 1570 } | |
| 1571 else if (*p == '{') | |
| 1572 { | |
| 1573 o = ++p; | |
| 1574 while (p != endp && *p != '}') p++; | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1575 if (*p != '}') |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1576 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1577 /* No substitution, no error. Keep looking. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1578 p = o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1579 continue; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1580 } |
| 428 | 1581 s = p; |
| 1582 } | |
| 1583 else | |
| 1584 { | |
| 1585 o = p; | |
| 1586 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
| 1587 s = p; | |
| 1588 } | |
| 1589 | |
| 1590 /* Copy out the variable name */ | |
| 2367 | 1591 target = alloca_ibytes (s - o + 1); |
| 771 | 1592 qxestrncpy (target, o, s - o); |
| 428 | 1593 target[s - o] = 0; |
| 442 | 1594 #ifdef WIN32_NATIVE |
| 1204 | 1595 qxestrupr (target); /* $home == $HOME etc. */ |
| 442 | 1596 #endif /* WIN32_NATIVE */ |
| 428 | 1597 |
| 1598 /* Get variable value */ | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1599 got = egetenv ((CIbyte *) target); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1600 if (got) |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1601 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1602 total += qxestrlen (got); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1603 substituted = 1; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1604 } |
| 428 | 1605 } |
| 1606 | |
| 1607 if (!substituted) | |
| 444 | 1608 return filename; |
| 1609 | |
| 1610 /* If substitution required, recopy the filename and do it */ | |
| 428 | 1611 /* Make space in stack frame for the new copy */ |
| 2367 | 1612 xnm = alloca_ibytes (XSTRING_LENGTH (filename) + total + 1); |
| 428 | 1613 x = xnm; |
| 1614 | |
| 1615 /* Copy the rest of the name through, replacing $ constructs with values */ | |
| 1616 for (p = nm; *p;) | |
| 1617 if (*p != '$') | |
| 1618 *x++ = *p++; | |
| 1619 else | |
| 1620 { | |
| 1621 p++; | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1622 seen_braces = 0; |
| 428 | 1623 if (p == endp) |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1624 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1625 *x++ = '$'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1626 break; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1627 } |
| 428 | 1628 else if (*p == '$') |
| 1629 { | |
| 1630 *x++ = *p++; | |
| 1631 continue; | |
| 1632 } | |
| 1633 else if (*p == '{') | |
| 1634 { | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1635 seen_braces = 1; |
| 428 | 1636 o = ++p; |
| 1637 while (p != endp && *p != '}') p++; | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1638 if (*p != '}') |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1639 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1640 /* Don't syntax error, don't substitute */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1641 *x++ = '{'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1642 p = o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1643 continue; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1644 } |
| 428 | 1645 s = p++; |
| 1646 } | |
| 1647 else | |
| 1648 { | |
| 1649 o = p; | |
| 1650 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
| 1651 s = p; | |
| 1652 } | |
| 1653 | |
| 1654 /* Copy out the variable name */ | |
| 2367 | 1655 target = alloca_ibytes (s - o + 1); |
| 771 | 1656 qxestrncpy (target, o, s - o); |
| 428 | 1657 target[s - o] = 0; |
| 442 | 1658 #ifdef WIN32_NATIVE |
| 1204 | 1659 qxestrupr (target); /* $home == $HOME etc. */ |
| 442 | 1660 #endif /* WIN32_NATIVE */ |
| 428 | 1661 |
| 1662 /* Get variable value */ | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1663 got = egetenv ((CIbyte *) target); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1664 if (got) |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1665 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1666 qxestrcpy (x, got); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1667 x += qxestrlen (got); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1668 } |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1669 else |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1670 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1671 *x++ = '$'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1672 if (seen_braces) |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1673 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1674 *x++ = '{'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1675 /* Preserve the original case. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1676 qxestrncpy (x, o, s - o); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1677 x += s - o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1678 *x++ = '}'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1679 } |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1680 else |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1681 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1682 /* Preserve the original case. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1683 qxestrncpy (x, o, s - o); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1684 x += s - o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1685 } |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1686 } |
| 428 | 1687 } |
| 1688 | |
| 1689 *x = 0; | |
| 1690 | |
| 1691 /* If /~ or // appears, discard everything through first slash. */ | |
| 1692 | |
| 1693 for (p = xnm; p != x; p++) | |
| 1694 if ((p[0] == '~' | |
| 657 | 1695 #if defined (WIN32_FILENAMES) |
| 428 | 1696 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) |
| 657 | 1697 #else /* not WIN32_FILENAMES */ |
| 428 | 1698 || IS_DIRECTORY_SEP (p[0]) |
| 657 | 1699 #endif /* not WIN32_FILENAMES */ |
| 428 | 1700 ) |
| 1701 /* don't do p[-1] if that would go off the beginning --jwz */ | |
| 1702 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1])) | |
| 1703 xnm = p; | |
| 657 | 1704 #ifdef WIN32_FILENAMES |
| 428 | 1705 else if (IS_DRIVE (p[0]) && p[1] == ':' |
| 1706 && p > nm && IS_DIRECTORY_SEP (p[-1])) | |
| 1707 xnm = p; | |
| 1708 #endif | |
| 1709 | |
| 1710 return make_string (xnm, x - xnm); | |
| 1711 } | |
| 1712 | |
| 1713 /* A slightly faster and more convenient way to get | |
| 1714 (directory-file-name (expand-file-name FOO)). */ | |
| 1715 | |
| 1716 Lisp_Object | |
| 1717 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) | |
| 1718 { | |
| 442 | 1719 /* This function can call Lisp. GC checked 2000-07-28 ben */ |
| 428 | 1720 Lisp_Object abspath; |
| 1721 struct gcpro gcpro1; | |
| 1722 | |
| 1723 abspath = Fexpand_file_name (filename, defdir); | |
| 1724 GCPRO1 (abspath); | |
| 1725 /* Remove final slash, if any (unless path is root). | |
| 1726 stat behaves differently depending! */ | |
| 1727 if (XSTRING_LENGTH (abspath) > 1 | |
| 826 | 1728 && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1)) |
| 1729 && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2))) | |
| 428 | 1730 /* We cannot take shortcuts; they might be wrong for magic file names. */ |
| 1731 abspath = Fdirectory_file_name (abspath); | |
| 1732 UNGCPRO; | |
| 1733 return abspath; | |
| 1734 } | |
| 1735 | |
| 1736 /* Signal an error if the file ABSNAME already exists. | |
| 1737 If INTERACTIVE is nonzero, ask the user whether to proceed, | |
| 1738 and bypass the error if the user says to go ahead. | |
| 1739 QUERYSTRING is a name for the action that is being considered | |
| 1740 to alter the file. | |
| 1741 *STATPTR is used to store the stat information if the file exists. | |
| 1742 If the file does not exist, STATPTR->st_mode is set to 0. */ | |
| 1743 | |
| 1744 static void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
1745 barf_or_query_if_file_exists (Lisp_Object absname, const Ascbyte *querystring, |
| 428 | 1746 int interactive, struct stat *statptr) |
| 1747 { | |
| 442 | 1748 /* This function can call Lisp. GC checked 2000-07-28 ben */ |
| 428 | 1749 struct stat statbuf; |
| 1750 | |
| 1751 /* stat is a good way to tell whether the file exists, | |
| 1752 regardless of what access permissions it has. */ | |
| 771 | 1753 if (qxe_stat (XSTRING_DATA (absname), &statbuf) >= 0) |
| 428 | 1754 { |
| 1755 Lisp_Object tem; | |
| 1756 | |
| 1757 if (interactive) | |
| 1758 { | |
| 1759 Lisp_Object prompt; | |
| 1760 struct gcpro gcpro1; | |
| 1761 | |
| 771 | 1762 prompt = |
| 1763 emacs_sprintf_string | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
1764 (GETTEXT ("File %s already exists; %s anyway? "), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
1765 XSTRING_DATA (absname), GETTEXT (querystring)); |
| 428 | 1766 |
| 1767 GCPRO1 (prompt); | |
| 1768 tem = call1 (Qyes_or_no_p, prompt); | |
| 1769 UNGCPRO; | |
| 1770 } | |
| 1771 else | |
| 1772 tem = Qnil; | |
| 1773 | |
| 1774 if (NILP (tem)) | |
| 1775 Fsignal (Qfile_already_exists, | |
| 771 | 1776 list2 (build_msg_string ("File already exists"), |
| 428 | 1777 absname)); |
| 1778 if (statptr) | |
| 1779 *statptr = statbuf; | |
| 1780 } | |
| 1781 else | |
| 1782 { | |
| 1783 if (statptr) | |
| 1784 statptr->st_mode = 0; | |
| 1785 } | |
| 1786 return; | |
| 1787 } | |
|
5779
e9d0228c5671
Use a larger buffering size in #'copy-file too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5778
diff
changeset
|
1788 |
|
e9d0228c5671
Use a larger buffering size in #'copy-file too.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5778
diff
changeset
|
1789 #define READ_BUF_SIZE (2 << 16) |
| 428 | 1790 |
| 1791 DEFUN ("copy-file", Fcopy_file, 2, 4, | |
| 1792 "fCopy file: \nFCopy %s to file: \np\nP", /* | |
| 444 | 1793 Copy FILENAME to NEWNAME. Both args must be strings. |
| 428 | 1794 Signals a `file-already-exists' error if file NEWNAME already exists, |
| 1795 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. | |
| 1796 A number as third arg means request confirmation if NEWNAME already exists. | |
| 1797 This is what happens in interactive use with M-x. | |
| 1798 Fourth arg KEEP-TIME non-nil means give the new file the same | |
| 1799 last-modified time as the old one. (This works on only some systems.) | |
| 1800 A prefix arg makes KEEP-TIME non-nil. | |
| 1801 */ | |
| 1802 (filename, newname, ok_if_already_exists, keep_time)) | |
| 1803 { | |
| 442 | 1804 /* This function can call Lisp. GC checked 2000-07-28 ben */ |
| 428 | 1805 int ifd, ofd, n; |
|
5781
0853e1ec8529
Use alloca_{rawbytes,ibytes} in #'copy-file, #'insert-file-contents-internal
Aidan Kehoe <kehoea@parhasard.net>
parents:
5779
diff
changeset
|
1806 Rawbyte *buf = alloca_rawbytes (READ_BUF_SIZE); |
| 428 | 1807 struct stat st, out_st; |
| 1808 Lisp_Object handler; | |
| 1809 int speccount = specpdl_depth (); | |
| 1810 struct gcpro gcpro1, gcpro2; | |
| 1811 /* Lisp_Object args[6]; */ | |
| 1812 int input_file_statable_p; | |
| 1813 | |
| 1814 GCPRO2 (filename, newname); | |
| 1815 CHECK_STRING (filename); | |
| 1816 CHECK_STRING (newname); | |
| 1817 filename = Fexpand_file_name (filename, Qnil); | |
| 1818 newname = Fexpand_file_name (newname, Qnil); | |
| 1819 | |
| 1820 /* If the input file name has special constructs in it, | |
| 1821 call the corresponding file handler. */ | |
| 1822 handler = Ffind_file_name_handler (filename, Qcopy_file); | |
| 1823 /* Likewise for output file name. */ | |
| 1824 if (NILP (handler)) | |
| 1825 handler = Ffind_file_name_handler (newname, Qcopy_file); | |
| 1826 if (!NILP (handler)) | |
| 1827 { | |
| 1828 UNGCPRO; | |
| 1829 return call5 (handler, Qcopy_file, filename, newname, | |
| 1830 ok_if_already_exists, keep_time); | |
| 1831 } | |
| 1832 | |
| 1833 /* When second argument is a directory, copy the file into it. | |
| 1834 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo") | |
| 1835 */ | |
| 1836 if (!NILP (Ffile_directory_p (newname))) | |
| 1837 { | |
| 1838 Lisp_Object args[3]; | |
| 1839 struct gcpro ngcpro1; | |
| 1840 int i = 1; | |
| 1841 | |
| 1842 args[0] = newname; | |
| 1843 args[1] = Qnil; args[2] = Qnil; | |
| 1844 NGCPRO1 (*args); | |
| 1845 ngcpro1.nvars = 3; | |
| 826 | 1846 if (!IS_DIRECTORY_SEP (string_byte (newname, |
| 442 | 1847 XSTRING_LENGTH (newname) - 1))) |
| 1848 | |
| 1849 args[i++] = Fchar_to_string (Vdirectory_sep_char); | |
| 428 | 1850 args[i++] = Ffile_name_nondirectory (filename); |
| 1851 newname = Fconcat (i, args); | |
| 1852 NUNGCPRO; | |
| 1853 } | |
| 1854 | |
| 1855 if (NILP (ok_if_already_exists) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
1856 || FIXNUMP (ok_if_already_exists)) |
| 428 | 1857 barf_or_query_if_file_exists (newname, "copy to it", |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
1858 FIXNUMP (ok_if_already_exists), &out_st); |
| 771 | 1859 else if (qxe_stat (XSTRING_DATA (newname), &out_st) < 0) |
| 428 | 1860 out_st.st_mode = 0; |
| 1861 | |
| 771 | 1862 ifd = qxe_interruptible_open (XSTRING_DATA (filename), |
| 1863 O_RDONLY | OPEN_BINARY, 0); | |
| 428 | 1864 if (ifd < 0) |
| 563 | 1865 report_file_error ("Opening input file", filename); |
| 428 | 1866 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
1867 record_unwind_protect (close_file_unwind, make_fixnum (ifd)); |
| 428 | 1868 |
| 1869 /* We can only copy regular files and symbolic links. Other files are not | |
| 1870 copyable by us. */ | |
| 771 | 1871 input_file_statable_p = (qxe_fstat (ifd, &st) >= 0); |
| 428 | 1872 |
| 442 | 1873 #ifndef WIN32_NATIVE |
| 428 | 1874 if (out_st.st_mode != 0 |
| 1875 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) | |
| 1876 { | |
| 1877 errno = 0; | |
| 1878 report_file_error ("Input and output files are the same", | |
| 563 | 1879 list3 (Qunbound, filename, newname)); |
| 428 | 1880 } |
| 1881 #endif | |
| 1882 | |
| 1883 #if defined (S_ISREG) && defined (S_ISLNK) | |
| 1884 if (input_file_statable_p) | |
| 1885 { | |
| 1886 if (!(S_ISREG (st.st_mode)) | |
| 1887 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */ | |
| 1888 #ifdef S_ISCHR | |
| 1889 && !(S_ISCHR (st.st_mode)) | |
| 1890 #endif | |
| 1891 && !(S_ISLNK (st.st_mode))) | |
| 1892 { | |
| 1893 #if defined (EISDIR) | |
| 1894 /* Get a better looking error message. */ | |
| 1895 errno = EISDIR; | |
| 1896 #endif /* EISDIR */ | |
| 563 | 1897 report_file_error ("Non-regular file", filename); |
| 428 | 1898 } |
| 1899 } | |
| 1900 #endif /* S_ISREG && S_ISLNK */ | |
| 1901 | |
| 771 | 1902 ofd = qxe_open (XSTRING_DATA (newname), |
| 1903 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE); | |
| 428 | 1904 if (ofd < 0) |
| 563 | 1905 report_file_error ("Opening output file", newname); |
| 428 | 1906 |
| 1907 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
1908 Lisp_Object ofd_locative = noseeum_cons (make_fixnum (ofd), Qnil); |
| 428 | 1909 |
| 1910 record_unwind_protect (close_file_unwind, ofd_locative); | |
| 1911 | |
|
5781
0853e1ec8529
Use alloca_{rawbytes,ibytes} in #'copy-file, #'insert-file-contents-internal
Aidan Kehoe <kehoea@parhasard.net>
parents:
5779
diff
changeset
|
1912 while ((n = read_allowing_quit (ifd, buf, READ_BUF_SIZE)) > 0) |
| 428 | 1913 { |
| 1914 if (write_allowing_quit (ofd, buf, n) != n) | |
| 563 | 1915 report_file_error ("I/O error", newname); |
| 428 | 1916 } |
| 1917 | |
| 1918 /* Closing the output clobbers the file times on some systems. */ | |
| 771 | 1919 if (retry_close (ofd) < 0) |
| 563 | 1920 report_file_error ("I/O error", newname); |
| 428 | 1921 |
| 1922 if (input_file_statable_p) | |
| 1923 { | |
| 442 | 1924 if (!NILP (keep_time)) |
| 1925 { | |
| 1926 EMACS_TIME atime, mtime; | |
| 1927 EMACS_SET_SECS_USECS (atime, st.st_atime, 0); | |
| 1928 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); | |
| 592 | 1929 if (set_file_times (newname, atime, mtime)) |
| 1930 report_file_error ("I/O error", list1 (newname)); | |
| 442 | 1931 } |
| 771 | 1932 qxe_chmod (XSTRING_DATA (newname), st.st_mode & 07777); |
| 428 | 1933 } |
| 1934 | |
| 1935 /* We'll close it by hand */ | |
| 1936 XCAR (ofd_locative) = Qnil; | |
| 1937 | |
| 1938 /* Close ifd */ | |
| 771 | 1939 unbind_to (speccount); |
| 428 | 1940 } |
| 1941 | |
| 1942 UNGCPRO; | |
| 1943 return Qnil; | |
| 1944 } | |
| 1945 | |
| 1946 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /* | |
| 1947 Create a directory. One argument, a file name string. | |
| 1948 */ | |
| 1949 (dirname_)) | |
| 1950 { | |
| 1951 /* This function can GC. GC checked 1997.04.06. */ | |
| 1952 Lisp_Object handler; | |
| 1953 struct gcpro gcpro1; | |
| 771 | 1954 DECLARE_EISTRING (dir); |
| 428 | 1955 |
| 1956 CHECK_STRING (dirname_); | |
| 1957 dirname_ = Fexpand_file_name (dirname_, Qnil); | |
| 1958 | |
| 1959 GCPRO1 (dirname_); | |
| 1960 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal); | |
| 1961 UNGCPRO; | |
| 1962 if (!NILP (handler)) | |
| 1963 return (call2 (handler, Qmake_directory_internal, dirname_)); | |
| 1964 | |
| 771 | 1965 eicpy_lstr (dir, dirname_); |
| 1966 if (eigetch_char (dir, eicharlen (dir) - 1) == '/') | |
| 1967 eidel (dir, eilen (dir) - 1, -1, 1, -1); | |
| 1968 | |
| 1969 if (qxe_mkdir (eidata (dir), 0777) != 0) | |
| 563 | 1970 report_file_error ("Creating directory", dirname_); |
| 428 | 1971 |
| 1972 return Qnil; | |
| 1973 } | |
| 1974 | |
| 1975 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /* | |
| 1976 Delete a directory. One argument, a file name or directory name string. | |
| 1977 */ | |
| 1978 (dirname_)) | |
| 1979 { | |
| 1980 /* This function can GC. GC checked 1997.04.06. */ | |
| 1981 Lisp_Object handler; | |
| 1982 struct gcpro gcpro1; | |
| 1983 | |
| 1984 CHECK_STRING (dirname_); | |
| 1985 | |
| 1986 GCPRO1 (dirname_); | |
| 1987 dirname_ = Fexpand_file_name (dirname_, Qnil); | |
| 1988 dirname_ = Fdirectory_file_name (dirname_); | |
| 1989 | |
| 1990 handler = Ffind_file_name_handler (dirname_, Qdelete_directory); | |
| 1991 UNGCPRO; | |
| 1992 if (!NILP (handler)) | |
| 1993 return (call2 (handler, Qdelete_directory, dirname_)); | |
| 1994 | |
| 771 | 1995 if (qxe_rmdir (XSTRING_DATA (dirname_)) != 0) |
| 563 | 1996 report_file_error ("Removing directory", dirname_); |
| 428 | 1997 |
| 1998 return Qnil; | |
| 1999 } | |
| 2000 | |
| 2001 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /* | |
| 442 | 2002 Delete the file named FILENAME (a string). |
| 2003 If FILENAME has multiple names, it continues to exist with the other names. | |
| 428 | 2004 */ |
| 2005 (filename)) | |
| 2006 { | |
| 2007 /* This function can GC. GC checked 1997.04.06. */ | |
| 2008 Lisp_Object handler; | |
| 2009 struct gcpro gcpro1; | |
| 2010 | |
| 2011 CHECK_STRING (filename); | |
| 2012 filename = Fexpand_file_name (filename, Qnil); | |
| 2013 | |
| 2014 GCPRO1 (filename); | |
| 2015 handler = Ffind_file_name_handler (filename, Qdelete_file); | |
| 2016 UNGCPRO; | |
| 2017 if (!NILP (handler)) | |
| 2018 return call2 (handler, Qdelete_file, filename); | |
| 2019 | |
| 771 | 2020 if (0 > qxe_unlink (XSTRING_DATA (filename))) |
| 563 | 2021 report_file_error ("Removing old name", filename); |
| 428 | 2022 return Qnil; |
| 2023 } | |
| 2024 | |
| 2025 static Lisp_Object | |
| 2286 | 2026 internal_delete_file_1 (Lisp_Object UNUSED (ignore), |
| 2027 Lisp_Object UNUSED (ignore2)) | |
| 428 | 2028 { |
| 2029 return Qt; | |
| 2030 } | |
| 2031 | |
| 2032 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */ | |
| 2033 | |
| 2034 int | |
| 2035 internal_delete_file (Lisp_Object filename) | |
| 2036 { | |
| 2037 /* This function can GC. GC checked 1997.04.06. */ | |
| 2038 return NILP (condition_case_1 (Qt, Fdelete_file, filename, | |
| 2039 internal_delete_file_1, Qnil)); | |
| 2040 } | |
| 2041 | |
| 2042 DEFUN ("rename-file", Frename_file, 2, 3, | |
| 2043 "fRename file: \nFRename %s to file: \np", /* | |
| 444 | 2044 Rename FILENAME as NEWNAME. Both args must be strings. |
| 2045 If file has names other than FILENAME, it continues to have those names. | |
| 428 | 2046 Signals a `file-already-exists' error if a file NEWNAME already exists |
| 2047 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | |
| 2048 A number as third arg means request confirmation if NEWNAME already exists. | |
| 2049 This is what happens in interactive use with M-x. | |
| 2050 */ | |
| 2051 (filename, newname, ok_if_already_exists)) | |
| 2052 { | |
| 2053 /* This function can GC. GC checked 1997.04.06. */ | |
| 2054 Lisp_Object handler; | |
| 2055 struct gcpro gcpro1, gcpro2; | |
| 2056 | |
| 2057 GCPRO2 (filename, newname); | |
| 2058 CHECK_STRING (filename); | |
| 2059 CHECK_STRING (newname); | |
| 2060 filename = Fexpand_file_name (filename, Qnil); | |
| 2061 newname = Fexpand_file_name (newname, Qnil); | |
| 2062 | |
| 2063 /* If the file name has special constructs in it, | |
| 2064 call the corresponding file handler. */ | |
| 2065 handler = Ffind_file_name_handler (filename, Qrename_file); | |
| 2066 if (NILP (handler)) | |
| 2067 handler = Ffind_file_name_handler (newname, Qrename_file); | |
| 2068 if (!NILP (handler)) | |
| 2069 { | |
| 2070 UNGCPRO; | |
| 2071 return call4 (handler, Qrename_file, | |
| 2072 filename, newname, ok_if_already_exists); | |
| 2073 } | |
| 2074 | |
| 2075 /* When second argument is a directory, rename the file into it. | |
| 2076 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo") | |
| 2077 */ | |
| 2078 if (!NILP (Ffile_directory_p (newname))) | |
| 2079 { | |
| 2080 Lisp_Object args[3]; | |
| 2081 struct gcpro ngcpro1; | |
| 2082 int i = 1; | |
| 2083 | |
| 2084 args[0] = newname; | |
| 2085 args[1] = Qnil; args[2] = Qnil; | |
| 2086 NGCPRO1 (*args); | |
| 2087 ngcpro1.nvars = 3; | |
| 826 | 2088 if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/') |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
2089 args[i++] = build_ascstring ("/"); |
| 428 | 2090 args[i++] = Ffile_name_nondirectory (filename); |
| 2091 newname = Fconcat (i, args); | |
| 2092 NUNGCPRO; | |
| 2093 } | |
| 2094 | |
| 2095 if (NILP (ok_if_already_exists) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2096 || FIXNUMP (ok_if_already_exists)) |
| 428 | 2097 barf_or_query_if_file_exists (newname, "rename to it", |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2098 FIXNUMP (ok_if_already_exists), 0); |
| 428 | 2099 |
| 442 | 2100 /* We have configure check for rename() and emulate using |
| 2101 link()/unlink() if necessary. */ | |
| 771 | 2102 if (0 > qxe_rename (XSTRING_DATA (filename), XSTRING_DATA (newname))) |
| 428 | 2103 { |
| 2104 if (errno == EXDEV) | |
| 2105 { | |
| 2106 Fcopy_file (filename, newname, | |
| 2107 /* We have already prompted if it was an integer, | |
| 2108 so don't have copy-file prompt again. */ | |
| 2109 (NILP (ok_if_already_exists) ? Qnil : Qt), | |
| 2110 Qt); | |
| 2111 Fdelete_file (filename); | |
| 2112 } | |
| 2113 else | |
| 2114 { | |
| 563 | 2115 report_file_error ("Renaming", list3 (Qunbound, filename, newname)); |
| 428 | 2116 } |
| 2117 } | |
| 2118 UNGCPRO; | |
| 2119 return Qnil; | |
| 2120 } | |
| 2121 | |
| 2122 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3, | |
| 2123 "fAdd name to file: \nFName to add to %s: \np", /* | |
| 444 | 2124 Give FILENAME additional name NEWNAME. Both args must be strings. |
| 428 | 2125 Signals a `file-already-exists' error if a file NEWNAME already exists |
| 2126 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | |
| 2127 A number as third arg means request confirmation if NEWNAME already exists. | |
| 2128 This is what happens in interactive use with M-x. | |
| 2129 */ | |
| 2130 (filename, newname, ok_if_already_exists)) | |
| 2131 { | |
| 2132 /* This function can GC. GC checked 1997.04.06. */ | |
| 2133 Lisp_Object handler; | |
| 2134 struct gcpro gcpro1, gcpro2; | |
| 2135 | |
| 2136 GCPRO2 (filename, newname); | |
| 2137 CHECK_STRING (filename); | |
| 2138 CHECK_STRING (newname); | |
| 2139 filename = Fexpand_file_name (filename, Qnil); | |
| 2140 newname = Fexpand_file_name (newname, Qnil); | |
| 2141 | |
| 2142 /* If the file name has special constructs in it, | |
| 2143 call the corresponding file handler. */ | |
| 2144 handler = Ffind_file_name_handler (filename, Qadd_name_to_file); | |
| 2145 if (!NILP (handler)) | |
| 2146 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, | |
| 2147 newname, ok_if_already_exists)); | |
| 2148 | |
| 2149 /* If the new name has special constructs in it, | |
| 2150 call the corresponding file handler. */ | |
| 2151 handler = Ffind_file_name_handler (newname, Qadd_name_to_file); | |
| 2152 if (!NILP (handler)) | |
| 2153 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, | |
| 2154 newname, ok_if_already_exists)); | |
| 2155 | |
| 2156 if (NILP (ok_if_already_exists) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2157 || FIXNUMP (ok_if_already_exists)) |
| 428 | 2158 barf_or_query_if_file_exists (newname, "make it a new name", |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2159 FIXNUMP (ok_if_already_exists), 0); |
| 771 | 2160 /* #### Emacs 20.6 contains an implementation of link() in w32.c. |
| 2161 Need to port. */ | |
| 2162 #ifndef HAVE_LINK | |
| 563 | 2163 signal_error_2 (Qunimplemented, "Adding new name", filename, newname); |
| 771 | 2164 #else /* HAVE_LINK */ |
| 2165 qxe_unlink (XSTRING_DATA (newname)); | |
| 2166 if (0 > qxe_link (XSTRING_DATA (filename), XSTRING_DATA (newname))) | |
| 428 | 2167 { |
| 2168 report_file_error ("Adding new name", | |
| 563 | 2169 list3 (Qunbound, filename, newname)); |
| 428 | 2170 } |
| 771 | 2171 #endif /* HAVE_LINK */ |
| 428 | 2172 |
| 2173 UNGCPRO; | |
| 2174 return Qnil; | |
| 2175 } | |
| 2176 | |
| 2177 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, | |
| 2178 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* | |
| 2179 Make a symbolic link to FILENAME, named LINKNAME. Both args strings. | |
| 2180 Signals a `file-already-exists' error if a file LINKNAME already exists | |
| 2181 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | |
| 2182 A number as third arg means request confirmation if LINKNAME already exists. | |
| 2183 This happens for interactive use with M-x. | |
|
4465
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2184 |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2185 On platforms where symbolic links are not available, any file handlers will |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2186 be run, but the check for the existence of LINKNAME will not be done, and |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2187 the symbolic link will not be created. |
| 428 | 2188 */ |
| 2189 (filename, linkname, ok_if_already_exists)) | |
| 2190 { | |
| 2191 /* This function can GC. GC checked 1997.06.04. */ | |
| 442 | 2192 /* XEmacs change: run handlers even if local machine doesn't have symlinks */ |
| 428 | 2193 Lisp_Object handler; |
| 2194 struct gcpro gcpro1, gcpro2; | |
| 2195 | |
| 2196 GCPRO2 (filename, linkname); | |
| 2197 CHECK_STRING (filename); | |
| 2198 CHECK_STRING (linkname); | |
| 2199 /* If the link target has a ~, we must expand it to get | |
| 2200 a truly valid file name. Otherwise, do not expand; | |
| 2201 we want to permit links to relative file names. */ | |
| 826 | 2202 if (string_byte (filename, 0) == '~') |
| 428 | 2203 filename = Fexpand_file_name (filename, Qnil); |
| 2204 linkname = Fexpand_file_name (linkname, Qnil); | |
| 2205 | |
| 2206 /* If the file name has special constructs in it, | |
| 2207 call the corresponding file handler. */ | |
| 2208 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); | |
| 2209 if (!NILP (handler)) | |
| 2210 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, | |
| 2211 ok_if_already_exists)); | |
| 2212 | |
| 2213 /* If the new link name has special constructs in it, | |
| 2214 call the corresponding file handler. */ | |
| 2215 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); | |
| 2216 if (!NILP (handler)) | |
| 2217 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, | |
| 2218 linkname, ok_if_already_exists)); | |
| 2219 | |
| 771 | 2220 #ifdef HAVE_SYMLINK |
| 428 | 2221 if (NILP (ok_if_already_exists) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2222 || FIXNUMP (ok_if_already_exists)) |
| 428 | 2223 barf_or_query_if_file_exists (linkname, "make it a link", |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2224 FIXNUMP (ok_if_already_exists), 0); |
| 428 | 2225 |
| 771 | 2226 qxe_unlink (XSTRING_DATA (linkname)); |
| 2227 if (0 > qxe_symlink (XSTRING_DATA (filename), | |
| 2228 XSTRING_DATA (linkname))) | |
| 428 | 2229 { |
| 2230 report_file_error ("Making symbolic link", | |
| 563 | 2231 list3 (Qunbound, filename, linkname)); |
| 428 | 2232 } |
| 771 | 2233 #endif |
| 442 | 2234 |
| 428 | 2235 UNGCPRO; |
| 2236 return Qnil; | |
| 2237 } | |
| 2238 | |
| 2239 #ifdef HPUX_NET | |
| 2240 | |
| 2241 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* | |
| 2242 Open a network connection to PATH using LOGIN as the login string. | |
| 2243 */ | |
| 2244 (path, login)) | |
| 2245 { | |
| 2246 int netresult; | |
| 1333 | 2247 const Extbyte *path_ext; |
| 2248 const Extbyte *login_ext; | |
| 428 | 2249 |
| 2250 CHECK_STRING (path); | |
| 2251 CHECK_STRING (login); | |
| 2252 | |
| 2253 /* netunam, being a strange-o system call only used once, is not | |
| 2254 encapsulated. */ | |
| 440 | 2255 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2256 LISP_PATHNAME_CONVERT_OUT (path, path_ext); |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2257 login_ext = LISP_STRING_TO_EXTERNAL (login, Quser_name_encoding); |
| 440 | 2258 |
| 2259 netresult = netunam (path_ext, login_ext); | |
| 2260 | |
| 2261 return netresult == -1 ? Qnil : Qt; | |
| 428 | 2262 } |
| 2263 #endif /* HPUX_NET */ | |
| 2264 | |
| 2265 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /* | |
| 2266 Return t if file FILENAME specifies an absolute path name. | |
| 2267 On Unix, this is a name starting with a `/' or a `~'. | |
| 2268 */ | |
| 2269 (filename)) | |
| 2270 { | |
| 2271 /* This function does not GC */ | |
| 867 | 2272 Ibyte *ptr; |
| 428 | 2273 |
| 2274 CHECK_STRING (filename); | |
| 2275 ptr = XSTRING_DATA (filename); | |
| 2276 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' | |
| 657 | 2277 #ifdef WIN32_FILENAMES |
| 428 | 2278 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2])) |
| 2279 #endif | |
| 2280 ) ? Qt : Qnil; | |
| 2281 } | |
| 2282 | |
| 2283 /* Return nonzero if file FILENAME exists and can be executed. */ | |
| 2284 | |
| 2285 static int | |
| 771 | 2286 check_executable (Lisp_Object filename) |
| 428 | 2287 { |
| 442 | 2288 #ifdef WIN32_NATIVE |
| 428 | 2289 struct stat st; |
| 771 | 2290 if (qxe_stat (XSTRING_DATA (filename), &st) < 0) |
| 428 | 2291 return 0; |
| 2292 return ((st.st_mode & S_IEXEC) != 0); | |
| 442 | 2293 #else /* not WIN32_NATIVE */ |
| 428 | 2294 #ifdef HAVE_EACCESS |
| 771 | 2295 return qxe_eaccess (XSTRING_DATA (filename), X_OK) >= 0; |
| 428 | 2296 #else |
| 2297 /* Access isn't quite right because it uses the real uid | |
| 2298 and we really want to test with the effective uid. | |
| 2299 But Unix doesn't give us a right way to do it. */ | |
| 771 | 2300 return qxe_access (XSTRING_DATA (filename), X_OK) >= 0; |
| 428 | 2301 #endif /* HAVE_EACCESS */ |
| 442 | 2302 #endif /* not WIN32_NATIVE */ |
| 428 | 2303 } |
| 2304 | |
| 2305 /* Return nonzero if file FILENAME exists and can be written. */ | |
| 2306 | |
| 2307 static int | |
| 867 | 2308 check_writable (const Ibyte *filename) |
| 428 | 2309 { |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2310 #ifdef WIN32_ANY |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2311 // Since this has to work for a directory, we can't just call 'CreateFile' |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2312 PSECURITY_DESCRIPTOR pDesc; /* Must be freed with LocalFree */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2313 /* these need not be freed, they point into pDesc */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2314 PSID psidOwner; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2315 PSID psidGroup; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2316 PACL pDacl; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2317 PACL pSacl; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2318 /* end of insides of descriptor */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2319 DWORD error; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2320 DWORD attributes; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2321 HANDLE tokenHandle; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2322 GENERIC_MAPPING genericMapping; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2323 DWORD accessMask; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2324 PRIVILEGE_SET PrivilegeSet; |
| 5198 | 2325 DWORD dwPrivSetSize = sizeof ( PRIVILEGE_SET ); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2326 BOOL fAccessGranted = FALSE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2327 DWORD dwAccessAllowed; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2328 Extbyte *fnameext; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2329 |
|
4867
7822019c5d98
Revert cast in check_writable() and fix up macros to use const.
Vin Shelton <acs@xemacs.org>
parents:
4864
diff
changeset
|
2330 LOCAL_FILE_FORMAT_TO_TSTR (filename, fnameext); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2331 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2332 // First check for a normal file with the old-style readonly bit |
| 5198 | 2333 attributes = qxeGetFileAttributes (fnameext); |
| 2334 if (FILE_ATTRIBUTE_READONLY == | |
| 2335 (attributes & (FILE_ATTRIBUTE_DIRECTORY|FILE_ATTRIBUTE_READONLY))) | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2336 return 0; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2337 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2338 /* Win32 prototype lacks const. */ |
| 5198 | 2339 error = qxeGetNamedSecurityInfo (fnameext, SE_FILE_OBJECT, |
| 2340 DACL_SECURITY_INFORMATION| | |
| 2341 GROUP_SECURITY_INFORMATION| | |
| 2342 OWNER_SECURITY_INFORMATION, | |
| 2343 &psidOwner, &psidGroup, &pDacl, &pSacl, | |
| 2344 &pDesc); | |
| 2345 if (error != ERROR_SUCCESS) | |
| 2346 { // FAT? | |
| 2347 attributes = qxeGetFileAttributes (fnameext); | |
| 2348 return (attributes & FILE_ATTRIBUTE_DIRECTORY) || | |
| 2349 (0 == (attributes & FILE_ATTRIBUTE_READONLY)); | |
| 2350 } | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2351 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2352 genericMapping.GenericRead = FILE_GENERIC_READ; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2353 genericMapping.GenericWrite = FILE_GENERIC_WRITE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2354 genericMapping.GenericExecute = FILE_GENERIC_EXECUTE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2355 genericMapping.GenericAll = FILE_ALL_ACCESS; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2356 |
| 5198 | 2357 if (!ImpersonateSelf (SecurityDelegation)) |
| 2358 { | |
| 2359 return 0; | |
| 2360 } | |
| 2361 if (!OpenThreadToken (GetCurrentThread(), TOKEN_ALL_ACCESS, TRUE, | |
| 2362 &tokenHandle)) | |
| 2363 { | |
| 2364 return 0; | |
| 2365 } | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2366 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2367 accessMask = GENERIC_WRITE; |
| 5198 | 2368 MapGenericMask (&accessMask, &genericMapping); |
| 2369 | |
| 2370 if (!AccessCheck(pDesc, tokenHandle, accessMask, &genericMapping, | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2371 &PrivilegeSet, // receives privileges used in check |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2372 &dwPrivSetSize, // size of PrivilegeSet buffer |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2373 &dwAccessAllowed, // receives mask of allowed access rights |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2374 &fAccessGranted)) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2375 { |
| 5198 | 2376 CloseHandle (tokenHandle); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2377 RevertToSelf(); |
| 5198 | 2378 LocalFree (pDesc); |
| 3781 | 2379 return 0; |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2380 } |
| 5198 | 2381 CloseHandle (tokenHandle); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2382 RevertToSelf(); |
| 5198 | 2383 LocalFree (pDesc); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2384 return fAccessGranted == TRUE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2385 #elif defined (HAVE_EACCESS) |
| 771 | 2386 return (qxe_eaccess (filename, W_OK) >= 0); |
| 428 | 2387 #else |
| 2388 /* Access isn't quite right because it uses the real uid | |
| 2389 and we really want to test with the effective uid. | |
| 2390 But Unix doesn't give us a right way to do it. | |
| 2391 Opening with O_WRONLY could work for an ordinary file, | |
| 2392 but would lose for directories. */ | |
| 771 | 2393 return (qxe_access (filename, W_OK) >= 0); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2394 #endif /* (not) defined (HAVE_EACCESS) */ |
| 428 | 2395 } |
| 2396 | |
| 2397 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /* | |
| 2398 Return t if file FILENAME exists. (This does not mean you can read it.) | |
| 2399 See also `file-readable-p' and `file-attributes'. | |
| 2400 */ | |
| 2401 (filename)) | |
| 2402 { | |
| 442 | 2403 /* This function can call lisp; GC checked 2000-07-11 ben */ |
| 428 | 2404 Lisp_Object abspath; |
| 2405 Lisp_Object handler; | |
| 2406 struct stat statbuf; | |
| 2407 struct gcpro gcpro1; | |
| 2408 | |
| 2409 CHECK_STRING (filename); | |
| 2410 abspath = Fexpand_file_name (filename, Qnil); | |
| 2411 | |
| 2412 /* If the file name has special constructs in it, | |
| 2413 call the corresponding file handler. */ | |
| 2414 GCPRO1 (abspath); | |
| 2415 handler = Ffind_file_name_handler (abspath, Qfile_exists_p); | |
| 2416 UNGCPRO; | |
| 2417 if (!NILP (handler)) | |
| 2418 return call2 (handler, Qfile_exists_p, abspath); | |
| 2419 | |
| 771 | 2420 return qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil; |
| 428 | 2421 } |
| 2422 | |
| 2423 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /* | |
| 2424 Return t if FILENAME can be executed by you. | |
| 2425 For a directory, this means you can access files in that directory. | |
| 2426 */ | |
| 2427 (filename)) | |
| 2428 | |
| 2429 { | |
| 442 | 2430 /* This function can GC. GC checked 07-11-2000 ben. */ |
| 428 | 2431 Lisp_Object abspath; |
| 2432 Lisp_Object handler; | |
| 2433 struct gcpro gcpro1; | |
| 2434 | |
| 2435 CHECK_STRING (filename); | |
| 2436 abspath = Fexpand_file_name (filename, Qnil); | |
| 2437 | |
| 2438 /* If the file name has special constructs in it, | |
| 2439 call the corresponding file handler. */ | |
| 2440 GCPRO1 (abspath); | |
| 2441 handler = Ffind_file_name_handler (abspath, Qfile_executable_p); | |
| 2442 UNGCPRO; | |
| 2443 if (!NILP (handler)) | |
| 2444 return call2 (handler, Qfile_executable_p, abspath); | |
| 2445 | |
| 771 | 2446 return check_executable (abspath) ? Qt : Qnil; |
| 428 | 2447 } |
| 2448 | |
| 2449 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /* | |
| 2450 Return t if file FILENAME exists and you can read it. | |
| 2451 See also `file-exists-p' and `file-attributes'. | |
| 2452 */ | |
| 2453 (filename)) | |
| 2454 { | |
| 2455 /* This function can GC */ | |
| 2456 Lisp_Object abspath = Qnil; | |
| 2457 Lisp_Object handler; | |
| 2458 struct gcpro gcpro1; | |
| 2459 GCPRO1 (abspath); | |
| 2460 | |
| 2461 CHECK_STRING (filename); | |
| 2462 abspath = Fexpand_file_name (filename, Qnil); | |
| 2463 | |
| 2464 /* If the file name has special constructs in it, | |
| 2465 call the corresponding file handler. */ | |
| 2466 handler = Ffind_file_name_handler (abspath, Qfile_readable_p); | |
| 2467 if (!NILP (handler)) | |
| 2468 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath)); | |
| 2469 | |
| 2526 | 2470 #if defined (WIN32_FILENAMES) |
| 428 | 2471 /* Under MS-DOS and Windows, open does not work for directories. */ |
| 2472 UNGCPRO; | |
| 771 | 2473 if (qxe_access (XSTRING_DATA (abspath), 0) == 0) |
| 428 | 2474 return Qt; |
| 2475 else | |
| 2476 return Qnil; | |
| 657 | 2477 #else /* not WIN32_FILENAMES */ |
| 428 | 2478 { |
| 771 | 2479 int desc = qxe_interruptible_open (XSTRING_DATA (abspath), |
| 2480 O_RDONLY | OPEN_BINARY, 0); | |
| 428 | 2481 UNGCPRO; |
| 2482 if (desc < 0) | |
| 2483 return Qnil; | |
| 771 | 2484 retry_close (desc); |
| 428 | 2485 return Qt; |
| 2486 } | |
| 657 | 2487 #endif /* not WIN32_FILENAMES */ |
| 428 | 2488 } |
| 2489 | |
| 2490 /* Having this before file-symlink-p mysteriously caused it to be forgotten | |
| 2491 on the RT/PC. */ | |
| 2492 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /* | |
| 2493 Return t if file FILENAME can be written or created by you. | |
| 2494 */ | |
| 2495 (filename)) | |
| 2496 { | |
| 2497 /* This function can GC. GC checked 1997.04.10. */ | |
| 2498 Lisp_Object abspath, dir; | |
| 2499 Lisp_Object handler; | |
| 2500 struct stat statbuf; | |
| 2501 struct gcpro gcpro1; | |
| 2502 | |
| 2503 CHECK_STRING (filename); | |
| 2504 abspath = Fexpand_file_name (filename, Qnil); | |
| 2505 | |
| 2506 /* If the file name has special constructs in it, | |
| 2507 call the corresponding file handler. */ | |
| 2508 GCPRO1 (abspath); | |
| 2509 handler = Ffind_file_name_handler (abspath, Qfile_writable_p); | |
| 2510 UNGCPRO; | |
| 2511 if (!NILP (handler)) | |
| 2512 return call2 (handler, Qfile_writable_p, abspath); | |
| 2513 | |
| 771 | 2514 if (qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0) |
| 2515 return (check_writable (XSTRING_DATA (abspath)) | |
| 428 | 2516 ? Qt : Qnil); |
| 2517 | |
| 2518 | |
| 2519 GCPRO1 (abspath); | |
| 2520 dir = Ffile_name_directory (abspath); | |
| 2521 UNGCPRO; | |
| 867 | 2522 return (check_writable (!NILP (dir) ? XSTRING_DATA (dir) : (Ibyte *) "") |
| 428 | 2523 ? Qt : Qnil); |
| 2524 } | |
| 2525 | |
| 2526 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /* | |
| 2527 Return non-nil if file FILENAME is the name of a symbolic link. | |
| 2528 The value is the name of the file to which it is linked. | |
| 2529 Otherwise returns nil. | |
| 2530 */ | |
| 2531 (filename)) | |
| 2532 { | |
| 2533 /* This function can GC. GC checked 1997.04.10. */ | |
| 442 | 2534 /* XEmacs change: run handlers even if local machine doesn't have symlinks */ |
| 771 | 2535 #ifdef HAVE_READLINK |
| 867 | 2536 Ibyte *buf; |
| 428 | 2537 int bufsize; |
| 2538 int valsize; | |
| 2539 Lisp_Object val; | |
| 442 | 2540 #endif |
| 428 | 2541 Lisp_Object handler; |
| 2542 struct gcpro gcpro1; | |
| 2543 | |
| 2544 CHECK_STRING (filename); | |
| 2545 filename = Fexpand_file_name (filename, Qnil); | |
| 2546 | |
| 2547 /* If the file name has special constructs in it, | |
| 2548 call the corresponding file handler. */ | |
| 2549 GCPRO1 (filename); | |
| 2550 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); | |
| 2551 UNGCPRO; | |
| 2552 if (!NILP (handler)) | |
| 2553 return call2 (handler, Qfile_symlink_p, filename); | |
| 2554 | |
| 771 | 2555 #ifdef HAVE_READLINK |
| 428 | 2556 bufsize = 100; |
| 2557 while (1) | |
| 2558 { | |
| 867 | 2559 buf = xnew_array_and_zero (Ibyte, bufsize); |
| 771 | 2560 valsize = qxe_readlink (XSTRING_DATA (filename), |
| 2561 buf, bufsize); | |
| 428 | 2562 if (valsize < bufsize) break; |
| 2563 /* Buffer was not long enough */ | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2564 xfree (buf); |
| 428 | 2565 bufsize *= 2; |
| 2566 } | |
| 2567 if (valsize == -1) | |
| 2568 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2569 xfree (buf); |
| 428 | 2570 return Qnil; |
| 2571 } | |
| 771 | 2572 val = make_string (buf, valsize); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2573 xfree (buf); |
| 428 | 2574 return val; |
| 2526 | 2575 #elif defined (WIN32_NATIVE) |
| 2576 if (mswindows_shortcuts_are_symlinks) | |
| 2577 { | |
| 2578 /* We want to resolve the directory component and leave the rest | |
| 2579 alone. */ | |
| 2580 Ibyte *path = XSTRING_DATA (filename); | |
| 2581 Ibyte *dirend = | |
| 2582 find_end_of_directory_component (path, XSTRING_LENGTH (filename)); | |
| 2583 Ibyte *fname; | |
| 2584 DECLARE_EISTRING (dir); | |
| 2585 | |
| 2586 if (dirend != path) | |
| 2587 { | |
| 2588 Ibyte *resdir; | |
| 2589 DECLARE_EISTRING (resname); | |
| 2590 | |
| 2591 eicpy_raw (dir, path, dirend - path); | |
| 2592 PATHNAME_RESOLVE_LINKS (eidata (dir), resdir); | |
| 2593 eicpy_rawz (resname, resdir); | |
| 2594 eicat_rawz (resname, dirend); | |
| 2595 path = eidata (resname); | |
| 2596 } | |
| 2597 | |
| 2598 fname = mswindows_read_link (path); | |
| 2599 if (!fname) | |
| 2600 return Qnil; | |
| 2601 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2602 Lisp_Object val = build_istring (fname); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2603 xfree (fname); |
| 2526 | 2604 return val; |
| 2605 } | |
| 2606 } | |
| 428 | 2607 return Qnil; |
| 2526 | 2608 #else |
| 2609 return Qnil; | |
| 2610 #endif | |
| 428 | 2611 } |
| 2612 | |
| 2613 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /* | |
| 2614 Return t if file FILENAME is the name of a directory as a file. | |
| 2615 A directory name spec may be given instead; then the value is t | |
| 2616 if the directory so specified exists and really is a directory. | |
| 2617 */ | |
| 2618 (filename)) | |
| 2619 { | |
| 2620 /* This function can GC. GC checked 1997.04.10. */ | |
| 2621 Lisp_Object abspath; | |
| 2622 struct stat st; | |
| 2623 Lisp_Object handler; | |
| 2624 struct gcpro gcpro1; | |
| 2625 | |
| 2626 GCPRO1 (current_buffer->directory); | |
| 2627 abspath = expand_and_dir_to_file (filename, | |
| 2628 current_buffer->directory); | |
| 2629 UNGCPRO; | |
| 2630 | |
| 2631 /* If the file name has special constructs in it, | |
| 2632 call the corresponding file handler. */ | |
| 2633 GCPRO1 (abspath); | |
| 2634 handler = Ffind_file_name_handler (abspath, Qfile_directory_p); | |
| 2635 UNGCPRO; | |
| 2636 if (!NILP (handler)) | |
| 2637 return call2 (handler, Qfile_directory_p, abspath); | |
| 2638 | |
| 771 | 2639 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0) |
| 428 | 2640 return Qnil; |
| 2641 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; | |
| 2642 } | |
| 2643 | |
| 2644 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /* | |
| 2645 Return t if file FILENAME is the name of a directory as a file, | |
| 2646 and files in that directory can be opened by you. In order to use a | |
| 2647 directory as a buffer's current directory, this predicate must return true. | |
| 2648 A directory name spec may be given instead; then the value is t | |
| 2649 if the directory so specified exists and really is a readable and | |
| 2650 searchable directory. | |
| 2651 */ | |
| 2652 (filename)) | |
| 2653 { | |
| 2654 /* This function can GC. GC checked 1997.04.10. */ | |
| 2655 Lisp_Object handler; | |
| 2656 | |
| 2657 /* If the file name has special constructs in it, | |
| 2658 call the corresponding file handler. */ | |
| 2659 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); | |
| 2660 if (!NILP (handler)) | |
| 2661 return call2 (handler, Qfile_accessible_directory_p, | |
| 2662 filename); | |
| 2663 | |
| 2526 | 2664 #if !defined (WIN32_NATIVE) |
| 428 | 2665 if (NILP (Ffile_directory_p (filename))) |
| 2666 return (Qnil); | |
| 2667 else | |
| 2668 return Ffile_executable_p (filename); | |
| 2669 #else | |
| 2670 { | |
| 2671 int tem; | |
| 2672 struct gcpro gcpro1; | |
| 2673 /* It's an unlikely combination, but yes we really do need to gcpro: | |
| 2674 Suppose that file-accessible-directory-p has no handler, but | |
| 2675 file-directory-p does have a handler; this handler causes a GC which | |
| 2676 relocates the string in `filename'; and finally file-directory-p | |
| 2677 returns non-nil. Then we would end up passing a garbaged string | |
| 2678 to file-executable-p. */ | |
| 2679 GCPRO1 (filename); | |
| 2680 tem = (NILP (Ffile_directory_p (filename)) | |
| 2681 || NILP (Ffile_executable_p (filename))); | |
| 2682 UNGCPRO; | |
| 2683 return tem ? Qnil : Qt; | |
| 2684 } | |
| 442 | 2685 #endif /* !defined(WIN32_NATIVE) */ |
| 428 | 2686 } |
| 2687 | |
| 2688 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* | |
| 2689 Return t if file FILENAME is the name of a regular file. | |
| 2690 This is the sort of file that holds an ordinary stream of data bytes. | |
| 2691 */ | |
| 2692 (filename)) | |
| 2693 { | |
| 2694 /* This function can GC. GC checked 1997.04.10. */ | |
| 2695 Lisp_Object abspath; | |
| 2696 struct stat st; | |
| 2697 Lisp_Object handler; | |
| 2698 struct gcpro gcpro1; | |
| 2699 | |
| 2700 GCPRO1 (current_buffer->directory); | |
| 2701 abspath = expand_and_dir_to_file (filename, current_buffer->directory); | |
| 2702 UNGCPRO; | |
| 2703 | |
| 2704 /* If the file name has special constructs in it, | |
| 2705 call the corresponding file handler. */ | |
| 2706 GCPRO1 (abspath); | |
| 2707 handler = Ffind_file_name_handler (abspath, Qfile_regular_p); | |
| 2708 UNGCPRO; | |
| 2709 if (!NILP (handler)) | |
| 2710 return call2 (handler, Qfile_regular_p, abspath); | |
| 2711 | |
| 771 | 2712 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0) |
| 428 | 2713 return Qnil; |
| 2714 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; | |
| 2715 } | |
| 2716 | |
| 2717 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /* | |
| 444 | 2718 Return mode bits of file named FILENAME, as an integer. |
| 428 | 2719 */ |
| 2720 (filename)) | |
| 2721 { | |
| 2722 /* This function can GC. GC checked 1997.04.10. */ | |
| 2723 Lisp_Object abspath; | |
| 2724 struct stat st; | |
| 2725 Lisp_Object handler; | |
| 2726 struct gcpro gcpro1; | |
| 2727 | |
| 2728 GCPRO1 (current_buffer->directory); | |
| 2729 abspath = expand_and_dir_to_file (filename, | |
| 2730 current_buffer->directory); | |
| 2731 UNGCPRO; | |
| 2732 | |
| 2733 /* If the file name has special constructs in it, | |
| 2734 call the corresponding file handler. */ | |
| 2735 GCPRO1 (abspath); | |
| 2736 handler = Ffind_file_name_handler (abspath, Qfile_modes); | |
| 2737 UNGCPRO; | |
| 2738 if (!NILP (handler)) | |
| 2739 return call2 (handler, Qfile_modes, abspath); | |
| 2740 | |
| 771 | 2741 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0) |
| 428 | 2742 return Qnil; |
| 2743 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */ | |
| 2744 #if 0 | |
| 442 | 2745 #ifdef WIN32_NATIVE |
| 771 | 2746 if (check_executable (abspath)) |
| 428 | 2747 st.st_mode |= S_IEXEC; |
| 442 | 2748 #endif /* WIN32_NATIVE */ |
| 428 | 2749 #endif /* 0 */ |
| 2750 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2751 return make_fixnum (st.st_mode & 07777); |
| 428 | 2752 } |
| 2753 | |
| 2754 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /* | |
| 444 | 2755 Set mode bits of file named FILENAME to MODE (an integer). |
| 428 | 2756 Only the 12 low bits of MODE are used. |
| 2757 */ | |
| 2758 (filename, mode)) | |
| 2759 { | |
| 2760 /* This function can GC. GC checked 1997.04.10. */ | |
| 2761 Lisp_Object abspath; | |
| 2762 Lisp_Object handler; | |
| 2763 struct gcpro gcpro1; | |
| 2764 | |
| 2765 GCPRO1 (current_buffer->directory); | |
| 2766 abspath = Fexpand_file_name (filename, current_buffer->directory); | |
| 2767 UNGCPRO; | |
| 2768 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2769 CHECK_FIXNUM (mode); |
| 428 | 2770 |
| 2771 /* If the file name has special constructs in it, | |
| 2772 call the corresponding file handler. */ | |
| 2773 GCPRO1 (abspath); | |
| 2774 handler = Ffind_file_name_handler (abspath, Qset_file_modes); | |
| 2775 UNGCPRO; | |
| 2776 if (!NILP (handler)) | |
| 2777 return call3 (handler, Qset_file_modes, abspath, mode); | |
| 2778 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2779 if (qxe_chmod (XSTRING_DATA (abspath), XFIXNUM (mode)) < 0) |
| 563 | 2780 report_file_error ("Doing chmod", abspath); |
| 428 | 2781 |
| 2782 return Qnil; | |
| 2783 } | |
| 2784 | |
| 2785 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /* | |
| 2786 Set the file permission bits for newly created files. | |
| 444 | 2787 The argument MODE should be an integer; if a bit in MODE is 1, |
| 2788 subsequently created files will not have the permission corresponding | |
| 2789 to that bit enabled. Only the low 9 bits are used. | |
| 428 | 2790 This setting is inherited by subprocesses. |
| 2791 */ | |
| 2792 (mode)) | |
| 2793 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2794 CHECK_FIXNUM (mode); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2795 |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2796 umask ((~ XFIXNUM (mode)) & 0777); |
| 428 | 2797 |
| 2798 return Qnil; | |
| 2799 } | |
| 2800 | |
| 2801 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /* | |
| 2802 Return the default file protection for created files. | |
| 2803 The umask value determines which permissions are enabled in newly | |
| 2804 created files. If a permission's bit in the umask is 1, subsequently | |
| 2805 created files will not have that permission enabled. | |
| 2806 */ | |
| 2807 ()) | |
| 2808 { | |
| 2809 int mode; | |
| 2810 | |
| 2811 mode = umask (0); | |
| 2812 umask (mode); | |
| 2813 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2814 return make_fixnum ((~ mode) & 0777); |
| 428 | 2815 } |
| 2816 | |
| 2817 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* | |
| 2818 Tell Unix to finish all pending disk updates. | |
| 2819 */ | |
| 2820 ()) | |
| 2821 { | |
| 442 | 2822 #ifndef WIN32_NATIVE |
| 428 | 2823 sync (); |
| 2824 #endif | |
| 2825 return Qnil; | |
| 2826 } | |
| 2827 | |
| 2828 | |
| 2829 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /* | |
| 2830 Return t if file FILE1 is newer than file FILE2. | |
| 2831 If FILE1 does not exist, the answer is nil; | |
| 2832 otherwise, if FILE2 does not exist, the answer is t. | |
| 2833 */ | |
| 2834 (file1, file2)) | |
| 2835 { | |
| 2836 /* This function can GC. GC checked 1997.04.10. */ | |
| 2837 Lisp_Object abspath1, abspath2; | |
| 2838 struct stat st; | |
| 2839 int mtime1; | |
| 2840 Lisp_Object handler; | |
| 2841 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2842 | |
| 2843 CHECK_STRING (file1); | |
| 2844 CHECK_STRING (file2); | |
| 2845 | |
| 2846 abspath1 = Qnil; | |
| 2847 abspath2 = Qnil; | |
| 2848 | |
| 2849 GCPRO3 (abspath1, abspath2, current_buffer->directory); | |
| 2850 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); | |
| 2851 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); | |
| 2852 | |
| 2853 /* If the file name has special constructs in it, | |
| 2854 call the corresponding file handler. */ | |
| 2855 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); | |
| 2856 if (NILP (handler)) | |
| 2857 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); | |
| 2858 UNGCPRO; | |
| 2859 if (!NILP (handler)) | |
| 2860 return call3 (handler, Qfile_newer_than_file_p, abspath1, | |
| 2861 abspath2); | |
| 2862 | |
| 771 | 2863 if (qxe_stat (XSTRING_DATA (abspath1), &st) < 0) |
| 428 | 2864 return Qnil; |
| 2865 | |
| 2866 mtime1 = st.st_mtime; | |
| 2867 | |
| 771 | 2868 if (qxe_stat (XSTRING_DATA (abspath2), &st) < 0) |
| 428 | 2869 return Qt; |
| 2870 | |
| 2871 return (mtime1 > st.st_mtime) ? Qt : Qnil; | |
| 2872 } | |
| 2873 | |
| 2874 | |
| 2875 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal, | |
| 2876 1, 7, 0, /* | |
| 2877 Insert contents of file FILENAME after point; no coding-system frobbing. | |
| 2878 This function is identical to `insert-file-contents' except for the | |
| 771 | 2879 handling of the CODESYS and USED-CODESYS arguments. |
| 2880 | |
| 2881 The file is decoded according to CODESYS; if omitted, no conversion | |
| 2882 happens. If USED-CODESYS is non-nil, it should be a symbol, and the actual | |
| 2883 coding system that was used for the decoding is stored into it. It will in | |
| 2884 general be different from CODESYS if CODESYS specifies automatic encoding | |
| 2885 detection or end-of-line detection. | |
| 428 | 2886 |
| 444 | 2887 Currently START and END refer to byte positions (as opposed to character |
| 771 | 2888 positions), even in Mule and under MS Windows. (Fixing this, particularly |
| 2889 under Mule, is very difficult.) | |
| 428 | 2890 */ |
| 444 | 2891 (filename, visit, start, end, replace, codesys, used_codesys)) |
| 428 | 2892 { |
| 2893 /* This function can call lisp */ | |
| 2894 struct stat st; | |
| 2895 int fd; | |
| 2896 int saverrno = 0; | |
| 2897 Charcount inserted = 0; | |
| 2898 int speccount; | |
| 3841 | 2899 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
| 3814 | 2900 Lisp_Object val; |
| 428 | 2901 int total; |
|
5781
0853e1ec8529
Use alloca_{rawbytes,ibytes} in #'copy-file, #'insert-file-contents-internal
Aidan Kehoe <kehoea@parhasard.net>
parents:
5779
diff
changeset
|
2902 Ibyte *read_buf = alloca_ibytes (READ_BUF_SIZE); |
| 428 | 2903 int mc_count; |
| 2904 struct buffer *buf = current_buffer; | |
| 2905 Lisp_Object curbuf; | |
| 2906 int not_regular = 0; | |
| 771 | 2907 int do_speedy_insert = |
| 2908 coding_system_is_binary (Fget_coding_system (codesys)); | |
| 428 | 2909 |
| 2910 if (buf->base_buffer && ! NILP (visit)) | |
| 563 | 2911 invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound); |
| 428 | 2912 |
| 2913 /* No need to call Fbarf_if_buffer_read_only() here. | |
| 2914 That's called in begin_multiple_change() or wherever. */ | |
| 2915 | |
| 2916 val = Qnil; | |
| 2917 | |
| 2918 /* #### dmoore - should probably check in various places to see if | |
| 2919 curbuf was killed and if so signal an error? */ | |
| 2920 | |
| 793 | 2921 curbuf = wrap_buffer (buf); |
| 428 | 2922 |
| 3814 | 2923 GCPRO4 (filename, val, visit, curbuf); |
| 428 | 2924 |
| 2925 mc_count = (NILP (replace)) ? | |
| 2926 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) : | |
| 2927 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf)); | |
| 2928 | |
| 2929 speccount = specpdl_depth (); /* begin_multiple_change also adds | |
| 2930 an unwind_protect */ | |
| 2931 | |
| 2932 filename = Fexpand_file_name (filename, Qnil); | |
| 2933 | |
| 2934 if (!NILP (used_codesys)) | |
| 2935 CHECK_SYMBOL (used_codesys); | |
| 2936 | |
| 444 | 2937 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) ) |
| 563 | 2938 invalid_operation ("Attempt to visit less than an entire file", Qunbound); |
| 428 | 2939 |
| 2940 fd = -1; | |
| 2941 | |
| 771 | 2942 if (qxe_stat (XSTRING_DATA (filename), &st) < 0) |
| 428 | 2943 { |
| 2944 badopen: | |
| 2945 if (NILP (visit)) | |
| 563 | 2946 report_file_error ("Opening input file", filename); |
| 428 | 2947 st.st_mtime = -1; |
| 2948 goto notfound; | |
| 2949 } | |
| 2950 | |
| 2951 #ifdef S_IFREG | |
| 2952 /* Signal an error if we are accessing a non-regular file, with | |
| 444 | 2953 REPLACE, START or END being non-nil. */ |
| 428 | 2954 if (!S_ISREG (st.st_mode)) |
| 2955 { | |
| 2956 not_regular = 1; | |
| 2957 | |
| 2958 if (!NILP (visit)) | |
| 2959 goto notfound; | |
| 2960 | |
| 444 | 2961 if (!NILP (replace) || !NILP (start) || !NILP (end)) |
| 428 | 2962 { |
| 2963 end_multiple_change (buf, mc_count); | |
| 2964 | |
| 444 | 2965 RETURN_UNGCPRO |
| 2966 (Fsignal (Qfile_error, | |
| 5198 | 2967 list2 (build_msg_string ("not a regular file"), |
| 444 | 2968 filename))); |
| 428 | 2969 } |
| 2970 } | |
| 2971 #endif /* S_IFREG */ | |
| 2972 | |
| 444 | 2973 if (!NILP (start)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2974 CHECK_FIXNUM (start); |
| 428 | 2975 else |
| 444 | 2976 start = Qzero; |
| 428 | 2977 |
| 2978 if (!NILP (end)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2979 CHECK_FIXNUM (end); |
| 428 | 2980 |
| 2981 if (fd < 0) | |
| 2982 { | |
| 771 | 2983 if ((fd = qxe_interruptible_open (XSTRING_DATA (filename), |
| 2984 O_RDONLY | OPEN_BINARY, 0)) < 0) | |
| 428 | 2985 goto badopen; |
| 2986 } | |
| 2987 | |
| 2988 /* Replacement should preserve point as it preserves markers. */ | |
| 2989 if (!NILP (replace)) | |
| 2990 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil)); | |
| 2991 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
2992 record_unwind_protect (close_file_unwind, make_fixnum (fd)); |
| 428 | 2993 |
| 2994 /* Supposedly happens on VMS. */ | |
| 2995 if (st.st_size < 0) | |
| 563 | 2996 signal_error (Qfile_error, "File size is negative", Qunbound); |
| 428 | 2997 |
| 2998 if (NILP (end)) | |
| 2999 { | |
| 3000 if (!not_regular) | |
| 3001 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3002 end = make_fixnum (st.st_size); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3003 if (XFIXNUM (end) != st.st_size) |
| 563 | 3004 out_of_memory ("Maximum buffer size exceeded", Qunbound); |
| 428 | 3005 } |
| 3006 } | |
| 3007 | |
| 3008 /* If requested, replace the accessible part of the buffer | |
| 3009 with the file contents. Avoid replacing text at the | |
| 3010 beginning or end of the buffer that matches the file contents; | |
| 771 | 3011 that preserves markers pointing to the unchanged parts. */ |
| 3012 /* The replace-mode code is currently implemented by comparing the | |
| 3013 file on disk with the contents in the buffer, character by character. | |
| 3014 That works only if the characters on disk are exactly what will go into | |
| 3015 the buffer -- i.e. `binary' conversion. | |
| 3016 | |
| 3017 FSF tries to implement this in all situations, even the non-binary | |
| 3018 conversion, by (in that case) loading the whole converted file into a | |
| 3019 separate memory area, then doing the comparison. I really don't see | |
| 3020 the point of this, and it will fail spectacularly if the file is many | |
| 3021 megabytes in size. To try to get around this, we could certainly read | |
| 3022 from the beginning and decode as necessary before comparing, but doing | |
| 3023 the same at the end gets very difficult because of the possibility of | |
| 3024 modal coding systems -- trying to decode data from any point forward | |
| 3025 without decoding previous data might always give you different results | |
| 3026 from starting at the beginning. We could try further tricks like | |
| 3027 keeping track of which coding systems are non-modal and providing some | |
| 3028 extra method for such coding systems to be given a chunk of data that | |
| 3029 came from a specified location in a specified file and ask the coding | |
| 3030 systems to return a "sync point" from which the data can be read | |
| 3031 forward and have results guaranteed to be the same as reading from the | |
| 3032 beginning to that point, but I really don't think it's worth it. If | |
| 3033 we implemented the FSF "brute-force" method, we would have to put a | |
| 3034 reasonable maximum file size on the files. Is any of this worth it? | |
| 3035 --ben | |
| 3036 | |
| 3638 | 3037 |
| 3038 It's probably not worth it, and despite what you might take from the | |
| 3039 above, we don't do it currently; that is, for non-"binary" coding | |
| 3040 systems, we don't try to implement replace-mode at all. See the | |
| 3041 do_speedy_insert variable above. The upside of this is that our API | |
| 3042 is consistent and not buggy. -- Aidan Kehoe, Fri Oct 27 21:02:30 CEST | |
| 3043 2006 | |
| 771 | 3044 */ |
| 3045 | |
| 428 | 3046 if (!NILP (replace)) |
| 3047 { | |
| 771 | 3048 if (!do_speedy_insert) |
| 3049 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf), | |
| 3050 !NILP (visit) ? INSDEL_NO_LOCKING : 0); | |
| 3051 else | |
| 428 | 3052 { |
|
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
3053 Rawbyte buffer[1 << 14]; |
| 771 | 3054 Charbpos same_at_start = BUF_BEGV (buf); |
| 3055 Charbpos same_at_end = BUF_ZV (buf); | |
| 3056 int overlap; | |
| 3057 | |
| 3058 /* Count how many chars at the start of the file | |
| 3059 match the text at the beginning of the buffer. */ | |
| 3060 while (1) | |
| 3061 { | |
| 3062 int nread; | |
| 3063 Charbpos charbpos; | |
| 3064 nread = read_allowing_quit (fd, buffer, sizeof (buffer)); | |
| 3065 if (nread < 0) | |
| 3066 report_file_error ("Reading", filename); | |
| 3067 else if (nread == 0) | |
| 3068 break; | |
| 3069 charbpos = 0; | |
| 3070 while (charbpos < nread && same_at_start < BUF_ZV (buf) | |
| 814 | 3071 && BUF_FETCH_CHAR (buf, same_at_start) == |
| 3072 buffer[charbpos]) | |
| 771 | 3073 same_at_start++, charbpos++; |
| 3074 /* If we found a discrepancy, stop the scan. | |
| 3075 Otherwise loop around and scan the next bufferful. */ | |
| 3076 if (charbpos != nread) | |
| 3077 break; | |
| 3078 } | |
| 3079 /* If the file matches the buffer completely, | |
| 3080 there's no need to replace anything. */ | |
| 3081 if (same_at_start - BUF_BEGV (buf) == st.st_size) | |
| 3082 { | |
| 3083 retry_close (fd); | |
| 3084 unbind_to (speccount); | |
| 3085 /* Truncate the buffer to the size of the file. */ | |
| 3086 buffer_delete_range (buf, same_at_start, same_at_end, | |
| 3087 !NILP (visit) ? INSDEL_NO_LOCKING : 0); | |
| 3088 goto handled; | |
| 3089 } | |
| 3090 /* Count how many chars at the end of the file | |
| 3091 match the text at the end of the buffer. */ | |
| 3092 while (1) | |
| 3093 { | |
| 3094 int total_read, nread; | |
| 814 | 3095 Charcount charbpos, curpos, trial; |
| 771 | 3096 |
| 3097 /* At what file position are we now scanning? */ | |
| 3098 curpos = st.st_size - (BUF_ZV (buf) - same_at_end); | |
| 3099 /* If the entire file matches the buffer tail, stop the scan. */ | |
| 3100 if (curpos == 0) | |
| 3101 break; | |
| 3102 /* How much can we scan in the next step? */ | |
| 3103 trial = min (curpos, (Charbpos) sizeof (buffer)); | |
| 3104 if (lseek (fd, curpos - trial, 0) < 0) | |
| 3105 report_file_error ("Setting file position", filename); | |
| 3106 | |
| 3107 total_read = 0; | |
| 3108 while (total_read < trial) | |
| 3109 { | |
| 3110 nread = read_allowing_quit (fd, buffer + total_read, | |
| 3111 trial - total_read); | |
| 3112 if (nread <= 0) | |
| 3113 report_file_error ("IO error reading file", filename); | |
| 3114 total_read += nread; | |
| 3115 } | |
| 3116 /* Scan this bufferful from the end, comparing with | |
| 3117 the Emacs buffer. */ | |
| 3118 charbpos = total_read; | |
| 3119 /* Compare with same_at_start to avoid counting some buffer text | |
| 3120 as matching both at the file's beginning and at the end. */ | |
| 3121 while (charbpos > 0 && same_at_end > same_at_start | |
| 3122 && BUF_FETCH_CHAR (buf, same_at_end - 1) == | |
| 3123 buffer[charbpos - 1]) | |
| 3124 same_at_end--, charbpos--; | |
| 3125 /* If we found a discrepancy, stop the scan. | |
| 3126 Otherwise loop around and scan the preceding bufferful. */ | |
| 3127 if (charbpos != 0) | |
| 3128 break; | |
| 3129 /* If display current starts at beginning of line, | |
| 3130 keep it that way. */ | |
| 3131 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf) | |
| 3132 XWINDOW (Fselected_window (Qnil))->start_at_line_beg = | |
| 3133 !NILP (Fbolp (wrap_buffer (buf))); | |
| 3134 } | |
| 3135 | |
| 3136 /* Don't try to reuse the same piece of text twice. */ | |
| 3137 overlap = same_at_start - BUF_BEGV (buf) - | |
| 3138 (same_at_end + st.st_size - BUF_ZV (buf)); | |
| 3139 if (overlap > 0) | |
| 3140 same_at_end += overlap; | |
| 3141 | |
| 3142 /* Arrange to read only the nonmatching middle part of the file. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3143 start = make_fixnum (same_at_start - BUF_BEGV (buf)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3144 end = make_fixnum (st.st_size - (BUF_ZV (buf) - same_at_end)); |
| 771 | 3145 |
| 428 | 3146 buffer_delete_range (buf, same_at_start, same_at_end, |
| 3147 !NILP (visit) ? INSDEL_NO_LOCKING : 0); | |
| 771 | 3148 /* Insert from the file at the proper position. */ |
| 3149 BUF_SET_PT (buf, same_at_start); | |
| 428 | 3150 } |
| 3151 } | |
| 3152 | |
| 3153 if (!not_regular) | |
| 3154 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3155 total = XFIXNUM (end) - XFIXNUM (start); |
| 428 | 3156 |
| 3157 /* Make sure point-max won't overflow after this insertion. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3158 if (total != XFIXNUM (make_fixnum (total))) |
| 563 | 3159 out_of_memory ("Maximum buffer size exceeded", Qunbound); |
| 428 | 3160 } |
| 3161 else | |
| 3162 /* For a special file, all we can do is guess. The value of -1 | |
| 3163 will make the stream functions read as much as possible. */ | |
| 3164 total = -1; | |
| 3165 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3166 if (XFIXNUM (start) != 0 |
| 428 | 3167 /* why was this here? asked jwz. The reason is that the replace-mode |
| 3168 connivings above will normally put the file pointer other than | |
| 3169 where it should be. */ | |
| 771 | 3170 || (!NILP (replace) && do_speedy_insert)) |
| 428 | 3171 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3172 if (lseek (fd, XFIXNUM (start), 0) < 0) |
| 563 | 3173 report_file_error ("Setting file position", filename); |
| 428 | 3174 } |
| 3175 | |
| 3176 { | |
| 665 | 3177 Charbpos cur_point = BUF_PT (buf); |
| 428 | 3178 struct gcpro ngcpro1; |
| 3179 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total, | |
| 3180 LSTR_ALLOW_QUIT); | |
|
5776
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3181 Charcount last_tell = -1; |
| 428 | 3182 |
| 3183 NGCPRO1 (stream); | |
| 3184 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536); | |
| 771 | 3185 stream = make_coding_input_stream |
| 3186 (XLSTREAM (stream), get_coding_system_for_text_file (codesys, 1), | |
| 800 | 3187 CODING_DECODE, 0); |
| 428 | 3188 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536); |
|
5776
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3189 last_tell = Lstream_character_tell (XLSTREAM (stream)); |
| 428 | 3190 |
| 3191 record_unwind_protect (delete_stream_unwind, stream); | |
| 3192 | |
| 3193 /* No need to limit the amount of stuff we attempt to read. (It would | |
| 3194 be incorrect, anyway, when Mule is enabled.) Instead, the limiting | |
| 3195 occurs inside of the filedesc stream. */ | |
| 3196 while (1) | |
| 3197 { | |
| 665 | 3198 Bytecount this_len; |
|
5776
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3199 Charcount cc_inserted, this_tell = last_tell; |
| 428 | 3200 |
| 3201 QUIT; | |
|
5781
0853e1ec8529
Use alloca_{rawbytes,ibytes} in #'copy-file, #'insert-file-contents-internal
Aidan Kehoe <kehoea@parhasard.net>
parents:
5779
diff
changeset
|
3202 this_len = Lstream_read (XLSTREAM (stream), read_buf, READ_BUF_SIZE); |
| 428 | 3203 |
| 3204 if (this_len <= 0) | |
| 3205 { | |
| 3206 if (this_len < 0) | |
| 3207 saverrno = errno; | |
| 3208 break; | |
| 3209 } | |
| 3210 | |
|
5776
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3211 cc_inserted |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3212 = buffer_insert_string_1 (buf, cur_point, read_buf, Qnil, |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3213 0, this_len, last_tell >= 0 |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3214 ? (this_tell |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3215 = Lstream_character_tell (XLSTREAM |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3216 (stream))) |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3217 - last_tell : -1, |
|
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3218 !NILP (visit) ? INSDEL_NO_LOCKING : 0); |
| 428 | 3219 inserted += cc_inserted; |
| 3220 cur_point += cc_inserted; | |
|
5776
65d65b52d608
Pass character count from coding systems to buffer insertion code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
3221 last_tell = this_tell; |
| 428 | 3222 } |
| 3223 if (!NILP (used_codesys)) | |
| 3224 { | |
| 3225 Fset (used_codesys, | |
| 771 | 3226 XCODING_SYSTEM_NAME |
| 3227 (coding_stream_detected_coding_system (XLSTREAM (stream)))); | |
| 428 | 3228 } |
| 3229 NUNGCPRO; | |
| 3230 } | |
| 3231 | |
| 3232 /* Close the file/stream */ | |
| 771 | 3233 unbind_to (speccount); |
| 428 | 3234 |
| 3235 if (saverrno != 0) | |
| 3236 { | |
| 563 | 3237 errno = saverrno; |
| 3238 report_file_error ("Reading", filename); | |
| 428 | 3239 } |
| 3240 | |
| 3241 notfound: | |
| 3242 handled: | |
| 3243 | |
| 3244 end_multiple_change (buf, mc_count); | |
| 3245 | |
| 3246 if (!NILP (visit)) | |
| 3247 { | |
| 3248 if (!EQ (buf->undo_list, Qt)) | |
| 3249 buf->undo_list = Qnil; | |
| 3814 | 3250 buf->modtime = st.st_mtime; |
| 3251 buf->filename = filename; | |
| 3252 /* XEmacs addition: */ | |
| 3253 /* This function used to be in C, ostensibly so that | |
| 3254 it could be called here. But that's just silly. | |
| 3255 There's no reason C code can't call out to Lisp | |
| 3256 code, and it's a lot cleaner this way. */ | |
| 3257 /* Note: compute-buffer-file-truename is called for | |
| 3258 side-effect! Its return value is intentionally | |
| 3259 ignored. */ | |
| 3260 if (!NILP (Ffboundp (Qcompute_buffer_file_truename))) | |
| 3261 call1 (Qcompute_buffer_file_truename, wrap_buffer (buf)); | |
| 428 | 3262 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf); |
| 3263 buf->auto_save_modified = BUF_MODIFF (buf); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3264 buf->saved_size = make_fixnum (BUF_SIZE (buf)); |
| 428 | 3265 #ifdef CLASH_DETECTION |
| 3814 | 3266 if (!NILP (buf->file_truename)) |
| 3267 unlock_file (buf->file_truename); | |
| 3268 unlock_file (filename); | |
| 428 | 3269 #endif /* CLASH_DETECTION */ |
| 3270 if (not_regular) | |
| 3271 RETURN_UNGCPRO (Fsignal (Qfile_error, | |
| 771 | 3272 list2 (build_msg_string ("not a regular file"), |
| 428 | 3273 filename))); |
| 3274 | |
| 3275 /* If visiting nonexistent file, return nil. */ | |
| 3276 if (buf->modtime == -1) | |
| 3277 report_file_error ("Opening input file", | |
| 563 | 3278 filename); |
| 428 | 3279 } |
| 3280 | |
| 3281 /* Decode file format */ | |
|
5004
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3282 if (inserted > 0 && !UNBOUNDP (XSYMBOL_FUNCTION (Qformat_decode))) |
| 428 | 3283 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3284 Lisp_Object insval = call3 (Qformat_decode, Qnil, make_fixnum (inserted), |
|
5004
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3285 visit); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3286 CHECK_FIXNUM (insval); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3287 inserted = XFIXNUM (insval); |
| 428 | 3288 } |
| 3289 | |
| 3290 if (inserted > 0) | |
| 3291 { | |
| 2367 | 3292 GC_EXTERNAL_LIST_LOOP_2 (p, Vafter_insert_file_functions) |
| 428 | 3293 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3294 Lisp_Object insval = call1 (p, make_fixnum (inserted)); |
| 428 | 3295 if (!NILP (insval)) |
| 3296 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3297 check_integer_range (insval, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3298 inserted = XFIXNUM (insval); |
| 428 | 3299 } |
| 3300 } | |
| 2367 | 3301 END_GC_EXTERNAL_LIST_LOOP (p); |
| 428 | 3302 } |
| 3303 | |
| 3304 UNGCPRO; | |
| 3305 | |
| 3306 if (!NILP (val)) | |
| 3307 return (val); | |
| 3308 else | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3309 return (list2 (filename, make_fixnum (inserted))); |
| 428 | 3310 } |
| 3311 | |
| 3312 | |
| 3313 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos, | |
| 3314 Lisp_Object *annot); | |
| 3315 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end); | |
| 3316 | |
| 3317 /* If build_annotations switched buffers, switch back to BUF. | |
| 3318 Kill the temporary buffer that was selected in the meantime. */ | |
| 3319 | |
| 3320 static Lisp_Object | |
| 3321 build_annotations_unwind (Lisp_Object buf) | |
| 3322 { | |
| 3323 Lisp_Object tembuf; | |
| 3324 | |
| 3325 if (XBUFFER (buf) == current_buffer) | |
| 3326 return Qnil; | |
| 3327 tembuf = Fcurrent_buffer (); | |
| 3328 Fset_buffer (buf); | |
| 3329 Fkill_buffer (tembuf); | |
| 3330 return Qnil; | |
| 3331 } | |
| 3332 | |
| 4266 | 3333 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 8, |
| 428 | 3334 "r\nFWrite region to file: ", /* |
| 3335 Write current region into specified file; no coding-system frobbing. | |
| 4266 | 3336 |
| 3337 This function is almost identical to `write-region'; see that function for | |
| 3338 documentation of the START, END, FILENAME, APPEND, VISIT, and LOCKNAME | |
| 3339 arguments. CODESYS specifies the encoding to be used for the file; if it is | |
| 3340 nil, no code conversion occurs. (With `write-region' the coding system is | |
| 3341 determined automatically if not specified.) | |
| 3342 | |
| 3343 MUSTBENEW specifies that a check for an existing file of the same name | |
| 3344 should be made. If it is 'excl, XEmacs will error on detecting such a file | |
| 3345 and never write it. If it is some other non-nil value, the user will be | |
| 3346 prompted to confirm the overwriting of an existing file. If it is nil, | |
| 3347 existing files are silently overwritten when file system permissions allow | |
| 3348 this. | |
| 764 | 3349 |
| 3350 As a special kludge to support auto-saving, when START is nil START and | |
| 3351 END are set to the beginning and end, respectively, of the buffer, | |
| 3352 regardless of any restrictions. Don't use this feature. It is documented | |
| 3353 here because write-region handler writers need to be aware of it. | |
| 4266 | 3354 |
| 428 | 3355 */ |
| 4266 | 3356 (start, end, filename, append, visit, lockname, codesys, |
| 3357 mustbenew)) | |
| 428 | 3358 { |
| 442 | 3359 /* This function can call lisp. GC checked 2000-07-28 ben */ |
| 428 | 3360 int desc; |
| 3361 int failure; | |
| 3362 int save_errno = 0; | |
| 3363 struct stat st; | |
| 442 | 3364 Lisp_Object fn = Qnil; |
| 428 | 3365 int speccount = specpdl_depth (); |
| 3366 int visiting_other = STRINGP (visit); | |
| 3367 int visiting = (EQ (visit, Qt) || visiting_other); | |
| 3368 int quietly = (!visiting && !NILP (visit)); | |
| 3369 Lisp_Object visit_file = Qnil; | |
| 3370 Lisp_Object annotations = Qnil; | |
| 3371 struct buffer *given_buffer; | |
| 665 | 3372 Charbpos start1, end1; |
| 442 | 3373 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 3374 struct gcpro ngcpro1, ngcpro2; | |
| 793 | 3375 Lisp_Object curbuf = wrap_buffer (current_buffer); |
| 3376 | |
| 442 | 3377 |
| 3378 /* start, end, visit, and append are never modified in this fun | |
| 3379 so we don't protect them. */ | |
| 3380 GCPRO5 (visit_file, filename, codesys, lockname, annotations); | |
| 3381 NGCPRO2 (curbuf, fn); | |
| 3382 | |
| 3383 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer, | |
| 428 | 3384 we should signal an error rather than blissfully continuing |
| 3385 along. ARGH, this function is going to lose lose lose. We need | |
| 3386 to protect the current_buffer from being destroyed, but the | |
| 442 | 3387 multiple return points make this a pain in the butt. ]] we do |
| 3388 protect curbuf now. --ben */ | |
| 428 | 3389 |
| 771 | 3390 codesys = get_coding_system_for_text_file (codesys, 0); |
| 428 | 3391 |
| 3392 if (current_buffer->base_buffer && ! NILP (visit)) | |
| 442 | 3393 invalid_operation ("Cannot do file visiting in an indirect buffer", |
| 3394 curbuf); | |
| 428 | 3395 |
| 3396 if (!NILP (start) && !STRINGP (start)) | |
| 3397 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0); | |
| 3398 | |
| 3399 { | |
| 3400 Lisp_Object handler; | |
| 3401 | |
| 4266 | 3402 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl)) |
| 3403 barf_or_query_if_file_exists (filename, "overwrite", 1, NULL); | |
| 3404 | |
| 428 | 3405 if (visiting_other) |
| 3406 visit_file = Fexpand_file_name (visit, Qnil); | |
| 3407 else | |
| 3408 visit_file = filename; | |
| 3409 filename = Fexpand_file_name (filename, Qnil); | |
| 3410 | |
| 3411 if (NILP (lockname)) | |
| 3412 lockname = visit_file; | |
| 3413 | |
| 442 | 3414 /* We used to UNGCPRO here. BAD! visit_file is used below after |
| 3415 more Lisp calling. */ | |
| 428 | 3416 /* If the file name has special constructs in it, |
| 3417 call the corresponding file handler. */ | |
| 3418 handler = Ffind_file_name_handler (filename, Qwrite_region); | |
| 3419 /* If FILENAME has no handler, see if VISIT has one. */ | |
| 3420 if (NILP (handler) && STRINGP (visit)) | |
| 3421 handler = Ffind_file_name_handler (visit, Qwrite_region); | |
| 3422 | |
| 3423 if (!NILP (handler)) | |
| 3424 { | |
| 3425 Lisp_Object val = call8 (handler, Qwrite_region, start, end, | |
| 3426 filename, append, visit, lockname, codesys); | |
| 3427 if (visiting) | |
| 3428 { | |
| 3429 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3430 current_buffer->saved_size = make_fixnum (BUF_SIZE (current_buffer)); |
| 428 | 3431 current_buffer->filename = visit_file; |
| 3432 MARK_MODELINE_CHANGED; | |
| 3433 } | |
| 442 | 3434 NUNGCPRO; |
| 3435 UNGCPRO; | |
| 428 | 3436 return val; |
| 3437 } | |
| 3438 } | |
| 3439 | |
| 3440 #ifdef CLASH_DETECTION | |
| 3441 if (!auto_saving) | |
| 442 | 3442 lock_file (lockname); |
| 428 | 3443 #endif /* CLASH_DETECTION */ |
| 3444 | |
| 3445 /* Special kludge to simplify auto-saving. */ | |
| 3446 if (NILP (start)) | |
| 3447 { | |
| 3448 start1 = BUF_BEG (current_buffer); | |
| 3449 end1 = BUF_Z (current_buffer); | |
| 3450 } | |
| 3451 | |
| 3452 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); | |
| 3453 | |
| 3454 given_buffer = current_buffer; | |
| 3455 annotations = build_annotations (start, end); | |
| 3456 if (current_buffer != given_buffer) | |
| 3457 { | |
| 3458 start1 = BUF_BEGV (current_buffer); | |
| 3459 end1 = BUF_ZV (current_buffer); | |
| 3460 } | |
| 3461 | |
| 3462 fn = filename; | |
| 3463 desc = -1; | |
| 3464 if (!NILP (append)) | |
| 3465 { | |
| 4266 | 3466 desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY |
| 3467 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), 0); | |
| 428 | 3468 } |
| 3469 if (desc < 0) | |
| 3470 { | |
| 771 | 3471 desc = qxe_open (XSTRING_DATA (fn), |
| 4266 | 3472 O_WRONLY | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC) |
| 3473 | O_CREAT | OPEN_BINARY, | |
| 771 | 3474 auto_saving ? auto_save_mode_bits : CREAT_MODE); |
| 428 | 3475 } |
| 3476 | |
| 3477 if (desc < 0) | |
| 3478 { | |
| 3479 #ifdef CLASH_DETECTION | |
| 3480 save_errno = errno; | |
| 3481 if (!auto_saving) unlock_file (lockname); | |
| 3482 errno = save_errno; | |
| 3483 #endif /* CLASH_DETECTION */ | |
| 563 | 3484 report_file_error ("Opening output file", filename); |
| 428 | 3485 } |
| 3486 | |
| 3487 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3488 Lisp_Object desc_locative = Fcons (make_fixnum (desc), Qnil); |
| 428 | 3489 Lisp_Object instream = Qnil, outstream = Qnil; |
| 442 | 3490 struct gcpro nngcpro1, nngcpro2; |
| 3491 NNGCPRO2 (instream, outstream); | |
| 428 | 3492 |
| 3493 record_unwind_protect (close_file_unwind, desc_locative); | |
| 3494 | |
| 3495 if (!NILP (append)) | |
| 3496 { | |
| 3497 if (lseek (desc, 0, 2) < 0) | |
| 3498 { | |
| 3499 #ifdef CLASH_DETECTION | |
| 3500 if (!auto_saving) unlock_file (lockname); | |
| 3501 #endif /* CLASH_DETECTION */ | |
| 3502 report_file_error ("Lseek error", | |
| 563 | 3503 filename); |
| 428 | 3504 } |
| 3505 } | |
| 3506 | |
| 3507 failure = 0; | |
| 3508 | |
| 3509 /* Note: I tried increasing the buffering size, along with | |
| 3510 various other tricks, but nothing seemed to make much of | |
| 3511 a difference in the time it took to save a large file. | |
| 3512 (Actually that's not true. With a local disk, changing | |
| 3513 the buffer size doesn't seem to make much difference. | |
| 3514 With an NFS-mounted disk, it could make a lot of difference | |
| 3515 because you're affecting the number of network requests | |
| 3516 that need to be made, and there could be a large latency | |
| 3517 for each request. So I've increased the buffer size | |
| 3518 to 64K.) */ | |
| 3519 outstream = make_filedesc_output_stream (desc, 0, -1, 0); | |
| 3520 Lstream_set_buffering (XLSTREAM (outstream), | |
| 3521 LSTREAM_BLOCKN_BUFFERED, 65536); | |
| 3522 outstream = | |
| 800 | 3523 make_coding_output_stream (XLSTREAM (outstream), codesys, |
| 3524 CODING_ENCODE, 0); | |
| 428 | 3525 Lstream_set_buffering (XLSTREAM (outstream), |
| 3526 LSTREAM_BLOCKN_BUFFERED, 65536); | |
| 3527 if (STRINGP (start)) | |
| 3528 { | |
| 3529 instream = make_lisp_string_input_stream (start, 0, -1); | |
| 3530 start1 = 0; | |
| 3531 } | |
| 3532 else | |
| 3533 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1, | |
| 3534 LSTR_SELECTIVE | | |
| 3535 LSTR_IGNORE_ACCESSIBLE); | |
| 3536 failure = (0 > (a_write (outstream, instream, start1, | |
| 3537 &annotations))); | |
| 3538 save_errno = errno; | |
| 3539 /* Note that this doesn't close the desc since we created the | |
| 3540 stream without the LSTR_CLOSING flag, but it does | |
| 3541 flush out any buffered data. */ | |
| 3542 if (Lstream_close (XLSTREAM (outstream)) < 0) | |
| 3543 { | |
| 3544 failure = 1; | |
| 3545 save_errno = errno; | |
| 3546 } | |
| 3547 Lstream_close (XLSTREAM (instream)); | |
| 3548 | |
| 3549 #ifdef HAVE_FSYNC | |
| 3550 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). | |
| 3551 Disk full in NFS may be reported here. */ | |
| 3552 /* mib says that closing the file will try to write as fast as NFS can do | |
| 3553 it, and that means the fsync here is not crucial for autosave files. */ | |
|
4499
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
3554 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0 |
| 428 | 3555 /* If fsync fails with EINTR, don't treat that as serious. */ |
| 3556 && errno != EINTR) | |
| 3557 { | |
| 3558 failure = 1; | |
| 3559 save_errno = errno; | |
| 3560 } | |
| 3561 #endif /* HAVE_FSYNC */ | |
| 3562 | |
| 440 | 3563 /* Spurious "file has changed on disk" warnings used to be seen on |
| 3564 systems where close() can change the modtime. This is known to | |
| 3565 happen on various NFS file systems, on Windows, and on Linux. | |
| 3566 Rather than handling this on a per-system basis, we | |
| 771 | 3567 unconditionally do the qxe_stat() after the retry_close(). */ |
| 428 | 3568 |
| 3569 /* NFS can report a write failure now. */ | |
| 771 | 3570 if (retry_close (desc) < 0) |
| 428 | 3571 { |
| 3572 failure = 1; | |
| 3573 save_errno = errno; | |
| 3574 } | |
| 3575 | |
| 3576 /* Discard the close unwind-protect. Execute the one for | |
| 3577 build_annotations (switches back to the original current buffer | |
| 3578 as necessary). */ | |
| 3579 XCAR (desc_locative) = Qnil; | |
| 771 | 3580 unbind_to (speccount); |
| 442 | 3581 |
| 3582 NNUNGCPRO; | |
| 428 | 3583 } |
| 3584 | |
| 771 | 3585 qxe_stat (XSTRING_DATA (fn), &st); |
| 428 | 3586 |
| 3587 #ifdef CLASH_DETECTION | |
| 3588 if (!auto_saving) | |
| 3589 unlock_file (lockname); | |
| 3590 #endif /* CLASH_DETECTION */ | |
| 3591 | |
| 3592 /* Do this before reporting IO error | |
| 3593 to avoid a "file has changed on disk" warning on | |
| 3594 next attempt to save. */ | |
| 3595 if (visiting) | |
| 3596 current_buffer->modtime = st.st_mtime; | |
| 3597 | |
| 3598 if (failure) | |
| 442 | 3599 { |
| 3600 errno = save_errno; | |
| 563 | 3601 report_file_error ("Writing file", fn); |
| 442 | 3602 } |
| 428 | 3603 |
| 3604 if (visiting) | |
| 3605 { | |
| 3606 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3607 current_buffer->saved_size = make_fixnum (BUF_SIZE (current_buffer)); |
| 428 | 3608 current_buffer->filename = visit_file; |
| 3609 MARK_MODELINE_CHANGED; | |
| 3610 } | |
| 3611 else if (quietly) | |
| 3612 { | |
| 442 | 3613 NUNGCPRO; |
| 3614 UNGCPRO; | |
| 428 | 3615 return Qnil; |
| 3616 } | |
| 3617 | |
| 3618 if (!auto_saving) | |
| 3619 { | |
| 3620 if (visiting_other) | |
| 3621 message ("Wrote %s", XSTRING_DATA (visit_file)); | |
| 3622 else | |
| 3623 { | |
| 446 | 3624 Lisp_Object fsp = Qnil; |
| 442 | 3625 struct gcpro nngcpro1; |
| 3626 | |
| 3627 NNGCPRO1 (fsp); | |
| 428 | 3628 fsp = Ffile_symlink_p (fn); |
| 3629 if (NILP (fsp)) | |
| 3630 message ("Wrote %s", XSTRING_DATA (fn)); | |
| 3631 else | |
| 3632 message ("Wrote %s (symlink to %s)", | |
| 3633 XSTRING_DATA (fn), XSTRING_DATA (fsp)); | |
| 442 | 3634 NNUNGCPRO; |
| 428 | 3635 } |
| 3636 } | |
| 442 | 3637 NUNGCPRO; |
| 3638 UNGCPRO; | |
| 428 | 3639 return Qnil; |
| 3640 } | |
| 3641 | |
| 3642 /* Build the complete list of annotations appropriate for writing out | |
| 3643 the text between START and END, by calling all the functions in | |
| 3644 write-region-annotate-functions and merging the lists they return. | |
| 3645 If one of these functions switches to a different buffer, we assume | |
| 3646 that buffer contains altered text. Therefore, the caller must | |
| 3647 make sure to restore the current buffer in all cases, | |
| 3648 as save-excursion would do. */ | |
| 3649 | |
| 3650 static Lisp_Object | |
| 3651 build_annotations (Lisp_Object start, Lisp_Object end) | |
| 3652 { | |
| 3653 /* This function can GC */ | |
| 3654 Lisp_Object annotations; | |
| 3655 Lisp_Object p, res; | |
| 3656 struct gcpro gcpro1, gcpro2; | |
| 793 | 3657 Lisp_Object original_buffer = wrap_buffer (current_buffer); |
| 3658 | |
| 428 | 3659 |
| 3660 annotations = Qnil; | |
| 3661 p = Vwrite_region_annotate_functions; | |
| 3662 GCPRO2 (annotations, p); | |
| 3663 while (!NILP (p)) | |
| 3664 { | |
| 3665 struct buffer *given_buffer = current_buffer; | |
| 3666 Vwrite_region_annotations_so_far = annotations; | |
| 3667 res = call2 (Fcar (p), start, end); | |
| 3668 /* If the function makes a different buffer current, | |
| 3669 assume that means this buffer contains altered text to be output. | |
| 3670 Reset START and END from the buffer bounds | |
| 3671 and discard all previous annotations because they should have | |
| 3672 been dealt with by this function. */ | |
| 3673 if (current_buffer != given_buffer) | |
| 3674 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3675 start = make_fixnum (BUF_BEGV (current_buffer)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3676 end = make_fixnum (BUF_ZV (current_buffer)); |
| 428 | 3677 annotations = Qnil; |
| 3678 } | |
| 3679 Flength (res); /* Check basic validity of return value */ | |
|
5350
94bbd4792049
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3680 annotations = list_merge (annotations, res, check_lss_key_car, Qnil, |
|
94bbd4792049
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3681 Qnil); |
| 428 | 3682 p = Fcdr (p); |
| 3683 } | |
| 3684 | |
| 3685 /* Now do the same for annotation functions implied by the file-format */ | |
|
5004
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3686 if (UNBOUNDP (XSYMBOL_FUNCTION (Qformat_annotate_function))) |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3687 { |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3688 p = Qnil; |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3689 } |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3690 else if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3691 { |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3692 p = Vauto_save_file_format; |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3693 } |
| 428 | 3694 else |
|
5004
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3695 { |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3696 p = current_buffer->file_format; |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3697 } |
|
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3698 |
| 428 | 3699 while (!NILP (p)) |
| 3700 { | |
| 3701 struct buffer *given_buffer = current_buffer; | |
| 3702 Vwrite_region_annotations_so_far = annotations; | |
| 3703 res = call4 (Qformat_annotate_function, Fcar (p), start, end, | |
| 3704 original_buffer); | |
| 3705 if (current_buffer != given_buffer) | |
| 3706 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3707 start = make_fixnum (BUF_BEGV (current_buffer)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3708 end = make_fixnum (BUF_ZV (current_buffer)); |
| 428 | 3709 annotations = Qnil; |
| 3710 } | |
| 3711 Flength (res); | |
|
5350
94bbd4792049
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3712 annotations = list_merge (annotations, res, check_lss_key_car, Qnil, |
|
94bbd4792049
Have #'sort*, #'merge use the same test approach as functions from cl-seq.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3713 Qnil); |
| 428 | 3714 p = Fcdr (p); |
| 3715 } | |
|
5004
788c38f20376
Do not assume #'format-decode exists in fileio.c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5000
diff
changeset
|
3716 |
| 428 | 3717 UNGCPRO; |
| 3718 return annotations; | |
| 3719 } | |
| 3720 | |
| 3721 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until | |
| 3722 EOF is encountered), assuming they start at position POS in the buffer | |
| 3723 of string that STREAM refers to. Intersperse with them the annotations | |
| 3724 from *ANNOT that fall into the range of positions we are reading from, | |
| 3725 each at its appropriate position. | |
| 3726 | |
| 3727 Modify *ANNOT by discarding elements as we output them. | |
| 3728 The return value is negative in case of system call failure. */ | |
| 3729 | |
| 3730 /* 4K should probably be fine. We just need to reduce the number of | |
| 3731 function calls to reasonable level. The Lstream stuff itself will | |
| 3732 batch to 64K to reduce the number of system calls. */ | |
| 3733 | |
| 3734 #define A_WRITE_BATCH_SIZE 4096 | |
| 3735 | |
| 3736 static int | |
| 3737 a_write (Lisp_Object outstream, Lisp_Object instream, int pos, | |
| 3738 Lisp_Object *annot) | |
| 3739 { | |
| 3740 Lisp_Object tem; | |
| 3741 int nextpos; | |
|
5000
44d7bde26046
fix compile errors, fix revert-buffer bug on binary/Latin 1 files, Mule-ize some files
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
3742 Ibyte largebuf[A_WRITE_BATCH_SIZE]; |
| 428 | 3743 Lstream *instr = XLSTREAM (instream); |
| 3744 Lstream *outstr = XLSTREAM (outstream); | |
| 3745 | |
| 3746 while (LISTP (*annot)) | |
| 3747 { | |
| 3748 tem = Fcar_safe (Fcar (*annot)); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3749 if (FIXNUMP (tem)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3750 nextpos = XFIXNUM (tem); |
| 428 | 3751 else |
| 3752 nextpos = INT_MAX; | |
| 3753 #ifdef MULE | |
| 3754 /* If there are annotations left and we have Mule, then we | |
| 867 | 3755 have to do the I/O one ichar at a time so we can |
| 428 | 3756 determine when to insert the annotation. */ |
| 3757 if (!NILP (*annot)) | |
| 3758 { | |
| 867 | 3759 Ichar ch; |
| 3760 while (pos != nextpos && (ch = Lstream_get_ichar (instr)) != EOF) | |
| 428 | 3761 { |
| 867 | 3762 if (Lstream_put_ichar (outstr, ch) < 0) |
| 428 | 3763 return -1; |
| 3764 pos++; | |
| 3765 } | |
| 3766 } | |
| 3767 else | |
| 3768 #endif /* MULE */ | |
| 3769 { | |
| 3770 while (pos != nextpos) | |
| 3771 { | |
| 3772 /* Otherwise there is no point to that. Just go in batches. */ | |
| 3773 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE); | |
| 3774 | |
| 3775 chunk = Lstream_read (instr, largebuf, chunk); | |
| 3776 if (chunk < 0) | |
| 3777 return -1; | |
| 3778 if (chunk == 0) /* EOF */ | |
| 3779 break; | |
| 771 | 3780 if (Lstream_write (outstr, largebuf, chunk) < 0) |
| 428 | 3781 return -1; |
| 3782 pos += chunk; | |
| 3783 } | |
| 3784 } | |
| 3785 if (pos == nextpos) | |
| 3786 { | |
| 3787 tem = Fcdr (Fcar (*annot)); | |
| 3788 if (STRINGP (tem)) | |
| 3789 { | |
| 3790 if (Lstream_write (outstr, XSTRING_DATA (tem), | |
| 3791 XSTRING_LENGTH (tem)) < 0) | |
| 3792 return -1; | |
| 3793 } | |
| 3794 *annot = Fcdr (*annot); | |
| 3795 } | |
| 3796 else | |
| 3797 return 0; | |
| 3798 } | |
| 3799 return -1; | |
| 3800 } | |
| 3801 | |
| 3802 | |
| 3803 | |
| 3804 #if 0 | |
| 3805 #include <des_crypt.h> | |
| 3806 | |
| 3807 #define CRYPT_BLOCK_SIZE 8 /* bytes */ | |
| 3808 #define CRYPT_KEY_SIZE 8 /* bytes */ | |
| 3809 | |
| 3810 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /* | |
| 3811 Encrypt STRING using KEY. | |
| 3812 */ | |
| 3813 (string, key)) | |
| 3814 { | |
| 2367 | 3815 /* !!#### Needs work */ |
| 1333 | 3816 Extbyte *encrypted_string, *raw_key; |
| 3817 Extbyte *string_ext, *key_ext; | |
| 3818 Bytecount string_size_ext, key_size_ext, rounded_size, extra, key_size; | |
| 3819 | |
| 428 | 3820 CHECK_STRING (string); |
| 3821 CHECK_STRING (key); | |
| 3822 | |
| 1333 | 3823 LISP_STRING_TO_SIZED_EXTERNAL (string, string_ext, string_size_ext, Qbinary); |
| 3824 LISP_STRING_TO_SIZED_EXTERNAL (key, key_ext, key_size_ext, Qbinary); | |
| 3825 | |
| 3826 extra = string_size_ext % CRYPT_BLOCK_SIZE; | |
| 3827 rounded_size = string_size_ext + extra; | |
| 851 | 3828 encrypted_string = ALLOCA (rounded_size + 1); |
| 1333 | 3829 memcpy (encrypted_string, string_ext, string_size_ext); |
| 428 | 3830 memset (encrypted_string + rounded_size - extra, 0, extra + 1); |
| 3831 | |
| 1333 | 3832 key_size = min (CRYPT_KEY_SIZE, key_size_ext); |
| 428 | 3833 |
| 851 | 3834 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1); |
| 1333 | 3835 memcpy (raw_key, key_ext, key_size); |
| 428 | 3836 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); |
| 3837 | |
| 3838 ecb_crypt (raw_key, encrypted_string, rounded_size, | |
| 3839 DES_ENCRYPT | DES_SW); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3840 return make_extstring (encrypted_string, rounded_size, Qbinary); |
| 428 | 3841 } |
| 3842 | |
| 3843 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /* | |
| 3844 Decrypt STRING using KEY. | |
| 3845 */ | |
| 3846 (string, key)) | |
| 3847 { | |
| 1333 | 3848 Extbyte *decrypted_string, *raw_key; |
| 3849 Extbyte *string_ext, *key_ext; | |
| 3850 Bytecount string_size_ext, key_size_ext, string_size, key_size; | |
| 428 | 3851 |
| 3852 CHECK_STRING (string); | |
| 3853 CHECK_STRING (key); | |
| 3854 | |
| 1333 | 3855 LISP_STRING_TO_SIZED_EXTERNAL (string, string_ext, string_size_ext, Qbinary); |
| 3856 LISP_STRING_TO_SIZED_EXTERNAL (key, key_ext, key_size_ext, Qbinary); | |
| 3857 | |
| 3858 string_size = string_size_ext + 1; | |
| 851 | 3859 decrypted_string = ALLOCA (string_size); |
| 1333 | 3860 memcpy (decrypted_string, string_ext, string_size); |
| 428 | 3861 decrypted_string[string_size - 1] = '\0'; |
| 3862 | |
| 1333 | 3863 key_size = min (CRYPT_KEY_SIZE, key_size_ext); |
| 428 | 3864 |
| 851 | 3865 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1); |
| 1333 | 3866 memcpy (raw_key, key_ext, key_size); |
| 428 | 3867 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); |
| 3868 | |
| 3869 | |
| 3870 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3871 return make_extstring (decrypted_string, string_size - 1, Qbinary); |
| 428 | 3872 } |
| 3873 #endif /* 0 */ | |
| 3874 | |
| 3875 | |
| 3876 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /* | |
| 444 | 3877 Return t if last mod time of BUFFER's visited file matches what BUFFER records. |
| 428 | 3878 This means that the file has not been changed since it was visited or saved. |
| 3879 */ | |
| 444 | 3880 (buffer)) |
| 428 | 3881 { |
| 442 | 3882 /* This function can call lisp; GC checked 2000-07-11 ben */ |
| 428 | 3883 struct buffer *b; |
| 3884 struct stat st; | |
| 3885 Lisp_Object handler; | |
| 3886 | |
| 444 | 3887 CHECK_BUFFER (buffer); |
| 3888 b = XBUFFER (buffer); | |
| 428 | 3889 |
| 3890 if (!STRINGP (b->filename)) return Qt; | |
| 3891 if (b->modtime == 0) return Qt; | |
| 3892 | |
| 3893 /* If the file name has special constructs in it, | |
| 3894 call the corresponding file handler. */ | |
| 3895 handler = Ffind_file_name_handler (b->filename, | |
| 3896 Qverify_visited_file_modtime); | |
| 3897 if (!NILP (handler)) | |
| 444 | 3898 return call2 (handler, Qverify_visited_file_modtime, buffer); |
| 428 | 3899 |
| 771 | 3900 if (qxe_stat (XSTRING_DATA (b->filename), &st) < 0) |
| 428 | 3901 { |
| 3902 /* If the file doesn't exist now and didn't exist before, | |
| 3903 we say that it isn't modified, provided the error is a tame one. */ | |
| 3904 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) | |
| 3905 st.st_mtime = -1; | |
| 3906 else | |
| 3907 st.st_mtime = 0; | |
| 3908 } | |
| 3909 if (st.st_mtime == b->modtime | |
| 3910 /* If both are positive, accept them if they are off by one second. */ | |
| 3911 || (st.st_mtime > 0 && b->modtime > 0 | |
| 3912 && (st.st_mtime == b->modtime + 1 | |
| 3913 || st.st_mtime == b->modtime - 1))) | |
| 3914 return Qt; | |
| 3915 return Qnil; | |
| 3916 } | |
| 3917 | |
| 3918 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /* | |
| 3919 Clear out records of last mod time of visited file. | |
| 3920 Next attempt to save will certainly not complain of a discrepancy. | |
| 3921 */ | |
| 3922 ()) | |
| 3923 { | |
| 3924 current_buffer->modtime = 0; | |
| 3925 return Qnil; | |
| 3926 } | |
| 3927 | |
| 3928 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /* | |
| 3929 Return the current buffer's recorded visited file modification time. | |
| 3930 The value is a list of the form (HIGH . LOW), like the time values | |
| 3931 that `file-attributes' returns. | |
| 3932 */ | |
| 3933 ()) | |
| 3934 { | |
| 3935 return time_to_lisp ((time_t) current_buffer->modtime); | |
| 3936 } | |
| 3937 | |
| 3938 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /* | |
| 3939 Update buffer's recorded modification time from the visited file's time. | |
| 3940 Useful if the buffer was not read from the file normally | |
| 3941 or if the file itself has been changed for some known benign reason. | |
| 3942 An argument specifies the modification time value to use | |
| 3943 \(instead of that of the visited file), in the form of a list | |
| 3944 \(HIGH . LOW) or (HIGH LOW). | |
| 3945 */ | |
| 3946 (time_list)) | |
| 3947 { | |
| 3948 /* This function can call lisp */ | |
| 3949 if (!NILP (time_list)) | |
| 3950 { | |
| 3951 time_t the_time; | |
| 3952 lisp_to_time (time_list, &the_time); | |
| 3953 current_buffer->modtime = (int) the_time; | |
| 3954 } | |
| 3955 else | |
| 3956 { | |
| 446 | 3957 Lisp_Object filename = Qnil; |
| 428 | 3958 struct stat st; |
| 3959 Lisp_Object handler; | |
| 3960 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 3961 | |
| 3962 GCPRO3 (filename, time_list, current_buffer->filename); | |
| 3963 filename = Fexpand_file_name (current_buffer->filename, Qnil); | |
| 3964 | |
| 3965 /* If the file name has special constructs in it, | |
| 3966 call the corresponding file handler. */ | |
| 3967 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); | |
| 3968 UNGCPRO; | |
| 3969 if (!NILP (handler)) | |
| 3970 /* The handler can find the file name the same way we did. */ | |
| 3971 return call2 (handler, Qset_visited_file_modtime, Qnil); | |
| 771 | 3972 else if (qxe_stat (XSTRING_DATA (filename), &st) >= 0) |
| 428 | 3973 current_buffer->modtime = st.st_mtime; |
| 3974 } | |
| 3975 | |
| 3976 return Qnil; | |
| 3977 } | |
| 3978 | |
| 3979 static Lisp_Object | |
| 2286 | 3980 auto_save_error (Lisp_Object UNUSED (condition_object), |
| 3981 Lisp_Object UNUSED (ignored)) | |
| 428 | 3982 { |
| 3983 /* This function can call lisp */ | |
| 3984 if (gc_in_progress) | |
| 3985 return Qnil; | |
| 3986 /* Don't try printing an error message after everything is gone! */ | |
| 3987 if (preparing_for_armageddon) | |
| 3988 return Qnil; | |
| 3989 clear_echo_area (selected_frame (), Qauto_saving, 1); | |
| 3990 Fding (Qt, Qauto_save_error, Qnil); | |
| 3991 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name)); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3992 Fsleep_for (make_fixnum (1)); |
| 428 | 3993 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name)); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3994 Fsleep_for (make_fixnum (1)); |
| 428 | 3995 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name)); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
3996 Fsleep_for (make_fixnum (1)); |
| 428 | 3997 return Qnil; |
| 3998 } | |
| 3999 | |
| 4000 static Lisp_Object | |
| 2286 | 4001 auto_save_1 (Lisp_Object UNUSED (ignored)) |
| 428 | 4002 { |
| 4003 /* This function can call lisp */ | |
| 4004 /* #### I think caller is protecting current_buffer? */ | |
| 4005 struct stat st; | |
| 4006 Lisp_Object fn = current_buffer->filename; | |
| 4007 Lisp_Object a = current_buffer->auto_save_file_name; | |
| 4008 | |
| 4009 if (!STRINGP (a)) | |
| 4010 return (Qnil); | |
| 4011 | |
| 4012 /* Get visited file's mode to become the auto save file's mode. */ | |
| 4013 if (STRINGP (fn) && | |
| 771 | 4014 qxe_stat (XSTRING_DATA (fn), &st) >= 0) |
| 428 | 4015 /* But make sure we can overwrite it later! */ |
| 4016 auto_save_mode_bits = st.st_mode | 0600; | |
| 4017 else | |
| 4018 /* default mode for auto-save files of buffers with no file is | |
| 4019 readable by owner only. This may annoy some small number of | |
| 4020 people, but the alternative removes all privacy from email. */ | |
| 4021 auto_save_mode_bits = 0600; | |
| 4022 | |
| 4023 return | |
| 4024 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil, | |
| 771 | 4025 #if 1 /* #### Kyle wants it changed to not use escape-quoted. Think |
| 4026 carefully about how this works. */ | |
| 4266 | 4027 Qescape_quoted, |
| 771 | 4028 #else |
| 4266 | 4029 current_buffer->buffer_file_coding_system, |
| 428 | 4030 #endif |
| 4266 | 4031 Qnil); |
| 428 | 4032 } |
| 4033 | |
| 4034 static Lisp_Object | |
| 2286 | 4035 auto_save_expand_name_error (Lisp_Object condition_object, |
| 4036 Lisp_Object UNUSED (ignored)) | |
| 428 | 4037 { |
| 771 | 4038 warn_when_safe_lispobj |
| 793 | 4039 (Qfile, Qerror, |
| 771 | 4040 Fcons (build_msg_string ("Invalid auto-save list-file"), |
| 4041 Fcons (Vauto_save_list_file_name, | |
| 4042 condition_object))); | |
| 428 | 4043 return Qnil; |
| 4044 } | |
| 4045 | |
| 4046 static Lisp_Object | |
| 4047 auto_save_expand_name (Lisp_Object name) | |
| 4048 { | |
| 4049 struct gcpro gcpro1; | |
| 4050 | |
| 4051 /* note that caller did NOT gc protect name, so we do it. */ | |
| 771 | 4052 /* [[dmoore - this might not be necessary, if condition_case_1 |
| 4053 protects it. but I don't think it does.]] indeed it doesn't. --ben */ | |
| 428 | 4054 GCPRO1 (name); |
| 4055 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil)); | |
| 4056 } | |
| 4057 | |
| 4058 | |
| 4059 static Lisp_Object | |
| 4060 do_auto_save_unwind (Lisp_Object fd) | |
| 4061 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4062 retry_close (XFIXNUM (fd)); |
| 428 | 4063 return (fd); |
| 4064 } | |
| 4065 | |
| 4066 /* Fdo_auto_save() checks whether a GC is in progress when it is called, | |
| 4067 and if so, tries to avoid touching lisp objects. | |
| 4068 | |
| 4069 The only time that Fdo_auto_save() is called while GC is in progress | |
| 2500 | 4070 is if we're going down, as a result of an ABORT() or a kill signal. |
| 428 | 4071 It's fairly important that we generate autosave files in that case! |
| 4072 */ | |
| 4073 | |
| 4074 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /* | |
| 4075 Auto-save all buffers that need it. | |
| 4076 This is all buffers that have auto-saving enabled | |
| 4077 and are changed since last auto-saved. | |
| 4078 Auto-saving writes the buffer into a file | |
| 4079 so that your editing is not lost if the system crashes. | |
| 4080 This file is not the file you visited; that changes only when you save. | |
| 4081 Normally we run the normal hook `auto-save-hook' before saving. | |
| 4082 | |
| 4083 Non-nil first argument means do not print any message if successful. | |
| 4084 Non-nil second argument means save only current buffer. | |
| 4085 */ | |
| 4086 (no_message, current_only)) | |
| 4087 { | |
| 4088 /* This function can call lisp */ | |
| 4089 struct buffer *b; | |
| 4090 Lisp_Object tail, buf; | |
| 4091 int auto_saved = 0; | |
| 4092 int do_handled_files; | |
| 4093 Lisp_Object oquit = Qnil; | |
| 4094 Lisp_Object listfile = Qnil; | |
| 4095 Lisp_Object old; | |
| 4096 int listdesc = -1; | |
| 4097 int speccount = specpdl_depth (); | |
| 4098 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 4099 | |
| 793 | 4100 old = wrap_buffer (current_buffer); |
| 428 | 4101 GCPRO3 (oquit, listfile, old); |
| 4102 check_quit (); /* make Vquit_flag accurate */ | |
| 4103 /* Ordinarily don't quit within this function, | |
| 4104 but don't make it impossible to quit (in case we get hung in I/O). */ | |
| 4105 oquit = Vquit_flag; | |
| 4106 Vquit_flag = Qnil; | |
| 4107 | |
| 4108 /* No further GCPRO needed, because (when it matters) all Lisp_Object | |
| 4109 variables point to non-strings reached from Vbuffer_alist. */ | |
| 4110 | |
| 4111 if (minibuf_level != 0 || preparing_for_armageddon) | |
| 4112 no_message = Qt; | |
| 4113 | |
| 4114 run_hook (Qauto_save_hook); | |
| 4115 | |
| 4116 if (STRINGP (Vauto_save_list_file_name)) | |
| 4117 listfile = condition_case_1 (Qt, | |
| 4118 auto_save_expand_name, | |
| 4119 Vauto_save_list_file_name, | |
| 4120 auto_save_expand_name_error, Qnil); | |
| 4121 | |
| 853 | 4122 internal_bind_int (&auto_saving, 1); |
| 428 | 4123 |
| 4124 /* First, save all files which don't have handlers. If Emacs is | |
| 4125 crashing, the handlers may tweak what is causing Emacs to crash | |
| 4126 in the first place, and it would be a shame if Emacs failed to | |
| 4127 autosave perfectly ordinary files because it couldn't handle some | |
| 4128 ange-ftp'd file. */ | |
| 4129 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) | |
| 4130 { | |
| 4131 for (tail = Vbuffer_alist; | |
| 4132 CONSP (tail); | |
| 4133 tail = XCDR (tail)) | |
| 4134 { | |
| 4135 buf = XCDR (XCAR (tail)); | |
| 4136 b = XBUFFER (buf); | |
| 4137 | |
| 4138 if (!NILP (current_only) | |
| 4139 && b != current_buffer) | |
| 4140 continue; | |
| 4141 | |
| 4142 /* Don't auto-save indirect buffers. | |
| 4143 The base buffer takes care of it. */ | |
| 4144 if (b->base_buffer) | |
| 4145 continue; | |
| 4146 | |
| 4147 /* Check for auto save enabled | |
| 4148 and file changed since last auto save | |
| 4149 and file changed since last real save. */ | |
| 4150 if (STRINGP (b->auto_save_file_name) | |
| 4151 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) | |
| 4152 && b->auto_save_modified < BUF_MODIFF (b) | |
| 4153 /* -1 means we've turned off autosaving for a while--see below. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4154 && XFIXNUM (b->saved_size) >= 0 |
| 428 | 4155 && (do_handled_files |
| 4156 || NILP (Ffind_file_name_handler (b->auto_save_file_name, | |
| 4157 Qwrite_region)))) | |
| 4158 { | |
| 4159 EMACS_TIME before_time, after_time; | |
| 4160 | |
| 4161 EMACS_GET_TIME (before_time); | |
| 4162 /* If we had a failure, don't try again for 20 minutes. */ | |
| 4163 if (!preparing_for_armageddon | |
| 4164 && b->auto_save_failure_time >= 0 | |
| 4165 && (EMACS_SECS (before_time) - b->auto_save_failure_time < | |
| 4166 1200)) | |
| 4167 continue; | |
| 4168 | |
| 4169 if (!preparing_for_armageddon && | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4170 (XFIXNUM (b->saved_size) * 10 |
| 428 | 4171 > (BUF_Z (b) - BUF_BEG (b)) * 13) |
| 4172 /* A short file is likely to change a large fraction; | |
| 4173 spare the user annoying messages. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4174 && XFIXNUM (b->saved_size) > 5000 |
| 428 | 4175 /* These messages are frequent and annoying for `*mail*'. */ |
| 4176 && !NILP (b->filename) | |
| 4177 && NILP (no_message) | |
| 4178 && disable_auto_save_when_buffer_shrinks) | |
| 4179 { | |
| 4180 /* It has shrunk too much; turn off auto-saving here. | |
| 4181 Unless we're about to crash, in which case auto-save it | |
| 4182 anyway. | |
| 4183 */ | |
| 4184 message | |
| 4185 ("Buffer %s has shrunk a lot; auto save turned off there", | |
| 4186 XSTRING_DATA (b->name)); | |
| 4187 /* Turn off auto-saving until there's a real save, | |
| 4188 and prevent any more warnings. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4189 b->saved_size = make_fixnum (-1); |
| 428 | 4190 if (!gc_in_progress) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4191 Fsleep_for (make_fixnum (1)); |
| 428 | 4192 continue; |
| 4193 } | |
| 4194 set_buffer_internal (b); | |
| 4195 if (!auto_saved && NILP (no_message)) | |
| 4196 { | |
| 1333 | 4197 static const Ibyte *msg = (const Ibyte *) "Auto-saving..."; |
| 428 | 4198 echo_area_message (selected_frame (), msg, Qnil, |
| 1333 | 4199 0, qxestrlen (msg), |
| 428 | 4200 Qauto_saving); |
| 4201 } | |
| 4202 | |
| 4203 /* Open the auto-save list file, if necessary. | |
| 4204 We only do this now so that the file only exists | |
| 4205 if we actually auto-saved any files. */ | |
| 444 | 4206 if (!auto_saved && !inhibit_auto_save_session |
| 4207 && !NILP (Vauto_save_list_file_prefix) | |
| 4208 && STRINGP (listfile) && listdesc < 0) | |
| 428 | 4209 { |
| 771 | 4210 listdesc = |
| 4211 qxe_open (XSTRING_DATA (listfile), | |
| 4212 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | |
| 4213 CREAT_MODE); | |
| 428 | 4214 |
| 4215 /* Arrange to close that file whether or not we get | |
| 4216 an error. */ | |
| 4217 if (listdesc >= 0) | |
| 4218 record_unwind_protect (do_auto_save_unwind, | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4219 make_fixnum (listdesc)); |
| 428 | 4220 } |
| 4221 | |
| 4222 /* Record all the buffers that we are auto-saving in | |
| 4223 the special file that lists them. For each of | |
| 4224 these buffers, record visited name (if any) and | |
| 4225 auto save name. */ | |
| 4226 if (listdesc >= 0) | |
| 4227 { | |
| 442 | 4228 const Extbyte *auto_save_file_name_ext; |
| 665 | 4229 Bytecount auto_save_file_name_ext_len; |
| 428 | 4230 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4231 LISP_STRING_TO_SIZED_EXTERNAL (b->auto_save_file_name, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4232 auto_save_file_name_ext, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4233 auto_save_file_name_ext_len, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4234 Qescape_quoted); |
| 428 | 4235 if (!NILP (b->filename)) |
| 4236 { | |
| 442 | 4237 const Extbyte *filename_ext; |
| 665 | 4238 Bytecount filename_ext_len; |
| 428 | 4239 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4240 LISP_STRING_TO_SIZED_EXTERNAL (b->filename, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4241 filename_ext, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4242 filename_ext_len, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
4243 Qescape_quoted); |
| 771 | 4244 retry_write (listdesc, filename_ext, filename_ext_len); |
| 428 | 4245 } |
| 771 | 4246 retry_write (listdesc, "\n", 1); |
| 4247 retry_write (listdesc, auto_save_file_name_ext, | |
| 428 | 4248 auto_save_file_name_ext_len); |
| 771 | 4249 retry_write (listdesc, "\n", 1); |
| 428 | 4250 } |
| 4251 | |
| 4252 /* dmoore - In a bad scenario we've set b=XBUFFER(buf) | |
| 4253 based on values in Vbuffer_alist. auto_save_1 may | |
| 4254 cause lisp handlers to run. Those handlers may kill | |
| 4255 the buffer and then GC. Since the buffer is killed, | |
| 4256 it's no longer in Vbuffer_alist so it might get reaped | |
| 4257 by the GC. We also need to protect tail. */ | |
| 4258 /* #### There is probably a lot of other code which has | |
| 4259 pointers into buffers which may get blown away by | |
| 4260 handlers. */ | |
| 4261 { | |
| 4262 struct gcpro ngcpro1, ngcpro2; | |
| 4263 NGCPRO2 (buf, tail); | |
| 4264 condition_case_1 (Qt, | |
| 4265 auto_save_1, Qnil, | |
| 4266 auto_save_error, Qnil); | |
| 4267 NUNGCPRO; | |
| 4268 } | |
| 4269 /* Handler killed our saved current-buffer! Pick any. */ | |
| 4270 if (!BUFFER_LIVE_P (XBUFFER (old))) | |
| 793 | 4271 old = wrap_buffer (current_buffer); |
| 428 | 4272 |
| 4273 set_buffer_internal (XBUFFER (old)); | |
| 4274 auto_saved++; | |
| 4275 | |
| 4276 /* Handler killed their own buffer! */ | |
| 5198 | 4277 if (!BUFFER_LIVE_P (b)) |
| 428 | 4278 continue; |
| 4279 | |
| 4280 b->auto_save_modified = BUF_MODIFF (b); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4281 b->saved_size = make_fixnum (BUF_SIZE (b)); |
| 428 | 4282 EMACS_GET_TIME (after_time); |
| 4283 /* If auto-save took more than 60 seconds, | |
| 4284 assume it was an NFS failure that got a timeout. */ | |
| 4285 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) | |
| 4286 b->auto_save_failure_time = EMACS_SECS (after_time); | |
| 4287 } | |
| 4288 } | |
| 4289 } | |
| 4290 | |
| 4291 /* Prevent another auto save till enough input events come in. */ | |
| 4292 if (auto_saved) | |
| 4293 record_auto_save (); | |
| 4294 | |
| 4295 /* If we didn't save anything into the listfile, remove the old | |
| 4296 one because nothing needed to be auto-saved. Do this afterwards | |
| 4297 rather than before in case we get a crash attempting to autosave | |
| 4298 (in that case we'd still want the old one around). */ | |
| 4299 if (listdesc < 0 && !auto_saved && STRINGP (listfile)) | |
| 771 | 4300 qxe_unlink (XSTRING_DATA (listfile)); |
| 428 | 4301 |
| 4302 /* Show "...done" only if the echo area would otherwise be empty. */ | |
| 4303 if (auto_saved && NILP (no_message) | |
| 4304 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0))) | |
| 4305 { | |
| 1333 | 4306 static const Ibyte *msg = (const Ibyte *)"Auto-saving...done"; |
| 428 | 4307 echo_area_message (selected_frame (), msg, Qnil, 0, |
| 1333 | 4308 qxestrlen (msg), Qauto_saving); |
| 428 | 4309 } |
| 4310 | |
| 4311 Vquit_flag = oquit; | |
| 4312 | |
| 771 | 4313 RETURN_UNGCPRO (unbind_to (speccount)); |
| 428 | 4314 } |
| 4315 | |
| 4316 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /* | |
| 4317 Mark current buffer as auto-saved with its current text. | |
| 4318 No auto-save file will be written until the buffer changes again. | |
| 4319 */ | |
| 4320 ()) | |
| 4321 { | |
| 4322 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
4323 current_buffer->saved_size = make_fixnum (BUF_SIZE (current_buffer)); |
| 428 | 4324 current_buffer->auto_save_failure_time = -1; |
| 4325 return Qnil; | |
| 4326 } | |
| 4327 | |
| 4328 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /* | |
| 4329 Clear any record of a recent auto-save failure in the current buffer. | |
| 4330 */ | |
| 4331 ()) | |
| 4332 { | |
| 4333 current_buffer->auto_save_failure_time = -1; | |
| 4334 return Qnil; | |
| 4335 } | |
| 4336 | |
| 4337 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /* | |
| 4338 Return t if buffer has been auto-saved since last read in or saved. | |
| 4339 */ | |
| 4340 ()) | |
| 4341 { | |
| 4342 return (BUF_SAVE_MODIFF (current_buffer) < | |
| 4343 current_buffer->auto_save_modified) ? Qt : Qnil; | |
| 4344 } | |
| 4345 | |
| 4346 | |
| 4347 /************************************************************************/ | |
| 4348 /* initialization */ | |
| 4349 /************************************************************************/ | |
| 4350 | |
| 4351 void | |
| 4352 syms_of_fileio (void) | |
| 4353 { | |
| 563 | 4354 DEFSYMBOL (Qexpand_file_name); |
| 4355 DEFSYMBOL (Qfile_truename); | |
| 4356 DEFSYMBOL (Qsubstitute_in_file_name); | |
| 4357 DEFSYMBOL (Qdirectory_file_name); | |
| 4358 DEFSYMBOL (Qfile_name_directory); | |
| 4359 DEFSYMBOL (Qfile_name_nondirectory); | |
| 996 | 4360 DEFSYMBOL (Qfile_name_sans_extension); |
| 563 | 4361 DEFSYMBOL (Qunhandled_file_name_directory); |
| 4362 DEFSYMBOL (Qfile_name_as_directory); | |
| 4363 DEFSYMBOL (Qcopy_file); | |
| 4364 DEFSYMBOL (Qmake_directory_internal); | |
| 4365 DEFSYMBOL (Qdelete_directory); | |
| 4366 DEFSYMBOL (Qdelete_file); | |
| 4367 DEFSYMBOL (Qrename_file); | |
| 4368 DEFSYMBOL (Qadd_name_to_file); | |
| 4369 DEFSYMBOL (Qmake_symbolic_link); | |
| 844 | 4370 DEFSYMBOL (Qmake_temp_name); |
| 563 | 4371 DEFSYMBOL (Qfile_exists_p); |
| 4372 DEFSYMBOL (Qfile_executable_p); | |
| 4373 DEFSYMBOL (Qfile_readable_p); | |
| 4374 DEFSYMBOL (Qfile_symlink_p); | |
| 4375 DEFSYMBOL (Qfile_writable_p); | |
| 4376 DEFSYMBOL (Qfile_directory_p); | |
| 4377 DEFSYMBOL (Qfile_regular_p); | |
| 4378 DEFSYMBOL (Qfile_accessible_directory_p); | |
| 4379 DEFSYMBOL (Qfile_modes); | |
| 4380 DEFSYMBOL (Qset_file_modes); | |
| 4381 DEFSYMBOL (Qfile_newer_than_file_p); | |
| 4382 DEFSYMBOL (Qinsert_file_contents); | |
| 4383 DEFSYMBOL (Qwrite_region); | |
| 4384 DEFSYMBOL (Qverify_visited_file_modtime); | |
| 4385 DEFSYMBOL (Qset_visited_file_modtime); | |
| 4266 | 4386 DEFSYMBOL (Qexcl); |
| 563 | 4387 |
| 4388 DEFSYMBOL (Qauto_save_hook); | |
| 4389 DEFSYMBOL (Qauto_save_error); | |
| 4390 DEFSYMBOL (Qauto_saving); | |
| 4391 | |
| 4392 DEFSYMBOL (Qformat_decode); | |
| 4393 DEFSYMBOL (Qformat_annotate_function); | |
| 4394 | |
| 4395 DEFSYMBOL (Qcompute_buffer_file_truename); | |
| 4396 | |
| 442 | 4397 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error); |
| 428 | 4398 |
| 4399 DEFSUBR (Ffind_file_name_handler); | |
| 4400 | |
| 4401 DEFSUBR (Ffile_name_directory); | |
| 4402 DEFSUBR (Ffile_name_nondirectory); | |
| 4403 DEFSUBR (Funhandled_file_name_directory); | |
| 4404 DEFSUBR (Ffile_name_as_directory); | |
| 4405 DEFSUBR (Fdirectory_file_name); | |
| 4406 DEFSUBR (Fmake_temp_name); | |
| 4407 DEFSUBR (Fexpand_file_name); | |
| 4408 DEFSUBR (Ffile_truename); | |
| 4409 DEFSUBR (Fsubstitute_in_file_name); | |
| 4410 DEFSUBR (Fcopy_file); | |
| 4411 DEFSUBR (Fmake_directory_internal); | |
| 4412 DEFSUBR (Fdelete_directory); | |
| 4413 DEFSUBR (Fdelete_file); | |
| 4414 DEFSUBR (Frename_file); | |
| 4415 DEFSUBR (Fadd_name_to_file); | |
| 4416 DEFSUBR (Fmake_symbolic_link); | |
| 4417 #ifdef HPUX_NET | |
| 4418 DEFSUBR (Fsysnetunam); | |
| 4419 #endif /* HPUX_NET */ | |
| 4420 DEFSUBR (Ffile_name_absolute_p); | |
| 4421 DEFSUBR (Ffile_exists_p); | |
| 4422 DEFSUBR (Ffile_executable_p); | |
| 4423 DEFSUBR (Ffile_readable_p); | |
| 4424 DEFSUBR (Ffile_writable_p); | |
| 4425 DEFSUBR (Ffile_symlink_p); | |
| 4426 DEFSUBR (Ffile_directory_p); | |
| 4427 DEFSUBR (Ffile_accessible_directory_p); | |
| 4428 DEFSUBR (Ffile_regular_p); | |
| 4429 DEFSUBR (Ffile_modes); | |
| 4430 DEFSUBR (Fset_file_modes); | |
| 4431 DEFSUBR (Fset_default_file_modes); | |
| 4432 DEFSUBR (Fdefault_file_modes); | |
| 4433 DEFSUBR (Funix_sync); | |
| 4434 DEFSUBR (Ffile_newer_than_file_p); | |
| 4435 DEFSUBR (Finsert_file_contents_internal); | |
| 4436 DEFSUBR (Fwrite_region_internal); | |
| 4437 #if 0 | |
| 4438 DEFSUBR (Fencrypt_string); | |
| 4439 DEFSUBR (Fdecrypt_string); | |
| 4440 #endif | |
| 4441 DEFSUBR (Fverify_visited_file_modtime); | |
| 4442 DEFSUBR (Fclear_visited_file_modtime); | |
| 4443 DEFSUBR (Fvisited_file_modtime); | |
| 4444 DEFSUBR (Fset_visited_file_modtime); | |
| 4445 | |
| 4446 DEFSUBR (Fdo_auto_save); | |
| 4447 DEFSUBR (Fset_buffer_auto_saved); | |
| 4448 DEFSUBR (Fclear_buffer_auto_save_failure); | |
| 4449 DEFSUBR (Frecent_auto_save_p); | |
| 4450 } | |
| 4451 | |
| 4452 void | |
| 4453 vars_of_fileio (void) | |
| 4454 { | |
| 2526 | 4455 QSin_expand_file_name = |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
4456 build_defer_string ("(in expand-file-name)"); |
| 2526 | 4457 staticpro (&QSin_expand_file_name); |
| 4458 | |
| 428 | 4459 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /* |
| 4460 *Format in which to write auto-save files. | |
| 4461 Should be a list of symbols naming formats that are defined in `format-alist'. | |
| 4462 If it is t, which is the default, auto-save files are written in the | |
| 4463 same format as a regular save would use. | |
| 4464 */ ); | |
| 4465 Vauto_save_file_format = Qt; | |
| 4466 | |
| 4467 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /* | |
| 4468 *Alist of elements (REGEXP . HANDLER) for file names handled specially. | |
| 4469 If a file name matches REGEXP, then all I/O on that file is done by calling | |
| 4470 HANDLER. | |
| 4471 | |
| 4472 The first argument given to HANDLER is the name of the I/O primitive | |
| 4473 to be handled; the remaining arguments are the arguments that were | |
| 4474 passed to that primitive. For example, if you do | |
| 4475 (file-exists-p FILENAME) | |
| 4476 and FILENAME is handled by HANDLER, then HANDLER is called like this: | |
| 4477 (funcall HANDLER 'file-exists-p FILENAME) | |
| 4478 The function `find-file-name-handler' checks this list for a handler | |
| 4479 for its argument. | |
| 4480 */ ); | |
| 4481 Vfile_name_handler_alist = Qnil; | |
| 4482 | |
| 4483 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /* | |
| 4484 A list of functions to be called at the end of `insert-file-contents'. | |
| 4485 Each is passed one argument, the number of bytes inserted. It should return | |
| 4486 the new byte count, and leave point the same. If `insert-file-contents' is | |
| 4487 intercepted by a handler from `file-name-handler-alist', that handler is | |
| 4488 responsible for calling the after-insert-file-functions if appropriate. | |
| 4489 */ ); | |
| 4490 Vafter_insert_file_functions = Qnil; | |
| 4491 | |
| 4492 DEFVAR_LISP ("write-region-annotate-functions", | |
| 4493 &Vwrite_region_annotate_functions /* | |
| 4494 A list of functions to be called at the start of `write-region'. | |
| 4495 Each is passed two arguments, START and END, as for `write-region'. | |
| 4496 It should return a list of pairs (POSITION . STRING) of strings to be | |
| 4497 effectively inserted at the specified positions of the file being written | |
| 4498 \(1 means to insert before the first byte written). The POSITIONs must be | |
| 4499 sorted into increasing order. If there are several functions in the list, | |
| 4500 the several lists are merged destructively. | |
| 4501 */ ); | |
| 4502 Vwrite_region_annotate_functions = Qnil; | |
| 4503 | |
| 4504 DEFVAR_LISP ("write-region-annotations-so-far", | |
| 4505 &Vwrite_region_annotations_so_far /* | |
| 4506 When an annotation function is called, this holds the previous annotations. | |
| 4507 These are the annotations made by other annotation functions | |
| 4508 that were already called. See also `write-region-annotate-functions'. | |
| 4509 */ ); | |
| 4510 Vwrite_region_annotations_so_far = Qnil; | |
| 4511 | |
| 4512 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /* | |
| 4513 A list of file name handlers that temporarily should not be used. | |
| 4514 This applies only to the operation `inhibit-file-name-operation'. | |
| 4515 */ ); | |
| 4516 Vinhibit_file_name_handlers = Qnil; | |
| 4517 | |
| 4518 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /* | |
| 4519 The operation for which `inhibit-file-name-handlers' is applicable. | |
| 4520 */ ); | |
| 4521 Vinhibit_file_name_operation = Qnil; | |
| 4522 | |
| 4523 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /* | |
| 4524 File name in which we write a list of all auto save file names. | |
| 4525 */ ); | |
| 4526 Vauto_save_list_file_name = Qnil; | |
| 4527 | |
|
4499
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4528 #ifdef HAVE_FSYNC |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4529 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync /* |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4530 *Non-nil means don't call fsync in `write-region'. |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4531 This variable affects calls to `write-region' as well as save commands. |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4532 A non-nil value may result in data loss! |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4533 */ ); |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4534 write_region_inhibit_fsync = 0; |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4535 #endif |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4536 |
| 444 | 4537 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /* |
| 4538 Prefix for generating auto-save-list-file-name. | |
| 4539 Emacs's pid and the system name will be appended to | |
| 4540 this prefix to create a unique file name. | |
| 4541 */ ); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
4542 Vauto_save_list_file_prefix = build_ascstring ("~/.saves-"); |
| 444 | 4543 |
| 4544 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /* | |
| 4545 When non-nil, inhibit auto save list file creation. | |
| 4546 */ ); | |
| 4547 inhibit_auto_save_session = 0; | |
| 4548 | |
| 428 | 4549 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks", |
| 4550 &disable_auto_save_when_buffer_shrinks /* | |
| 4551 If non-nil, auto-saving is disabled when a buffer shrinks too much. | |
| 4552 This is to prevent you from losing your edits if you accidentally | |
| 4553 delete a large chunk of the buffer and don't notice it until too late. | |
| 4554 Saving the buffer normally turns auto-save back on. | |
| 4555 */ ); | |
| 4556 disable_auto_save_when_buffer_shrinks = 1; | |
| 4557 | |
| 4558 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /* | |
| 4559 Directory separator character for built-in functions that return file names. | |
| 4560 The value should be either ?/ or ?\\ (any other value is treated as ?\\). | |
| 4561 This variable affects the built-in functions only on Windows, | |
| 4562 on other platforms, it is initialized so that Lisp code can find out | |
| 4563 what the normal separator is. | |
| 4564 */ ); | |
| 771 | 4565 Vdirectory_sep_char = make_char (DEFAULT_DIRECTORY_SEP); |
|
5211
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4566 |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4567 DEFVAR_CONST_BOOL ("default-file-system-ignore-case", &default_file_system_ignore_case /* |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4568 What `file-system-ignore-case-p' returns by default. |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4569 This is in the case that nothing in `file-system-case-alist' matches. |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4570 */ ); |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4571 #ifdef DEFAULT_FILE_SYSTEM_IGNORE_CASE |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4572 default_file_system_ignore_case = DEFAULT_FILE_SYSTEM_IGNORE_CASE; |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4573 #else |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4574 default_file_system_ignore_case = 0; |
|
cdca98f2d36f
Move `default-file-system-ignore-case' to C; fix bug in directory hash tables
Aidan Kehoe <kehoea@parhasard.net>
parents:
5198
diff
changeset
|
4575 #endif |
| 428 | 4576 } |
| 442 | 4577 |
| 4578 void | |
| 4579 reinit_vars_of_fileio (void) | |
| 4580 { | |
| 4581 /* We want temp_name_rand to be initialized to a value likely to be | |
| 4582 unique to the process, not to the executable. The danger is that | |
| 4583 two different XEmacs processes using the same binary on different | |
| 4584 machines creating temp files in the same directory will be | |
| 4585 unlucky enough to have the same pid. If we randomize using | |
| 4586 process startup time, then in practice they will be unlikely to | |
| 4587 collide. We use the microseconds field so that scripts that start | |
| 4588 simultaneous XEmacs processes on multiple machines will have less | |
| 4589 chance of collision. */ | |
| 4590 { | |
| 4591 EMACS_TIME thyme; | |
| 4592 | |
| 4593 EMACS_GET_TIME (thyme); | |
| 4594 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme)); | |
| 4595 } | |
| 4596 } |