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