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