Mercurial > hg > xemacs-beta
annotate src/fileio.c @ 5932:d2c2d83dbb52 cygwin
working with new Xpm.dll
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Wed, 09 Dec 2015 15:50:11 +0000 |
| parents | e24390bd4235 |
| children |
| 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 { |
|
5835
e24390bd4235
Fix off-by-one error in Ffile_truename.
Jerry James <james@xemacs.org>
parents:
5814
diff
changeset
|
1469 if (rlen + 1 >= countof (resolved_path)) |
| 428 | 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 |
|
5782
7277cf461612
Use an explicit hexadecimal constant for READ_BUF_SIZE, correct ChangeLog.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5781
diff
changeset
|
1789 #define READ_BUF_SIZE 0x20000 |
| 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, | |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5782
diff
changeset
|
3180 LSTR_ALLOW_QUIT, NULL); |
|
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.) */ | |
|
5814
a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
5782
diff
changeset
|
3519 outstream = make_filedesc_output_stream (desc, 0, -1, 0, NULL); |
| 428 | 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 } |