1/* File IO for GNU Emacs. 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4 2005, 2006, 2007 Free Software Foundation, Inc. 5 6This file is part of GNU Emacs. 7 8GNU Emacs is free software; you can redistribute it and/or modify 9it under the terms of the GNU General Public License as published by 10the Free Software Foundation; either version 2, or (at your option) 11any later version. 12 13GNU Emacs is distributed in the hope that it will be useful, 14but WITHOUT ANY WARRANTY; without even the implied warranty of 15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16GNU General Public License for more details. 17 18You should have received a copy of the GNU General Public License 19along with GNU Emacs; see the file COPYING. If not, write to 20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 21Boston, MA 02110-1301, USA. */ 22 23#include <config.h> 24 25#ifdef HAVE_FCNTL_H 26#include <fcntl.h> 27#endif 28 29#include <stdio.h> 30#include <sys/types.h> 31#include <sys/stat.h> 32 33#ifdef HAVE_UNISTD_H 34#include <unistd.h> 35#endif 36 37#if !defined (S_ISLNK) && defined (S_IFLNK) 38# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) 39#endif 40 41#if !defined (S_ISFIFO) && defined (S_IFIFO) 42# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) 43#endif 44 45#if !defined (S_ISREG) && defined (S_IFREG) 46# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) 47#endif 48 49#ifdef HAVE_PWD_H 50#include <pwd.h> 51#endif 52 53#include <ctype.h> 54 55#ifdef VMS 56#include "vmsdir.h" 57#include <perror.h> 58#include <stddef.h> 59#include <string.h> 60#endif 61 62#include <errno.h> 63 64#ifndef vax11c 65#ifndef USE_CRT_DLL 66extern int errno; 67#endif 68#endif 69 70#ifdef APOLLO 71#include <sys/time.h> 72#endif 73 74#include "lisp.h" 75#include "intervals.h" 76#include "buffer.h" 77#include "charset.h" 78#include "coding.h" 79#include "window.h" 80#include "blockinput.h" 81 82#ifdef WINDOWSNT 83#define NOMINMAX 1 84#include <windows.h> 85#include <stdlib.h> 86#include <fcntl.h> 87#endif /* not WINDOWSNT */ 88 89#ifdef MSDOS 90#include "msdos.h" 91#include <sys/param.h> 92#if __DJGPP__ >= 2 93#include <fcntl.h> 94#include <string.h> 95#endif 96#endif 97 98#ifdef DOS_NT 99#define CORRECT_DIR_SEPS(s) \ 100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ 101 else unixtodos_filename (s); \ 102 } while (0) 103/* On Windows, drive letters must be alphabetic - on DOS, the Netware 104 redirector allows the six letters between 'Z' and 'a' as well. */ 105#ifdef MSDOS 106#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z') 107#endif 108#ifdef WINDOWSNT 109#define IS_DRIVE(x) isalpha (x) 110#endif 111/* Need to lower-case the drive letter, or else expanded 112 filenames will sometimes compare inequal, because 113 `expand-file-name' doesn't always down-case the drive letter. */ 114#define DRIVE_LETTER(x) (tolower (x)) 115#endif 116 117#ifdef VMS 118#include <file.h> 119#include <rmsdef.h> 120#include <fab.h> 121#include <nam.h> 122#endif 123 124#include "systime.h" 125 126#ifdef HPUX 127#include <netio.h> 128#ifndef HPUX8 129#ifndef HPUX9 130#include <errnet.h> 131#endif 132#endif 133#endif 134 135#include "commands.h" 136extern int use_dialog_box; 137extern int use_file_dialog; 138 139#ifndef O_WRONLY 140#define O_WRONLY 1 141#endif 142 143#ifndef O_RDONLY 144#define O_RDONLY 0 145#endif 146 147#ifndef S_ISLNK 148# define lstat stat 149#endif 150 151#ifndef FILE_SYSTEM_CASE 152#define FILE_SYSTEM_CASE(filename) (filename) 153#endif 154 155/* Nonzero during writing of auto-save files */ 156int auto_saving; 157 158/* Set by auto_save_1 to mode of original file so Fwrite_region will create 159 a new file with the same mode as the original */ 160int auto_save_mode_bits; 161 162/* The symbol bound to coding-system-for-read when 163 insert-file-contents is called for recovering a file. This is not 164 an actual coding system name, but just an indicator to tell 165 insert-file-contents to use `emacs-mule' with a special flag for 166 auto saving and recovering a file. */ 167Lisp_Object Qauto_save_coding; 168 169/* Coding system for file names, or nil if none. */ 170Lisp_Object Vfile_name_coding_system; 171 172/* Coding system for file names used only when 173 Vfile_name_coding_system is nil. */ 174Lisp_Object Vdefault_file_name_coding_system; 175 176/* Alist of elements (REGEXP . HANDLER) for file names 177 whose I/O is done with a special handler. */ 178Lisp_Object Vfile_name_handler_alist; 179 180/* Property name of a file name handler, 181 which gives a list of operations it handles.. */ 182Lisp_Object Qoperations; 183 184/* Lisp functions for translating file formats */ 185Lisp_Object Qformat_decode, Qformat_annotate_function; 186 187/* Function to be called to decide a coding system of a reading file. */ 188Lisp_Object Vset_auto_coding_function; 189 190/* Functions to be called to process text properties in inserted file. */ 191Lisp_Object Vafter_insert_file_functions; 192 193/* Lisp function for setting buffer-file-coding-system and the 194 multibyteness of the current buffer after inserting a file. */ 195Lisp_Object Qafter_insert_file_set_coding; 196 197/* Functions to be called to create text property annotations for file. */ 198Lisp_Object Vwrite_region_annotate_functions; 199Lisp_Object Qwrite_region_annotate_functions; 200 201/* During build_annotations, each time an annotation function is called, 202 this holds the annotations made by the previous functions. */ 203Lisp_Object Vwrite_region_annotations_so_far; 204 205/* File name in which we write a list of all our auto save files. */ 206Lisp_Object Vauto_save_list_file_name; 207 208/* Function to call to read a file name. */ 209Lisp_Object Vread_file_name_function; 210 211/* Current predicate used by read_file_name_internal. */ 212Lisp_Object Vread_file_name_predicate; 213 214/* Nonzero means completion ignores case when reading file name. */ 215int read_file_name_completion_ignore_case; 216 217/* Nonzero means, when reading a filename in the minibuffer, 218 start out by inserting the default directory into the minibuffer. */ 219int insert_default_directory; 220 221/* On VMS, nonzero means write new files with record format stmlf. 222 Zero means use var format. */ 223int vms_stmlf_recfm; 224 225/* On NT, specifies the directory separator character, used (eg.) when 226 expanding file names. This can be bound to / or \. */ 227Lisp_Object Vdirectory_sep_char; 228 229#ifdef HAVE_FSYNC 230/* Nonzero means skip the call to fsync in Fwrite-region. */ 231int write_region_inhibit_fsync; 232#endif 233 234extern Lisp_Object Vuser_login_name; 235 236#ifdef WINDOWSNT 237extern Lisp_Object Vw32_get_true_file_attributes; 238#endif 239 240extern int minibuf_level; 241 242extern int minibuffer_auto_raise; 243 244extern int history_delete_duplicates; 245 246/* These variables describe handlers that have "already" had a chance 247 to handle the current operation. 248 249 Vinhibit_file_name_handlers is a list of file name handlers. 250 Vinhibit_file_name_operation is the operation being handled. 251 If we try to handle that operation, we ignore those handlers. */ 252 253static Lisp_Object Vinhibit_file_name_handlers; 254static Lisp_Object Vinhibit_file_name_operation; 255 256Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error; 257Lisp_Object Qexcl; 258Lisp_Object Qfile_name_history; 259 260Lisp_Object Qcar_less_than_car; 261 262static int a_write P_ ((int, Lisp_Object, int, int, 263 Lisp_Object *, struct coding_system *)); 264static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *)); 265 266 267void 268report_file_error (string, data) 269 const char *string; 270 Lisp_Object data; 271{ 272 Lisp_Object errstring; 273 int errorno = errno; 274 275 synchronize_system_messages_locale (); 276 errstring = code_convert_string_norecord (build_string (strerror (errorno)), 277 Vlocale_coding_system, 0); 278 279 while (1) 280 switch (errorno) 281 { 282 case EEXIST: 283 xsignal (Qfile_already_exists, Fcons (errstring, data)); 284 break; 285 default: 286 /* System error messages are capitalized. Downcase the initial 287 unless it is followed by a slash. */ 288 if (SREF (errstring, 1) != '/') 289 SSET (errstring, 0, DOWNCASE (SREF (errstring, 0))); 290 291 xsignal (Qfile_error, 292 Fcons (build_string (string), Fcons (errstring, data))); 293 } 294} 295 296Lisp_Object 297close_file_unwind (fd) 298 Lisp_Object fd; 299{ 300 emacs_close (XFASTINT (fd)); 301 return Qnil; 302} 303 304/* Restore point, having saved it as a marker. */ 305 306static Lisp_Object 307restore_point_unwind (location) 308 Lisp_Object location; 309{ 310 Fgoto_char (location); 311 Fset_marker (location, Qnil, Qnil); 312 return Qnil; 313} 314 315Lisp_Object Qexpand_file_name; 316Lisp_Object Qsubstitute_in_file_name; 317Lisp_Object Qdirectory_file_name; 318Lisp_Object Qfile_name_directory; 319Lisp_Object Qfile_name_nondirectory; 320Lisp_Object Qunhandled_file_name_directory; 321Lisp_Object Qfile_name_as_directory; 322Lisp_Object Qcopy_file; 323Lisp_Object Qmake_directory_internal; 324Lisp_Object Qmake_directory; 325Lisp_Object Qdelete_directory; 326Lisp_Object Qdelete_file; 327Lisp_Object Qrename_file; 328Lisp_Object Qadd_name_to_file; 329Lisp_Object Qmake_symbolic_link; 330Lisp_Object Qfile_exists_p; 331Lisp_Object Qfile_executable_p; 332Lisp_Object Qfile_readable_p; 333Lisp_Object Qfile_writable_p; 334Lisp_Object Qfile_symlink_p; 335Lisp_Object Qaccess_file; 336Lisp_Object Qfile_directory_p; 337Lisp_Object Qfile_regular_p; 338Lisp_Object Qfile_accessible_directory_p; 339Lisp_Object Qfile_modes; 340Lisp_Object Qset_file_modes; 341Lisp_Object Qset_file_times; 342Lisp_Object Qfile_newer_than_file_p; 343Lisp_Object Qinsert_file_contents; 344Lisp_Object Qwrite_region; 345Lisp_Object Qverify_visited_file_modtime; 346Lisp_Object Qset_visited_file_modtime; 347 348DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0, 349 doc: /* Return FILENAME's handler function for OPERATION, if it has one. 350Otherwise, return nil. 351A file name is handled if one of the regular expressions in 352`file-name-handler-alist' matches it. 353 354If OPERATION equals `inhibit-file-name-operation', then we ignore 355any handlers that are members of `inhibit-file-name-handlers', 356but we still do run any other handlers. This lets handlers 357use the standard functions without calling themselves recursively. */) 358 (filename, operation) 359 Lisp_Object filename, operation; 360{ 361 /* This function must not munge the match data. */ 362 Lisp_Object chain, inhibited_handlers, result; 363 int pos = -1; 364 365 result = Qnil; 366 CHECK_STRING (filename); 367 368 if (EQ (operation, Vinhibit_file_name_operation)) 369 inhibited_handlers = Vinhibit_file_name_handlers; 370 else 371 inhibited_handlers = Qnil; 372 373 for (chain = Vfile_name_handler_alist; CONSP (chain); 374 chain = XCDR (chain)) 375 { 376 Lisp_Object elt; 377 elt = XCAR (chain); 378 if (CONSP (elt)) 379 { 380 Lisp_Object string = XCAR (elt); 381 int match_pos; 382 Lisp_Object handler = XCDR (elt); 383 Lisp_Object operations = Qnil; 384 385 if (SYMBOLP (handler)) 386 operations = Fget (handler, Qoperations); 387 388 if (STRINGP (string) 389 && (match_pos = fast_string_match (string, filename)) > pos 390 && (NILP (operations) || ! NILP (Fmemq (operation, operations)))) 391 { 392 Lisp_Object tem; 393 394 handler = XCDR (elt); 395 tem = Fmemq (handler, inhibited_handlers); 396 if (NILP (tem)) 397 { 398 result = handler; 399 pos = match_pos; 400 } 401 } 402 } 403 404 QUIT; 405 } 406 return result; 407} 408 409DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, 410 1, 1, 0, 411 doc: /* Return the directory component in file name FILENAME. 412Return nil if FILENAME does not include a directory. 413Otherwise return a directory spec. 414Given a Unix syntax file name, returns a string ending in slash; 415on VMS, perhaps instead a string ending in `:', `]' or `>'. */) 416 (filename) 417 Lisp_Object filename; 418{ 419#ifndef DOS_NT 420 register const unsigned char *beg; 421#else 422 register unsigned char *beg; 423#endif 424 register const unsigned char *p; 425 Lisp_Object handler; 426 427 CHECK_STRING (filename); 428 429 /* If the file name has special constructs in it, 430 call the corresponding file handler. */ 431 handler = Ffind_file_name_handler (filename, Qfile_name_directory); 432 if (!NILP (handler)) 433 return call2 (handler, Qfile_name_directory, filename); 434 435 filename = FILE_SYSTEM_CASE (filename); 436 beg = SDATA (filename); 437#ifdef DOS_NT 438 beg = strcpy (alloca (strlen (beg) + 1), beg); 439#endif 440 p = beg + SBYTES (filename); 441 442 while (p != beg && !IS_DIRECTORY_SEP (p[-1]) 443#ifdef VMS 444 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' 445#endif /* VMS */ 446#ifdef DOS_NT 447 /* only recognise drive specifier at the beginning */ 448 && !(p[-1] == ':' 449 /* handle the "/:d:foo" and "/:foo" cases correctly */ 450 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg)) 451 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg)))) 452#endif 453 ) p--; 454 455 if (p == beg) 456 return Qnil; 457#ifdef DOS_NT 458 /* Expansion of "c:" to drive and default directory. */ 459 if (p[-1] == ':') 460 { 461 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ 462 unsigned char *res = alloca (MAXPATHLEN + 1); 463 unsigned char *r = res; 464 465 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':') 466 { 467 strncpy (res, beg, 2); 468 beg += 2; 469 r += 2; 470 } 471 472 if (getdefdir (toupper (*beg) - 'A' + 1, r)) 473 { 474 if (!IS_DIRECTORY_SEP (res[strlen (res) - 1])) 475 strcat (res, "/"); 476 beg = res; 477 p = beg + strlen (beg); 478 } 479 } 480 CORRECT_DIR_SEPS (beg); 481#endif /* DOS_NT */ 482 483 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); 484} 485 486DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 487 Sfile_name_nondirectory, 1, 1, 0, 488 doc: /* Return file name FILENAME sans its directory. 489For example, in a Unix-syntax file name, 490this is everything after the last slash, 491or the entire name if it contains no slash. */) 492 (filename) 493 Lisp_Object filename; 494{ 495 register const unsigned char *beg, *p, *end; 496 Lisp_Object handler; 497 498 CHECK_STRING (filename); 499 500 /* If the file name has special constructs in it, 501 call the corresponding file handler. */ 502 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory); 503 if (!NILP (handler)) 504 return call2 (handler, Qfile_name_nondirectory, filename); 505 506 beg = SDATA (filename); 507 end = p = beg + SBYTES (filename); 508 509 while (p != beg && !IS_DIRECTORY_SEP (p[-1]) 510#ifdef VMS 511 && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' 512#endif /* VMS */ 513#ifdef DOS_NT 514 /* only recognise drive specifier at beginning */ 515 && !(p[-1] == ':' 516 /* handle the "/:d:foo" case correctly */ 517 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg)))) 518#endif 519 ) 520 p--; 521 522 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename)); 523} 524 525DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 526 Sunhandled_file_name_directory, 1, 1, 0, 527 doc: /* Return a directly usable directory name somehow associated with FILENAME. 528A `directly usable' directory name is one that may be used without the 529intervention of any file handler. 530If FILENAME is a directly usable file itself, return 531\(file-name-directory FILENAME). 532The `call-process' and `start-process' functions use this function to 533get a current directory to run processes in. */) 534 (filename) 535 Lisp_Object filename; 536{ 537 Lisp_Object handler; 538 539 /* If the file name has special constructs in it, 540 call the corresponding file handler. */ 541 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); 542 if (!NILP (handler)) 543 return call2 (handler, Qunhandled_file_name_directory, filename); 544 545 return Ffile_name_directory (filename); 546} 547 548 549char * 550file_name_as_directory (out, in) 551 char *out, *in; 552{ 553 int size = strlen (in) - 1; 554 555 strcpy (out, in); 556 557 if (size < 0) 558 { 559 out[0] = '.'; 560 out[1] = '/'; 561 out[2] = 0; 562 return out; 563 } 564 565#ifdef VMS 566 /* Is it already a directory string? */ 567 if (in[size] == ':' || in[size] == ']' || in[size] == '>') 568 return out; 569 /* Is it a VMS directory file name? If so, hack VMS syntax. */ 570 else if (! index (in, '/') 571 && ((size > 3 && ! strcmp (&in[size - 3], ".DIR")) 572 || (size > 3 && ! strcmp (&in[size - 3], ".dir")) 573 || (size > 5 && (! strncmp (&in[size - 5], ".DIR", 4) 574 || ! strncmp (&in[size - 5], ".dir", 4)) 575 && (in[size - 1] == '.' || in[size - 1] == ';') 576 && in[size] == '1'))) 577 { 578 register char *p, *dot; 579 char brack; 580 581 /* x.dir -> [.x] 582 dir:x.dir --> dir:[x] 583 dir:[x]y.dir --> dir:[x.y] */ 584 p = in + size; 585 while (p != in && *p != ':' && *p != '>' && *p != ']') p--; 586 if (p != in) 587 { 588 strncpy (out, in, p - in); 589 out[p - in] = '\0'; 590 if (*p == ':') 591 { 592 brack = ']'; 593 strcat (out, ":["); 594 } 595 else 596 { 597 brack = *p; 598 strcat (out, "."); 599 } 600 p++; 601 } 602 else 603 { 604 brack = ']'; 605 strcpy (out, "[."); 606 } 607 dot = index (p, '.'); 608 if (dot) 609 { 610 /* blindly remove any extension */ 611 size = strlen (out) + (dot - p); 612 strncat (out, p, dot - p); 613 } 614 else 615 { 616 strcat (out, p); 617 size = strlen (out); 618 } 619 out[size++] = brack; 620 out[size] = '\0'; 621 } 622#else /* not VMS */ 623 /* For Unix syntax, Append a slash if necessary */ 624 if (!IS_DIRECTORY_SEP (out[size])) 625 { 626 /* Cannot use DIRECTORY_SEP, which could have any value */ 627 out[size + 1] = '/'; 628 out[size + 2] = '\0'; 629 } 630#ifdef DOS_NT 631 CORRECT_DIR_SEPS (out); 632#endif 633#endif /* not VMS */ 634 return out; 635} 636 637DEFUN ("file-name-as-directory", Ffile_name_as_directory, 638 Sfile_name_as_directory, 1, 1, 0, 639 doc: /* Return a string representing the file name FILE interpreted as a directory. 640This operation exists because a directory is also a file, but its name as 641a directory is different from its name as a file. 642The result can be used as the value of `default-directory' 643or passed as second argument to `expand-file-name'. 644For a Unix-syntax file name, just appends a slash. 645On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */) 646 (file) 647 Lisp_Object file; 648{ 649 char *buf; 650 Lisp_Object handler; 651 652 CHECK_STRING (file); 653 if (NILP (file)) 654 return Qnil; 655 656 /* If the file name has special constructs in it, 657 call the corresponding file handler. */ 658 handler = Ffind_file_name_handler (file, Qfile_name_as_directory); 659 if (!NILP (handler)) 660 return call2 (handler, Qfile_name_as_directory, file); 661 662 buf = (char *) alloca (SBYTES (file) + 10); 663 file_name_as_directory (buf, SDATA (file)); 664 return make_specified_string (buf, -1, strlen (buf), 665 STRING_MULTIBYTE (file)); 666} 667 668/* 669 * Convert from directory name to filename. 670 * On VMS: 671 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1 672 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1 673 * On UNIX, it's simple: just make sure there isn't a terminating / 674 675 * Value is nonzero if the string output is different from the input. 676 */ 677 678int 679directory_file_name (src, dst) 680 char *src, *dst; 681{ 682 long slen; 683#ifdef VMS 684 long rlen; 685 char * ptr, * rptr; 686 char bracket; 687 struct FAB fab = cc$rms_fab; 688 struct NAM nam = cc$rms_nam; 689 char esa[NAM$C_MAXRSS]; 690#endif /* VMS */ 691 692 slen = strlen (src); 693#ifdef VMS 694 if (! index (src, '/') 695 && (src[slen - 1] == ']' 696 || src[slen - 1] == ':' 697 || src[slen - 1] == '>')) 698 { 699 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */ 700 fab.fab$l_fna = src; 701 fab.fab$b_fns = slen; 702 fab.fab$l_nam = &nam; 703 fab.fab$l_fop = FAB$M_NAM; 704 705 nam.nam$l_esa = esa; 706 nam.nam$b_ess = sizeof esa; 707 nam.nam$b_nop |= NAM$M_SYNCHK; 708 709 /* We call SYS$PARSE to handle such things as [--] for us. */ 710 if (SYS$PARSE (&fab, 0, 0) == RMS$_NORMAL) 711 { 712 slen = nam.nam$b_esl; 713 if (esa[slen - 1] == ';' && esa[slen - 2] == '.') 714 slen -= 2; 715 esa[slen] = '\0'; 716 src = esa; 717 } 718 if (src[slen - 1] != ']' && src[slen - 1] != '>') 719 { 720 /* what about when we have logical_name:???? */ 721 if (src[slen - 1] == ':') 722 { /* Xlate logical name and see what we get */ 723 ptr = strcpy (dst, src); /* upper case for getenv */ 724 while (*ptr) 725 { 726 if ('a' <= *ptr && *ptr <= 'z') 727 *ptr -= 040; 728 ptr++; 729 } 730 dst[slen - 1] = 0; /* remove colon */ 731 if (!(src = egetenv (dst))) 732 return 0; 733 /* should we jump to the beginning of this procedure? 734 Good points: allows us to use logical names that xlate 735 to Unix names, 736 Bad points: can be a problem if we just translated to a device 737 name... 738 For now, I'll punt and always expect VMS names, and hope for 739 the best! */ 740 slen = strlen (src); 741 if (src[slen - 1] != ']' && src[slen - 1] != '>') 742 { /* no recursion here! */ 743 strcpy (dst, src); 744 return 0; 745 } 746 } 747 else 748 { /* not a directory spec */ 749 strcpy (dst, src); 750 return 0; 751 } 752 } 753 bracket = src[slen - 1]; 754 755 /* If bracket is ']' or '>', bracket - 2 is the corresponding 756 opening bracket. */ 757 ptr = index (src, bracket - 2); 758 if (ptr == 0) 759 { /* no opening bracket */ 760 strcpy (dst, src); 761 return 0; 762 } 763 if (!(rptr = rindex (src, '.'))) 764 rptr = ptr; 765 slen = rptr - src; 766 strncpy (dst, src, slen); 767 dst[slen] = '\0'; 768 if (*rptr == '.') 769 { 770 dst[slen++] = bracket; 771 dst[slen] = '\0'; 772 } 773 else 774 { 775 /* If we have the top-level of a rooted directory (i.e. xx:[000000]), 776 then translate the device and recurse. */ 777 if (dst[slen - 1] == ':' 778 && dst[slen - 2] != ':' /* skip decnet nodes */ 779 && strcmp (src + slen, "[000000]") == 0) 780 { 781 dst[slen - 1] = '\0'; 782 if ((ptr = egetenv (dst)) 783 && (rlen = strlen (ptr) - 1) > 0 784 && (ptr[rlen] == ']' || ptr[rlen] == '>') 785 && ptr[rlen - 1] == '.') 786 { 787 char * buf = (char *) alloca (strlen (ptr) + 1); 788 strcpy (buf, ptr); 789 buf[rlen - 1] = ']'; 790 buf[rlen] = '\0'; 791 return directory_file_name (buf, dst); 792 } 793 else 794 dst[slen - 1] = ':'; 795 } 796 strcat (dst, "[000000]"); 797 slen += 8; 798 } 799 rptr++; 800 rlen = strlen (rptr) - 1; 801 strncat (dst, rptr, rlen); 802 dst[slen + rlen] = '\0'; 803 strcat (dst, ".DIR.1"); 804 return 1; 805 } 806#endif /* VMS */ 807 /* Process as Unix format: just remove any final slash. 808 But leave "/" unchanged; do not change it to "". */ 809 strcpy (dst, src); 810#ifdef APOLLO 811 /* Handle // as root for apollo's. */ 812 if ((slen > 2 && dst[slen - 1] == '/') 813 || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/')) 814 dst[slen - 1] = 0; 815#else 816 if (slen > 1 817 && IS_DIRECTORY_SEP (dst[slen - 1]) 818#ifdef DOS_NT 819 && !IS_ANY_SEP (dst[slen - 2]) 820#endif 821 ) 822 dst[slen - 1] = 0; 823#endif 824#ifdef DOS_NT 825 CORRECT_DIR_SEPS (dst); 826#endif 827 return 1; 828} 829 830DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, 831 1, 1, 0, 832 doc: /* Returns the file name of the directory named DIRECTORY. 833This is the name of the file that holds the data for the directory DIRECTORY. 834This operation exists because a directory is also a file, but its name as 835a directory is different from its name as a file. 836In Unix-syntax, this function just removes the final slash. 837On VMS, given a VMS-syntax directory name such as \"[X.Y]\", 838it returns a file name such as \"[X]Y.DIR.1\". */) 839 (directory) 840 Lisp_Object directory; 841{ 842 char *buf; 843 Lisp_Object handler; 844 845 CHECK_STRING (directory); 846 847 if (NILP (directory)) 848 return Qnil; 849 850 /* If the file name has special constructs in it, 851 call the corresponding file handler. */ 852 handler = Ffind_file_name_handler (directory, Qdirectory_file_name); 853 if (!NILP (handler)) 854 return call2 (handler, Qdirectory_file_name, directory); 855 856#ifdef VMS 857 /* 20 extra chars is insufficient for VMS, since we might perform a 858 logical name translation. an equivalence string can be up to 255 859 chars long, so grab that much extra space... - sss */ 860 buf = (char *) alloca (SBYTES (directory) + 20 + 255); 861#else 862 buf = (char *) alloca (SBYTES (directory) + 20); 863#endif 864 directory_file_name (SDATA (directory), buf); 865 return make_specified_string (buf, -1, strlen (buf), 866 STRING_MULTIBYTE (directory)); 867} 868 869static char make_temp_name_tbl[64] = 870{ 871 'A','B','C','D','E','F','G','H', 872 'I','J','K','L','M','N','O','P', 873 'Q','R','S','T','U','V','W','X', 874 'Y','Z','a','b','c','d','e','f', 875 'g','h','i','j','k','l','m','n', 876 'o','p','q','r','s','t','u','v', 877 'w','x','y','z','0','1','2','3', 878 '4','5','6','7','8','9','-','_' 879}; 880 881static unsigned make_temp_name_count, make_temp_name_count_initialized_p; 882 883/* Value is a temporary file name starting with PREFIX, a string. 884 885 The Emacs process number forms part of the result, so there is 886 no danger of generating a name being used by another process. 887 In addition, this function makes an attempt to choose a name 888 which has no existing file. To make this work, PREFIX should be 889 an absolute file name. 890 891 BASE64_P non-zero means add the pid as 3 characters in base64 892 encoding. In this case, 6 characters will be added to PREFIX to 893 form the file name. Otherwise, if Emacs is running on a system 894 with long file names, add the pid as a decimal number. 895 896 This function signals an error if no unique file name could be 897 generated. */ 898 899Lisp_Object 900make_temp_name (prefix, base64_p) 901 Lisp_Object prefix; 902 int base64_p; 903{ 904 Lisp_Object val; 905 int len, clen; 906 int pid; 907 unsigned char *p, *data; 908 char pidbuf[20]; 909 int pidlen; 910 911 CHECK_STRING (prefix); 912 913 /* VAL is created by adding 6 characters to PREFIX. The first 914 three are the PID of this process, in base 64, and the second 915 three are incremented if the file already exists. This ensures 916 262144 unique file names per PID per PREFIX. */ 917 918 pid = (int) getpid (); 919 920 if (base64_p) 921 { 922 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; 923 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; 924 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6; 925 pidlen = 3; 926 } 927 else 928 { 929#ifdef HAVE_LONG_FILE_NAMES 930 sprintf (pidbuf, "%d", pid); 931 pidlen = strlen (pidbuf); 932#else 933 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; 934 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; 935 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6; 936 pidlen = 3; 937#endif 938 } 939 940 len = SBYTES (prefix); clen = SCHARS (prefix); 941 val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen); 942 if (!STRING_MULTIBYTE (prefix)) 943 STRING_SET_UNIBYTE (val); 944 data = SDATA (val); 945 bcopy(SDATA (prefix), data, len); 946 p = data + len; 947 948 bcopy (pidbuf, p, pidlen); 949 p += pidlen; 950 951 /* Here we try to minimize useless stat'ing when this function is 952 invoked many times successively with the same PREFIX. We achieve 953 this by initializing count to a random value, and incrementing it 954 afterwards. 955 956 We don't want make-temp-name to be called while dumping, 957 because then make_temp_name_count_initialized_p would get set 958 and then make_temp_name_count would not be set when Emacs starts. */ 959 960 if (!make_temp_name_count_initialized_p) 961 { 962 make_temp_name_count = (unsigned) time (NULL); 963 make_temp_name_count_initialized_p = 1; 964 } 965 966 while (1) 967 { 968 struct stat ignored; 969 unsigned num = make_temp_name_count; 970 971 p[0] = make_temp_name_tbl[num & 63], num >>= 6; 972 p[1] = make_temp_name_tbl[num & 63], num >>= 6; 973 p[2] = make_temp_name_tbl[num & 63], num >>= 6; 974 975 /* Poor man's congruential RN generator. Replace with 976 ++make_temp_name_count for debugging. */ 977 make_temp_name_count += 25229; 978 make_temp_name_count %= 225307; 979 980 if (stat (data, &ignored) < 0) 981 { 982 /* We want to return only if errno is ENOENT. */ 983 if (errno == ENOENT) 984 return val; 985 else 986 /* The error here is dubious, but there is little else we 987 can do. The alternatives are to return nil, which is 988 as bad as (and in many cases worse than) throwing the 989 error, or to ignore the error, which will likely result 990 in looping through 225307 stat's, which is not only 991 dog-slow, but also useless since it will fallback to 992 the errow below, anyway. */ 993 report_file_error ("Cannot create temporary name for prefix", 994 Fcons (prefix, Qnil)); 995 /* not reached */ 996 } 997 } 998 999 error ("Cannot create temporary name for prefix `%s'", 1000 SDATA (prefix)); 1001 return Qnil; 1002} 1003 1004 1005DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, 1006 doc: /* Generate temporary file name (string) starting with PREFIX (a string). 1007The Emacs process number forms part of the result, 1008so there is no danger of generating a name being used by another process. 1009 1010In addition, this function makes an attempt to choose a name 1011which has no existing file. To make this work, 1012PREFIX should be an absolute file name. 1013 1014There is a race condition between calling `make-temp-name' and creating the 1015file which opens all kinds of security holes. For that reason, you should 1016probably use `make-temp-file' instead, except in three circumstances: 1017 1018* If you are creating the file in the user's home directory. 1019* If you are creating a directory rather than an ordinary file. 1020* If you are taking special precautions as `make-temp-file' does. */) 1021 (prefix) 1022 Lisp_Object prefix; 1023{ 1024 return make_temp_name (prefix, 0); 1025} 1026 1027 1028 1029DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, 1030 doc: /* Convert filename NAME to absolute, and canonicalize it. 1031Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative 1032\(does not start with slash); if DEFAULT-DIRECTORY is nil or missing, 1033the current buffer's value of `default-directory' is used. 1034File name components that are `.' are removed, and 1035so are file name components followed by `..', along with the `..' itself; 1036note that these simplifications are done without checking the resulting 1037file names in the file system. 1038An initial `~/' expands to your home directory. 1039An initial `~USER/' expands to USER's home directory. 1040See also the function `substitute-in-file-name'. */) 1041 (name, default_directory) 1042 Lisp_Object name, default_directory; 1043{ 1044 unsigned char *nm; 1045 1046 register unsigned char *newdir, *p, *o; 1047 int tlen; 1048 unsigned char *target; 1049 struct passwd *pw; 1050#ifdef VMS 1051 unsigned char * colon = 0; 1052 unsigned char * close = 0; 1053 unsigned char * slash = 0; 1054 unsigned char * brack = 0; 1055 int lbrack = 0, rbrack = 0; 1056 int dots = 0; 1057#endif /* VMS */ 1058#ifdef DOS_NT 1059 int drive = 0; 1060 int collapse_newdir = 1; 1061 int is_escaped = 0; 1062#endif /* DOS_NT */ 1063 int length; 1064 Lisp_Object handler, result; 1065 int multibyte; 1066 1067 CHECK_STRING (name); 1068 1069 /* If the file name has special constructs in it, 1070 call the corresponding file handler. */ 1071 handler = Ffind_file_name_handler (name, Qexpand_file_name); 1072 if (!NILP (handler)) 1073 return call3 (handler, Qexpand_file_name, name, default_directory); 1074 1075 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ 1076 if (NILP (default_directory)) 1077 default_directory = current_buffer->directory; 1078 if (! STRINGP (default_directory)) 1079 { 1080#ifdef DOS_NT 1081 /* "/" is not considered a root directory on DOS_NT, so using "/" 1082 here causes an infinite recursion in, e.g., the following: 1083 1084 (let (default-directory) 1085 (expand-file-name "a")) 1086 1087 To avoid this, we set default_directory to the root of the 1088 current drive. */ 1089 extern char *emacs_root_dir (void); 1090 1091 default_directory = build_string (emacs_root_dir ()); 1092#else 1093 default_directory = build_string ("/"); 1094#endif 1095 } 1096 1097 if (!NILP (default_directory)) 1098 { 1099 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name); 1100 if (!NILP (handler)) 1101 return call3 (handler, Qexpand_file_name, name, default_directory); 1102 } 1103 1104 o = SDATA (default_directory); 1105 1106 /* Make sure DEFAULT_DIRECTORY is properly expanded. 1107 It would be better to do this down below where we actually use 1108 default_directory. Unfortunately, calling Fexpand_file_name recursively 1109 could invoke GC, and the strings might be relocated. This would 1110 be annoying because we have pointers into strings lying around 1111 that would need adjusting, and people would add new pointers to 1112 the code and forget to adjust them, resulting in intermittent bugs. 1113 Putting this call here avoids all that crud. 1114 1115 The EQ test avoids infinite recursion. */ 1116 if (! NILP (default_directory) && !EQ (default_directory, name) 1117 /* Save time in some common cases - as long as default_directory 1118 is not relative, it can be canonicalized with name below (if it 1119 is needed at all) without requiring it to be expanded now. */ 1120#ifdef DOS_NT 1121 /* Detect MSDOS file names with drive specifiers. */ 1122 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])) 1123#ifdef WINDOWSNT 1124 /* Detect Windows file names in UNC format. */ 1125 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) 1126#endif 1127#else /* not DOS_NT */ 1128 /* Detect Unix absolute file names (/... alone is not absolute on 1129 DOS or Windows). */ 1130 && ! (IS_DIRECTORY_SEP (o[0])) 1131#endif /* not DOS_NT */ 1132 ) 1133 { 1134 struct gcpro gcpro1; 1135 1136 GCPRO1 (name); 1137 default_directory = Fexpand_file_name (default_directory, Qnil); 1138 UNGCPRO; 1139 } 1140 1141 name = FILE_SYSTEM_CASE (name); 1142 nm = SDATA (name); 1143 multibyte = STRING_MULTIBYTE (name); 1144 1145#ifdef DOS_NT 1146 /* We will force directory separators to be either all \ or /, so make 1147 a local copy to modify, even if there ends up being no change. */ 1148 nm = strcpy (alloca (strlen (nm) + 1), nm); 1149 1150 /* Note if special escape prefix is present, but remove for now. */ 1151 if (nm[0] == '/' && nm[1] == ':') 1152 { 1153 is_escaped = 1; 1154 nm += 2; 1155 } 1156 1157 /* Find and remove drive specifier if present; this makes nm absolute 1158 even if the rest of the name appears to be relative. Only look for 1159 drive specifier at the beginning. */ 1160 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1])) 1161 { 1162 drive = nm[0]; 1163 nm += 2; 1164 } 1165 1166#ifdef WINDOWSNT 1167 /* If we see "c://somedir", we want to strip the first slash after the 1168 colon when stripping the drive letter. Otherwise, this expands to 1169 "//somedir". */ 1170 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) 1171 nm++; 1172#endif /* WINDOWSNT */ 1173#endif /* DOS_NT */ 1174 1175#ifdef WINDOWSNT 1176 /* Discard any previous drive specifier if nm is now in UNC format. */ 1177 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) 1178 { 1179 drive = 0; 1180 } 1181#endif 1182 1183 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if 1184 none are found, we can probably return right away. We will avoid 1185 allocating a new string if name is already fully expanded. */ 1186 if ( 1187 IS_DIRECTORY_SEP (nm[0]) 1188#ifdef MSDOS 1189 && drive && !is_escaped 1190#endif 1191#ifdef WINDOWSNT 1192 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped 1193#endif 1194#ifdef VMS 1195 || index (nm, ':') 1196#endif /* VMS */ 1197 ) 1198 { 1199 /* If it turns out that the filename we want to return is just a 1200 suffix of FILENAME, we don't need to go through and edit 1201 things; we just need to construct a new string using data 1202 starting at the middle of FILENAME. If we set lose to a 1203 non-zero value, that means we've discovered that we can't do 1204 that cool trick. */ 1205 int lose = 0; 1206 1207 p = nm; 1208 while (*p) 1209 { 1210 /* Since we know the name is absolute, we can assume that each 1211 element starts with a "/". */ 1212 1213 /* "." and ".." are hairy. */ 1214 if (IS_DIRECTORY_SEP (p[0]) 1215 && p[1] == '.' 1216 && (IS_DIRECTORY_SEP (p[2]) 1217 || p[2] == 0 1218 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) 1219 || p[3] == 0)))) 1220 lose = 1; 1221 /* We want to replace multiple `/' in a row with a single 1222 slash. */ 1223 else if (p > nm 1224 && IS_DIRECTORY_SEP (p[0]) 1225 && IS_DIRECTORY_SEP (p[1])) 1226 lose = 1; 1227 1228#ifdef VMS 1229 if (p[0] == '\\') 1230 lose = 1; 1231 if (p[0] == '/') { 1232 /* if dev:[dir]/, move nm to / */ 1233 if (!slash && p > nm && (brack || colon)) { 1234 nm = (brack ? brack + 1 : colon + 1); 1235 lbrack = rbrack = 0; 1236 brack = 0; 1237 colon = 0; 1238 } 1239 slash = p; 1240 } 1241 if (p[0] == '-') 1242#ifdef NO_HYPHENS_IN_FILENAMES 1243 if (lbrack == rbrack) 1244 { 1245 /* Avoid clobbering negative version numbers. */ 1246 if (dots < 2) 1247 p[0] = '_'; 1248 } 1249 else 1250#endif /* NO_HYPHENS_IN_FILENAMES */ 1251 if (lbrack > rbrack 1252 && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') 1253 && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) 1254 lose = 1; 1255#ifdef NO_HYPHENS_IN_FILENAMES 1256 else 1257 p[0] = '_'; 1258#endif /* NO_HYPHENS_IN_FILENAMES */ 1259 /* count open brackets, reset close bracket pointer */ 1260 if (p[0] == '[' || p[0] == '<') 1261 lbrack++, brack = 0; 1262 /* count close brackets, set close bracket pointer */ 1263 if (p[0] == ']' || p[0] == '>') 1264 rbrack++, brack = p; 1265 /* detect ][ or >< */ 1266 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) 1267 lose = 1; 1268 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') 1269 nm = p + 1, lose = 1; 1270 if (p[0] == ':' && (colon || slash)) 1271 /* if dev1:[dir]dev2:, move nm to dev2: */ 1272 if (brack) 1273 { 1274 nm = brack + 1; 1275 brack = 0; 1276 } 1277 /* if /name/dev:, move nm to dev: */ 1278 else if (slash) 1279 nm = slash + 1; 1280 /* if node::dev:, move colon following dev */ 1281 else if (colon && colon[-1] == ':') 1282 colon = p; 1283 /* if dev1:dev2:, move nm to dev2: */ 1284 else if (colon && colon[-1] != ':') 1285 { 1286 nm = colon + 1; 1287 colon = 0; 1288 } 1289 if (p[0] == ':' && !colon) 1290 { 1291 if (p[1] == ':') 1292 p++; 1293 colon = p; 1294 } 1295 if (lbrack == rbrack) 1296 if (p[0] == ';') 1297 dots = 2; 1298 else if (p[0] == '.') 1299 dots++; 1300#endif /* VMS */ 1301 p++; 1302 } 1303 if (!lose) 1304 { 1305#ifdef VMS 1306 if (index (nm, '/')) 1307 { 1308 nm = sys_translate_unix (nm); 1309 return make_specified_string (nm, -1, strlen (nm), multibyte); 1310 } 1311#endif /* VMS */ 1312#ifdef DOS_NT 1313 /* Make sure directories are all separated with / or \ as 1314 desired, but avoid allocation of a new string when not 1315 required. */ 1316 CORRECT_DIR_SEPS (nm); 1317#ifdef WINDOWSNT 1318 if (IS_DIRECTORY_SEP (nm[1])) 1319 { 1320 if (strcmp (nm, SDATA (name)) != 0) 1321 name = make_specified_string (nm, -1, strlen (nm), multibyte); 1322 } 1323 else 1324#endif 1325 /* drive must be set, so this is okay */ 1326 if (strcmp (nm - 2, SDATA (name)) != 0) 1327 { 1328 char temp[] = " :"; 1329 1330 name = make_specified_string (nm, -1, p - nm, multibyte); 1331 temp[0] = DRIVE_LETTER (drive); 1332 name = concat2 (build_string (temp), name); 1333 } 1334 return name; 1335#else /* not DOS_NT */ 1336 if (nm == SDATA (name)) 1337 return name; 1338 return make_specified_string (nm, -1, strlen (nm), multibyte); 1339#endif /* not DOS_NT */ 1340 } 1341 } 1342 1343 /* At this point, nm might or might not be an absolute file name. We 1344 need to expand ~ or ~user if present, otherwise prefix nm with 1345 default_directory if nm is not absolute, and finally collapse /./ 1346 and /foo/../ sequences. 1347 1348 We set newdir to be the appropriate prefix if one is needed: 1349 - the relevant user directory if nm starts with ~ or ~user 1350 - the specified drive's working dir (DOS/NT only) if nm does not 1351 start with / 1352 - the value of default_directory. 1353 1354 Note that these prefixes are not guaranteed to be absolute (except 1355 for the working dir of a drive). Therefore, to ensure we always 1356 return an absolute name, if the final prefix is not absolute we 1357 append it to the current working directory. */ 1358 1359 newdir = 0; 1360 1361 if (nm[0] == '~') /* prefix ~ */ 1362 { 1363 if (IS_DIRECTORY_SEP (nm[1]) 1364#ifdef VMS 1365 || nm[1] == ':' 1366#endif /* VMS */ 1367 || nm[1] == 0) /* ~ by itself */ 1368 { 1369 if (!(newdir = (unsigned char *) egetenv ("HOME"))) 1370 newdir = (unsigned char *) ""; 1371 nm++; 1372#ifdef DOS_NT 1373 collapse_newdir = 0; 1374#endif 1375#ifdef VMS 1376 nm++; /* Don't leave the slash in nm. */ 1377#endif /* VMS */ 1378 } 1379 else /* ~user/filename */ 1380 { 1381 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p) 1382#ifdef VMS 1383 && *p != ':' 1384#endif /* VMS */ 1385 ); p++); 1386 o = (unsigned char *) alloca (p - nm + 1); 1387 bcopy ((char *) nm, o, p - nm); 1388 o [p - nm] = 0; 1389 1390 BLOCK_INPUT; 1391 pw = (struct passwd *) getpwnam (o + 1); 1392 UNBLOCK_INPUT; 1393 if (pw) 1394 { 1395 newdir = (unsigned char *) pw -> pw_dir; 1396#ifdef VMS 1397 nm = p + 1; /* skip the terminator */ 1398#else 1399 nm = p; 1400#ifdef DOS_NT 1401 collapse_newdir = 0; 1402#endif 1403#endif /* VMS */ 1404 } 1405 1406 /* If we don't find a user of that name, leave the name 1407 unchanged; don't move nm forward to p. */ 1408 } 1409 } 1410 1411#ifdef DOS_NT 1412 /* On DOS and Windows, nm is absolute if a drive name was specified; 1413 use the drive's current directory as the prefix if needed. */ 1414 if (!newdir && drive) 1415 { 1416 /* Get default directory if needed to make nm absolute. */ 1417 if (!IS_DIRECTORY_SEP (nm[0])) 1418 { 1419 newdir = alloca (MAXPATHLEN + 1); 1420 if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) 1421 newdir = NULL; 1422 } 1423 if (!newdir) 1424 { 1425 /* Either nm starts with /, or drive isn't mounted. */ 1426 newdir = alloca (4); 1427 newdir[0] = DRIVE_LETTER (drive); 1428 newdir[1] = ':'; 1429 newdir[2] = '/'; 1430 newdir[3] = 0; 1431 } 1432 } 1433#endif /* DOS_NT */ 1434 1435 /* Finally, if no prefix has been specified and nm is not absolute, 1436 then it must be expanded relative to default_directory. */ 1437 1438 if (1 1439#ifndef DOS_NT 1440 /* /... alone is not absolute on DOS and Windows. */ 1441 && !IS_DIRECTORY_SEP (nm[0]) 1442#endif 1443#ifdef WINDOWSNT 1444 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) 1445#endif 1446#ifdef VMS 1447 && !index (nm, ':') 1448#endif 1449 && !newdir) 1450 { 1451 newdir = SDATA (default_directory); 1452 multibyte |= STRING_MULTIBYTE (default_directory); 1453#ifdef DOS_NT 1454 /* Note if special escape prefix is present, but remove for now. */ 1455 if (newdir[0] == '/' && newdir[1] == ':') 1456 { 1457 is_escaped = 1; 1458 newdir += 2; 1459 } 1460#endif 1461 } 1462 1463#ifdef DOS_NT 1464 if (newdir) 1465 { 1466 /* First ensure newdir is an absolute name. */ 1467 if ( 1468 /* Detect MSDOS file names with drive specifiers. */ 1469 ! (IS_DRIVE (newdir[0]) 1470 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) 1471#ifdef WINDOWSNT 1472 /* Detect Windows file names in UNC format. */ 1473 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) 1474#endif 1475 ) 1476 { 1477 /* Effectively, let newdir be (expand-file-name newdir cwd). 1478 Because of the admonition against calling expand-file-name 1479 when we have pointers into lisp strings, we accomplish this 1480 indirectly by prepending newdir to nm if necessary, and using 1481 cwd (or the wd of newdir's drive) as the new newdir. */ 1482 1483 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1])) 1484 { 1485 drive = newdir[0]; 1486 newdir += 2; 1487 } 1488 if (!IS_DIRECTORY_SEP (nm[0])) 1489 { 1490 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2); 1491 file_name_as_directory (tmp, newdir); 1492 strcat (tmp, nm); 1493 nm = tmp; 1494 } 1495 newdir = alloca (MAXPATHLEN + 1); 1496 if (drive) 1497 { 1498 if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) 1499 newdir = "/"; 1500 } 1501 else 1502 getwd (newdir); 1503 } 1504 1505 /* Strip off drive name from prefix, if present. */ 1506 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1])) 1507 { 1508 drive = newdir[0]; 1509 newdir += 2; 1510 } 1511 1512 /* Keep only a prefix from newdir if nm starts with slash 1513 (//server/share for UNC, nothing otherwise). */ 1514 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir) 1515 { 1516#ifdef WINDOWSNT 1517 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) 1518 { 1519 newdir = strcpy (alloca (strlen (newdir) + 1), newdir); 1520 p = newdir + 2; 1521 while (*p && !IS_DIRECTORY_SEP (*p)) p++; 1522 p++; 1523 while (*p && !IS_DIRECTORY_SEP (*p)) p++; 1524 *p = 0; 1525 } 1526 else 1527#endif 1528 newdir = ""; 1529 } 1530 } 1531#endif /* DOS_NT */ 1532 1533 if (newdir) 1534 { 1535 /* Get rid of any slash at the end of newdir, unless newdir is 1536 just / or // (an incomplete UNC name). */ 1537 length = strlen (newdir); 1538 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) 1539#ifdef WINDOWSNT 1540 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) 1541#endif 1542 ) 1543 { 1544 unsigned char *temp = (unsigned char *) alloca (length); 1545 bcopy (newdir, temp, length - 1); 1546 temp[length - 1] = 0; 1547 newdir = temp; 1548 } 1549 tlen = length + 1; 1550 } 1551 else 1552 tlen = 0; 1553 1554 /* Now concatenate the directory and name to new space in the stack frame */ 1555 tlen += strlen (nm) + 1; 1556#ifdef DOS_NT 1557 /* Reserve space for drive specifier and escape prefix, since either 1558 or both may need to be inserted. (The Microsoft x86 compiler 1559 produces incorrect code if the following two lines are combined.) */ 1560 target = (unsigned char *) alloca (tlen + 4); 1561 target += 4; 1562#else /* not DOS_NT */ 1563 target = (unsigned char *) alloca (tlen); 1564#endif /* not DOS_NT */ 1565 *target = 0; 1566 1567 if (newdir) 1568 { 1569#ifndef VMS 1570 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) 1571 { 1572#ifdef DOS_NT 1573 /* If newdir is effectively "C:/", then the drive letter will have 1574 been stripped and newdir will be "/". Concatenating with an 1575 absolute directory in nm produces "//", which will then be 1576 incorrectly treated as a network share. Ignore newdir in 1577 this case (keeping the drive letter). */ 1578 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) 1579 && newdir[1] == '\0')) 1580#endif 1581 strcpy (target, newdir); 1582 } 1583 else 1584#endif 1585 file_name_as_directory (target, newdir); 1586 } 1587 1588 strcat (target, nm); 1589#ifdef VMS 1590 if (index (target, '/')) 1591 strcpy (target, sys_translate_unix (target)); 1592#endif /* VMS */ 1593 1594 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */ 1595 1596 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they 1597 appear. */ 1598 1599 p = target; 1600 o = target; 1601 1602 while (*p) 1603 { 1604#ifdef VMS 1605 if (*p != ']' && *p != '>' && *p != '-') 1606 { 1607 if (*p == '\\') 1608 p++; 1609 *o++ = *p++; 1610 } 1611 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) 1612 /* brackets are offset from each other by 2 */ 1613 { 1614 p += 2; 1615 if (*p != '.' && *p != '-' && o[-1] != '.') 1616 /* convert [foo][bar] to [bar] */ 1617 while (o[-1] != '[' && o[-1] != '<') 1618 o--; 1619 else if (*p == '-' && *o != '.') 1620 *--p = '.'; 1621 } 1622 else if (p[0] == '-' && o[-1] == '.' 1623 && (p[1] == '.' || p[1] == ']' || p[1] == '>')) 1624 /* flush .foo.- ; leave - if stopped by '[' or '<' */ 1625 { 1626 do 1627 o--; 1628 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); 1629 if (p[1] == '.') /* foo.-.bar ==> bar. */ 1630 p += 2; 1631 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ 1632 p++, o--; 1633 /* else [foo.-] ==> [-] */ 1634 } 1635 else 1636 { 1637#ifdef NO_HYPHENS_IN_FILENAMES 1638 if (*p == '-' 1639 && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' 1640 && p[1] != ']' && p[1] != '>' && p[1] != '.') 1641 *p = '_'; 1642#endif /* NO_HYPHENS_IN_FILENAMES */ 1643 *o++ = *p++; 1644 } 1645#else /* not VMS */ 1646 if (!IS_DIRECTORY_SEP (*p)) 1647 { 1648 *o++ = *p++; 1649 } 1650 else if (p[1] == '.' 1651 && (IS_DIRECTORY_SEP (p[2]) 1652 || p[2] == 0)) 1653 { 1654 /* If "/." is the entire filename, keep the "/". Otherwise, 1655 just delete the whole "/.". */ 1656 if (o == target && p[2] == '\0') 1657 *o++ = *p; 1658 p += 2; 1659 } 1660 else if (p[1] == '.' && p[2] == '.' 1661 /* `/../' is the "superroot" on certain file systems. 1662 Turned off on DOS_NT systems because they have no 1663 "superroot" and because this causes us to produce 1664 file names like "d:/../foo" which fail file-related 1665 functions of the underlying OS. (To reproduce, try a 1666 long series of "../../" in default_directory, longer 1667 than the number of levels from the root.) */ 1668#ifndef DOS_NT 1669 && o != target 1670#endif 1671 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) 1672 { 1673 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) 1674 ; 1675 /* Keep initial / only if this is the whole name. */ 1676 if (o == target && IS_ANY_SEP (*o) && p[3] == 0) 1677 ++o; 1678 p += 3; 1679 } 1680 else if (p > target && IS_DIRECTORY_SEP (p[1])) 1681 /* Collapse multiple `/' in a row. */ 1682 p++; 1683 else 1684 { 1685 *o++ = *p++; 1686 } 1687#endif /* not VMS */ 1688 } 1689 1690#ifdef DOS_NT 1691 /* At last, set drive name. */ 1692#ifdef WINDOWSNT 1693 /* Except for network file name. */ 1694 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]))) 1695#endif /* WINDOWSNT */ 1696 { 1697 if (!drive) abort (); 1698 target -= 2; 1699 target[0] = DRIVE_LETTER (drive); 1700 target[1] = ':'; 1701 } 1702 /* Reinsert the escape prefix if required. */ 1703 if (is_escaped) 1704 { 1705 target -= 2; 1706 target[0] = '/'; 1707 target[1] = ':'; 1708 } 1709 CORRECT_DIR_SEPS (target); 1710#endif /* DOS_NT */ 1711 1712 result = make_specified_string (target, -1, o - target, multibyte); 1713 1714 /* Again look to see if the file name has special constructs in it 1715 and perhaps call the corresponding file handler. This is needed 1716 for filenames such as "/foo/../user@host:/bar/../baz". Expanding 1717 the ".." component gives us "/user@host:/bar/../baz" which needs 1718 to be expanded again. */ 1719 handler = Ffind_file_name_handler (result, Qexpand_file_name); 1720 if (!NILP (handler)) 1721 return call3 (handler, Qexpand_file_name, result, default_directory); 1722 1723 return result; 1724} 1725 1726#if 0 1727/* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION! 1728 This is the old version of expand-file-name, before it was thoroughly 1729 rewritten for Emacs 10.31. We leave this version here commented-out, 1730 because the code is very complex and likely to have subtle bugs. If 1731 bugs _are_ found, it might be of interest to look at the old code and 1732 see what did it do in the relevant situation. 1733 1734 Don't remove this code: it's true that it will be accessible via CVS, 1735 but a few years from deletion, people will forget it is there. */ 1736 1737/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */ 1738DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, 1739 "Convert FILENAME to absolute, and canonicalize it.\n\ 1740Second arg DEFAULT is directory to start with if FILENAME is relative\n\ 1741\(does not start with slash); if DEFAULT is nil or missing,\n\ 1742the current buffer's value of default-directory is used.\n\ 1743Filenames containing `.' or `..' as components are simplified;\n\ 1744initial `~/' expands to your home directory.\n\ 1745See also the function `substitute-in-file-name'.") 1746 (name, defalt) 1747 Lisp_Object name, defalt; 1748{ 1749 unsigned char *nm; 1750 1751 register unsigned char *newdir, *p, *o; 1752 int tlen; 1753 unsigned char *target; 1754 struct passwd *pw; 1755 int lose; 1756#ifdef VMS 1757 unsigned char * colon = 0; 1758 unsigned char * close = 0; 1759 unsigned char * slash = 0; 1760 unsigned char * brack = 0; 1761 int lbrack = 0, rbrack = 0; 1762 int dots = 0; 1763#endif /* VMS */ 1764 1765 CHECK_STRING (name); 1766 1767#ifdef VMS 1768 /* Filenames on VMS are always upper case. */ 1769 name = Fupcase (name); 1770#endif 1771 1772 nm = SDATA (name); 1773 1774 /* If nm is absolute, flush ...// and detect /./ and /../. 1775 If no /./ or /../ we can return right away. */ 1776 if ( 1777 nm[0] == '/' 1778#ifdef VMS 1779 || index (nm, ':') 1780#endif /* VMS */ 1781 ) 1782 { 1783 p = nm; 1784 lose = 0; 1785 while (*p) 1786 { 1787 if (p[0] == '/' && p[1] == '/' 1788#ifdef APOLLO 1789 /* // at start of filename is meaningful on Apollo system. */ 1790 && nm != p 1791#endif /* APOLLO */ 1792 ) 1793 nm = p + 1; 1794 if (p[0] == '/' && p[1] == '~') 1795 nm = p + 1, lose = 1; 1796 if (p[0] == '/' && p[1] == '.' 1797 && (p[2] == '/' || p[2] == 0 1798 || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) 1799 lose = 1; 1800#ifdef VMS 1801 if (p[0] == '\\') 1802 lose = 1; 1803 if (p[0] == '/') { 1804 /* if dev:[dir]/, move nm to / */ 1805 if (!slash && p > nm && (brack || colon)) { 1806 nm = (brack ? brack + 1 : colon + 1); 1807 lbrack = rbrack = 0; 1808 brack = 0; 1809 colon = 0; 1810 } 1811 slash = p; 1812 } 1813 if (p[0] == '-') 1814#ifndef VMS4_4 1815 /* VMS pre V4.4,convert '-'s in filenames. */ 1816 if (lbrack == rbrack) 1817 { 1818 if (dots < 2) /* this is to allow negative version numbers */ 1819 p[0] = '_'; 1820 } 1821 else 1822#endif /* VMS4_4 */ 1823 if (lbrack > rbrack 1824 && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') 1825 && (p[1] == '.' || p[1] == ']' || p[1] == '>'))) 1826 lose = 1; 1827#ifndef VMS4_4 1828 else 1829 p[0] = '_'; 1830#endif /* VMS4_4 */ 1831 /* count open brackets, reset close bracket pointer */ 1832 if (p[0] == '[' || p[0] == '<') 1833 lbrack++, brack = 0; 1834 /* count close brackets, set close bracket pointer */ 1835 if (p[0] == ']' || p[0] == '>') 1836 rbrack++, brack = p; 1837 /* detect ][ or >< */ 1838 if ((p[0] == ']' || p[0] == '>') && (p[1] == '[' || p[1] == '<')) 1839 lose = 1; 1840 if ((p[0] == ':' || p[0] == ']' || p[0] == '>') && p[1] == '~') 1841 nm = p + 1, lose = 1; 1842 if (p[0] == ':' && (colon || slash)) 1843 /* if dev1:[dir]dev2:, move nm to dev2: */ 1844 if (brack) 1845 { 1846 nm = brack + 1; 1847 brack = 0; 1848 } 1849 /* If /name/dev:, move nm to dev: */ 1850 else if (slash) 1851 nm = slash + 1; 1852 /* If node::dev:, move colon following dev */ 1853 else if (colon && colon[-1] == ':') 1854 colon = p; 1855 /* If dev1:dev2:, move nm to dev2: */ 1856 else if (colon && colon[-1] != ':') 1857 { 1858 nm = colon + 1; 1859 colon = 0; 1860 } 1861 if (p[0] == ':' && !colon) 1862 { 1863 if (p[1] == ':') 1864 p++; 1865 colon = p; 1866 } 1867 if (lbrack == rbrack) 1868 if (p[0] == ';') 1869 dots = 2; 1870 else if (p[0] == '.') 1871 dots++; 1872#endif /* VMS */ 1873 p++; 1874 } 1875 if (!lose) 1876 { 1877#ifdef VMS 1878 if (index (nm, '/')) 1879 return build_string (sys_translate_unix (nm)); 1880#endif /* VMS */ 1881 if (nm == SDATA (name)) 1882 return name; 1883 return build_string (nm); 1884 } 1885 } 1886 1887 /* Now determine directory to start with and put it in NEWDIR */ 1888 1889 newdir = 0; 1890 1891 if (nm[0] == '~') /* prefix ~ */ 1892 if (nm[1] == '/' 1893#ifdef VMS 1894 || nm[1] == ':' 1895#endif /* VMS */ 1896 || nm[1] == 0)/* ~/filename */ 1897 { 1898 if (!(newdir = (unsigned char *) egetenv ("HOME"))) 1899 newdir = (unsigned char *) ""; 1900 nm++; 1901#ifdef VMS 1902 nm++; /* Don't leave the slash in nm. */ 1903#endif /* VMS */ 1904 } 1905 else /* ~user/filename */ 1906 { 1907 /* Get past ~ to user */ 1908 unsigned char *user = nm + 1; 1909 /* Find end of name. */ 1910 unsigned char *ptr = (unsigned char *) index (user, '/'); 1911 int len = ptr ? ptr - user : strlen (user); 1912#ifdef VMS 1913 unsigned char *ptr1 = index (user, ':'); 1914 if (ptr1 != 0 && ptr1 - user < len) 1915 len = ptr1 - user; 1916#endif /* VMS */ 1917 /* Copy the user name into temp storage. */ 1918 o = (unsigned char *) alloca (len + 1); 1919 bcopy ((char *) user, o, len); 1920 o[len] = 0; 1921 1922 /* Look up the user name. */ 1923 BLOCK_INPUT; 1924 pw = (struct passwd *) getpwnam (o + 1); 1925 UNBLOCK_INPUT; 1926 if (!pw) 1927 error ("\"%s\" isn't a registered user", o + 1); 1928 1929 newdir = (unsigned char *) pw->pw_dir; 1930 1931 /* Discard the user name from NM. */ 1932 nm += len; 1933 } 1934 1935 if (nm[0] != '/' 1936#ifdef VMS 1937 && !index (nm, ':') 1938#endif /* not VMS */ 1939 && !newdir) 1940 { 1941 if (NILP (defalt)) 1942 defalt = current_buffer->directory; 1943 CHECK_STRING (defalt); 1944 newdir = SDATA (defalt); 1945 } 1946 1947 /* Now concatenate the directory and name to new space in the stack frame */ 1948 1949 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1; 1950 target = (unsigned char *) alloca (tlen); 1951 *target = 0; 1952 1953 if (newdir) 1954 { 1955#ifndef VMS 1956 if (nm[0] == 0 || nm[0] == '/') 1957 strcpy (target, newdir); 1958 else 1959#endif 1960 file_name_as_directory (target, newdir); 1961 } 1962 1963 strcat (target, nm); 1964#ifdef VMS 1965 if (index (target, '/')) 1966 strcpy (target, sys_translate_unix (target)); 1967#endif /* VMS */ 1968 1969 /* Now canonicalize by removing /. and /foo/.. if they appear */ 1970 1971 p = target; 1972 o = target; 1973 1974 while (*p) 1975 { 1976#ifdef VMS 1977 if (*p != ']' && *p != '>' && *p != '-') 1978 { 1979 if (*p == '\\') 1980 p++; 1981 *o++ = *p++; 1982 } 1983 else if ((p[0] == ']' || p[0] == '>') && p[0] == p[1] + 2) 1984 /* brackets are offset from each other by 2 */ 1985 { 1986 p += 2; 1987 if (*p != '.' && *p != '-' && o[-1] != '.') 1988 /* convert [foo][bar] to [bar] */ 1989 while (o[-1] != '[' && o[-1] != '<') 1990 o--; 1991 else if (*p == '-' && *o != '.') 1992 *--p = '.'; 1993 } 1994 else if (p[0] == '-' && o[-1] == '.' 1995 && (p[1] == '.' || p[1] == ']' || p[1] == '>')) 1996 /* flush .foo.- ; leave - if stopped by '[' or '<' */ 1997 { 1998 do 1999 o--; 2000 while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<'); 2001 if (p[1] == '.') /* foo.-.bar ==> bar. */ 2002 p += 2; 2003 else if (o[-1] == '.') /* '.foo.-]' ==> ']' */ 2004 p++, o--; 2005 /* else [foo.-] ==> [-] */ 2006 } 2007 else 2008 { 2009#ifndef VMS4_4 2010 if (*p == '-' 2011 && o[-1] != '[' && o[-1] != '<' && o[-1] != '.' 2012 && p[1] != ']' && p[1] != '>' && p[1] != '.') 2013 *p = '_'; 2014#endif /* VMS4_4 */ 2015 *o++ = *p++; 2016 } 2017#else /* not VMS */ 2018 if (*p != '/') 2019 { 2020 *o++ = *p++; 2021 } 2022 else if (!strncmp (p, "//", 2) 2023#ifdef APOLLO 2024 /* // at start of filename is meaningful in Apollo system. */ 2025 && o != target 2026#endif /* APOLLO */ 2027 ) 2028 { 2029 o = target; 2030 p++; 2031 } 2032 else if (p[0] == '/' && p[1] == '.' 2033 && (p[2] == '/' || p[2] == 0)) 2034 p += 2; 2035 else if (!strncmp (p, "/..", 3) 2036 /* `/../' is the "superroot" on certain file systems. */ 2037 && o != target 2038 && (p[3] == '/' || p[3] == 0)) 2039 { 2040 while (o != target && *--o != '/') 2041 ; 2042#ifdef APOLLO 2043 if (o == target + 1 && o[-1] == '/' && o[0] == '/') 2044 ++o; 2045 else 2046#endif /* APOLLO */ 2047 if (o == target && *o == '/') 2048 ++o; 2049 p += 3; 2050 } 2051 else 2052 { 2053 *o++ = *p++; 2054 } 2055#endif /* not VMS */ 2056 } 2057 2058 return make_string (target, o - target); 2059} 2060#endif 2061 2062/* If /~ or // appears, discard everything through first slash. */ 2063static int 2064file_name_absolute_p (filename) 2065 const unsigned char *filename; 2066{ 2067 return 2068 (IS_DIRECTORY_SEP (*filename) || *filename == '~' 2069#ifdef VMS 2070 /* ??? This criterion is probably wrong for '<'. */ 2071 || index (filename, ':') || index (filename, '<') 2072 || (*filename == '[' && (filename[1] != '-' 2073 || (filename[2] != '.' && filename[2] != ']')) 2074 && filename[1] != '.') 2075#endif /* VMS */ 2076#ifdef DOS_NT 2077 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1]) 2078 && IS_DIRECTORY_SEP (filename[2])) 2079#endif 2080 ); 2081} 2082 2083static unsigned char * 2084search_embedded_absfilename (nm, endp) 2085 unsigned char *nm, *endp; 2086{ 2087 unsigned char *p, *s; 2088 2089 for (p = nm + 1; p < endp; p++) 2090 { 2091 if ((0 2092#ifdef VMS 2093 || p[-1] == ':' || p[-1] == ']' || p[-1] == '>' 2094#endif /* VMS */ 2095 || IS_DIRECTORY_SEP (p[-1])) 2096 && file_name_absolute_p (p) 2097#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) 2098 /* // at start of file name is meaningful in Apollo, 2099 WindowsNT and Cygwin systems. */ 2100 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm) 2101#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ 2102 ) 2103 { 2104 for (s = p; *s && (!IS_DIRECTORY_SEP (*s) 2105#ifdef VMS 2106 && *s != ':' 2107#endif /* VMS */ 2108 ); s++); 2109 if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */ 2110 { 2111 unsigned char *o = alloca (s - p + 1); 2112 struct passwd *pw; 2113 bcopy (p, o, s - p); 2114 o [s - p] = 0; 2115 2116 /* If we have ~user and `user' exists, discard 2117 everything up to ~. But if `user' does not exist, leave 2118 ~user alone, it might be a literal file name. */ 2119 BLOCK_INPUT; 2120 pw = getpwnam (o + 1); 2121 UNBLOCK_INPUT; 2122 if (pw) 2123 return p; 2124 } 2125 else 2126 return p; 2127 } 2128 } 2129 return NULL; 2130} 2131 2132DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 2133 Ssubstitute_in_file_name, 1, 1, 0, 2134 doc: /* Substitute environment variables referred to in FILENAME. 2135`$FOO' where FOO is an environment variable name means to substitute 2136the value of that variable. The variable name should be terminated 2137with a character not a letter, digit or underscore; otherwise, enclose 2138the entire variable name in braces. 2139If `/~' appears, all of FILENAME through that `/' is discarded. 2140 2141On VMS, `$' substitution is not done; this function does little and only 2142duplicates what `expand-file-name' does. */) 2143 (filename) 2144 Lisp_Object filename; 2145{ 2146 unsigned char *nm; 2147 2148 register unsigned char *s, *p, *o, *x, *endp; 2149 unsigned char *target = NULL; 2150 int total = 0; 2151 int substituted = 0; 2152 unsigned char *xnm; 2153 Lisp_Object handler; 2154 2155 CHECK_STRING (filename); 2156 2157 /* If the file name has special constructs in it, 2158 call the corresponding file handler. */ 2159 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name); 2160 if (!NILP (handler)) 2161 return call2 (handler, Qsubstitute_in_file_name, filename); 2162 2163 nm = SDATA (filename); 2164#ifdef DOS_NT 2165 nm = strcpy (alloca (strlen (nm) + 1), nm); 2166 CORRECT_DIR_SEPS (nm); 2167 substituted = (strcmp (nm, SDATA (filename)) != 0); 2168#endif 2169 endp = nm + SBYTES (filename); 2170 2171 /* If /~ or // appears, discard everything through first slash. */ 2172 p = search_embedded_absfilename (nm, endp); 2173 if (p) 2174 /* Start over with the new string, so we check the file-name-handler 2175 again. Important with filenames like "/home/foo//:/hello///there" 2176 which whould substitute to "/:/hello///there" rather than "/there". */ 2177 return Fsubstitute_in_file_name 2178 (make_specified_string (p, -1, endp - p, 2179 STRING_MULTIBYTE (filename))); 2180 2181#ifdef VMS 2182 return filename; 2183#else 2184 2185 /* See if any variables are substituted into the string 2186 and find the total length of their values in `total' */ 2187 2188 for (p = nm; p != endp;) 2189 if (*p != '$') 2190 p++; 2191 else 2192 { 2193 p++; 2194 if (p == endp) 2195 goto badsubst; 2196 else if (*p == '$') 2197 { 2198 /* "$$" means a single "$" */ 2199 p++; 2200 total -= 1; 2201 substituted = 1; 2202 continue; 2203 } 2204 else if (*p == '{') 2205 { 2206 o = ++p; 2207 while (p != endp && *p != '}') p++; 2208 if (*p != '}') goto missingclose; 2209 s = p; 2210 } 2211 else 2212 { 2213 o = p; 2214 while (p != endp && (isalnum (*p) || *p == '_')) p++; 2215 s = p; 2216 } 2217 2218 /* Copy out the variable name */ 2219 target = (unsigned char *) alloca (s - o + 1); 2220 strncpy (target, o, s - o); 2221 target[s - o] = 0; 2222#ifdef DOS_NT 2223 strupr (target); /* $home == $HOME etc. */ 2224#endif /* DOS_NT */ 2225 2226 /* Get variable value */ 2227 o = (unsigned char *) egetenv (target); 2228 if (o) 2229 { 2230 total += strlen (o); 2231 substituted = 1; 2232 } 2233 else if (*p == '}') 2234 goto badvar; 2235 } 2236 2237 if (!substituted) 2238 return filename; 2239 2240 /* If substitution required, recopy the string and do it */ 2241 /* Make space in stack frame for the new copy */ 2242 xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1); 2243 x = xnm; 2244 2245 /* Copy the rest of the name through, replacing $ constructs with values */ 2246 for (p = nm; *p;) 2247 if (*p != '$') 2248 *x++ = *p++; 2249 else 2250 { 2251 p++; 2252 if (p == endp) 2253 goto badsubst; 2254 else if (*p == '$') 2255 { 2256 *x++ = *p++; 2257 continue; 2258 } 2259 else if (*p == '{') 2260 { 2261 o = ++p; 2262 while (p != endp && *p != '}') p++; 2263 if (*p != '}') goto missingclose; 2264 s = p++; 2265 } 2266 else 2267 { 2268 o = p; 2269 while (p != endp && (isalnum (*p) || *p == '_')) p++; 2270 s = p; 2271 } 2272 2273 /* Copy out the variable name */ 2274 target = (unsigned char *) alloca (s - o + 1); 2275 strncpy (target, o, s - o); 2276 target[s - o] = 0; 2277#ifdef DOS_NT 2278 strupr (target); /* $home == $HOME etc. */ 2279#endif /* DOS_NT */ 2280 2281 /* Get variable value */ 2282 o = (unsigned char *) egetenv (target); 2283 if (!o) 2284 { 2285 *x++ = '$'; 2286 strcpy (x, target); x+= strlen (target); 2287 } 2288 else if (STRING_MULTIBYTE (filename)) 2289 { 2290 /* If the original string is multibyte, 2291 convert what we substitute into multibyte. */ 2292 while (*o) 2293 { 2294 int c = unibyte_char_to_multibyte (*o++); 2295 x += CHAR_STRING (c, x); 2296 } 2297 } 2298 else 2299 { 2300 strcpy (x, o); 2301 x += strlen (o); 2302 } 2303 } 2304 2305 *x = 0; 2306 2307 /* If /~ or // appears, discard everything through first slash. */ 2308 while ((p = search_embedded_absfilename (xnm, x))) 2309 /* This time we do not start over because we've already expanded envvars 2310 and replaced $$ with $. Maybe we should start over as well, but we'd 2311 need to quote some $ to $$ first. */ 2312 xnm = p; 2313 2314 return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename)); 2315 2316 badsubst: 2317 error ("Bad format environment-variable substitution"); 2318 missingclose: 2319 error ("Missing \"}\" in environment-variable substitution"); 2320 badvar: 2321 error ("Substituting nonexistent environment variable \"%s\"", target); 2322 2323 /* NOTREACHED */ 2324#endif /* not VMS */ 2325 return Qnil; 2326} 2327 2328/* A slightly faster and more convenient way to get 2329 (directory-file-name (expand-file-name FOO)). */ 2330 2331Lisp_Object 2332expand_and_dir_to_file (filename, defdir) 2333 Lisp_Object filename, defdir; 2334{ 2335 register Lisp_Object absname; 2336 2337 absname = Fexpand_file_name (filename, defdir); 2338#ifdef VMS 2339 { 2340 register int c = SREF (absname, SBYTES (absname) - 1); 2341 if (c == ':' || c == ']' || c == '>') 2342 absname = Fdirectory_file_name (absname); 2343 } 2344#else 2345 /* Remove final slash, if any (unless this is the root dir). 2346 stat behaves differently depending! */ 2347 if (SCHARS (absname) > 1 2348 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1)) 2349 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2))) 2350 /* We cannot take shortcuts; they might be wrong for magic file names. */ 2351 absname = Fdirectory_file_name (absname); 2352#endif 2353 return absname; 2354} 2355 2356/* Signal an error if the file ABSNAME already exists. 2357 If INTERACTIVE is nonzero, ask the user whether to proceed, 2358 and bypass the error if the user says to go ahead. 2359 QUERYSTRING is a name for the action that is being considered 2360 to alter the file. 2361 2362 *STATPTR is used to store the stat information if the file exists. 2363 If the file does not exist, STATPTR->st_mode is set to 0. 2364 If STATPTR is null, we don't store into it. 2365 2366 If QUICK is nonzero, we ask for y or n, not yes or no. */ 2367 2368void 2369barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) 2370 Lisp_Object absname; 2371 unsigned char *querystring; 2372 int interactive; 2373 struct stat *statptr; 2374 int quick; 2375{ 2376 register Lisp_Object tem, encoded_filename; 2377 struct stat statbuf; 2378 struct gcpro gcpro1; 2379 2380 encoded_filename = ENCODE_FILE (absname); 2381 2382 /* stat is a good way to tell whether the file exists, 2383 regardless of what access permissions it has. */ 2384 if (lstat (SDATA (encoded_filename), &statbuf) >= 0) 2385 { 2386 if (! interactive) 2387 xsignal2 (Qfile_already_exists, 2388 build_string ("File already exists"), absname); 2389 GCPRO1 (absname); 2390 tem = format2 ("File %s already exists; %s anyway? ", 2391 absname, build_string (querystring)); 2392 if (quick) 2393 tem = Fy_or_n_p (tem); 2394 else 2395 tem = do_yes_or_no_p (tem); 2396 UNGCPRO; 2397 if (NILP (tem)) 2398 xsignal2 (Qfile_already_exists, 2399 build_string ("File already exists"), absname); 2400 if (statptr) 2401 *statptr = statbuf; 2402 } 2403 else 2404 { 2405 if (statptr) 2406 statptr->st_mode = 0; 2407 } 2408 return; 2409} 2410 2411DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5, 2412 "fCopy file: \nGCopy %s to file: \np\nP", 2413 doc: /* Copy FILE to NEWNAME. Both args must be strings. 2414If NEWNAME names a directory, copy FILE there. 2415 2416This function always sets the file modes of the output file to match 2417the input file. 2418 2419The optional third argument OK-IF-ALREADY-EXISTS specifies what to do 2420if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we 2421signal a `file-already-exists' error without overwriting. If 2422OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user 2423about overwriting; this is what happens in interactive use with M-x. 2424Any other value for OK-IF-ALREADY-EXISTS means to overwrite the 2425existing file. 2426 2427Fourth arg KEEP-TIME non-nil means give the output file the same 2428last-modified time as the old one. (This works on only some systems.) 2429 2430A prefix arg makes KEEP-TIME non-nil. 2431 2432If PRESERVE-UID-GID is non-nil, we try to transfer the 2433uid and gid of FILE to NEWNAME. */) 2434 (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid) 2435 Lisp_Object file, newname, ok_if_already_exists, keep_time; 2436 Lisp_Object preserve_uid_gid; 2437{ 2438 int ifd, ofd, n; 2439 char buf[16 * 1024]; 2440 struct stat st, out_st; 2441 Lisp_Object handler; 2442 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 2443 int count = SPECPDL_INDEX (); 2444 int input_file_statable_p; 2445 Lisp_Object encoded_file, encoded_newname; 2446 2447 encoded_file = encoded_newname = Qnil; 2448 GCPRO4 (file, newname, encoded_file, encoded_newname); 2449 CHECK_STRING (file); 2450 CHECK_STRING (newname); 2451 2452 if (!NILP (Ffile_directory_p (newname))) 2453 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); 2454 else 2455 newname = Fexpand_file_name (newname, Qnil); 2456 2457 file = Fexpand_file_name (file, Qnil); 2458 2459 /* If the input file name has special constructs in it, 2460 call the corresponding file handler. */ 2461 handler = Ffind_file_name_handler (file, Qcopy_file); 2462 /* Likewise for output file name. */ 2463 if (NILP (handler)) 2464 handler = Ffind_file_name_handler (newname, Qcopy_file); 2465 if (!NILP (handler)) 2466 RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname, 2467 ok_if_already_exists, keep_time)); 2468 2469 encoded_file = ENCODE_FILE (file); 2470 encoded_newname = ENCODE_FILE (newname); 2471 2472 if (NILP (ok_if_already_exists) 2473 || INTEGERP (ok_if_already_exists)) 2474 barf_or_query_if_file_exists (newname, "copy to it", 2475 INTEGERP (ok_if_already_exists), &out_st, 0); 2476 else if (stat (SDATA (encoded_newname), &out_st) < 0) 2477 out_st.st_mode = 0; 2478 2479#ifdef WINDOWSNT 2480 if (!CopyFile (SDATA (encoded_file), 2481 SDATA (encoded_newname), 2482 FALSE)) 2483 report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); 2484 /* CopyFile retains the timestamp by default. */ 2485 else if (NILP (keep_time)) 2486 { 2487 EMACS_TIME now; 2488 DWORD attributes; 2489 char * filename; 2490 2491 EMACS_GET_TIME (now); 2492 filename = SDATA (encoded_newname); 2493 2494 /* Ensure file is writable while its modified time is set. */ 2495 attributes = GetFileAttributes (filename); 2496 SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY); 2497 if (set_file_times (filename, now, now)) 2498 { 2499 /* Restore original attributes. */ 2500 SetFileAttributes (filename, attributes); 2501 xsignal2 (Qfile_date_error, 2502 build_string ("Cannot set file date"), newname); 2503 } 2504 /* Restore original attributes. */ 2505 SetFileAttributes (filename, attributes); 2506 } 2507#else /* not WINDOWSNT */ 2508 immediate_quit = 1; 2509 ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0); 2510 immediate_quit = 0; 2511 2512 if (ifd < 0) 2513 report_file_error ("Opening input file", Fcons (file, Qnil)); 2514 2515 record_unwind_protect (close_file_unwind, make_number (ifd)); 2516 2517 /* We can only copy regular files and symbolic links. Other files are not 2518 copyable by us. */ 2519 input_file_statable_p = (fstat (ifd, &st) >= 0); 2520 2521#if !defined (MSDOS) || __DJGPP__ > 1 2522 if (out_st.st_mode != 0 2523 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) 2524 { 2525 errno = 0; 2526 report_file_error ("Input and output files are the same", 2527 Fcons (file, Fcons (newname, Qnil))); 2528 } 2529#endif 2530 2531#if defined (S_ISREG) && defined (S_ISLNK) 2532 if (input_file_statable_p) 2533 { 2534 if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode))) 2535 { 2536#if defined (EISDIR) 2537 /* Get a better looking error message. */ 2538 errno = EISDIR; 2539#endif /* EISDIR */ 2540 report_file_error ("Non-regular file", Fcons (file, Qnil)); 2541 } 2542 } 2543#endif /* S_ISREG && S_ISLNK */ 2544 2545#ifdef VMS 2546 /* Create the copy file with the same record format as the input file */ 2547 ofd = sys_creat (SDATA (encoded_newname), 0666, ifd); 2548#else 2549#ifdef MSDOS 2550 /* System's default file type was set to binary by _fmode in emacs.c. */ 2551 ofd = emacs_open (SDATA (encoded_newname), 2552 O_WRONLY | O_TRUNC | O_CREAT 2553 | (NILP (ok_if_already_exists) ? O_EXCL : 0), 2554 S_IREAD | S_IWRITE); 2555#else /* not MSDOS */ 2556 ofd = emacs_open (SDATA (encoded_newname), 2557 O_WRONLY | O_TRUNC | O_CREAT 2558 | (NILP (ok_if_already_exists) ? O_EXCL : 0), 2559 0666); 2560#endif /* not MSDOS */ 2561#endif /* VMS */ 2562 if (ofd < 0) 2563 report_file_error ("Opening output file", Fcons (newname, Qnil)); 2564 2565 record_unwind_protect (close_file_unwind, make_number (ofd)); 2566 2567 immediate_quit = 1; 2568 QUIT; 2569 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0) 2570 if (emacs_write (ofd, buf, n) != n) 2571 report_file_error ("I/O error", Fcons (newname, Qnil)); 2572 immediate_quit = 0; 2573 2574#ifndef MSDOS 2575 /* Preserve the original file modes, and if requested, also its 2576 owner and group. */ 2577 if (input_file_statable_p) 2578 { 2579 if (! NILP (preserve_uid_gid)) 2580 fchown (ofd, st.st_uid, st.st_gid); 2581 fchmod (ofd, st.st_mode & 07777); 2582 } 2583#endif /* not MSDOS */ 2584 2585 /* Closing the output clobbers the file times on some systems. */ 2586 if (emacs_close (ofd) < 0) 2587 report_file_error ("I/O error", Fcons (newname, Qnil)); 2588 2589 if (input_file_statable_p) 2590 { 2591 if (!NILP (keep_time)) 2592 { 2593 EMACS_TIME atime, mtime; 2594 EMACS_SET_SECS_USECS (atime, st.st_atime, 0); 2595 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); 2596 if (set_file_times (SDATA (encoded_newname), 2597 atime, mtime)) 2598 xsignal2 (Qfile_date_error, 2599 build_string ("Cannot set file date"), newname); 2600 } 2601 } 2602 2603 emacs_close (ifd); 2604 2605#if defined (__DJGPP__) && __DJGPP__ > 1 2606 if (input_file_statable_p) 2607 { 2608 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits, 2609 and if it can't, it tells so. Otherwise, under MSDOS we usually 2610 get only the READ bit, which will make the copied file read-only, 2611 so it's better not to chmod at all. */ 2612 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0) 2613 chmod (SDATA (encoded_newname), st.st_mode & 07777); 2614 } 2615#endif /* DJGPP version 2 or newer */ 2616#endif /* not WINDOWSNT */ 2617 2618 /* Discard the unwind protects. */ 2619 specpdl_ptr = specpdl + count; 2620 2621 UNGCPRO; 2622 return Qnil; 2623} 2624 2625DEFUN ("make-directory-internal", Fmake_directory_internal, 2626 Smake_directory_internal, 1, 1, 0, 2627 doc: /* Create a new directory named DIRECTORY. */) 2628 (directory) 2629 Lisp_Object directory; 2630{ 2631 const unsigned char *dir; 2632 Lisp_Object handler; 2633 Lisp_Object encoded_dir; 2634 2635 CHECK_STRING (directory); 2636 directory = Fexpand_file_name (directory, Qnil); 2637 2638 handler = Ffind_file_name_handler (directory, Qmake_directory_internal); 2639 if (!NILP (handler)) 2640 return call2 (handler, Qmake_directory_internal, directory); 2641 2642 encoded_dir = ENCODE_FILE (directory); 2643 2644 dir = SDATA (encoded_dir); 2645 2646#ifdef WINDOWSNT 2647 if (mkdir (dir) != 0) 2648#else 2649 if (mkdir (dir, 0777) != 0) 2650#endif 2651 report_file_error ("Creating directory", list1 (directory)); 2652 2653 return Qnil; 2654} 2655 2656DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", 2657 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */) 2658 (directory) 2659 Lisp_Object directory; 2660{ 2661 const unsigned char *dir; 2662 Lisp_Object handler; 2663 Lisp_Object encoded_dir; 2664 2665 CHECK_STRING (directory); 2666 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil)); 2667 2668 handler = Ffind_file_name_handler (directory, Qdelete_directory); 2669 if (!NILP (handler)) 2670 return call2 (handler, Qdelete_directory, directory); 2671 2672 encoded_dir = ENCODE_FILE (directory); 2673 2674 dir = SDATA (encoded_dir); 2675 2676 if (rmdir (dir) != 0) 2677 report_file_error ("Removing directory", list1 (directory)); 2678 2679 return Qnil; 2680} 2681 2682DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", 2683 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink. 2684If file has multiple names, it continues to exist with the other names. */) 2685 (filename) 2686 Lisp_Object filename; 2687{ 2688 Lisp_Object handler; 2689 Lisp_Object encoded_file; 2690 struct gcpro gcpro1; 2691 2692 GCPRO1 (filename); 2693 if (!NILP (Ffile_directory_p (filename)) 2694 && NILP (Ffile_symlink_p (filename))) 2695 xsignal2 (Qfile_error, 2696 build_string ("Removing old name: is a directory"), 2697 filename); 2698 UNGCPRO; 2699 filename = Fexpand_file_name (filename, Qnil); 2700 2701 handler = Ffind_file_name_handler (filename, Qdelete_file); 2702 if (!NILP (handler)) 2703 return call2 (handler, Qdelete_file, filename); 2704 2705 encoded_file = ENCODE_FILE (filename); 2706 2707 if (0 > unlink (SDATA (encoded_file))) 2708 report_file_error ("Removing old name", list1 (filename)); 2709 return Qnil; 2710} 2711 2712static Lisp_Object 2713internal_delete_file_1 (ignore) 2714 Lisp_Object ignore; 2715{ 2716 return Qt; 2717} 2718 2719/* Delete file FILENAME, returning 1 if successful and 0 if failed. */ 2720 2721int 2722internal_delete_file (filename) 2723 Lisp_Object filename; 2724{ 2725 Lisp_Object tem; 2726 tem = internal_condition_case_1 (Fdelete_file, filename, 2727 Qt, internal_delete_file_1); 2728 return NILP (tem); 2729} 2730 2731DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, 2732 "fRename file: \nGRename %s to file: \np", 2733 doc: /* Rename FILE as NEWNAME. Both args must be strings. 2734If file has names other than FILE, it continues to have those names. 2735Signals a `file-already-exists' error if a file NEWNAME already exists 2736unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. 2737A number as third arg means request confirmation if NEWNAME already exists. 2738This is what happens in interactive use with M-x. */) 2739 (file, newname, ok_if_already_exists) 2740 Lisp_Object file, newname, ok_if_already_exists; 2741{ 2742 Lisp_Object handler; 2743 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 2744 Lisp_Object encoded_file, encoded_newname, symlink_target; 2745 2746 symlink_target = encoded_file = encoded_newname = Qnil; 2747 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target); 2748 CHECK_STRING (file); 2749 CHECK_STRING (newname); 2750 file = Fexpand_file_name (file, Qnil); 2751 2752 if ((!NILP (Ffile_directory_p (newname))) 2753#ifdef DOS_NT 2754 /* If the file names are identical but for the case, 2755 don't attempt to move directory to itself. */ 2756 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))) 2757#endif 2758 ) 2759 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); 2760 else 2761 newname = Fexpand_file_name (newname, Qnil); 2762 2763 /* If the file name has special constructs in it, 2764 call the corresponding file handler. */ 2765 handler = Ffind_file_name_handler (file, Qrename_file); 2766 if (NILP (handler)) 2767 handler = Ffind_file_name_handler (newname, Qrename_file); 2768 if (!NILP (handler)) 2769 RETURN_UNGCPRO (call4 (handler, Qrename_file, 2770 file, newname, ok_if_already_exists)); 2771 2772 encoded_file = ENCODE_FILE (file); 2773 encoded_newname = ENCODE_FILE (newname); 2774 2775#ifdef DOS_NT 2776 /* If the file names are identical but for the case, don't ask for 2777 confirmation: they simply want to change the letter-case of the 2778 file name. */ 2779 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))) 2780#endif 2781 if (NILP (ok_if_already_exists) 2782 || INTEGERP (ok_if_already_exists)) 2783 barf_or_query_if_file_exists (newname, "rename to it", 2784 INTEGERP (ok_if_already_exists), 0, 0); 2785#ifndef BSD4_1 2786 if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname))) 2787#else 2788 if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)) 2789 || 0 > unlink (SDATA (encoded_file))) 2790#endif 2791 { 2792 if (errno == EXDEV) 2793 { 2794#ifdef S_IFLNK 2795 symlink_target = Ffile_symlink_p (file); 2796 if (! NILP (symlink_target)) 2797 Fmake_symbolic_link (symlink_target, newname, 2798 NILP (ok_if_already_exists) ? Qnil : Qt); 2799 else 2800#endif 2801 Fcopy_file (file, newname, 2802 /* We have already prompted if it was an integer, 2803 so don't have copy-file prompt again. */ 2804 NILP (ok_if_already_exists) ? Qnil : Qt, 2805 Qt, Qt); 2806 2807 Fdelete_file (file); 2808 } 2809 else 2810 report_file_error ("Renaming", list2 (file, newname)); 2811 } 2812 UNGCPRO; 2813 return Qnil; 2814} 2815 2816DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, 2817 "fAdd name to file: \nGName to add to %s: \np", 2818 doc: /* Give FILE additional name NEWNAME. Both args must be strings. 2819Signals a `file-already-exists' error if a file NEWNAME already exists 2820unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. 2821A number as third arg means request confirmation if NEWNAME already exists. 2822This is what happens in interactive use with M-x. */) 2823 (file, newname, ok_if_already_exists) 2824 Lisp_Object file, newname, ok_if_already_exists; 2825{ 2826 Lisp_Object handler; 2827 Lisp_Object encoded_file, encoded_newname; 2828 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 2829 2830 GCPRO4 (file, newname, encoded_file, encoded_newname); 2831 encoded_file = encoded_newname = Qnil; 2832 CHECK_STRING (file); 2833 CHECK_STRING (newname); 2834 file = Fexpand_file_name (file, Qnil); 2835 2836 if (!NILP (Ffile_directory_p (newname))) 2837 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); 2838 else 2839 newname = Fexpand_file_name (newname, Qnil); 2840 2841 /* If the file name has special constructs in it, 2842 call the corresponding file handler. */ 2843 handler = Ffind_file_name_handler (file, Qadd_name_to_file); 2844 if (!NILP (handler)) 2845 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file, 2846 newname, ok_if_already_exists)); 2847 2848 /* If the new name has special constructs in it, 2849 call the corresponding file handler. */ 2850 handler = Ffind_file_name_handler (newname, Qadd_name_to_file); 2851 if (!NILP (handler)) 2852 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file, 2853 newname, ok_if_already_exists)); 2854 2855 encoded_file = ENCODE_FILE (file); 2856 encoded_newname = ENCODE_FILE (newname); 2857 2858 if (NILP (ok_if_already_exists) 2859 || INTEGERP (ok_if_already_exists)) 2860 barf_or_query_if_file_exists (newname, "make it a new name", 2861 INTEGERP (ok_if_already_exists), 0, 0); 2862 2863 unlink (SDATA (newname)); 2864 if (0 > link (SDATA (encoded_file), SDATA (encoded_newname))) 2865 report_file_error ("Adding new name", list2 (file, newname)); 2866 2867 UNGCPRO; 2868 return Qnil; 2869} 2870 2871#ifdef S_IFLNK 2872DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, 2873 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np", 2874 doc: /* Make a symbolic link to FILENAME, named LINKNAME. 2875Both args must be strings. 2876Signals a `file-already-exists' error if a file LINKNAME already exists 2877unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. 2878A number as third arg means request confirmation if LINKNAME already exists. 2879This happens for interactive use with M-x. */) 2880 (filename, linkname, ok_if_already_exists) 2881 Lisp_Object filename, linkname, ok_if_already_exists; 2882{ 2883 Lisp_Object handler; 2884 Lisp_Object encoded_filename, encoded_linkname; 2885 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 2886 2887 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname); 2888 encoded_filename = encoded_linkname = Qnil; 2889 CHECK_STRING (filename); 2890 CHECK_STRING (linkname); 2891 /* If the link target has a ~, we must expand it to get 2892 a truly valid file name. Otherwise, do not expand; 2893 we want to permit links to relative file names. */ 2894 if (SREF (filename, 0) == '~') 2895 filename = Fexpand_file_name (filename, Qnil); 2896 2897 if (!NILP (Ffile_directory_p (linkname))) 2898 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname); 2899 else 2900 linkname = Fexpand_file_name (linkname, Qnil); 2901 2902 /* If the file name has special constructs in it, 2903 call the corresponding file handler. */ 2904 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); 2905 if (!NILP (handler)) 2906 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, 2907 linkname, ok_if_already_exists)); 2908 2909 /* If the new link name has special constructs in it, 2910 call the corresponding file handler. */ 2911 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); 2912 if (!NILP (handler)) 2913 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, 2914 linkname, ok_if_already_exists)); 2915 2916 encoded_filename = ENCODE_FILE (filename); 2917 encoded_linkname = ENCODE_FILE (linkname); 2918 2919 if (NILP (ok_if_already_exists) 2920 || INTEGERP (ok_if_already_exists)) 2921 barf_or_query_if_file_exists (linkname, "make it a link", 2922 INTEGERP (ok_if_already_exists), 0, 0); 2923 if (0 > symlink (SDATA (encoded_filename), 2924 SDATA (encoded_linkname))) 2925 { 2926 /* If we didn't complain already, silently delete existing file. */ 2927 if (errno == EEXIST) 2928 { 2929 unlink (SDATA (encoded_linkname)); 2930 if (0 <= symlink (SDATA (encoded_filename), 2931 SDATA (encoded_linkname))) 2932 { 2933 UNGCPRO; 2934 return Qnil; 2935 } 2936 } 2937 2938 report_file_error ("Making symbolic link", list2 (filename, linkname)); 2939 } 2940 UNGCPRO; 2941 return Qnil; 2942} 2943#endif /* S_IFLNK */ 2944 2945#ifdef VMS 2946 2947DEFUN ("define-logical-name", Fdefine_logical_name, Sdefine_logical_name, 2948 2, 2, "sDefine logical name: \nsDefine logical name %s as: ", 2949 doc: /* Define the job-wide logical name NAME to have the value STRING. 2950If STRING is nil or a null string, the logical name NAME is deleted. */) 2951 (name, string) 2952 Lisp_Object name; 2953 Lisp_Object string; 2954{ 2955 CHECK_STRING (name); 2956 if (NILP (string)) 2957 delete_logical_name (SDATA (name)); 2958 else 2959 { 2960 CHECK_STRING (string); 2961 2962 if (SCHARS (string) == 0) 2963 delete_logical_name (SDATA (name)); 2964 else 2965 define_logical_name (SDATA (name), SDATA (string)); 2966 } 2967 2968 return string; 2969} 2970#endif /* VMS */ 2971 2972#ifdef HPUX_NET 2973 2974DEFUN ("sysnetunam", Fsysnetunam, Ssysnetunam, 2, 2, 0, 2975 doc: /* Open a network connection to PATH using LOGIN as the login string. */) 2976 (path, login) 2977 Lisp_Object path, login; 2978{ 2979 int netresult; 2980 2981 CHECK_STRING (path); 2982 CHECK_STRING (login); 2983 2984 netresult = netunam (SDATA (path), SDATA (login)); 2985 2986 if (netresult == -1) 2987 return Qnil; 2988 else 2989 return Qt; 2990} 2991#endif /* HPUX_NET */ 2992 2993DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, 2994 1, 1, 0, 2995 doc: /* Return t if file FILENAME specifies an absolute file name. 2996On Unix, this is a name starting with a `/' or a `~'. */) 2997 (filename) 2998 Lisp_Object filename; 2999{ 3000 CHECK_STRING (filename); 3001 return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil; 3002} 3003 3004/* Return nonzero if file FILENAME exists and can be executed. */ 3005 3006static int 3007check_executable (filename) 3008 char *filename; 3009{ 3010#ifdef DOS_NT 3011 int len = strlen (filename); 3012 char *suffix; 3013 struct stat st; 3014 if (stat (filename, &st) < 0) 3015 return 0; 3016#if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1) 3017 return ((st.st_mode & S_IEXEC) != 0); 3018#else 3019 return (S_ISREG (st.st_mode) 3020 && len >= 5 3021 && (stricmp ((suffix = filename + len-4), ".com") == 0 3022 || stricmp (suffix, ".exe") == 0 3023 || stricmp (suffix, ".bat") == 0) 3024 || (st.st_mode & S_IFMT) == S_IFDIR); 3025#endif /* not WINDOWSNT */ 3026#else /* not DOS_NT */ 3027#ifdef HAVE_EUIDACCESS 3028 return (euidaccess (filename, 1) >= 0); 3029#else 3030 /* Access isn't quite right because it uses the real uid 3031 and we really want to test with the effective uid. 3032 But Unix doesn't give us a right way to do it. */ 3033 return (access (filename, 1) >= 0); 3034#endif 3035#endif /* not DOS_NT */ 3036} 3037 3038/* Return nonzero if file FILENAME exists and can be written. */ 3039 3040static int 3041check_writable (filename) 3042 char *filename; 3043{ 3044#ifdef MSDOS 3045 struct stat st; 3046 if (stat (filename, &st) < 0) 3047 return 0; 3048 return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR); 3049#else /* not MSDOS */ 3050#ifdef HAVE_EUIDACCESS 3051 return (euidaccess (filename, 2) >= 0); 3052#else 3053 /* Access isn't quite right because it uses the real uid 3054 and we really want to test with the effective uid. 3055 But Unix doesn't give us a right way to do it. 3056 Opening with O_WRONLY could work for an ordinary file, 3057 but would lose for directories. */ 3058 return (access (filename, 2) >= 0); 3059#endif 3060#endif /* not MSDOS */ 3061} 3062 3063DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, 3064 doc: /* Return t if file FILENAME exists (whether or not you can read it.) 3065See also `file-readable-p' and `file-attributes'. 3066This returns nil for a symlink to a nonexistent file. 3067Use `file-symlink-p' to test for such links. */) 3068 (filename) 3069 Lisp_Object filename; 3070{ 3071 Lisp_Object absname; 3072 Lisp_Object handler; 3073 struct stat statbuf; 3074 3075 CHECK_STRING (filename); 3076 absname = Fexpand_file_name (filename, Qnil); 3077 3078 /* If the file name has special constructs in it, 3079 call the corresponding file handler. */ 3080 handler = Ffind_file_name_handler (absname, Qfile_exists_p); 3081 if (!NILP (handler)) 3082 return call2 (handler, Qfile_exists_p, absname); 3083 3084 absname = ENCODE_FILE (absname); 3085 3086 return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil; 3087} 3088 3089DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, 3090 doc: /* Return t if FILENAME can be executed by you. 3091For a directory, this means you can access files in that directory. */) 3092 (filename) 3093 Lisp_Object filename; 3094{ 3095 Lisp_Object absname; 3096 Lisp_Object handler; 3097 3098 CHECK_STRING (filename); 3099 absname = Fexpand_file_name (filename, Qnil); 3100 3101 /* If the file name has special constructs in it, 3102 call the corresponding file handler. */ 3103 handler = Ffind_file_name_handler (absname, Qfile_executable_p); 3104 if (!NILP (handler)) 3105 return call2 (handler, Qfile_executable_p, absname); 3106 3107 absname = ENCODE_FILE (absname); 3108 3109 return (check_executable (SDATA (absname)) ? Qt : Qnil); 3110} 3111 3112DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, 3113 doc: /* Return t if file FILENAME exists and you can read it. 3114See also `file-exists-p' and `file-attributes'. */) 3115 (filename) 3116 Lisp_Object filename; 3117{ 3118 Lisp_Object absname; 3119 Lisp_Object handler; 3120 int desc; 3121 int flags; 3122 struct stat statbuf; 3123 3124 CHECK_STRING (filename); 3125 absname = Fexpand_file_name (filename, Qnil); 3126 3127 /* If the file name has special constructs in it, 3128 call the corresponding file handler. */ 3129 handler = Ffind_file_name_handler (absname, Qfile_readable_p); 3130 if (!NILP (handler)) 3131 return call2 (handler, Qfile_readable_p, absname); 3132 3133 absname = ENCODE_FILE (absname); 3134 3135#if defined(DOS_NT) || defined(macintosh) 3136 /* Under MS-DOS, Windows, and Macintosh, open does not work for 3137 directories. */ 3138 if (access (SDATA (absname), 0) == 0) 3139 return Qt; 3140 return Qnil; 3141#else /* not DOS_NT and not macintosh */ 3142 flags = O_RDONLY; 3143#if defined (S_ISFIFO) && defined (O_NONBLOCK) 3144 /* Opening a fifo without O_NONBLOCK can wait. 3145 We don't want to wait. But we don't want to mess wth O_NONBLOCK 3146 except in the case of a fifo, on a system which handles it. */ 3147 desc = stat (SDATA (absname), &statbuf); 3148 if (desc < 0) 3149 return Qnil; 3150 if (S_ISFIFO (statbuf.st_mode)) 3151 flags |= O_NONBLOCK; 3152#endif 3153 desc = emacs_open (SDATA (absname), flags, 0); 3154 if (desc < 0) 3155 return Qnil; 3156 emacs_close (desc); 3157 return Qt; 3158#endif /* not DOS_NT and not macintosh */ 3159} 3160 3161/* Having this before file-symlink-p mysteriously caused it to be forgotten 3162 on the RT/PC. */ 3163DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, 3164 doc: /* Return t if file FILENAME can be written or created by you. */) 3165 (filename) 3166 Lisp_Object filename; 3167{ 3168 Lisp_Object absname, dir, encoded; 3169 Lisp_Object handler; 3170 struct stat statbuf; 3171 3172 CHECK_STRING (filename); 3173 absname = Fexpand_file_name (filename, Qnil); 3174 3175 /* If the file name has special constructs in it, 3176 call the corresponding file handler. */ 3177 handler = Ffind_file_name_handler (absname, Qfile_writable_p); 3178 if (!NILP (handler)) 3179 return call2 (handler, Qfile_writable_p, absname); 3180 3181 encoded = ENCODE_FILE (absname); 3182 if (stat (SDATA (encoded), &statbuf) >= 0) 3183 return (check_writable (SDATA (encoded)) 3184 ? Qt : Qnil); 3185 3186 dir = Ffile_name_directory (absname); 3187#ifdef VMS 3188 if (!NILP (dir)) 3189 dir = Fdirectory_file_name (dir); 3190#endif /* VMS */ 3191#ifdef MSDOS 3192 if (!NILP (dir)) 3193 dir = Fdirectory_file_name (dir); 3194#endif /* MSDOS */ 3195 3196 dir = ENCODE_FILE (dir); 3197#ifdef WINDOWSNT 3198 /* The read-only attribute of the parent directory doesn't affect 3199 whether a file or directory can be created within it. Some day we 3200 should check ACLs though, which do affect this. */ 3201 if (stat (SDATA (dir), &statbuf) < 0) 3202 return Qnil; 3203 return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; 3204#else 3205 return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "") 3206 ? Qt : Qnil); 3207#endif 3208} 3209 3210DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, 3211 doc: /* Access file FILENAME, and get an error if that does not work. 3212The second argument STRING is used in the error message. 3213If there is no error, returns nil. */) 3214 (filename, string) 3215 Lisp_Object filename, string; 3216{ 3217 Lisp_Object handler, encoded_filename, absname; 3218 int fd; 3219 3220 CHECK_STRING (filename); 3221 absname = Fexpand_file_name (filename, Qnil); 3222 3223 CHECK_STRING (string); 3224 3225 /* If the file name has special constructs in it, 3226 call the corresponding file handler. */ 3227 handler = Ffind_file_name_handler (absname, Qaccess_file); 3228 if (!NILP (handler)) 3229 return call3 (handler, Qaccess_file, absname, string); 3230 3231 encoded_filename = ENCODE_FILE (absname); 3232 3233 fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0); 3234 if (fd < 0) 3235 report_file_error (SDATA (string), Fcons (filename, Qnil)); 3236 emacs_close (fd); 3237 3238 return Qnil; 3239} 3240 3241DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, 3242 doc: /* Return non-nil if file FILENAME is the name of a symbolic link. 3243The value is the link target, as a string. 3244Otherwise it returns nil. 3245 3246This function returns t when given the name of a symlink that 3247points to a nonexistent file. */) 3248 (filename) 3249 Lisp_Object filename; 3250{ 3251 Lisp_Object handler; 3252 3253 CHECK_STRING (filename); 3254 filename = Fexpand_file_name (filename, Qnil); 3255 3256 /* If the file name has special constructs in it, 3257 call the corresponding file handler. */ 3258 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); 3259 if (!NILP (handler)) 3260 return call2 (handler, Qfile_symlink_p, filename); 3261 3262#ifdef S_IFLNK 3263 { 3264 char *buf; 3265 int bufsize; 3266 int valsize; 3267 Lisp_Object val; 3268 3269 filename = ENCODE_FILE (filename); 3270 3271 bufsize = 50; 3272 buf = NULL; 3273 do 3274 { 3275 bufsize *= 2; 3276 buf = (char *) xrealloc (buf, bufsize); 3277 bzero (buf, bufsize); 3278 3279 errno = 0; 3280 valsize = readlink (SDATA (filename), buf, bufsize); 3281 if (valsize == -1) 3282 { 3283#ifdef ERANGE 3284 /* HP-UX reports ERANGE if buffer is too small. */ 3285 if (errno == ERANGE) 3286 valsize = bufsize; 3287 else 3288#endif 3289 { 3290 xfree (buf); 3291 return Qnil; 3292 } 3293 } 3294 } 3295 while (valsize >= bufsize); 3296 3297 val = make_string (buf, valsize); 3298 if (buf[0] == '/' && index (buf, ':')) 3299 val = concat2 (build_string ("/:"), val); 3300 xfree (buf); 3301 val = DECODE_FILE (val); 3302 return val; 3303 } 3304#else /* not S_IFLNK */ 3305 return Qnil; 3306#endif /* not S_IFLNK */ 3307} 3308 3309DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, 3310 doc: /* Return t if FILENAME names an existing directory. 3311Symbolic links to directories count as directories. 3312See `file-symlink-p' to distinguish symlinks. */) 3313 (filename) 3314 Lisp_Object filename; 3315{ 3316 register Lisp_Object absname; 3317 struct stat st; 3318 Lisp_Object handler; 3319 3320 absname = expand_and_dir_to_file (filename, current_buffer->directory); 3321 3322 /* If the file name has special constructs in it, 3323 call the corresponding file handler. */ 3324 handler = Ffind_file_name_handler (absname, Qfile_directory_p); 3325 if (!NILP (handler)) 3326 return call2 (handler, Qfile_directory_p, absname); 3327 3328 absname = ENCODE_FILE (absname); 3329 3330 if (stat (SDATA (absname), &st) < 0) 3331 return Qnil; 3332 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; 3333} 3334 3335DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, 3336 doc: /* Return t if file FILENAME names a directory you can open. 3337For the value to be t, FILENAME must specify the name of a directory as a file, 3338and the directory must allow you to open files in it. In order to use a 3339directory as a buffer's current directory, this predicate must return true. 3340A directory name spec may be given instead; then the value is t 3341if the directory so specified exists and really is a readable and 3342searchable directory. */) 3343 (filename) 3344 Lisp_Object filename; 3345{ 3346 Lisp_Object handler; 3347 int tem; 3348 struct gcpro gcpro1; 3349 3350 /* If the file name has special constructs in it, 3351 call the corresponding file handler. */ 3352 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); 3353 if (!NILP (handler)) 3354 return call2 (handler, Qfile_accessible_directory_p, filename); 3355 3356 GCPRO1 (filename); 3357 tem = (NILP (Ffile_directory_p (filename)) 3358 || NILP (Ffile_executable_p (filename))); 3359 UNGCPRO; 3360 return tem ? Qnil : Qt; 3361} 3362 3363DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, 3364 doc: /* Return t if FILENAME names a regular file. 3365This is the sort of file that holds an ordinary stream of data bytes. 3366Symbolic links to regular files count as regular files. 3367See `file-symlink-p' to distinguish symlinks. */) 3368 (filename) 3369 Lisp_Object filename; 3370{ 3371 register Lisp_Object absname; 3372 struct stat st; 3373 Lisp_Object handler; 3374 3375 absname = expand_and_dir_to_file (filename, current_buffer->directory); 3376 3377 /* If the file name has special constructs in it, 3378 call the corresponding file handler. */ 3379 handler = Ffind_file_name_handler (absname, Qfile_regular_p); 3380 if (!NILP (handler)) 3381 return call2 (handler, Qfile_regular_p, absname); 3382 3383 absname = ENCODE_FILE (absname); 3384 3385#ifdef WINDOWSNT 3386 { 3387 int result; 3388 Lisp_Object tem = Vw32_get_true_file_attributes; 3389 3390 /* Tell stat to use expensive method to get accurate info. */ 3391 Vw32_get_true_file_attributes = Qt; 3392 result = stat (SDATA (absname), &st); 3393 Vw32_get_true_file_attributes = tem; 3394 3395 if (result < 0) 3396 return Qnil; 3397 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; 3398 } 3399#else 3400 if (stat (SDATA (absname), &st) < 0) 3401 return Qnil; 3402 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; 3403#endif 3404} 3405 3406DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, 3407 doc: /* Return mode bits of file named FILENAME, as an integer. 3408Return nil, if file does not exist or is not accessible. */) 3409 (filename) 3410 Lisp_Object filename; 3411{ 3412 Lisp_Object absname; 3413 struct stat st; 3414 Lisp_Object handler; 3415 3416 absname = expand_and_dir_to_file (filename, current_buffer->directory); 3417 3418 /* If the file name has special constructs in it, 3419 call the corresponding file handler. */ 3420 handler = Ffind_file_name_handler (absname, Qfile_modes); 3421 if (!NILP (handler)) 3422 return call2 (handler, Qfile_modes, absname); 3423 3424 absname = ENCODE_FILE (absname); 3425 3426 if (stat (SDATA (absname), &st) < 0) 3427 return Qnil; 3428#if defined (MSDOS) && __DJGPP__ < 2 3429 if (check_executable (SDATA (absname))) 3430 st.st_mode |= S_IEXEC; 3431#endif /* MSDOS && __DJGPP__ < 2 */ 3432 3433 return make_number (st.st_mode & 07777); 3434} 3435 3436DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, 3437 doc: /* Set mode bits of file named FILENAME to MODE (an integer). 3438Only the 12 low bits of MODE are used. */) 3439 (filename, mode) 3440 Lisp_Object filename, mode; 3441{ 3442 Lisp_Object absname, encoded_absname; 3443 Lisp_Object handler; 3444 3445 absname = Fexpand_file_name (filename, current_buffer->directory); 3446 CHECK_NUMBER (mode); 3447 3448 /* If the file name has special constructs in it, 3449 call the corresponding file handler. */ 3450 handler = Ffind_file_name_handler (absname, Qset_file_modes); 3451 if (!NILP (handler)) 3452 return call3 (handler, Qset_file_modes, absname, mode); 3453 3454 encoded_absname = ENCODE_FILE (absname); 3455 3456 if (chmod (SDATA (encoded_absname), XINT (mode)) < 0) 3457 report_file_error ("Doing chmod", Fcons (absname, Qnil)); 3458 3459 return Qnil; 3460} 3461 3462DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, 3463 doc: /* Set the file permission bits for newly created files. 3464The argument MODE should be an integer; only the low 9 bits are used. 3465This setting is inherited by subprocesses. */) 3466 (mode) 3467 Lisp_Object mode; 3468{ 3469 CHECK_NUMBER (mode); 3470 3471 umask ((~ XINT (mode)) & 0777); 3472 3473 return Qnil; 3474} 3475 3476DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, 3477 doc: /* Return the default file protection for created files. 3478The value is an integer. */) 3479 () 3480{ 3481 int realmask; 3482 Lisp_Object value; 3483 3484 realmask = umask (0); 3485 umask (realmask); 3486 3487 XSETINT (value, (~ realmask) & 0777); 3488 return value; 3489} 3490 3491extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *)); 3492 3493DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0, 3494 doc: /* Set times of file FILENAME to TIME. 3495Set both access and modification times. 3496Return t on success, else nil. 3497Use the current time if TIME is nil. TIME is in the format of 3498`current-time'. */) 3499 (filename, time) 3500 Lisp_Object filename, time; 3501{ 3502 Lisp_Object absname, encoded_absname; 3503 Lisp_Object handler; 3504 time_t sec; 3505 int usec; 3506 3507 if (! lisp_time_argument (time, &sec, &usec)) 3508 error ("Invalid time specification"); 3509 3510 absname = Fexpand_file_name (filename, current_buffer->directory); 3511 3512 /* If the file name has special constructs in it, 3513 call the corresponding file handler. */ 3514 handler = Ffind_file_name_handler (absname, Qset_file_times); 3515 if (!NILP (handler)) 3516 return call3 (handler, Qset_file_times, absname, time); 3517 3518 encoded_absname = ENCODE_FILE (absname); 3519 3520 { 3521 EMACS_TIME t; 3522 3523 EMACS_SET_SECS (t, sec); 3524 EMACS_SET_USECS (t, usec); 3525 3526 if (set_file_times (SDATA (encoded_absname), t, t)) 3527 { 3528#ifdef DOS_NT 3529 struct stat st; 3530 3531 /* Setting times on a directory always fails. */ 3532 if (stat (SDATA (encoded_absname), &st) == 0 3533 && (st.st_mode & S_IFMT) == S_IFDIR) 3534 return Qnil; 3535#endif 3536 report_file_error ("Setting file times", Fcons (absname, Qnil)); 3537 return Qnil; 3538 } 3539 } 3540 3541 return Qt; 3542} 3543 3544#ifdef HAVE_SYNC 3545DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", 3546 doc: /* Tell Unix to finish all pending disk updates. */) 3547 () 3548{ 3549 sync (); 3550 return Qnil; 3551} 3552 3553#endif /* HAVE_SYNC */ 3554 3555DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, 3556 doc: /* Return t if file FILE1 is newer than file FILE2. 3557If FILE1 does not exist, the answer is nil; 3558otherwise, if FILE2 does not exist, the answer is t. */) 3559 (file1, file2) 3560 Lisp_Object file1, file2; 3561{ 3562 Lisp_Object absname1, absname2; 3563 struct stat st; 3564 int mtime1; 3565 Lisp_Object handler; 3566 struct gcpro gcpro1, gcpro2; 3567 3568 CHECK_STRING (file1); 3569 CHECK_STRING (file2); 3570 3571 absname1 = Qnil; 3572 GCPRO2 (absname1, file2); 3573 absname1 = expand_and_dir_to_file (file1, current_buffer->directory); 3574 absname2 = expand_and_dir_to_file (file2, current_buffer->directory); 3575 UNGCPRO; 3576 3577 /* If the file name has special constructs in it, 3578 call the corresponding file handler. */ 3579 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p); 3580 if (NILP (handler)) 3581 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p); 3582 if (!NILP (handler)) 3583 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); 3584 3585 GCPRO2 (absname1, absname2); 3586 absname1 = ENCODE_FILE (absname1); 3587 absname2 = ENCODE_FILE (absname2); 3588 UNGCPRO; 3589 3590 if (stat (SDATA (absname1), &st) < 0) 3591 return Qnil; 3592 3593 mtime1 = st.st_mtime; 3594 3595 if (stat (SDATA (absname2), &st) < 0) 3596 return Qt; 3597 3598 return (mtime1 > st.st_mtime) ? Qt : Qnil; 3599} 3600 3601#ifdef DOS_NT 3602Lisp_Object Qfind_buffer_file_type; 3603#endif /* DOS_NT */ 3604 3605#ifndef READ_BUF_SIZE 3606#define READ_BUF_SIZE (64 << 10) 3607#endif 3608 3609extern void adjust_markers_for_delete P_ ((int, int, int, int)); 3610 3611/* This function is called after Lisp functions to decide a coding 3612 system are called, or when they cause an error. Before they are 3613 called, the current buffer is set unibyte and it contains only a 3614 newly inserted text (thus the buffer was empty before the 3615 insertion). 3616 3617 The functions may set markers, overlays, text properties, or even 3618 alter the buffer contents, change the current buffer. 3619 3620 Here, we reset all those changes by: 3621 o set back the current buffer. 3622 o move all markers and overlays to BEG. 3623 o remove all text properties. 3624 o set back the buffer multibyteness. */ 3625 3626static Lisp_Object 3627decide_coding_unwind (unwind_data) 3628 Lisp_Object unwind_data; 3629{ 3630 Lisp_Object multibyte, undo_list, buffer; 3631 3632 multibyte = XCAR (unwind_data); 3633 unwind_data = XCDR (unwind_data); 3634 undo_list = XCAR (unwind_data); 3635 buffer = XCDR (unwind_data); 3636 3637 if (current_buffer != XBUFFER (buffer)) 3638 set_buffer_internal (XBUFFER (buffer)); 3639 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE); 3640 adjust_overlays_for_delete (BEG, Z - BEG); 3641 BUF_INTERVALS (current_buffer) = 0; 3642 TEMP_SET_PT_BOTH (BEG, BEG_BYTE); 3643 3644 /* Now we are safe to change the buffer's multibyteness directly. */ 3645 current_buffer->enable_multibyte_characters = multibyte; 3646 current_buffer->undo_list = undo_list; 3647 3648 return Qnil; 3649} 3650 3651 3652/* Used to pass values from insert-file-contents to read_non_regular. */ 3653 3654static int non_regular_fd; 3655static int non_regular_inserted; 3656static int non_regular_nbytes; 3657 3658 3659/* Read from a non-regular file. 3660 Read non_regular_trytry bytes max from non_regular_fd. 3661 Non_regular_inserted specifies where to put the read bytes. 3662 Value is the number of bytes read. */ 3663 3664static Lisp_Object 3665read_non_regular () 3666{ 3667 int nbytes; 3668 3669 immediate_quit = 1; 3670 QUIT; 3671 nbytes = emacs_read (non_regular_fd, 3672 BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted, 3673 non_regular_nbytes); 3674 immediate_quit = 0; 3675 return make_number (nbytes); 3676} 3677 3678 3679/* Condition-case handler used when reading from non-regular files 3680 in insert-file-contents. */ 3681 3682static Lisp_Object 3683read_non_regular_quit () 3684{ 3685 return Qnil; 3686} 3687 3688 3689DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 3690 1, 5, 0, 3691 doc: /* Insert contents of file FILENAME after point. 3692Returns list of absolute file name and number of characters inserted. 3693If second argument VISIT is non-nil, the buffer's visited filename 3694and last save file modtime are set, and it is marked unmodified. 3695If visiting and the file does not exist, visiting is completed 3696before the error is signaled. 3697The optional third and fourth arguments BEG and END 3698specify what portion of the file to insert. 3699These arguments count bytes in the file, not characters in the buffer. 3700If VISIT is non-nil, BEG and END must be nil. 3701 3702If optional fifth argument REPLACE is non-nil, 3703it means replace the current buffer contents (in the accessible portion) 3704with the file contents. This is better than simply deleting and inserting 3705the whole thing because (1) it preserves some marker positions 3706and (2) it puts less data in the undo list. 3707When REPLACE is non-nil, the value is the number of characters actually read, 3708which is often less than the number of characters to be read. 3709 3710This does code conversion according to the value of 3711`coding-system-for-read' or `file-coding-system-alist', 3712and sets the variable `last-coding-system-used' to the coding system 3713actually used. */) 3714 (filename, visit, beg, end, replace) 3715 Lisp_Object filename, visit, beg, end, replace; 3716{ 3717 struct stat st; 3718 register int fd; 3719 int inserted = 0; 3720 register int how_much; 3721 register int unprocessed; 3722 int count = SPECPDL_INDEX (); 3723 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 3724 Lisp_Object handler, val, insval, orig_filename; 3725 Lisp_Object p; 3726 int total = 0; 3727 int not_regular = 0; 3728 unsigned char read_buf[READ_BUF_SIZE]; 3729 struct coding_system coding; 3730 unsigned char buffer[1 << 14]; 3731 int replace_handled = 0; 3732 int set_coding_system = 0; 3733 int coding_system_decided = 0; 3734 int read_quit = 0; 3735 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; 3736 int we_locked_file = 0; 3737 3738 if (current_buffer->base_buffer && ! NILP (visit)) 3739 error ("Cannot do file visiting in an indirect buffer"); 3740 3741 if (!NILP (current_buffer->read_only)) 3742 Fbarf_if_buffer_read_only (); 3743 3744 val = Qnil; 3745 p = Qnil; 3746 orig_filename = Qnil; 3747 3748 GCPRO4 (filename, val, p, orig_filename); 3749 3750 CHECK_STRING (filename); 3751 filename = Fexpand_file_name (filename, Qnil); 3752 3753 /* If the file name has special constructs in it, 3754 call the corresponding file handler. */ 3755 handler = Ffind_file_name_handler (filename, Qinsert_file_contents); 3756 if (!NILP (handler)) 3757 { 3758 val = call6 (handler, Qinsert_file_contents, filename, 3759 visit, beg, end, replace); 3760 if (CONSP (val) && CONSP (XCDR (val))) 3761 inserted = XINT (XCAR (XCDR (val))); 3762 goto handled; 3763 } 3764 3765 orig_filename = filename; 3766 filename = ENCODE_FILE (filename); 3767 3768 fd = -1; 3769 3770#ifdef WINDOWSNT 3771 { 3772 Lisp_Object tem = Vw32_get_true_file_attributes; 3773 3774 /* Tell stat to use expensive method to get accurate info. */ 3775 Vw32_get_true_file_attributes = Qt; 3776 total = stat (SDATA (filename), &st); 3777 Vw32_get_true_file_attributes = tem; 3778 } 3779 if (total < 0) 3780#else 3781#ifndef APOLLO 3782 if (stat (SDATA (filename), &st) < 0) 3783#else 3784 if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0 3785 || fstat (fd, &st) < 0) 3786#endif /* not APOLLO */ 3787#endif /* WINDOWSNT */ 3788 { 3789 if (fd >= 0) emacs_close (fd); 3790 badopen: 3791 if (NILP (visit)) 3792 report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); 3793 st.st_mtime = -1; 3794 how_much = 0; 3795 if (!NILP (Vcoding_system_for_read)) 3796 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read); 3797 goto notfound; 3798 } 3799 3800#ifdef S_IFREG 3801 /* This code will need to be changed in order to work on named 3802 pipes, and it's probably just not worth it. So we should at 3803 least signal an error. */ 3804 if (!S_ISREG (st.st_mode)) 3805 { 3806 not_regular = 1; 3807 3808 if (! NILP (visit)) 3809 goto notfound; 3810 3811 if (! NILP (replace) || ! NILP (beg) || ! NILP (end)) 3812 xsignal2 (Qfile_error, 3813 build_string ("not a regular file"), orig_filename); 3814 } 3815#endif 3816 3817 if (fd < 0) 3818 if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0) 3819 goto badopen; 3820 3821 /* Replacement should preserve point as it preserves markers. */ 3822 if (!NILP (replace)) 3823 record_unwind_protect (restore_point_unwind, Fpoint_marker ()); 3824 3825 record_unwind_protect (close_file_unwind, make_number (fd)); 3826 3827 /* Supposedly happens on VMS. */ 3828 /* Can happen on any platform that uses long as type of off_t, but allows 3829 file sizes to exceed 2Gb. VMS is no longer officially supported, so 3830 give a message suitable for the latter case. */ 3831 if (! not_regular && st.st_size < 0) 3832 error ("Maximum buffer size exceeded"); 3833 3834 /* Prevent redisplay optimizations. */ 3835 current_buffer->clip_changed = 1; 3836 3837 if (!NILP (visit)) 3838 { 3839 if (!NILP (beg) || !NILP (end)) 3840 error ("Attempt to visit less than an entire file"); 3841 if (BEG < Z && NILP (replace)) 3842 error ("Cannot do file visiting in a non-empty buffer"); 3843 } 3844 3845 if (!NILP (beg)) 3846 CHECK_NUMBER (beg); 3847 else 3848 XSETFASTINT (beg, 0); 3849 3850 if (!NILP (end)) 3851 CHECK_NUMBER (end); 3852 else 3853 { 3854 if (! not_regular) 3855 { 3856 XSETINT (end, st.st_size); 3857 3858 /* Arithmetic overflow can occur if an Emacs integer cannot 3859 represent the file size, or if the calculations below 3860 overflow. The calculations below double the file size 3861 twice, so check that it can be multiplied by 4 safely. */ 3862 if (XINT (end) != st.st_size 3863 /* || ((int) st.st_size * 4) / 4 != st.st_size */) 3864 error ("Maximum buffer size exceeded"); 3865 3866 /* The file size returned from stat may be zero, but data 3867 may be readable nonetheless, for example when this is a 3868 file in the /proc filesystem. */ 3869 if (st.st_size == 0) 3870 XSETINT (end, READ_BUF_SIZE); 3871 } 3872 } 3873 3874 if (EQ (Vcoding_system_for_read, Qauto_save_coding)) 3875 { 3876 /* We use emacs-mule for auto saving... */ 3877 setup_coding_system (Qemacs_mule, &coding); 3878 /* ... but with the special flag to indicate to read in a 3879 multibyte sequence for eight-bit-control char as is. */ 3880 coding.flags = 1; 3881 coding.src_multibyte = 0; 3882 coding.dst_multibyte 3883 = !NILP (current_buffer->enable_multibyte_characters); 3884 coding.eol_type = CODING_EOL_LF; 3885 coding_system_decided = 1; 3886 } 3887 else if (BEG < Z) 3888 { 3889 /* Decide the coding system to use for reading the file now 3890 because we can't use an optimized method for handling 3891 `coding:' tag if the current buffer is not empty. */ 3892 Lisp_Object val; 3893 val = Qnil; 3894 3895 if (!NILP (Vcoding_system_for_read)) 3896 val = Vcoding_system_for_read; 3897 else 3898 { 3899 /* Don't try looking inside a file for a coding system 3900 specification if it is not seekable. */ 3901 if (! not_regular && ! NILP (Vset_auto_coding_function)) 3902 { 3903 /* Find a coding system specified in the heading two 3904 lines or in the tailing several lines of the file. 3905 We assume that the 1K-byte and 3K-byte for heading 3906 and tailing respectively are sufficient for this 3907 purpose. */ 3908 int nread; 3909 3910 if (st.st_size <= (1024 * 4)) 3911 nread = emacs_read (fd, read_buf, 1024 * 4); 3912 else 3913 { 3914 nread = emacs_read (fd, read_buf, 1024); 3915 if (nread >= 0) 3916 { 3917 if (lseek (fd, st.st_size - (1024 * 3), 0) < 0) 3918 report_file_error ("Setting file position", 3919 Fcons (orig_filename, Qnil)); 3920 nread += emacs_read (fd, read_buf + nread, 1024 * 3); 3921 } 3922 } 3923 3924 if (nread < 0) 3925 error ("IO error reading %s: %s", 3926 SDATA (orig_filename), emacs_strerror (errno)); 3927 else if (nread > 0) 3928 { 3929 struct buffer *prev = current_buffer; 3930 Lisp_Object buffer; 3931 struct buffer *buf; 3932 3933 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); 3934 3935 buffer = Fget_buffer_create (build_string (" *code-converting-work*")); 3936 buf = XBUFFER (buffer); 3937 3938 delete_all_overlays (buf); 3939 buf->directory = current_buffer->directory; 3940 buf->read_only = Qnil; 3941 buf->filename = Qnil; 3942 buf->undo_list = Qt; 3943 eassert (buf->overlays_before == NULL); 3944 eassert (buf->overlays_after == NULL); 3945 3946 set_buffer_internal (buf); 3947 Ferase_buffer (); 3948 buf->enable_multibyte_characters = Qnil; 3949 3950 insert_1_both (read_buf, nread, nread, 0, 0, 0); 3951 TEMP_SET_PT_BOTH (BEG, BEG_BYTE); 3952 val = call2 (Vset_auto_coding_function, 3953 filename, make_number (nread)); 3954 set_buffer_internal (prev); 3955 3956 /* Discard the unwind protect for recovering the 3957 current buffer. */ 3958 specpdl_ptr--; 3959 3960 /* Rewind the file for the actual read done later. */ 3961 if (lseek (fd, 0, 0) < 0) 3962 report_file_error ("Setting file position", 3963 Fcons (orig_filename, Qnil)); 3964 } 3965 } 3966 3967 if (NILP (val)) 3968 { 3969 /* If we have not yet decided a coding system, check 3970 file-coding-system-alist. */ 3971 Lisp_Object args[6], coding_systems; 3972 3973 args[0] = Qinsert_file_contents, args[1] = orig_filename; 3974 args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace; 3975 coding_systems = Ffind_operation_coding_system (6, args); 3976 if (CONSP (coding_systems)) 3977 val = XCAR (coding_systems); 3978 } 3979 } 3980 3981 setup_coding_system (Fcheck_coding_system (val), &coding); 3982 /* Ensure we set Vlast_coding_system_used. */ 3983 set_coding_system = 1; 3984 3985 if (NILP (current_buffer->enable_multibyte_characters) 3986 && ! NILP (val)) 3987 /* We must suppress all character code conversion except for 3988 end-of-line conversion. */ 3989 setup_raw_text_coding_system (&coding); 3990 3991 coding.src_multibyte = 0; 3992 coding.dst_multibyte 3993 = !NILP (current_buffer->enable_multibyte_characters); 3994 coding_system_decided = 1; 3995 } 3996 3997 /* If requested, replace the accessible part of the buffer 3998 with the file contents. Avoid replacing text at the 3999 beginning or end of the buffer that matches the file contents; 4000 that preserves markers pointing to the unchanged parts. 4001 4002 Here we implement this feature in an optimized way 4003 for the case where code conversion is NOT needed. 4004 The following if-statement handles the case of conversion 4005 in a less optimal way. 4006 4007 If the code conversion is "automatic" then we try using this 4008 method and hope for the best. 4009 But if we discover the need for conversion, we give up on this method 4010 and let the following if-statement handle the replace job. */ 4011 if (!NILP (replace) 4012 && BEGV < ZV 4013 && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK)) 4014 { 4015 /* same_at_start and same_at_end count bytes, 4016 because file access counts bytes 4017 and BEG and END count bytes. */ 4018 int same_at_start = BEGV_BYTE; 4019 int same_at_end = ZV_BYTE; 4020 int overlap; 4021 /* There is still a possibility we will find the need to do code 4022 conversion. If that happens, we set this variable to 1 to 4023 give up on handling REPLACE in the optimized way. */ 4024 int giveup_match_end = 0; 4025 4026 if (XINT (beg) != 0) 4027 { 4028 if (lseek (fd, XINT (beg), 0) < 0) 4029 report_file_error ("Setting file position", 4030 Fcons (orig_filename, Qnil)); 4031 } 4032 4033 immediate_quit = 1; 4034 QUIT; 4035 /* Count how many chars at the start of the file 4036 match the text at the beginning of the buffer. */ 4037 while (1) 4038 { 4039 int nread, bufpos; 4040 4041 nread = emacs_read (fd, buffer, sizeof buffer); 4042 if (nread < 0) 4043 error ("IO error reading %s: %s", 4044 SDATA (orig_filename), emacs_strerror (errno)); 4045 else if (nread == 0) 4046 break; 4047 4048 if (coding.type == coding_type_undecided) 4049 detect_coding (&coding, buffer, nread); 4050 if (coding.common_flags & CODING_REQUIRE_DECODING_MASK) 4051 /* We found that the file should be decoded somehow. 4052 Let's give up here. */ 4053 { 4054 giveup_match_end = 1; 4055 break; 4056 } 4057 4058 if (coding.eol_type == CODING_EOL_UNDECIDED) 4059 detect_eol (&coding, buffer, nread); 4060 if (coding.eol_type != CODING_EOL_UNDECIDED 4061 && coding.eol_type != CODING_EOL_LF) 4062 /* We found that the format of eol should be decoded. 4063 Let's give up here. */ 4064 { 4065 giveup_match_end = 1; 4066 break; 4067 } 4068 4069 bufpos = 0; 4070 while (bufpos < nread && same_at_start < ZV_BYTE 4071 && FETCH_BYTE (same_at_start) == buffer[bufpos]) 4072 same_at_start++, bufpos++; 4073 /* If we found a discrepancy, stop the scan. 4074 Otherwise loop around and scan the next bufferful. */ 4075 if (bufpos != nread) 4076 break; 4077 } 4078 immediate_quit = 0; 4079 /* If the file matches the buffer completely, 4080 there's no need to replace anything. */ 4081 if (same_at_start - BEGV_BYTE == XINT (end)) 4082 { 4083 emacs_close (fd); 4084 specpdl_ptr--; 4085 /* Truncate the buffer to the size of the file. */ 4086 del_range_1 (same_at_start, same_at_end, 0, 0); 4087 goto handled; 4088 } 4089 immediate_quit = 1; 4090 QUIT; 4091 /* Count how many chars at the end of the file 4092 match the text at the end of the buffer. But, if we have 4093 already found that decoding is necessary, don't waste time. */ 4094 while (!giveup_match_end) 4095 { 4096 int total_read, nread, bufpos, curpos, trial; 4097 4098 /* At what file position are we now scanning? */ 4099 curpos = XINT (end) - (ZV_BYTE - same_at_end); 4100 /* If the entire file matches the buffer tail, stop the scan. */ 4101 if (curpos == 0) 4102 break; 4103 /* How much can we scan in the next step? */ 4104 trial = min (curpos, sizeof buffer); 4105 if (lseek (fd, curpos - trial, 0) < 0) 4106 report_file_error ("Setting file position", 4107 Fcons (orig_filename, Qnil)); 4108 4109 total_read = nread = 0; 4110 while (total_read < trial) 4111 { 4112 nread = emacs_read (fd, buffer + total_read, trial - total_read); 4113 if (nread < 0) 4114 error ("IO error reading %s: %s", 4115 SDATA (orig_filename), emacs_strerror (errno)); 4116 else if (nread == 0) 4117 break; 4118 total_read += nread; 4119 } 4120 4121 /* Scan this bufferful from the end, comparing with 4122 the Emacs buffer. */ 4123 bufpos = total_read; 4124 4125 /* Compare with same_at_start to avoid counting some buffer text 4126 as matching both at the file's beginning and at the end. */ 4127 while (bufpos > 0 && same_at_end > same_at_start 4128 && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1]) 4129 same_at_end--, bufpos--; 4130 4131 /* If we found a discrepancy, stop the scan. 4132 Otherwise loop around and scan the preceding bufferful. */ 4133 if (bufpos != 0) 4134 { 4135 /* If this discrepancy is because of code conversion, 4136 we cannot use this method; giveup and try the other. */ 4137 if (same_at_end > same_at_start 4138 && FETCH_BYTE (same_at_end - 1) >= 0200 4139 && ! NILP (current_buffer->enable_multibyte_characters) 4140 && (CODING_MAY_REQUIRE_DECODING (&coding))) 4141 giveup_match_end = 1; 4142 break; 4143 } 4144 4145 if (nread == 0) 4146 break; 4147 } 4148 immediate_quit = 0; 4149 4150 if (! giveup_match_end) 4151 { 4152 int temp; 4153 4154 /* We win! We can handle REPLACE the optimized way. */ 4155 4156 /* Extend the start of non-matching text area to multibyte 4157 character boundary. */ 4158 if (! NILP (current_buffer->enable_multibyte_characters)) 4159 while (same_at_start > BEGV_BYTE 4160 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) 4161 same_at_start--; 4162 4163 /* Extend the end of non-matching text area to multibyte 4164 character boundary. */ 4165 if (! NILP (current_buffer->enable_multibyte_characters)) 4166 while (same_at_end < ZV_BYTE 4167 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) 4168 same_at_end++; 4169 4170 /* Don't try to reuse the same piece of text twice. */ 4171 overlap = (same_at_start - BEGV_BYTE 4172 - (same_at_end + st.st_size - ZV)); 4173 if (overlap > 0) 4174 same_at_end += overlap; 4175 4176 /* Arrange to read only the nonmatching middle part of the file. */ 4177 XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE)); 4178 XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end)); 4179 4180 del_range_byte (same_at_start, same_at_end, 0); 4181 /* Insert from the file at the proper position. */ 4182 temp = BYTE_TO_CHAR (same_at_start); 4183 SET_PT_BOTH (temp, same_at_start); 4184 4185 /* If display currently starts at beginning of line, 4186 keep it that way. */ 4187 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) 4188 XWINDOW (selected_window)->start_at_line_beg = Fbolp (); 4189 4190 replace_handled = 1; 4191 } 4192 } 4193 4194 /* If requested, replace the accessible part of the buffer 4195 with the file contents. Avoid replacing text at the 4196 beginning or end of the buffer that matches the file contents; 4197 that preserves markers pointing to the unchanged parts. 4198 4199 Here we implement this feature for the case where code conversion 4200 is needed, in a simple way that needs a lot of memory. 4201 The preceding if-statement handles the case of no conversion 4202 in a more optimized way. */ 4203 if (!NILP (replace) && ! replace_handled && BEGV < ZV) 4204 { 4205 int same_at_start = BEGV_BYTE; 4206 int same_at_end = ZV_BYTE; 4207 int overlap; 4208 int bufpos; 4209 /* Make sure that the gap is large enough. */ 4210 int bufsize = 2 * st.st_size; 4211 unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize); 4212 int temp; 4213 4214 /* First read the whole file, performing code conversion into 4215 CONVERSION_BUFFER. */ 4216 4217 if (lseek (fd, XINT (beg), 0) < 0) 4218 { 4219 xfree (conversion_buffer); 4220 report_file_error ("Setting file position", 4221 Fcons (orig_filename, Qnil)); 4222 } 4223 4224 total = st.st_size; /* Total bytes in the file. */ 4225 how_much = 0; /* Bytes read from file so far. */ 4226 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ 4227 unprocessed = 0; /* Bytes not processed in previous loop. */ 4228 4229 while (how_much < total) 4230 { 4231 /* try is reserved in some compilers (Microsoft C) */ 4232 int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); 4233 unsigned char *destination = read_buf + unprocessed; 4234 int this; 4235 4236 /* Allow quitting out of the actual I/O. */ 4237 immediate_quit = 1; 4238 QUIT; 4239 this = emacs_read (fd, destination, trytry); 4240 immediate_quit = 0; 4241 4242 if (this < 0 || this + unprocessed == 0) 4243 { 4244 how_much = this; 4245 break; 4246 } 4247 4248 how_much += this; 4249 4250 if (CODING_MAY_REQUIRE_DECODING (&coding)) 4251 { 4252 int require, result; 4253 4254 this += unprocessed; 4255 4256 /* If we are using more space than estimated, 4257 make CONVERSION_BUFFER bigger. */ 4258 require = decoding_buffer_size (&coding, this); 4259 if (inserted + require + 2 * (total - how_much) > bufsize) 4260 { 4261 bufsize = inserted + require + 2 * (total - how_much); 4262 conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize); 4263 } 4264 4265 /* Convert this batch with results in CONVERSION_BUFFER. */ 4266 if (how_much >= total) /* This is the last block. */ 4267 coding.mode |= CODING_MODE_LAST_BLOCK; 4268 if (coding.composing != COMPOSITION_DISABLED) 4269 coding_allocate_composition_data (&coding, BEGV); 4270 result = decode_coding (&coding, read_buf, 4271 conversion_buffer + inserted, 4272 this, bufsize - inserted); 4273 4274 /* Save for next iteration whatever we didn't convert. */ 4275 unprocessed = this - coding.consumed; 4276 bcopy (read_buf + coding.consumed, read_buf, unprocessed); 4277 if (!NILP (current_buffer->enable_multibyte_characters)) 4278 this = coding.produced; 4279 else 4280 this = str_as_unibyte (conversion_buffer + inserted, 4281 coding.produced); 4282 } 4283 4284 inserted += this; 4285 } 4286 4287 /* At this point, INSERTED is how many characters (i.e. bytes) 4288 are present in CONVERSION_BUFFER. 4289 HOW_MUCH should equal TOTAL, 4290 or should be <= 0 if we couldn't read the file. */ 4291 4292 if (how_much < 0) 4293 { 4294 xfree (conversion_buffer); 4295 coding_free_composition_data (&coding); 4296 error ("IO error reading %s: %s", 4297 SDATA (orig_filename), emacs_strerror (errno)); 4298 } 4299 4300 /* Compare the beginning of the converted file 4301 with the buffer text. */ 4302 4303 bufpos = 0; 4304 while (bufpos < inserted && same_at_start < same_at_end 4305 && FETCH_BYTE (same_at_start) == conversion_buffer[bufpos]) 4306 same_at_start++, bufpos++; 4307 4308 /* If the file matches the buffer completely, 4309 there's no need to replace anything. */ 4310 4311 if (bufpos == inserted) 4312 { 4313 xfree (conversion_buffer); 4314 coding_free_composition_data (&coding); 4315 emacs_close (fd); 4316 specpdl_ptr--; 4317 /* Truncate the buffer to the size of the file. */ 4318 del_range_byte (same_at_start, same_at_end, 0); 4319 inserted = 0; 4320 goto handled; 4321 } 4322 4323 /* Extend the start of non-matching text area to multibyte 4324 character boundary. */ 4325 if (! NILP (current_buffer->enable_multibyte_characters)) 4326 while (same_at_start > BEGV_BYTE 4327 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) 4328 same_at_start--; 4329 4330 /* Scan this bufferful from the end, comparing with 4331 the Emacs buffer. */ 4332 bufpos = inserted; 4333 4334 /* Compare with same_at_start to avoid counting some buffer text 4335 as matching both at the file's beginning and at the end. */ 4336 while (bufpos > 0 && same_at_end > same_at_start 4337 && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1]) 4338 same_at_end--, bufpos--; 4339 4340 /* Extend the end of non-matching text area to multibyte 4341 character boundary. */ 4342 if (! NILP (current_buffer->enable_multibyte_characters)) 4343 while (same_at_end < ZV_BYTE 4344 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) 4345 same_at_end++; 4346 4347 /* Don't try to reuse the same piece of text twice. */ 4348 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE); 4349 if (overlap > 0) 4350 same_at_end += overlap; 4351 4352 /* If display currently starts at beginning of line, 4353 keep it that way. */ 4354 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) 4355 XWINDOW (selected_window)->start_at_line_beg = Fbolp (); 4356 4357 /* Replace the chars that we need to replace, 4358 and update INSERTED to equal the number of bytes 4359 we are taking from the file. */ 4360 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE); 4361 4362 if (same_at_end != same_at_start) 4363 { 4364 del_range_byte (same_at_start, same_at_end, 0); 4365 temp = GPT; 4366 same_at_start = GPT_BYTE; 4367 } 4368 else 4369 { 4370 temp = BYTE_TO_CHAR (same_at_start); 4371 } 4372 /* Insert from the file at the proper position. */ 4373 SET_PT_BOTH (temp, same_at_start); 4374 insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted, 4375 0, 0, 0); 4376 if (coding.cmp_data && coding.cmp_data->used) 4377 coding_restore_composition (&coding, Fcurrent_buffer ()); 4378 coding_free_composition_data (&coding); 4379 4380 /* Set `inserted' to the number of inserted characters. */ 4381 inserted = PT - temp; 4382 /* Set point before the inserted characters. */ 4383 SET_PT_BOTH (temp, same_at_start); 4384 4385 xfree (conversion_buffer); 4386 emacs_close (fd); 4387 specpdl_ptr--; 4388 4389 goto handled; 4390 } 4391 4392 if (! not_regular) 4393 { 4394 register Lisp_Object temp; 4395 4396 total = XINT (end) - XINT (beg); 4397 4398 /* Make sure point-max won't overflow after this insertion. */ 4399 XSETINT (temp, total); 4400 if (total != XINT (temp)) 4401 error ("Maximum buffer size exceeded"); 4402 } 4403 else 4404 /* For a special file, all we can do is guess. */ 4405 total = READ_BUF_SIZE; 4406 4407 if (NILP (visit) && inserted > 0) 4408 { 4409#ifdef CLASH_DETECTION 4410 if (!NILP (current_buffer->file_truename) 4411 /* Make binding buffer-file-name to nil effective. */ 4412 && !NILP (current_buffer->filename) 4413 && SAVE_MODIFF >= MODIFF) 4414 we_locked_file = 1; 4415#endif /* CLASH_DETECTION */ 4416 prepare_to_modify_buffer (GPT, GPT, NULL); 4417 } 4418 4419 move_gap (PT); 4420 if (GAP_SIZE < total) 4421 make_gap (total - GAP_SIZE); 4422 4423 if (XINT (beg) != 0 || !NILP (replace)) 4424 { 4425 if (lseek (fd, XINT (beg), 0) < 0) 4426 report_file_error ("Setting file position", 4427 Fcons (orig_filename, Qnil)); 4428 } 4429 4430 /* In the following loop, HOW_MUCH contains the total bytes read so 4431 far for a regular file, and not changed for a special file. But, 4432 before exiting the loop, it is set to a negative value if I/O 4433 error occurs. */ 4434 how_much = 0; 4435 4436 /* Total bytes inserted. */ 4437 inserted = 0; 4438 4439 /* Here, we don't do code conversion in the loop. It is done by 4440 code_convert_region after all data are read into the buffer. */ 4441 { 4442 int gap_size = GAP_SIZE; 4443 4444 while (how_much < total) 4445 { 4446 /* try is reserved in some compilers (Microsoft C) */ 4447 int trytry = min (total - how_much, READ_BUF_SIZE); 4448 int this; 4449 4450 if (not_regular) 4451 { 4452 Lisp_Object val; 4453 4454 /* Maybe make more room. */ 4455 if (gap_size < trytry) 4456 { 4457 make_gap (total - gap_size); 4458 gap_size = GAP_SIZE; 4459 } 4460 4461 /* Read from the file, capturing `quit'. When an 4462 error occurs, end the loop, and arrange for a quit 4463 to be signaled after decoding the text we read. */ 4464 non_regular_fd = fd; 4465 non_regular_inserted = inserted; 4466 non_regular_nbytes = trytry; 4467 val = internal_condition_case_1 (read_non_regular, Qnil, Qerror, 4468 read_non_regular_quit); 4469 if (NILP (val)) 4470 { 4471 read_quit = 1; 4472 break; 4473 } 4474 4475 this = XINT (val); 4476 } 4477 else 4478 { 4479 /* Allow quitting out of the actual I/O. We don't make text 4480 part of the buffer until all the reading is done, so a C-g 4481 here doesn't do any harm. */ 4482 immediate_quit = 1; 4483 QUIT; 4484 this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry); 4485 immediate_quit = 0; 4486 } 4487 4488 if (this <= 0) 4489 { 4490 how_much = this; 4491 break; 4492 } 4493 4494 gap_size -= this; 4495 4496 /* For a regular file, where TOTAL is the real size, 4497 count HOW_MUCH to compare with it. 4498 For a special file, where TOTAL is just a buffer size, 4499 so don't bother counting in HOW_MUCH. 4500 (INSERTED is where we count the number of characters inserted.) */ 4501 if (! not_regular) 4502 how_much += this; 4503 inserted += this; 4504 } 4505 } 4506 4507 /* Now we have read all the file data into the gap. 4508 If it was empty, undo marking the buffer modified. */ 4509 4510 if (inserted == 0) 4511 { 4512#ifdef CLASH_DETECTION 4513 if (we_locked_file) 4514 unlock_file (current_buffer->file_truename); 4515#endif 4516 Vdeactivate_mark = old_Vdeactivate_mark; 4517 } 4518 else 4519 Vdeactivate_mark = Qt; 4520 4521 /* Make the text read part of the buffer. */ 4522 GAP_SIZE -= inserted; 4523 GPT += inserted; 4524 GPT_BYTE += inserted; 4525 ZV += inserted; 4526 ZV_BYTE += inserted; 4527 Z += inserted; 4528 Z_BYTE += inserted; 4529 4530 if (GAP_SIZE > 0) 4531 /* Put an anchor to ensure multi-byte form ends at gap. */ 4532 *GPT_ADDR = 0; 4533 4534 emacs_close (fd); 4535 4536 /* Discard the unwind protect for closing the file. */ 4537 specpdl_ptr--; 4538 4539 if (how_much < 0) 4540 error ("IO error reading %s: %s", 4541 SDATA (orig_filename), emacs_strerror (errno)); 4542 4543 notfound: 4544 4545 if (! coding_system_decided) 4546 { 4547 /* The coding system is not yet decided. Decide it by an 4548 optimized method for handling `coding:' tag. 4549 4550 Note that we can get here only if the buffer was empty 4551 before the insertion. */ 4552 Lisp_Object val; 4553 val = Qnil; 4554 4555 if (!NILP (Vcoding_system_for_read)) 4556 val = Vcoding_system_for_read; 4557 else 4558 { 4559 /* Since we are sure that the current buffer was empty 4560 before the insertion, we can toggle 4561 enable-multibyte-characters directly here without taking 4562 care of marker adjustment and byte combining problem. By 4563 this way, we can run Lisp program safely before decoding 4564 the inserted text. */ 4565 Lisp_Object unwind_data; 4566 int count = SPECPDL_INDEX (); 4567 4568 unwind_data = Fcons (current_buffer->enable_multibyte_characters, 4569 Fcons (current_buffer->undo_list, 4570 Fcurrent_buffer ())); 4571 current_buffer->enable_multibyte_characters = Qnil; 4572 current_buffer->undo_list = Qt; 4573 record_unwind_protect (decide_coding_unwind, unwind_data); 4574 4575 if (inserted > 0 && ! NILP (Vset_auto_coding_function)) 4576 { 4577 val = call2 (Vset_auto_coding_function, 4578 filename, make_number (inserted)); 4579 } 4580 4581 if (NILP (val)) 4582 { 4583 /* If the coding system is not yet decided, check 4584 file-coding-system-alist. */ 4585 Lisp_Object args[6], coding_systems; 4586 4587 args[0] = Qinsert_file_contents, args[1] = orig_filename; 4588 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil; 4589 coding_systems = Ffind_operation_coding_system (6, args); 4590 if (CONSP (coding_systems)) 4591 val = XCAR (coding_systems); 4592 } 4593 unbind_to (count, Qnil); 4594 inserted = Z_BYTE - BEG_BYTE; 4595 } 4596 4597 /* The following kludgy code is to avoid some compiler bug. 4598 We can't simply do 4599 setup_coding_system (val, &coding); 4600 on some system. */ 4601 { 4602 struct coding_system temp_coding; 4603 setup_coding_system (Fcheck_coding_system (val), &temp_coding); 4604 bcopy (&temp_coding, &coding, sizeof coding); 4605 } 4606 /* Ensure we set Vlast_coding_system_used. */ 4607 set_coding_system = 1; 4608 4609 if (NILP (current_buffer->enable_multibyte_characters) 4610 && ! NILP (val)) 4611 /* We must suppress all character code conversion except for 4612 end-of-line conversion. */ 4613 setup_raw_text_coding_system (&coding); 4614 coding.src_multibyte = 0; 4615 coding.dst_multibyte 4616 = !NILP (current_buffer->enable_multibyte_characters); 4617 } 4618 4619 if (!NILP (visit) 4620 /* Can't do this if part of the buffer might be preserved. */ 4621 && NILP (replace) 4622 && (coding.type == coding_type_no_conversion 4623 || coding.type == coding_type_raw_text)) 4624 { 4625 /* Visiting a file with these coding system makes the buffer 4626 unibyte. */ 4627 current_buffer->enable_multibyte_characters = Qnil; 4628 coding.dst_multibyte = 0; 4629 } 4630 4631 if (inserted > 0 || coding.type == coding_type_ccl) 4632 { 4633 if (CODING_MAY_REQUIRE_DECODING (&coding)) 4634 { 4635 code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, 4636 &coding, 0, 0); 4637 inserted = coding.produced_char; 4638 } 4639 else 4640 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, 4641 inserted); 4642 } 4643 4644 /* Now INSERTED is measured in characters. */ 4645 4646#ifdef DOS_NT 4647 /* Use the conversion type to determine buffer-file-type 4648 (find-buffer-file-type is now used to help determine the 4649 conversion). */ 4650 if ((coding.eol_type == CODING_EOL_UNDECIDED 4651 || coding.eol_type == CODING_EOL_LF) 4652 && ! CODING_REQUIRE_DECODING (&coding)) 4653 current_buffer->buffer_file_type = Qt; 4654 else 4655 current_buffer->buffer_file_type = Qnil; 4656#endif 4657 4658 handled: 4659 4660 if (!NILP (visit)) 4661 { 4662 if (!EQ (current_buffer->undo_list, Qt)) 4663 current_buffer->undo_list = Qnil; 4664#ifdef APOLLO 4665 stat (SDATA (filename), &st); 4666#endif 4667 4668 if (NILP (handler)) 4669 { 4670 current_buffer->modtime = st.st_mtime; 4671 current_buffer->filename = orig_filename; 4672 } 4673 4674 SAVE_MODIFF = MODIFF; 4675 current_buffer->auto_save_modified = MODIFF; 4676 XSETFASTINT (current_buffer->save_length, Z - BEG); 4677#ifdef CLASH_DETECTION 4678 if (NILP (handler)) 4679 { 4680 if (!NILP (current_buffer->file_truename)) 4681 unlock_file (current_buffer->file_truename); 4682 unlock_file (filename); 4683 } 4684#endif /* CLASH_DETECTION */ 4685 if (not_regular) 4686 xsignal2 (Qfile_error, 4687 build_string ("not a regular file"), orig_filename); 4688 } 4689 4690 if (set_coding_system) 4691 Vlast_coding_system_used = coding.symbol; 4692 4693 if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) 4694 { 4695 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted), 4696 visit); 4697 if (! NILP (insval)) 4698 { 4699 CHECK_NUMBER (insval); 4700 inserted = XFASTINT (insval); 4701 } 4702 } 4703 4704 /* Decode file format */ 4705 if (inserted > 0) 4706 { 4707 int empty_undo_list_p = 0; 4708 4709 /* If we're anyway going to discard undo information, don't 4710 record it in the first place. The buffer's undo list at this 4711 point is either nil or t when visiting a file. */ 4712 if (!NILP (visit)) 4713 { 4714 empty_undo_list_p = NILP (current_buffer->undo_list); 4715 current_buffer->undo_list = Qt; 4716 } 4717 4718 insval = call3 (Qformat_decode, 4719 Qnil, make_number (inserted), visit); 4720 CHECK_NUMBER (insval); 4721 inserted = XFASTINT (insval); 4722 4723 if (!NILP (visit)) 4724 current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt; 4725 } 4726 4727 /* Call after-change hooks for the inserted text, aside from the case 4728 of normal visiting (not with REPLACE), which is done in a new buffer 4729 "before" the buffer is changed. */ 4730 if (inserted > 0 && total > 0 4731 && (NILP (visit) || !NILP (replace))) 4732 { 4733 signal_after_change (PT, 0, inserted); 4734 update_compositions (PT, PT, CHECK_BORDER); 4735 } 4736 4737 p = Vafter_insert_file_functions; 4738 while (CONSP (p)) 4739 { 4740 insval = call1 (XCAR (p), make_number (inserted)); 4741 if (!NILP (insval)) 4742 { 4743 CHECK_NUMBER (insval); 4744 inserted = XFASTINT (insval); 4745 } 4746 QUIT; 4747 p = XCDR (p); 4748 } 4749 4750 if (!NILP (visit) 4751 && current_buffer->modtime == -1) 4752 { 4753 /* If visiting nonexistent file, return nil. */ 4754 report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); 4755 } 4756 4757 if (read_quit) 4758 Fsignal (Qquit, Qnil); 4759 4760 /* ??? Retval needs to be dealt with in all cases consistently. */ 4761 if (NILP (val)) 4762 val = Fcons (orig_filename, 4763 Fcons (make_number (inserted), 4764 Qnil)); 4765 4766 RETURN_UNGCPRO (unbind_to (count, val)); 4767} 4768 4769static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object)); 4770static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object, 4771 Lisp_Object, Lisp_Object)); 4772 4773/* If build_annotations switched buffers, switch back to BUF. 4774 Kill the temporary buffer that was selected in the meantime. 4775 4776 Since this kill only the last temporary buffer, some buffers remain 4777 not killed if build_annotations switched buffers more than once. 4778 -- K.Handa */ 4779 4780static Lisp_Object 4781build_annotations_unwind (buf) 4782 Lisp_Object buf; 4783{ 4784 Lisp_Object tembuf; 4785 4786 if (XBUFFER (buf) == current_buffer) 4787 return Qnil; 4788 tembuf = Fcurrent_buffer (); 4789 Fset_buffer (buf); 4790 Fkill_buffer (tembuf); 4791 return Qnil; 4792} 4793 4794/* Decide the coding-system to encode the data with. */ 4795 4796void 4797choose_write_coding_system (start, end, filename, 4798 append, visit, lockname, coding) 4799 Lisp_Object start, end, filename, append, visit, lockname; 4800 struct coding_system *coding; 4801{ 4802 Lisp_Object val; 4803 4804 if (auto_saving 4805 && NILP (Fstring_equal (current_buffer->filename, 4806 current_buffer->auto_save_file_name))) 4807 { 4808 /* We use emacs-mule for auto saving... */ 4809 setup_coding_system (Qemacs_mule, coding); 4810 /* ... but with the special flag to indicate not to strip off 4811 leading code of eight-bit-control chars. */ 4812 coding->flags = 1; 4813 /* We force LF for end-of-line because that is faster. */ 4814 coding->eol_type = CODING_EOL_LF; 4815 goto done_setup_coding; 4816 } 4817 else if (!NILP (Vcoding_system_for_write)) 4818 { 4819 val = Vcoding_system_for_write; 4820 if (coding_system_require_warning 4821 && !NILP (Ffboundp (Vselect_safe_coding_system_function))) 4822 /* Confirm that VAL can surely encode the current region. */ 4823 val = call5 (Vselect_safe_coding_system_function, 4824 start, end, Fcons (Qt, Fcons (val, Qnil)), 4825 Qnil, filename); 4826 } 4827 else 4828 { 4829 /* If the variable `buffer-file-coding-system' is set locally, 4830 it means that the file was read with some kind of code 4831 conversion or the variable is explicitly set by users. We 4832 had better write it out with the same coding system even if 4833 `enable-multibyte-characters' is nil. 4834 4835 If it is not set locally, we anyway have to convert EOL 4836 format if the default value of `buffer-file-coding-system' 4837 tells that it is not Unix-like (LF only) format. */ 4838 int using_default_coding = 0; 4839 int force_raw_text = 0; 4840 4841 val = current_buffer->buffer_file_coding_system; 4842 if (NILP (val) 4843 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) 4844 { 4845 val = Qnil; 4846 if (NILP (current_buffer->enable_multibyte_characters)) 4847 force_raw_text = 1; 4848 } 4849 4850 if (NILP (val)) 4851 { 4852 /* Check file-coding-system-alist. */ 4853 Lisp_Object args[7], coding_systems; 4854 4855 args[0] = Qwrite_region; args[1] = start; args[2] = end; 4856 args[3] = filename; args[4] = append; args[5] = visit; 4857 args[6] = lockname; 4858 coding_systems = Ffind_operation_coding_system (7, args); 4859 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems))) 4860 val = XCDR (coding_systems); 4861 } 4862 4863 if (NILP (val) 4864 && !NILP (current_buffer->buffer_file_coding_system)) 4865 { 4866 /* If we still have not decided a coding system, use the 4867 default value of buffer-file-coding-system. */ 4868 val = current_buffer->buffer_file_coding_system; 4869 using_default_coding = 1; 4870 } 4871 4872 if (!force_raw_text 4873 && !NILP (Ffboundp (Vselect_safe_coding_system_function))) 4874 /* Confirm that VAL can surely encode the current region. */ 4875 val = call5 (Vselect_safe_coding_system_function, 4876 start, end, val, Qnil, filename); 4877 4878 setup_coding_system (Fcheck_coding_system (val), coding); 4879 if (coding->eol_type == CODING_EOL_UNDECIDED 4880 && !using_default_coding) 4881 { 4882 if (! EQ (default_buffer_file_coding.symbol, 4883 buffer_defaults.buffer_file_coding_system)) 4884 setup_coding_system (buffer_defaults.buffer_file_coding_system, 4885 &default_buffer_file_coding); 4886 if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED) 4887 { 4888 Lisp_Object subsidiaries; 4889 4890 coding->eol_type = default_buffer_file_coding.eol_type; 4891 subsidiaries = Fget (coding->symbol, Qeol_type); 4892 if (VECTORP (subsidiaries) 4893 && XVECTOR (subsidiaries)->size == 3) 4894 coding->symbol 4895 = XVECTOR (subsidiaries)->contents[coding->eol_type]; 4896 } 4897 } 4898 4899 if (force_raw_text) 4900 setup_raw_text_coding_system (coding); 4901 goto done_setup_coding; 4902 } 4903 4904 setup_coding_system (Fcheck_coding_system (val), coding); 4905 4906 done_setup_coding: 4907 if (coding->eol_type == CODING_EOL_UNDECIDED) 4908 coding->eol_type = system_eol_type; 4909 if (!STRINGP (start) && !NILP (current_buffer->selective_display)) 4910 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; 4911} 4912 4913DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7, 4914 "r\nFWrite region to file: \ni\ni\ni\np", 4915 doc: /* Write current region into specified file. 4916When called from a program, requires three arguments: 4917START, END and FILENAME. START and END are normally buffer positions 4918specifying the part of the buffer to write. 4919If START is nil, that means to use the entire buffer contents. 4920If START is a string, then output that string to the file 4921instead of any buffer contents; END is ignored. 4922 4923Optional fourth argument APPEND if non-nil means 4924 append to existing file contents (if any). If it is an integer, 4925 seek to that offset in the file before writing. 4926Optional fifth argument VISIT, if t or a string, means 4927 set the last-save-file-modtime of buffer to this file's modtime 4928 and mark buffer not modified. 4929If VISIT is a string, it is a second file name; 4930 the output goes to FILENAME, but the buffer is marked as visiting VISIT. 4931 VISIT is also the file name to lock and unlock for clash detection. 4932If VISIT is neither t nor nil nor a string, 4933 that means do not display the \"Wrote file\" message. 4934The optional sixth arg LOCKNAME, if non-nil, specifies the name to 4935 use for locking and unlocking, overriding FILENAME and VISIT. 4936The optional seventh arg MUSTBENEW, if non-nil, insists on a check 4937 for an existing file with the same name. If MUSTBENEW is `excl', 4938 that means to get an error if the file already exists; never overwrite. 4939 If MUSTBENEW is neither nil nor `excl', that means ask for 4940 confirmation before overwriting, but do go ahead and overwrite the file 4941 if the user confirms. 4942 4943This does code conversion according to the value of 4944`coding-system-for-write', `buffer-file-coding-system', or 4945`file-coding-system-alist', and sets the variable 4946`last-coding-system-used' to the coding system actually used. */) 4947 (start, end, filename, append, visit, lockname, mustbenew) 4948 Lisp_Object start, end, filename, append, visit, lockname, mustbenew; 4949{ 4950 register int desc; 4951 int failure; 4952 int save_errno = 0; 4953 const unsigned char *fn; 4954 struct stat st; 4955 int tem; 4956 int count = SPECPDL_INDEX (); 4957 int count1; 4958#ifdef VMS 4959 unsigned char *fname = 0; /* If non-0, original filename (must rename) */ 4960#endif /* VMS */ 4961 Lisp_Object handler; 4962 Lisp_Object visit_file; 4963 Lisp_Object annotations; 4964 Lisp_Object encoded_filename; 4965 int visiting = (EQ (visit, Qt) || STRINGP (visit)); 4966 int quietly = !NILP (visit); 4967 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 4968 struct buffer *given_buffer; 4969#ifdef DOS_NT 4970 int buffer_file_type = O_BINARY; 4971#endif /* DOS_NT */ 4972 struct coding_system coding; 4973 4974 if (current_buffer->base_buffer && visiting) 4975 error ("Cannot do file visiting in an indirect buffer"); 4976 4977 if (!NILP (start) && !STRINGP (start)) 4978 validate_region (&start, &end); 4979 4980 visit_file = Qnil; 4981 GCPRO5 (start, filename, visit, visit_file, lockname); 4982 4983 filename = Fexpand_file_name (filename, Qnil); 4984 4985 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl)) 4986 barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1); 4987 4988 if (STRINGP (visit)) 4989 visit_file = Fexpand_file_name (visit, Qnil); 4990 else 4991 visit_file = filename; 4992 4993 if (NILP (lockname)) 4994 lockname = visit_file; 4995 4996 annotations = Qnil; 4997 4998 /* If the file name has special constructs in it, 4999 call the corresponding file handler. */ 5000 handler = Ffind_file_name_handler (filename, Qwrite_region); 5001 /* If FILENAME has no handler, see if VISIT has one. */ 5002 if (NILP (handler) && STRINGP (visit)) 5003 handler = Ffind_file_name_handler (visit, Qwrite_region); 5004 5005 if (!NILP (handler)) 5006 { 5007 Lisp_Object val; 5008 val = call6 (handler, Qwrite_region, start, end, 5009 filename, append, visit); 5010 5011 if (visiting) 5012 { 5013 SAVE_MODIFF = MODIFF; 5014 XSETFASTINT (current_buffer->save_length, Z - BEG); 5015 current_buffer->filename = visit_file; 5016 } 5017 UNGCPRO; 5018 return val; 5019 } 5020 5021 record_unwind_protect (save_restriction_restore, save_restriction_save ()); 5022 5023 /* Special kludge to simplify auto-saving. */ 5024 if (NILP (start)) 5025 { 5026 XSETFASTINT (start, BEG); 5027 XSETFASTINT (end, Z); 5028 Fwiden (); 5029 } 5030 5031 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); 5032 count1 = SPECPDL_INDEX (); 5033 5034 given_buffer = current_buffer; 5035 5036 if (!STRINGP (start)) 5037 { 5038 annotations = build_annotations (start, end); 5039 5040 if (current_buffer != given_buffer) 5041 { 5042 XSETFASTINT (start, BEGV); 5043 XSETFASTINT (end, ZV); 5044 } 5045 } 5046 5047 UNGCPRO; 5048 5049 GCPRO5 (start, filename, annotations, visit_file, lockname); 5050 5051 /* Decide the coding-system to encode the data with. 5052 We used to make this choice before calling build_annotations, but that 5053 leads to problems when a write-annotate-function takes care of 5054 unsavable chars (as was the case with X-Symbol). */ 5055 choose_write_coding_system (start, end, filename, 5056 append, visit, lockname, &coding); 5057 Vlast_coding_system_used = coding.symbol; 5058 5059 given_buffer = current_buffer; 5060 if (! STRINGP (start)) 5061 { 5062 annotations = build_annotations_2 (start, end, 5063 coding.pre_write_conversion, annotations); 5064 if (current_buffer != given_buffer) 5065 { 5066 XSETFASTINT (start, BEGV); 5067 XSETFASTINT (end, ZV); 5068 } 5069 } 5070 5071#ifdef CLASH_DETECTION 5072 if (!auto_saving) 5073 { 5074#if 0 /* This causes trouble for GNUS. */ 5075 /* If we've locked this file for some other buffer, 5076 query before proceeding. */ 5077 if (!visiting && EQ (Ffile_locked_p (lockname), Qt)) 5078 call2 (intern ("ask-user-about-lock"), filename, Vuser_login_name); 5079#endif 5080 5081 lock_file (lockname); 5082 } 5083#endif /* CLASH_DETECTION */ 5084 5085 encoded_filename = ENCODE_FILE (filename); 5086 5087 fn = SDATA (encoded_filename); 5088 desc = -1; 5089 if (!NILP (append)) 5090#ifdef DOS_NT 5091 desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0); 5092#else /* not DOS_NT */ 5093 desc = emacs_open (fn, O_WRONLY, 0); 5094#endif /* not DOS_NT */ 5095 5096 if (desc < 0 && (NILP (append) || errno == ENOENT)) 5097#ifdef VMS 5098 if (auto_saving) /* Overwrite any previous version of autosave file */ 5099 { 5100 vms_truncate (fn); /* if fn exists, truncate to zero length */ 5101 desc = emacs_open (fn, O_RDWR, 0); 5102 if (desc < 0) 5103 desc = creat_copy_attrs (STRINGP (current_buffer->filename) 5104 ? SDATA (current_buffer->filename) : 0, 5105 fn); 5106 } 5107 else /* Write to temporary name and rename if no errors */ 5108 { 5109 Lisp_Object temp_name; 5110 temp_name = Ffile_name_directory (filename); 5111 5112 if (!NILP (temp_name)) 5113 { 5114 temp_name = Fmake_temp_name (concat2 (temp_name, 5115 build_string ("$$SAVE$$"))); 5116 fname = SDATA (filename); 5117 fn = SDATA (temp_name); 5118 desc = creat_copy_attrs (fname, fn); 5119 if (desc < 0) 5120 { 5121 /* If we can't open the temporary file, try creating a new 5122 version of the original file. VMS "creat" creates a 5123 new version rather than truncating an existing file. */ 5124 fn = fname; 5125 fname = 0; 5126 desc = creat (fn, 0666); 5127#if 0 /* This can clobber an existing file and fail to replace it, 5128 if the user runs out of space. */ 5129 if (desc < 0) 5130 { 5131 /* We can't make a new version; 5132 try to truncate and rewrite existing version if any. */ 5133 vms_truncate (fn); 5134 desc = emacs_open (fn, O_RDWR, 0); 5135 } 5136#endif 5137 } 5138 } 5139 else 5140 desc = creat (fn, 0666); 5141 } 5142#else /* not VMS */ 5143#ifdef DOS_NT 5144 desc = emacs_open (fn, 5145 O_WRONLY | O_CREAT | buffer_file_type 5146 | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC), 5147 S_IREAD | S_IWRITE); 5148#else /* not DOS_NT */ 5149 desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT 5150 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), 5151 auto_saving ? auto_save_mode_bits : 0666); 5152#endif /* not DOS_NT */ 5153#endif /* not VMS */ 5154 5155 if (desc < 0) 5156 { 5157#ifdef CLASH_DETECTION 5158 save_errno = errno; 5159 if (!auto_saving) unlock_file (lockname); 5160 errno = save_errno; 5161#endif /* CLASH_DETECTION */ 5162 UNGCPRO; 5163 report_file_error ("Opening output file", Fcons (filename, Qnil)); 5164 } 5165 5166 record_unwind_protect (close_file_unwind, make_number (desc)); 5167 5168 if (!NILP (append) && !NILP (Ffile_regular_p (filename))) 5169 { 5170 long ret; 5171 5172 if (NUMBERP (append)) 5173 ret = lseek (desc, XINT (append), 1); 5174 else 5175 ret = lseek (desc, 0, 2); 5176 if (ret < 0) 5177 { 5178#ifdef CLASH_DETECTION 5179 if (!auto_saving) unlock_file (lockname); 5180#endif /* CLASH_DETECTION */ 5181 UNGCPRO; 5182 report_file_error ("Lseek error", Fcons (filename, Qnil)); 5183 } 5184 } 5185 5186 UNGCPRO; 5187 5188#ifdef VMS 5189/* 5190 * Kludge Warning: The VMS C RTL likes to insert carriage returns 5191 * if we do writes that don't end with a carriage return. Furthermore 5192 * it cannot handle writes of more then 16K. The modified 5193 * version of "sys_write" in SYSDEP.C (see comment there) copes with 5194 * this EXCEPT for the last record (iff it doesn't end with a carriage 5195 * return). This implies that if your buffer doesn't end with a carriage 5196 * return, you get one free... tough. However it also means that if 5197 * we make two calls to sys_write (a la the following code) you can 5198 * get one at the gap as well. The easiest way to fix this (honest) 5199 * is to move the gap to the next newline (or the end of the buffer). 5200 * Thus this change. 5201 * 5202 * Yech! 5203 */ 5204 if (GPT > BEG && GPT_ADDR[-1] != '\n') 5205 move_gap (find_next_newline (GPT, 1)); 5206#else 5207 /* Whether VMS or not, we must move the gap to the next of newline 5208 when we must put designation sequences at beginning of line. */ 5209 if (INTEGERP (start) 5210 && coding.type == coding_type_iso2022 5211 && coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL 5212 && GPT > BEG && GPT_ADDR[-1] != '\n') 5213 { 5214 int opoint = PT, opoint_byte = PT_BYTE; 5215 scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0); 5216 move_gap_both (PT, PT_BYTE); 5217 SET_PT_BOTH (opoint, opoint_byte); 5218 } 5219#endif 5220 5221 failure = 0; 5222 immediate_quit = 1; 5223 5224 if (STRINGP (start)) 5225 { 5226 failure = 0 > a_write (desc, start, 0, SCHARS (start), 5227 &annotations, &coding); 5228 save_errno = errno; 5229 } 5230 else if (XINT (start) != XINT (end)) 5231 { 5232 tem = CHAR_TO_BYTE (XINT (start)); 5233 5234 if (XINT (start) < GPT) 5235 { 5236 failure = 0 > a_write (desc, Qnil, XINT (start), 5237 min (GPT, XINT (end)) - XINT (start), 5238 &annotations, &coding); 5239 save_errno = errno; 5240 } 5241 5242 if (XINT (end) > GPT && !failure) 5243 { 5244 tem = max (XINT (start), GPT); 5245 failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem, 5246 &annotations, &coding); 5247 save_errno = errno; 5248 } 5249 } 5250 else 5251 { 5252 /* If file was empty, still need to write the annotations */ 5253 coding.mode |= CODING_MODE_LAST_BLOCK; 5254 failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding); 5255 save_errno = errno; 5256 } 5257 5258 if (CODING_REQUIRE_FLUSHING (&coding) 5259 && !(coding.mode & CODING_MODE_LAST_BLOCK) 5260 && ! failure) 5261 { 5262 /* We have to flush out a data. */ 5263 coding.mode |= CODING_MODE_LAST_BLOCK; 5264 failure = 0 > e_write (desc, Qnil, 0, 0, &coding); 5265 save_errno = errno; 5266 } 5267 5268 immediate_quit = 0; 5269 5270#ifdef HAVE_FSYNC 5271 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). 5272 Disk full in NFS may be reported here. */ 5273 /* mib says that closing the file will try to write as fast as NFS can do 5274 it, and that means the fsync here is not crucial for autosave files. */ 5275 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0) 5276 { 5277 /* If fsync fails with EINTR, don't treat that as serious. */ 5278 if (errno != EINTR) 5279 failure = 1, save_errno = errno; 5280 } 5281#endif 5282 5283 /* Spurious "file has changed on disk" warnings have been 5284 observed on Suns as well. 5285 It seems that `close' can change the modtime, under nfs. 5286 5287 (This has supposedly been fixed in Sunos 4, 5288 but who knows about all the other machines with NFS?) */ 5289#if 0 5290 5291 /* On VMS and APOLLO, must do the stat after the close 5292 since closing changes the modtime. */ 5293#ifndef VMS 5294#ifndef APOLLO 5295 /* Recall that #if defined does not work on VMS. */ 5296#define FOO 5297 fstat (desc, &st); 5298#endif 5299#endif 5300#endif 5301 5302 /* NFS can report a write failure now. */ 5303 if (emacs_close (desc) < 0) 5304 failure = 1, save_errno = errno; 5305 5306#ifdef VMS 5307 /* If we wrote to a temporary name and had no errors, rename to real name. */ 5308 if (fname) 5309 { 5310 if (!failure) 5311 failure = (rename (fn, fname) != 0), save_errno = errno; 5312 fn = fname; 5313 } 5314#endif /* VMS */ 5315 5316#ifndef FOO 5317 stat (fn, &st); 5318#endif 5319 /* Discard the unwind protect for close_file_unwind. */ 5320 specpdl_ptr = specpdl + count1; 5321 /* Restore the original current buffer. */ 5322 visit_file = unbind_to (count, visit_file); 5323 5324#ifdef CLASH_DETECTION 5325 if (!auto_saving) 5326 unlock_file (lockname); 5327#endif /* CLASH_DETECTION */ 5328 5329 /* Do this before reporting IO error 5330 to avoid a "file has changed on disk" warning on 5331 next attempt to save. */ 5332 if (visiting) 5333 current_buffer->modtime = st.st_mtime; 5334 5335 if (failure) 5336 error ("IO error writing %s: %s", SDATA (filename), 5337 emacs_strerror (save_errno)); 5338 5339 if (visiting) 5340 { 5341 SAVE_MODIFF = MODIFF; 5342 XSETFASTINT (current_buffer->save_length, Z - BEG); 5343 current_buffer->filename = visit_file; 5344 update_mode_lines++; 5345 } 5346 else if (quietly) 5347 { 5348 if (auto_saving 5349 && ! NILP (Fstring_equal (current_buffer->filename, 5350 current_buffer->auto_save_file_name))) 5351 SAVE_MODIFF = MODIFF; 5352 5353 return Qnil; 5354 } 5355 5356 if (!auto_saving) 5357 message_with_string ((INTEGERP (append) 5358 ? "Updated %s" 5359 : ! NILP (append) 5360 ? "Added to %s" 5361 : "Wrote %s"), 5362 visit_file, 1); 5363 5364 return Qnil; 5365} 5366 5367Lisp_Object merge (); 5368 5369DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, 5370 doc: /* Return t if (car A) is numerically less than (car B). */) 5371 (a, b) 5372 Lisp_Object a, b; 5373{ 5374 return Flss (Fcar (a), Fcar (b)); 5375} 5376 5377/* Build the complete list of annotations appropriate for writing out 5378 the text between START and END, by calling all the functions in 5379 write-region-annotate-functions and merging the lists they return. 5380 If one of these functions switches to a different buffer, we assume 5381 that buffer contains altered text. Therefore, the caller must 5382 make sure to restore the current buffer in all cases, 5383 as save-excursion would do. */ 5384 5385static Lisp_Object 5386build_annotations (start, end) 5387 Lisp_Object start, end; 5388{ 5389 Lisp_Object annotations; 5390 Lisp_Object p, res; 5391 struct gcpro gcpro1, gcpro2; 5392 Lisp_Object original_buffer; 5393 int i, used_global = 0; 5394 5395 XSETBUFFER (original_buffer, current_buffer); 5396 5397 annotations = Qnil; 5398 p = Vwrite_region_annotate_functions; 5399 GCPRO2 (annotations, p); 5400 while (CONSP (p)) 5401 { 5402 struct buffer *given_buffer = current_buffer; 5403 if (EQ (Qt, XCAR (p)) && !used_global) 5404 { /* Use the global value of the hook. */ 5405 Lisp_Object arg[2]; 5406 used_global = 1; 5407 arg[0] = Fdefault_value (Qwrite_region_annotate_functions); 5408 arg[1] = XCDR (p); 5409 p = Fappend (2, arg); 5410 continue; 5411 } 5412 Vwrite_region_annotations_so_far = annotations; 5413 res = call2 (XCAR (p), start, end); 5414 /* If the function makes a different buffer current, 5415 assume that means this buffer contains altered text to be output. 5416 Reset START and END from the buffer bounds 5417 and discard all previous annotations because they should have 5418 been dealt with by this function. */ 5419 if (current_buffer != given_buffer) 5420 { 5421 XSETFASTINT (start, BEGV); 5422 XSETFASTINT (end, ZV); 5423 annotations = Qnil; 5424 } 5425 Flength (res); /* Check basic validity of return value */ 5426 annotations = merge (annotations, res, Qcar_less_than_car); 5427 p = XCDR (p); 5428 } 5429 5430 /* Now do the same for annotation functions implied by the file-format */ 5431 if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt))) 5432 p = current_buffer->auto_save_file_format; 5433 else 5434 p = current_buffer->file_format; 5435 for (i = 0; CONSP (p); p = XCDR (p), ++i) 5436 { 5437 struct buffer *given_buffer = current_buffer; 5438 5439 Vwrite_region_annotations_so_far = annotations; 5440 5441 /* Value is either a list of annotations or nil if the function 5442 has written annotations to a temporary buffer, which is now 5443 current. */ 5444 res = call5 (Qformat_annotate_function, XCAR (p), start, end, 5445 original_buffer, make_number (i)); 5446 if (current_buffer != given_buffer) 5447 { 5448 XSETFASTINT (start, BEGV); 5449 XSETFASTINT (end, ZV); 5450 annotations = Qnil; 5451 } 5452 5453 if (CONSP (res)) 5454 annotations = merge (annotations, res, Qcar_less_than_car); 5455 } 5456 5457 UNGCPRO; 5458 return annotations; 5459} 5460 5461static Lisp_Object 5462build_annotations_2 (start, end, pre_write_conversion, annotations) 5463 Lisp_Object start, end, pre_write_conversion, annotations; 5464{ 5465 struct gcpro gcpro1; 5466 Lisp_Object res; 5467 5468 GCPRO1 (annotations); 5469 /* At last, do the same for the function PRE_WRITE_CONVERSION 5470 implied by the current coding-system. */ 5471 if (!NILP (pre_write_conversion)) 5472 { 5473 struct buffer *given_buffer = current_buffer; 5474 Vwrite_region_annotations_so_far = annotations; 5475 res = call2 (pre_write_conversion, start, end); 5476 Flength (res); 5477 annotations = (current_buffer != given_buffer 5478 ? res 5479 : merge (annotations, res, Qcar_less_than_car)); 5480 } 5481 5482 UNGCPRO; 5483 return annotations; 5484} 5485 5486/* Write to descriptor DESC the NCHARS chars starting at POS of STRING. 5487 If STRING is nil, POS is the character position in the current buffer. 5488 Intersperse with them the annotations from *ANNOT 5489 which fall within the range of POS to POS + NCHARS, 5490 each at its appropriate position. 5491 5492 We modify *ANNOT by discarding elements as we use them up. 5493 5494 The return value is negative in case of system call failure. */ 5495 5496static int 5497a_write (desc, string, pos, nchars, annot, coding) 5498 int desc; 5499 Lisp_Object string; 5500 register int nchars; 5501 int pos; 5502 Lisp_Object *annot; 5503 struct coding_system *coding; 5504{ 5505 Lisp_Object tem; 5506 int nextpos; 5507 int lastpos = pos + nchars; 5508 5509 while (NILP (*annot) || CONSP (*annot)) 5510 { 5511 tem = Fcar_safe (Fcar (*annot)); 5512 nextpos = pos - 1; 5513 if (INTEGERP (tem)) 5514 nextpos = XFASTINT (tem); 5515 5516 /* If there are no more annotations in this range, 5517 output the rest of the range all at once. */ 5518 if (! (nextpos >= pos && nextpos <= lastpos)) 5519 return e_write (desc, string, pos, lastpos, coding); 5520 5521 /* Output buffer text up to the next annotation's position. */ 5522 if (nextpos > pos) 5523 { 5524 if (0 > e_write (desc, string, pos, nextpos, coding)) 5525 return -1; 5526 pos = nextpos; 5527 } 5528 /* Output the annotation. */ 5529 tem = Fcdr (Fcar (*annot)); 5530 if (STRINGP (tem)) 5531 { 5532 if (0 > e_write (desc, tem, 0, SCHARS (tem), coding)) 5533 return -1; 5534 } 5535 *annot = Fcdr (*annot); 5536 } 5537 return 0; 5538} 5539 5540#ifndef WRITE_BUF_SIZE 5541#define WRITE_BUF_SIZE (16 * 1024) 5542#endif 5543 5544/* Write text in the range START and END into descriptor DESC, 5545 encoding them with coding system CODING. If STRING is nil, START 5546 and END are character positions of the current buffer, else they 5547 are indexes to the string STRING. */ 5548 5549static int 5550e_write (desc, string, start, end, coding) 5551 int desc; 5552 Lisp_Object string; 5553 int start, end; 5554 struct coding_system *coding; 5555{ 5556 register char *addr; 5557 register int nbytes; 5558 char buf[WRITE_BUF_SIZE]; 5559 int return_val = 0; 5560 5561 if (start >= end) 5562 coding->composing = COMPOSITION_DISABLED; 5563 if (coding->composing != COMPOSITION_DISABLED) 5564 coding_save_composition (coding, start, end, string); 5565 5566 if (STRINGP (string)) 5567 { 5568 addr = SDATA (string); 5569 nbytes = SBYTES (string); 5570 coding->src_multibyte = STRING_MULTIBYTE (string); 5571 } 5572 else if (start < end) 5573 { 5574 /* It is assured that the gap is not in the range START and END-1. */ 5575 addr = CHAR_POS_ADDR (start); 5576 nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start); 5577 coding->src_multibyte 5578 = !NILP (current_buffer->enable_multibyte_characters); 5579 } 5580 else 5581 { 5582 addr = ""; 5583 nbytes = 0; 5584 coding->src_multibyte = 1; 5585 } 5586 5587 /* We used to have a code for handling selective display here. But, 5588 now it is handled within encode_coding. */ 5589 while (1) 5590 { 5591 int result; 5592 5593 result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE); 5594 if (coding->produced > 0) 5595 { 5596 coding->produced -= emacs_write (desc, buf, coding->produced); 5597 if (coding->produced) 5598 { 5599 return_val = -1; 5600 break; 5601 } 5602 } 5603 nbytes -= coding->consumed; 5604 addr += coding->consumed; 5605 if (result == CODING_FINISH_INSUFFICIENT_SRC 5606 && nbytes > 0) 5607 { 5608 /* The source text ends by an incomplete multibyte form. 5609 There's no way other than write it out as is. */ 5610 nbytes -= emacs_write (desc, addr, nbytes); 5611 if (nbytes) 5612 { 5613 return_val = -1; 5614 break; 5615 } 5616 } 5617 if (nbytes <= 0) 5618 break; 5619 start += coding->consumed_char; 5620 if (coding->cmp_data) 5621 coding_adjust_composition_offset (coding, start); 5622 } 5623 5624 if (coding->cmp_data) 5625 coding_free_composition_data (coding); 5626 5627 return return_val; 5628} 5629 5630DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 5631 Sverify_visited_file_modtime, 1, 1, 0, 5632 doc: /* Return t if last mod time of BUF's visited file matches what BUF records. 5633This means that the file has not been changed since it was visited or saved. 5634See Info node `(elisp)Modification Time' for more details. */) 5635 (buf) 5636 Lisp_Object buf; 5637{ 5638 struct buffer *b; 5639 struct stat st; 5640 Lisp_Object handler; 5641 Lisp_Object filename; 5642 5643 CHECK_BUFFER (buf); 5644 b = XBUFFER (buf); 5645 5646 if (!STRINGP (b->filename)) return Qt; 5647 if (b->modtime == 0) return Qt; 5648 5649 /* If the file name has special constructs in it, 5650 call the corresponding file handler. */ 5651 handler = Ffind_file_name_handler (b->filename, 5652 Qverify_visited_file_modtime); 5653 if (!NILP (handler)) 5654 return call2 (handler, Qverify_visited_file_modtime, buf); 5655 5656 filename = ENCODE_FILE (b->filename); 5657 5658 if (stat (SDATA (filename), &st) < 0) 5659 { 5660 /* If the file doesn't exist now and didn't exist before, 5661 we say that it isn't modified, provided the error is a tame one. */ 5662 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) 5663 st.st_mtime = -1; 5664 else 5665 st.st_mtime = 0; 5666 } 5667 if (st.st_mtime == b->modtime 5668 /* If both are positive, accept them if they are off by one second. */ 5669 || (st.st_mtime > 0 && b->modtime > 0 5670 && (st.st_mtime == b->modtime + 1 5671 || st.st_mtime == b->modtime - 1))) 5672 return Qt; 5673 return Qnil; 5674} 5675 5676DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 5677 Sclear_visited_file_modtime, 0, 0, 0, 5678 doc: /* Clear out records of last mod time of visited file. 5679Next attempt to save will certainly not complain of a discrepancy. */) 5680 () 5681{ 5682 current_buffer->modtime = 0; 5683 return Qnil; 5684} 5685 5686DEFUN ("visited-file-modtime", Fvisited_file_modtime, 5687 Svisited_file_modtime, 0, 0, 0, 5688 doc: /* Return the current buffer's recorded visited file modification time. 5689The value is a list of the form (HIGH LOW), like the time values 5690that `file-attributes' returns. If the current buffer has no recorded 5691file modification time, this function returns 0. 5692See Info node `(elisp)Modification Time' for more details. */) 5693 () 5694{ 5695 Lisp_Object tcons; 5696 tcons = long_to_cons ((unsigned long) current_buffer->modtime); 5697 if (CONSP (tcons)) 5698 return list2 (XCAR (tcons), XCDR (tcons)); 5699 return tcons; 5700} 5701 5702DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 5703 Sset_visited_file_modtime, 0, 1, 0, 5704 doc: /* Update buffer's recorded modification time from the visited file's time. 5705Useful if the buffer was not read from the file normally 5706or if the file itself has been changed for some known benign reason. 5707An argument specifies the modification time value to use 5708\(instead of that of the visited file), in the form of a list 5709\(HIGH . LOW) or (HIGH LOW). */) 5710 (time_list) 5711 Lisp_Object time_list; 5712{ 5713 if (!NILP (time_list)) 5714 current_buffer->modtime = cons_to_long (time_list); 5715 else 5716 { 5717 register Lisp_Object filename; 5718 struct stat st; 5719 Lisp_Object handler; 5720 5721 filename = Fexpand_file_name (current_buffer->filename, Qnil); 5722 5723 /* If the file name has special constructs in it, 5724 call the corresponding file handler. */ 5725 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); 5726 if (!NILP (handler)) 5727 /* The handler can find the file name the same way we did. */ 5728 return call2 (handler, Qset_visited_file_modtime, Qnil); 5729 5730 filename = ENCODE_FILE (filename); 5731 5732 if (stat (SDATA (filename), &st) >= 0) 5733 current_buffer->modtime = st.st_mtime; 5734 } 5735 5736 return Qnil; 5737} 5738 5739Lisp_Object 5740auto_save_error (error) 5741 Lisp_Object error; 5742{ 5743 Lisp_Object args[3], msg; 5744 int i, nbytes; 5745 struct gcpro gcpro1; 5746 char *msgbuf; 5747 USE_SAFE_ALLOCA; 5748 5749 ring_bell (); 5750 5751 args[0] = build_string ("Auto-saving %s: %s"); 5752 args[1] = current_buffer->name; 5753 args[2] = Ferror_message_string (error); 5754 msg = Fformat (3, args); 5755 GCPRO1 (msg); 5756 nbytes = SBYTES (msg); 5757 SAFE_ALLOCA (msgbuf, char *, nbytes); 5758 bcopy (SDATA (msg), msgbuf, nbytes); 5759 5760 for (i = 0; i < 3; ++i) 5761 { 5762 if (i == 0) 5763 message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg)); 5764 else 5765 message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg)); 5766 Fsleep_for (make_number (1), Qnil); 5767 } 5768 5769 SAFE_FREE (); 5770 UNGCPRO; 5771 return Qnil; 5772} 5773 5774Lisp_Object 5775auto_save_1 () 5776{ 5777 struct stat st; 5778 Lisp_Object modes; 5779 5780 auto_save_mode_bits = 0666; 5781 5782 /* Get visited file's mode to become the auto save file's mode. */ 5783 if (! NILP (current_buffer->filename)) 5784 { 5785 if (stat (SDATA (current_buffer->filename), &st) >= 0) 5786 /* But make sure we can overwrite it later! */ 5787 auto_save_mode_bits = st.st_mode | 0600; 5788 else if ((modes = Ffile_modes (current_buffer->filename), 5789 INTEGERP (modes))) 5790 /* Remote files don't cooperate with stat. */ 5791 auto_save_mode_bits = XINT (modes) | 0600; 5792 } 5793 5794 return 5795 Fwrite_region (Qnil, Qnil, 5796 current_buffer->auto_save_file_name, 5797 Qnil, Qlambda, Qnil, Qnil); 5798} 5799 5800static Lisp_Object 5801do_auto_save_unwind (arg) /* used as unwind-protect function */ 5802 Lisp_Object arg; 5803{ 5804 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; 5805 auto_saving = 0; 5806 if (stream != NULL) 5807 { 5808 BLOCK_INPUT; 5809 fclose (stream); 5810 UNBLOCK_INPUT; 5811 } 5812 return Qnil; 5813} 5814 5815static Lisp_Object 5816do_auto_save_unwind_1 (value) /* used as unwind-protect function */ 5817 Lisp_Object value; 5818{ 5819 minibuffer_auto_raise = XINT (value); 5820 return Qnil; 5821} 5822 5823static Lisp_Object 5824do_auto_save_make_dir (dir) 5825 Lisp_Object dir; 5826{ 5827 Lisp_Object mode; 5828 5829 call2 (Qmake_directory, dir, Qt); 5830 XSETFASTINT (mode, 0700); 5831 return Fset_file_modes (dir, mode); 5832} 5833 5834static Lisp_Object 5835do_auto_save_eh (ignore) 5836 Lisp_Object ignore; 5837{ 5838 return Qnil; 5839} 5840 5841DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "", 5842 doc: /* Auto-save all buffers that need it. 5843This is all buffers that have auto-saving enabled 5844and are changed since last auto-saved. 5845Auto-saving writes the buffer into a file 5846so that your editing is not lost if the system crashes. 5847This file is not the file you visited; that changes only when you save. 5848Normally we run the normal hook `auto-save-hook' before saving. 5849 5850A non-nil NO-MESSAGE argument means do not print any message if successful. 5851A non-nil CURRENT-ONLY argument means save only current buffer. */) 5852 (no_message, current_only) 5853 Lisp_Object no_message, current_only; 5854{ 5855 struct buffer *old = current_buffer, *b; 5856 Lisp_Object tail, buf; 5857 int auto_saved = 0; 5858 int do_handled_files; 5859 Lisp_Object oquit; 5860 FILE *stream = NULL; 5861 int count = SPECPDL_INDEX (); 5862 int orig_minibuffer_auto_raise = minibuffer_auto_raise; 5863 int old_message_p = 0; 5864 struct gcpro gcpro1, gcpro2; 5865 5866 if (max_specpdl_size < specpdl_size + 40) 5867 max_specpdl_size = specpdl_size + 40; 5868 5869 if (minibuf_level) 5870 no_message = Qt; 5871 5872 if (NILP (no_message)) 5873 { 5874 old_message_p = push_message (); 5875 record_unwind_protect (pop_message_unwind, Qnil); 5876 } 5877 5878 /* Ordinarily don't quit within this function, 5879 but don't make it impossible to quit (in case we get hung in I/O). */ 5880 oquit = Vquit_flag; 5881 Vquit_flag = Qnil; 5882 5883 /* No GCPRO needed, because (when it matters) all Lisp_Object variables 5884 point to non-strings reached from Vbuffer_alist. */ 5885 5886 if (!NILP (Vrun_hooks)) 5887 call1 (Vrun_hooks, intern ("auto-save-hook")); 5888 5889 if (STRINGP (Vauto_save_list_file_name)) 5890 { 5891 Lisp_Object listfile; 5892 5893 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); 5894 5895 /* Don't try to create the directory when shutting down Emacs, 5896 because creating the directory might signal an error, and 5897 that would leave Emacs in a strange state. */ 5898 if (!NILP (Vrun_hooks)) 5899 { 5900 Lisp_Object dir; 5901 dir = Qnil; 5902 GCPRO2 (dir, listfile); 5903 dir = Ffile_name_directory (listfile); 5904 if (NILP (Ffile_directory_p (dir))) 5905 internal_condition_case_1 (do_auto_save_make_dir, 5906 dir, Fcons (Fcons (Qfile_error, Qnil), Qnil), 5907 do_auto_save_eh); 5908 UNGCPRO; 5909 } 5910 5911 stream = fopen (SDATA (listfile), "w"); 5912 } 5913 5914 record_unwind_protect (do_auto_save_unwind, 5915 make_save_value (stream, 0)); 5916 record_unwind_protect (do_auto_save_unwind_1, 5917 make_number (minibuffer_auto_raise)); 5918 minibuffer_auto_raise = 0; 5919 auto_saving = 1; 5920 5921 /* On first pass, save all files that don't have handlers. 5922 On second pass, save all files that do have handlers. 5923 5924 If Emacs is crashing, the handlers may tweak what is causing 5925 Emacs to crash in the first place, and it would be a shame if 5926 Emacs failed to autosave perfectly ordinary files because it 5927 couldn't handle some ange-ftp'd file. */ 5928 5929 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) 5930 for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) 5931 { 5932 buf = XCDR (XCAR (tail)); 5933 b = XBUFFER (buf); 5934 5935 /* Record all the buffers that have auto save mode 5936 in the special file that lists them. For each of these buffers, 5937 Record visited name (if any) and auto save name. */ 5938 if (STRINGP (b->auto_save_file_name) 5939 && stream != NULL && do_handled_files == 0) 5940 { 5941 BLOCK_INPUT; 5942 if (!NILP (b->filename)) 5943 { 5944 fwrite (SDATA (b->filename), 1, 5945 SBYTES (b->filename), stream); 5946 } 5947 putc ('\n', stream); 5948 fwrite (SDATA (b->auto_save_file_name), 1, 5949 SBYTES (b->auto_save_file_name), stream); 5950 putc ('\n', stream); 5951 UNBLOCK_INPUT; 5952 } 5953 5954 if (!NILP (current_only) 5955 && b != current_buffer) 5956 continue; 5957 5958 /* Don't auto-save indirect buffers. 5959 The base buffer takes care of it. */ 5960 if (b->base_buffer) 5961 continue; 5962 5963 /* Check for auto save enabled 5964 and file changed since last auto save 5965 and file changed since last real save. */ 5966 if (STRINGP (b->auto_save_file_name) 5967 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) 5968 && b->auto_save_modified < BUF_MODIFF (b) 5969 /* -1 means we've turned off autosaving for a while--see below. */ 5970 && XINT (b->save_length) >= 0 5971 && (do_handled_files 5972 || NILP (Ffind_file_name_handler (b->auto_save_file_name, 5973 Qwrite_region)))) 5974 { 5975 EMACS_TIME before_time, after_time; 5976 5977 EMACS_GET_TIME (before_time); 5978 5979 /* If we had a failure, don't try again for 20 minutes. */ 5980 if (b->auto_save_failure_time >= 0 5981 && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200) 5982 continue; 5983 5984 if ((XFASTINT (b->save_length) * 10 5985 > (BUF_Z (b) - BUF_BEG (b)) * 13) 5986 /* A short file is likely to change a large fraction; 5987 spare the user annoying messages. */ 5988 && XFASTINT (b->save_length) > 5000 5989 /* These messages are frequent and annoying for `*mail*'. */ 5990 && !EQ (b->filename, Qnil) 5991 && NILP (no_message)) 5992 { 5993 /* It has shrunk too much; turn off auto-saving here. */ 5994 minibuffer_auto_raise = orig_minibuffer_auto_raise; 5995 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save", 5996 b->name, 1); 5997 minibuffer_auto_raise = 0; 5998 /* Turn off auto-saving until there's a real save, 5999 and prevent any more warnings. */ 6000 XSETINT (b->save_length, -1); 6001 Fsleep_for (make_number (1), Qnil); 6002 continue; 6003 } 6004 set_buffer_internal (b); 6005 if (!auto_saved && NILP (no_message)) 6006 message1 ("Auto-saving..."); 6007 internal_condition_case (auto_save_1, Qt, auto_save_error); 6008 auto_saved++; 6009 b->auto_save_modified = BUF_MODIFF (b); 6010 XSETFASTINT (current_buffer->save_length, Z - BEG); 6011 set_buffer_internal (old); 6012 6013 EMACS_GET_TIME (after_time); 6014 6015 /* If auto-save took more than 60 seconds, 6016 assume it was an NFS failure that got a timeout. */ 6017 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) 6018 b->auto_save_failure_time = EMACS_SECS (after_time); 6019 } 6020 } 6021 6022 /* Prevent another auto save till enough input events come in. */ 6023 record_auto_save (); 6024 6025 if (auto_saved && NILP (no_message)) 6026 { 6027 if (old_message_p) 6028 { 6029 /* If we are going to restore an old message, 6030 give time to read ours. */ 6031 sit_for (make_number (1), 0, 0); 6032 restore_message (); 6033 } 6034 else 6035 /* If we displayed a message and then restored a state 6036 with no message, leave a "done" message on the screen. */ 6037 message1 ("Auto-saving...done"); 6038 } 6039 6040 Vquit_flag = oquit; 6041 6042 /* This restores the message-stack status. */ 6043 unbind_to (count, Qnil); 6044 return Qnil; 6045} 6046 6047DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 6048 Sset_buffer_auto_saved, 0, 0, 0, 6049 doc: /* Mark current buffer as auto-saved with its current text. 6050No auto-save file will be written until the buffer changes again. */) 6051 () 6052{ 6053 current_buffer->auto_save_modified = MODIFF; 6054 XSETFASTINT (current_buffer->save_length, Z - BEG); 6055 current_buffer->auto_save_failure_time = -1; 6056 return Qnil; 6057} 6058 6059DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 6060 Sclear_buffer_auto_save_failure, 0, 0, 0, 6061 doc: /* Clear any record of a recent auto-save failure in the current buffer. */) 6062 () 6063{ 6064 current_buffer->auto_save_failure_time = -1; 6065 return Qnil; 6066} 6067 6068DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p, 6069 0, 0, 0, 6070 doc: /* Return t if current buffer has been auto-saved recently. 6071More precisely, if it has been auto-saved since last read from or saved 6072in the visited file. If the buffer has no visited file, 6073then any auto-save counts as "recent". */) 6074 () 6075{ 6076 return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil; 6077} 6078 6079/* Reading and completing file names */ 6080extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions (); 6081 6082/* In the string VAL, change each $ to $$ and return the result. */ 6083 6084static Lisp_Object 6085double_dollars (val) 6086 Lisp_Object val; 6087{ 6088 register const unsigned char *old; 6089 register unsigned char *new; 6090 register int n; 6091 int osize, count; 6092 6093 osize = SBYTES (val); 6094 6095 /* Count the number of $ characters. */ 6096 for (n = osize, count = 0, old = SDATA (val); n > 0; n--) 6097 if (*old++ == '$') count++; 6098 if (count > 0) 6099 { 6100 old = SDATA (val); 6101 val = make_uninit_multibyte_string (SCHARS (val) + count, 6102 osize + count); 6103 new = SDATA (val); 6104 for (n = osize; n > 0; n--) 6105 if (*old != '$') 6106 *new++ = *old++; 6107 else 6108 { 6109 *new++ = '$'; 6110 *new++ = '$'; 6111 old++; 6112 } 6113 } 6114 return val; 6115} 6116 6117static Lisp_Object 6118read_file_name_cleanup (arg) 6119 Lisp_Object arg; 6120{ 6121 return (current_buffer->directory = arg); 6122} 6123 6124DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal, 6125 3, 3, 0, 6126 doc: /* Internal subroutine for read-file-name. Do not call this. */) 6127 (string, dir, action) 6128 Lisp_Object string, dir, action; 6129 /* action is nil for complete, t for return list of completions, 6130 lambda for verify final value */ 6131{ 6132 Lisp_Object name, specdir, realdir, val, orig_string; 6133 int changed; 6134 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 6135 6136 CHECK_STRING (string); 6137 6138 realdir = dir; 6139 name = string; 6140 orig_string = Qnil; 6141 specdir = Qnil; 6142 changed = 0; 6143 /* No need to protect ACTION--we only compare it with t and nil. */ 6144 GCPRO5 (string, realdir, name, specdir, orig_string); 6145 6146 if (SCHARS (string) == 0) 6147 { 6148 if (EQ (action, Qlambda)) 6149 { 6150 UNGCPRO; 6151 return Qnil; 6152 } 6153 } 6154 else 6155 { 6156 orig_string = string; 6157 string = Fsubstitute_in_file_name (string); 6158 changed = NILP (Fstring_equal (string, orig_string)); 6159 name = Ffile_name_nondirectory (string); 6160 val = Ffile_name_directory (string); 6161 if (! NILP (val)) 6162 realdir = Fexpand_file_name (val, realdir); 6163 } 6164 6165 if (NILP (action)) 6166 { 6167 specdir = Ffile_name_directory (string); 6168 val = Ffile_name_completion (name, realdir, Vread_file_name_predicate); 6169 UNGCPRO; 6170 if (!STRINGP (val)) 6171 { 6172 if (changed) 6173 return double_dollars (string); 6174 return val; 6175 } 6176 6177 if (!NILP (specdir)) 6178 val = concat2 (specdir, val); 6179#ifndef VMS 6180 return double_dollars (val); 6181#else /* not VMS */ 6182 return val; 6183#endif /* not VMS */ 6184 } 6185 UNGCPRO; 6186 6187 if (EQ (action, Qt)) 6188 { 6189 Lisp_Object all = Ffile_name_all_completions (name, realdir); 6190 Lisp_Object comp; 6191 int count; 6192 6193 if (NILP (Vread_file_name_predicate) 6194 || EQ (Vread_file_name_predicate, Qfile_exists_p)) 6195 return all; 6196 6197#ifndef VMS 6198 if (EQ (Vread_file_name_predicate, Qfile_directory_p)) 6199 { 6200 /* Brute-force speed up for directory checking: 6201 Discard strings which don't end in a slash. */ 6202 for (comp = Qnil; CONSP (all); all = XCDR (all)) 6203 { 6204 Lisp_Object tem = XCAR (all); 6205 int len; 6206 if (STRINGP (tem) 6207 && (len = SBYTES (tem), len > 0) 6208 && IS_DIRECTORY_SEP (SREF (tem, len-1))) 6209 comp = Fcons (tem, comp); 6210 } 6211 } 6212 else 6213#endif 6214 { 6215 /* Must do it the hard (and slow) way. */ 6216 Lisp_Object tem; 6217 GCPRO3 (all, comp, specdir); 6218 count = SPECPDL_INDEX (); 6219 record_unwind_protect (read_file_name_cleanup, current_buffer->directory); 6220 current_buffer->directory = realdir; 6221 for (comp = Qnil; CONSP (all); all = XCDR (all)) 6222 { 6223 tem = call1 (Vread_file_name_predicate, XCAR (all)); 6224 if (!NILP (tem)) 6225 comp = Fcons (XCAR (all), comp); 6226 } 6227 unbind_to (count, Qnil); 6228 UNGCPRO; 6229 } 6230 return Fnreverse (comp); 6231 } 6232 6233 /* Only other case actually used is ACTION = lambda */ 6234#ifdef VMS 6235 /* Supposedly this helps commands such as `cd' that read directory names, 6236 but can someone explain how it helps them? -- RMS */ 6237 if (SCHARS (name) == 0) 6238 return Qt; 6239#endif /* VMS */ 6240 string = Fexpand_file_name (string, dir); 6241 if (!NILP (Vread_file_name_predicate)) 6242 return call1 (Vread_file_name_predicate, string); 6243 return Ffile_exists_p (string); 6244} 6245 6246DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p, 6247 Snext_read_file_uses_dialog_p, 0, 0, 0, 6248 doc: /* Return t if a call to `read-file-name' will use a dialog. 6249The return value is only relevant for a call to `read-file-name' that happens 6250before any other event (mouse or keypress) is handeled. */) 6251 () 6252{ 6253#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON) 6254 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) 6255 && use_dialog_box 6256 && use_file_dialog 6257 && have_menus_p ()) 6258 return Qt; 6259#endif 6260 return Qnil; 6261} 6262 6263DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, 6264 doc: /* Read file name, prompting with PROMPT and completing in directory DIR. 6265Value is not expanded---you must call `expand-file-name' yourself. 6266Default name to DEFAULT-FILENAME if user exits the minibuffer with 6267the same non-empty string that was inserted by this function. 6268 (If DEFAULT-FILENAME is omitted, the visited file name is used, 6269 except that if INITIAL is specified, that combined with DIR is used.) 6270If the user exits with an empty minibuffer, this function returns 6271an empty string. (This can only happen if the user erased the 6272pre-inserted contents or if `insert-default-directory' is nil.) 6273Fourth arg MUSTMATCH non-nil means require existing file's name. 6274 Non-nil and non-t means also require confirmation after completion. 6275Fifth arg INITIAL specifies text to start with. 6276If optional sixth arg PREDICATE is non-nil, possible completions and 6277the resulting file name must satisfy (funcall PREDICATE NAME). 6278DIR should be an absolute directory name. It defaults to the value of 6279`default-directory'. 6280 6281If this command was invoked with the mouse, use a file dialog box if 6282`use-dialog-box' is non-nil, and the window system or X toolkit in use 6283provides a file dialog box. 6284 6285See also `read-file-name-completion-ignore-case' 6286and `read-file-name-function'. */) 6287 (prompt, dir, default_filename, mustmatch, initial, predicate) 6288 Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate; 6289{ 6290 Lisp_Object val, insdef, tem; 6291 struct gcpro gcpro1, gcpro2; 6292 register char *homedir; 6293 Lisp_Object decoded_homedir; 6294 int replace_in_history = 0; 6295 int add_to_history = 0; 6296 int count; 6297 6298 if (NILP (dir)) 6299 dir = current_buffer->directory; 6300 if (NILP (Ffile_name_absolute_p (dir))) 6301 dir = Fexpand_file_name (dir, Qnil); 6302 if (NILP (default_filename)) 6303 default_filename 6304 = (!NILP (initial) 6305 ? Fexpand_file_name (initial, dir) 6306 : current_buffer->filename); 6307 6308 /* If dir starts with user's homedir, change that to ~. */ 6309 homedir = (char *) egetenv ("HOME"); 6310#ifdef DOS_NT 6311 /* homedir can be NULL in temacs, since Vprocess_environment is not 6312 yet set up. We shouldn't crash in that case. */ 6313 if (homedir != 0) 6314 { 6315 homedir = strcpy (alloca (strlen (homedir) + 1), homedir); 6316 CORRECT_DIR_SEPS (homedir); 6317 } 6318#endif 6319 if (homedir != 0) 6320 decoded_homedir 6321 = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir))); 6322 if (homedir != 0 6323 && STRINGP (dir) 6324 && !strncmp (SDATA (decoded_homedir), SDATA (dir), 6325 SBYTES (decoded_homedir)) 6326 && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir)))) 6327 { 6328 dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil); 6329 dir = concat2 (build_string ("~"), dir); 6330 } 6331 /* Likewise for default_filename. */ 6332 if (homedir != 0 6333 && STRINGP (default_filename) 6334 && !strncmp (SDATA (decoded_homedir), SDATA (default_filename), 6335 SBYTES (decoded_homedir)) 6336 && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir)))) 6337 { 6338 default_filename 6339 = Fsubstring (default_filename, 6340 make_number (SCHARS (decoded_homedir)), Qnil); 6341 default_filename = concat2 (build_string ("~"), default_filename); 6342 } 6343 if (!NILP (default_filename)) 6344 { 6345 CHECK_STRING (default_filename); 6346 default_filename = double_dollars (default_filename); 6347 } 6348 6349 if (insert_default_directory && STRINGP (dir)) 6350 { 6351 insdef = dir; 6352 if (!NILP (initial)) 6353 { 6354 Lisp_Object args[2], pos; 6355 6356 args[0] = insdef; 6357 args[1] = initial; 6358 insdef = Fconcat (2, args); 6359 pos = make_number (SCHARS (double_dollars (dir))); 6360 insdef = Fcons (double_dollars (insdef), pos); 6361 } 6362 else 6363 insdef = double_dollars (insdef); 6364 } 6365 else if (STRINGP (initial)) 6366 insdef = Fcons (double_dollars (initial), make_number (0)); 6367 else 6368 insdef = Qnil; 6369 6370 if (!NILP (Vread_file_name_function)) 6371 { 6372 Lisp_Object args[7]; 6373 6374 GCPRO2 (insdef, default_filename); 6375 args[0] = Vread_file_name_function; 6376 args[1] = prompt; 6377 args[2] = dir; 6378 args[3] = default_filename; 6379 args[4] = mustmatch; 6380 args[5] = initial; 6381 args[6] = predicate; 6382 RETURN_UNGCPRO (Ffuncall (7, args)); 6383 } 6384 6385 count = SPECPDL_INDEX (); 6386 specbind (intern ("completion-ignore-case"), 6387 read_file_name_completion_ignore_case ? Qt : Qnil); 6388 specbind (intern ("minibuffer-completing-file-name"), Qt); 6389 specbind (intern ("read-file-name-predicate"), 6390 (NILP (predicate) ? Qfile_exists_p : predicate)); 6391 6392 GCPRO2 (insdef, default_filename); 6393 6394#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON) 6395 if (! NILP (Fnext_read_file_uses_dialog_p ())) 6396 { 6397 /* If DIR contains a file name, split it. */ 6398 Lisp_Object file; 6399 file = Ffile_name_nondirectory (dir); 6400 if (SCHARS (file) && NILP (default_filename)) 6401 { 6402 default_filename = file; 6403 dir = Ffile_name_directory (dir); 6404 } 6405 if (!NILP(default_filename)) 6406 default_filename = Fexpand_file_name (default_filename, dir); 6407 val = Fx_file_dialog (prompt, dir, default_filename, mustmatch, 6408 EQ (predicate, Qfile_directory_p) ? Qt : Qnil); 6409 add_to_history = 1; 6410 } 6411 else 6412#endif 6413 val = Fcompleting_read (prompt, intern ("read-file-name-internal"), 6414 dir, mustmatch, insdef, 6415 Qfile_name_history, default_filename, Qnil); 6416 6417 tem = Fsymbol_value (Qfile_name_history); 6418 if (CONSP (tem) && EQ (XCAR (tem), val)) 6419 replace_in_history = 1; 6420 6421 /* If Fcompleting_read returned the inserted default string itself 6422 (rather than a new string with the same contents), 6423 it has to mean that the user typed RET with the minibuffer empty. 6424 In that case, we really want to return "" 6425 so that commands such as set-visited-file-name can distinguish. */ 6426 if (EQ (val, default_filename)) 6427 { 6428 /* In this case, Fcompleting_read has not added an element 6429 to the history. Maybe we should. */ 6430 if (! replace_in_history) 6431 add_to_history = 1; 6432 6433 val = empty_string; 6434 } 6435 6436 unbind_to (count, Qnil); 6437 UNGCPRO; 6438 if (NILP (val)) 6439 error ("No file name specified"); 6440 6441 tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef); 6442 6443 if (!NILP (tem) && !NILP (default_filename)) 6444 val = default_filename; 6445 val = Fsubstitute_in_file_name (val); 6446 6447 if (replace_in_history) 6448 /* Replace what Fcompleting_read added to the history 6449 with what we will actually return. */ 6450 { 6451 Lisp_Object val1 = double_dollars (val); 6452 tem = Fsymbol_value (Qfile_name_history); 6453 if (history_delete_duplicates) 6454 XSETCDR (tem, Fdelete (val1, XCDR(tem))); 6455 XSETCAR (tem, val1); 6456 } 6457 else if (add_to_history) 6458 { 6459 /* Add the value to the history--but not if it matches 6460 the last value already there. */ 6461 Lisp_Object val1 = double_dollars (val); 6462 tem = Fsymbol_value (Qfile_name_history); 6463 if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1))) 6464 { 6465 if (history_delete_duplicates) tem = Fdelete (val1, tem); 6466 Fset (Qfile_name_history, Fcons (val1, tem)); 6467 } 6468 } 6469 6470 return val; 6471} 6472 6473 6474void 6475init_fileio_once () 6476{ 6477 /* Must be set before any path manipulation is performed. */ 6478 XSETFASTINT (Vdirectory_sep_char, '/'); 6479} 6480 6481 6482void 6483syms_of_fileio () 6484{ 6485 Qoperations = intern ("operations"); 6486 Qexpand_file_name = intern ("expand-file-name"); 6487 Qsubstitute_in_file_name = intern ("substitute-in-file-name"); 6488 Qdirectory_file_name = intern ("directory-file-name"); 6489 Qfile_name_directory = intern ("file-name-directory"); 6490 Qfile_name_nondirectory = intern ("file-name-nondirectory"); 6491 Qunhandled_file_name_directory = intern ("unhandled-file-name-directory"); 6492 Qfile_name_as_directory = intern ("file-name-as-directory"); 6493 Qcopy_file = intern ("copy-file"); 6494 Qmake_directory_internal = intern ("make-directory-internal"); 6495 Qmake_directory = intern ("make-directory"); 6496 Qdelete_directory = intern ("delete-directory"); 6497 Qdelete_file = intern ("delete-file"); 6498 Qrename_file = intern ("rename-file"); 6499 Qadd_name_to_file = intern ("add-name-to-file"); 6500 Qmake_symbolic_link = intern ("make-symbolic-link"); 6501 Qfile_exists_p = intern ("file-exists-p"); 6502 Qfile_executable_p = intern ("file-executable-p"); 6503 Qfile_readable_p = intern ("file-readable-p"); 6504 Qfile_writable_p = intern ("file-writable-p"); 6505 Qfile_symlink_p = intern ("file-symlink-p"); 6506 Qaccess_file = intern ("access-file"); 6507 Qfile_directory_p = intern ("file-directory-p"); 6508 Qfile_regular_p = intern ("file-regular-p"); 6509 Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); 6510 Qfile_modes = intern ("file-modes"); 6511 Qset_file_modes = intern ("set-file-modes"); 6512 Qset_file_times = intern ("set-file-times"); 6513 Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); 6514 Qinsert_file_contents = intern ("insert-file-contents"); 6515 Qwrite_region = intern ("write-region"); 6516 Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); 6517 Qset_visited_file_modtime = intern ("set-visited-file-modtime"); 6518 Qauto_save_coding = intern ("auto-save-coding"); 6519 6520 staticpro (&Qoperations); 6521 staticpro (&Qexpand_file_name); 6522 staticpro (&Qsubstitute_in_file_name); 6523 staticpro (&Qdirectory_file_name); 6524 staticpro (&Qfile_name_directory); 6525 staticpro (&Qfile_name_nondirectory); 6526 staticpro (&Qunhandled_file_name_directory); 6527 staticpro (&Qfile_name_as_directory); 6528 staticpro (&Qcopy_file); 6529 staticpro (&Qmake_directory_internal); 6530 staticpro (&Qmake_directory); 6531 staticpro (&Qdelete_directory); 6532 staticpro (&Qdelete_file); 6533 staticpro (&Qrename_file); 6534 staticpro (&Qadd_name_to_file); 6535 staticpro (&Qmake_symbolic_link); 6536 staticpro (&Qfile_exists_p); 6537 staticpro (&Qfile_executable_p); 6538 staticpro (&Qfile_readable_p); 6539 staticpro (&Qfile_writable_p); 6540 staticpro (&Qaccess_file); 6541 staticpro (&Qfile_symlink_p); 6542 staticpro (&Qfile_directory_p); 6543 staticpro (&Qfile_regular_p); 6544 staticpro (&Qfile_accessible_directory_p); 6545 staticpro (&Qfile_modes); 6546 staticpro (&Qset_file_modes); 6547 staticpro (&Qset_file_times); 6548 staticpro (&Qfile_newer_than_file_p); 6549 staticpro (&Qinsert_file_contents); 6550 staticpro (&Qwrite_region); 6551 staticpro (&Qverify_visited_file_modtime); 6552 staticpro (&Qset_visited_file_modtime); 6553 staticpro (&Qauto_save_coding); 6554 6555 Qfile_name_history = intern ("file-name-history"); 6556 Fset (Qfile_name_history, Qnil); 6557 staticpro (&Qfile_name_history); 6558 6559 Qfile_error = intern ("file-error"); 6560 staticpro (&Qfile_error); 6561 Qfile_already_exists = intern ("file-already-exists"); 6562 staticpro (&Qfile_already_exists); 6563 Qfile_date_error = intern ("file-date-error"); 6564 staticpro (&Qfile_date_error); 6565 Qexcl = intern ("excl"); 6566 staticpro (&Qexcl); 6567 6568#ifdef DOS_NT 6569 Qfind_buffer_file_type = intern ("find-buffer-file-type"); 6570 staticpro (&Qfind_buffer_file_type); 6571#endif /* DOS_NT */ 6572 6573 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system, 6574 doc: /* *Coding system for encoding file names. 6575If it is nil, `default-file-name-coding-system' (which see) is used. */); 6576 Vfile_name_coding_system = Qnil; 6577 6578 DEFVAR_LISP ("default-file-name-coding-system", 6579 &Vdefault_file_name_coding_system, 6580 doc: /* Default coding system for encoding file names. 6581This variable is used only when `file-name-coding-system' is nil. 6582 6583This variable is set/changed by the command `set-language-environment'. 6584User should not set this variable manually, 6585instead use `file-name-coding-system' to get a constant encoding 6586of file names regardless of the current language environment. */); 6587 Vdefault_file_name_coding_system = Qnil; 6588 6589 Qformat_decode = intern ("format-decode"); 6590 staticpro (&Qformat_decode); 6591 Qformat_annotate_function = intern ("format-annotate-function"); 6592 staticpro (&Qformat_annotate_function); 6593 Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding"); 6594 staticpro (&Qafter_insert_file_set_coding); 6595 6596 Qcar_less_than_car = intern ("car-less-than-car"); 6597 staticpro (&Qcar_less_than_car); 6598 6599 Fput (Qfile_error, Qerror_conditions, 6600 list2 (Qfile_error, Qerror)); 6601 Fput (Qfile_error, Qerror_message, 6602 build_string ("File error")); 6603 6604 Fput (Qfile_already_exists, Qerror_conditions, 6605 list3 (Qfile_already_exists, Qfile_error, Qerror)); 6606 Fput (Qfile_already_exists, Qerror_message, 6607 build_string ("File already exists")); 6608 6609 Fput (Qfile_date_error, Qerror_conditions, 6610 list3 (Qfile_date_error, Qfile_error, Qerror)); 6611 Fput (Qfile_date_error, Qerror_message, 6612 build_string ("Cannot set file date")); 6613 6614 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function, 6615 doc: /* If this is non-nil, `read-file-name' does its work by calling this function. */); 6616 Vread_file_name_function = Qnil; 6617 6618 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate, 6619 doc: /* Current predicate used by `read-file-name-internal'. */); 6620 Vread_file_name_predicate = Qnil; 6621 6622 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case, 6623 doc: /* *Non-nil means when reading a file name completion ignores case. */); 6624#if defined VMS || defined DOS_NT || defined MAC_OS 6625 read_file_name_completion_ignore_case = 1; 6626#else 6627 read_file_name_completion_ignore_case = 0; 6628#endif 6629 6630 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory, 6631 doc: /* *Non-nil means when reading a filename start with default dir in minibuffer. 6632If the initial minibuffer contents are non-empty, you can usually 6633request a default filename by typing RETURN without editing. For some 6634commands, exiting with an empty minibuffer has a special meaning, 6635such as making the current buffer visit no file in the case of 6636`set-visited-file-name'. 6637If this variable is non-nil, the minibuffer contents are always 6638initially non-empty and typing RETURN without editing will fetch the 6639default name, if one is provided. Note however that this default name 6640is not necessarily the name originally inserted in the minibuffer, if 6641that is just the default directory. 6642If this variable is nil, the minibuffer often starts out empty. In 6643that case you may have to explicitly fetch the next history element to 6644request the default name. */); 6645 insert_default_directory = 1; 6646 6647 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm, 6648 doc: /* *Non-nil means write new files with record format `stmlf'. 6649nil means use format `var'. This variable is meaningful only on VMS. */); 6650 vms_stmlf_recfm = 0; 6651 6652 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char, 6653 doc: /* Directory separator character for built-in functions that return file names. 6654The value is always ?/. Don't use this variable, just use `/'. */); 6655 6656 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, 6657 doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially. 6658If a file name matches REGEXP, then all I/O on that file is done by calling 6659HANDLER. 6660 6661The first argument given to HANDLER is the name of the I/O primitive 6662to be handled; the remaining arguments are the arguments that were 6663passed to that primitive. For example, if you do 6664 (file-exists-p FILENAME) 6665and FILENAME is handled by HANDLER, then HANDLER is called like this: 6666 (funcall HANDLER 'file-exists-p FILENAME) 6667The function `find-file-name-handler' checks this list for a handler 6668for its argument. */); 6669 Vfile_name_handler_alist = Qnil; 6670 6671 DEFVAR_LISP ("set-auto-coding-function", 6672 &Vset_auto_coding_function, 6673 doc: /* If non-nil, a function to call to decide a coding system of file. 6674Two arguments are passed to this function: the file name 6675and the length of a file contents following the point. 6676This function should return a coding system to decode the file contents. 6677It should check the file name against `auto-coding-alist'. 6678If no coding system is decided, it should check a coding system 6679specified in the heading lines with the format: 6680 -*- ... coding: CODING-SYSTEM; ... -*- 6681or local variable spec of the tailing lines with `coding:' tag. */); 6682 Vset_auto_coding_function = Qnil; 6683 6684 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, 6685 doc: /* A list of functions to be called at the end of `insert-file-contents'. 6686Each is passed one argument, the number of characters inserted. 6687It should return the new character count, and leave point the same. 6688If `insert-file-contents' is intercepted by a handler from 6689`file-name-handler-alist', that handler is responsible for calling the 6690functions in `after-insert-file-functions' if appropriate. */); 6691 Vafter_insert_file_functions = Qnil; 6692 6693 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, 6694 doc: /* A list of functions to be called at the start of `write-region'. 6695Each is passed two arguments, START and END as for `write-region'. 6696These are usually two numbers but not always; see the documentation 6697for `write-region'. The function should return a list of pairs 6698of the form (POSITION . STRING), consisting of strings to be effectively 6699inserted at the specified positions of the file being written (1 means to 6700insert before the first byte written). The POSITIONs must be sorted into 6701increasing order. If there are several functions in the list, the several 6702lists are merged destructively. Alternatively, the function can return 6703with a different buffer current; in that case it should pay attention 6704to the annotations returned by previous functions and listed in 6705`write-region-annotations-so-far'.*/); 6706 Vwrite_region_annotate_functions = Qnil; 6707 staticpro (&Qwrite_region_annotate_functions); 6708 Qwrite_region_annotate_functions 6709 = intern ("write-region-annotate-functions"); 6710 6711 DEFVAR_LISP ("write-region-annotations-so-far", 6712 &Vwrite_region_annotations_so_far, 6713 doc: /* When an annotation function is called, this holds the previous annotations. 6714These are the annotations made by other annotation functions 6715that were already called. See also `write-region-annotate-functions'. */); 6716 Vwrite_region_annotations_so_far = Qnil; 6717 6718 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, 6719 doc: /* A list of file name handlers that temporarily should not be used. 6720This applies only to the operation `inhibit-file-name-operation'. */); 6721 Vinhibit_file_name_handlers = Qnil; 6722 6723 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation, 6724 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */); 6725 Vinhibit_file_name_operation = Qnil; 6726 6727 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name, 6728 doc: /* File name in which we write a list of all auto save file names. 6729This variable is initialized automatically from `auto-save-list-file-prefix' 6730shortly after Emacs reads your `.emacs' file, if you have not yet given it 6731a non-nil value. */); 6732 Vauto_save_list_file_name = Qnil; 6733 6734#ifdef HAVE_FSYNC 6735 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync, 6736 doc: /* *Non-nil means don't call fsync in `write-region'. 6737This variable affects calls to `write-region' as well as save commands. 6738A non-nil value may result in data loss! */); 6739 write_region_inhibit_fsync = 0; 6740#endif 6741 6742 defsubr (&Sfind_file_name_handler); 6743 defsubr (&Sfile_name_directory); 6744 defsubr (&Sfile_name_nondirectory); 6745 defsubr (&Sunhandled_file_name_directory); 6746 defsubr (&Sfile_name_as_directory); 6747 defsubr (&Sdirectory_file_name); 6748 defsubr (&Smake_temp_name); 6749 defsubr (&Sexpand_file_name); 6750 defsubr (&Ssubstitute_in_file_name); 6751 defsubr (&Scopy_file); 6752 defsubr (&Smake_directory_internal); 6753 defsubr (&Sdelete_directory); 6754 defsubr (&Sdelete_file); 6755 defsubr (&Srename_file); 6756 defsubr (&Sadd_name_to_file); 6757#ifdef S_IFLNK 6758 defsubr (&Smake_symbolic_link); 6759#endif /* S_IFLNK */ 6760#ifdef VMS 6761 defsubr (&Sdefine_logical_name); 6762#endif /* VMS */ 6763#ifdef HPUX_NET 6764 defsubr (&Ssysnetunam); 6765#endif /* HPUX_NET */ 6766 defsubr (&Sfile_name_absolute_p); 6767 defsubr (&Sfile_exists_p); 6768 defsubr (&Sfile_executable_p); 6769 defsubr (&Sfile_readable_p); 6770 defsubr (&Sfile_writable_p); 6771 defsubr (&Saccess_file); 6772 defsubr (&Sfile_symlink_p); 6773 defsubr (&Sfile_directory_p); 6774 defsubr (&Sfile_accessible_directory_p); 6775 defsubr (&Sfile_regular_p); 6776 defsubr (&Sfile_modes); 6777 defsubr (&Sset_file_modes); 6778 defsubr (&Sset_file_times); 6779 defsubr (&Sset_default_file_modes); 6780 defsubr (&Sdefault_file_modes); 6781 defsubr (&Sfile_newer_than_file_p); 6782 defsubr (&Sinsert_file_contents); 6783 defsubr (&Swrite_region); 6784 defsubr (&Scar_less_than_car); 6785 defsubr (&Sverify_visited_file_modtime); 6786 defsubr (&Sclear_visited_file_modtime); 6787 defsubr (&Svisited_file_modtime); 6788 defsubr (&Sset_visited_file_modtime); 6789 defsubr (&Sdo_auto_save); 6790 defsubr (&Sset_buffer_auto_saved); 6791 defsubr (&Sclear_buffer_auto_save_failure); 6792 defsubr (&Srecent_auto_save_p); 6793 6794 defsubr (&Sread_file_name_internal); 6795 defsubr (&Sread_file_name); 6796 defsubr (&Snext_read_file_uses_dialog_p); 6797 6798#ifdef HAVE_SYNC 6799 defsubr (&Sunix_sync); 6800#endif 6801} 6802 6803/* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c 6804 (do not change this comment) */ 6805