fileio.c 188 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* File IO for GNU Emacs.
Glenn Morris's avatar
Glenn Morris committed
2

3
Copyright (C) 1985-1988, 1993-2014 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19

20
#include <config.h>
21
#include <limits.h>
22
#include <fcntl.h>
23
#include "sysstdio.h"
Jim Blandy's avatar
Jim Blandy committed
24 25
#include <sys/types.h>
#include <sys/stat.h>
26 27
#include <unistd.h>

28
#ifdef HAVE_PWD_H
Jim Blandy's avatar
Jim Blandy committed
29
#include <pwd.h>
Jim Blandy's avatar
Jim Blandy committed
30 31
#endif

Jim Blandy's avatar
Jim Blandy committed
32 33
#include <errno.h>

Karel Klíc's avatar
Karel Klíc committed
34 35 36 37 38
#ifdef HAVE_LIBSELINUX
#include <selinux/selinux.h>
#include <selinux/context.h>
#endif

39
#ifdef HAVE_ACL_SET_FILE
40 41 42
#include <sys/acl.h>
#endif

43 44
#include <c-ctype.h>

Jim Blandy's avatar
Jim Blandy committed
45
#include "lisp.h"
46
#include "intervals.h"
47
#include "character.h"
48
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
49
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
50
#include "window.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
51
#include "blockinput.h"
52
#include "region-cache.h"
Karoly Lorentey's avatar
Karoly Lorentey committed
53 54
#include "frame.h"
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
55

56 57 58
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
59
#include <sys/file.h>
60
#include "w32.h"
61 62
#endif /* not WINDOWSNT */

Eli Zaretskii's avatar
Eli Zaretskii committed
63 64 65 66 67
#ifdef MSDOS
#include "msdos.h"
#include <sys/param.h>
#endif

68 69
#ifdef DOS_NT
/* On Windows, drive letters must be alphabetic - on DOS, the Netware
70
   redirector allows the six letters between 'Z' and 'a' as well.  */
71 72 73 74
#ifdef MSDOS
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
75
#define IS_DRIVE(x) c_isalpha (x)
76
#endif
77
/* Need to lower-case the drive letter, or else expanded
Paul Eggert's avatar
Paul Eggert committed
78
   filenames will sometimes compare unequal, because
79
   `expand-file-name' doesn't always down-case the drive letter.  */
80
#define DRIVE_LETTER(x) c_tolower (x)
81 82
#endif

Jim Blandy's avatar
Jim Blandy committed
83
#include "systime.h"
84
#include <acl.h>
85 86
#include <allocator.h>
#include <careadlinkat.h>
87
#include <stat-time.h>
Jim Blandy's avatar
Jim Blandy committed
88 89 90

#ifdef HPUX
#include <netio.h>
91
#endif
Jim Blandy's avatar
Jim Blandy committed
92

93 94
#include "commands.h"

95 96
/* True during writing of auto-save files.  */
static bool auto_saving;
Jim Blandy's avatar
Jim Blandy committed
97

98 99 100
/* Emacs's real umask.  */
static mode_t realmask;

101
/* Nonzero umask during creation of auto-save directories.  */
102
static mode_t auto_saving_dir_umask;
103

Jim Blandy's avatar
Jim Blandy committed
104
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
105
   a new file with the same mode as the original.  */
106
static mode_t auto_save_mode_bits;
Jim Blandy's avatar
Jim Blandy committed
107

108
/* Set by auto_save_1 if an error occurred during the last auto-save.  */
109
static bool auto_save_error_occurred;
110

111 112 113 114 115
/* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
   number of a file system where time stamps were observed to to work.  */
static bool valid_timestamp_file_system;
static dev_t timestamp_file_system;

116 117 118 119 120
/* The symbol bound to coding-system-for-read when
   insert-file-contents is called for recovering a file.  This is not
   an actual coding system name, but just an indicator to tell
   insert-file-contents to use `emacs-mule' with a special flag for
   auto saving and recovering a file.  */
121
static Lisp_Object Qauto_save_coding;
122

123 124
/* Property name of a file name handler,
   which gives a list of operations it handles..  */
125
static Lisp_Object Qoperations;
126

127
/* Lisp functions for translating file formats.  */
128
static Lisp_Object Qformat_decode, Qformat_annotate_function;
129

130
/* Lisp function for setting buffer-file-coding-system and the
131
   multibyteness of the current buffer after inserting a file.  */
132
static Lisp_Object Qafter_insert_file_set_coding;
133

134
static Lisp_Object Qwrite_region_annotate_functions;
135 136
/* Each time an annotation function changes the buffer, the new buffer
   is added here.  */
137
static Lisp_Object Vwrite_region_annotation_buffers;
138

139
static Lisp_Object Qdelete_by_moving_to_trash;
140

141
/* Lisp function for moving files to trash.  */
142
static Lisp_Object Qmove_file_to_trash;
143

144
/* Lisp function for recursively copying directories.  */
145
static Lisp_Object Qcopy_directory;
146 147

/* Lisp function for recursively deleting directories.  */
148
static Lisp_Object Qdelete_directory;
149

150 151
static Lisp_Object Qsubstitute_env_in_file_name;

152
Lisp_Object Qfile_error, Qfile_notify_error;
153 154
static Lisp_Object Qfile_already_exists, Qfile_date_error;
static Lisp_Object Qexcl;
155 156
Lisp_Object Qfile_name_history;

157
static Lisp_Object Qcar_less_than_car;
158

159 160 161 162
static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
		     Lisp_Object *, struct coding_system *);
static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
		     struct coding_system *);
163

164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213

/* Return true if FILENAME exists.  */

static bool
check_existing (const char *filename)
{
  return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
}

/* Return true if file FILENAME exists and can be executed.  */

static bool
check_executable (char *filename)
{
  return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
}

/* Return true if file FILENAME exists and can be accessed
   according to AMODE, which should include W_OK.
   On failure, return false and set errno.  */

static bool
check_writable (const char *filename, int amode)
{
#ifdef MSDOS
  /* FIXME: an faccessat implementation should be added to the
     DOS/Windows ports and this #ifdef branch should be removed.  */
  struct stat st;
  if (stat (filename, &st) < 0)
    return 0;
  errno = EPERM;
  return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
#else /* not MSDOS */
  bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
#ifdef CYGWIN
  /* faccessat may have returned failure because Cygwin couldn't
     determine the file's UID or GID; if so, we return success. */
  if (!res)
    {
      int faccessat_errno = errno;
      struct stat st;
      if (stat (filename, &st) < 0)
        return 0;
      res = (st.st_uid == -1 || st.st_gid == -1);
      errno = faccessat_errno;
    }
#endif /* CYGWIN */
  return res;
#endif /* not MSDOS */
}
214

215
/* Signal a file-access failure.  STRING describes the failure,
216 217 218 219 220
   NAME the file involved, and ERRORNO the errno value.

   If NAME is neither null nor a pair, package it up as a singleton
   list before reporting it; this saves report_file_errno's caller the
   trouble of preserving errno before calling list1.  */
221

222
void
223
report_file_errno (char const *string, Lisp_Object name, int errorno)
Jim Blandy's avatar
Jim Blandy committed
224
{
225
  Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Jim Blandy's avatar
Jim Blandy committed
226
  Lisp_Object errstring;
227
  char *str;
Jim Blandy's avatar
Jim Blandy committed
228

229
  synchronize_system_messages_locale ();
230
  str = strerror (errorno);
231
  errstring = code_convert_string_norecord (build_unibyte_string (str),
232 233
					    Vlocale_coding_system, 0);

Jim Blandy's avatar
Jim Blandy committed
234
  while (1)
Richard M. Stallman's avatar
Richard M. Stallman committed
235 236 237
    switch (errorno)
      {
      case EEXIST:
238
	xsignal (Qfile_already_exists, Fcons (errstring, data));
Richard M. Stallman's avatar
Richard M. Stallman committed
239 240 241
	break;
      default:
	/* System error messages are capitalized.  Downcase the initial
242 243
	   unless it is followed by a slash.  (The slash case caters to
	   error messages that begin with "I/O" or, in German, "E/A".)  */
244 245
	if (STRING_MULTIBYTE (errstring)
	    && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
246 247 248
	  {
	    int c;

249
	    str = SSDATA (errstring);
250
	    c = STRING_CHAR ((unsigned char *) str);
251
	    Faset (errstring, make_number (0), make_number (downcase (c)));
252
	  }
Richard M. Stallman's avatar
Richard M. Stallman committed
253

254
	xsignal (Qfile_error,
Richard M. Stallman's avatar
Richard M. Stallman committed
255 256
		 Fcons (build_string (string), Fcons (errstring, data)));
      }
Jim Blandy's avatar
Jim Blandy committed
257
}
258

259
/* Signal a file-access failure that set errno.  STRING describes the
260 261 262
   failure, NAME the file involved.  When invoking this function, take
   care to not use arguments such as build_string ("foo") that involve
   side effects that may set errno.  */
263

264
void
265
report_file_error (char const *string, Lisp_Object name)
266
{
267
  report_file_errno (string, name, errno);
268 269
}

270 271
void
close_file_unwind (int fd)
272
{
273
  emacs_close (fd);
274
}
275

276 277 278 279 280 281 282
void
fclose_unwind (void *arg)
{
  FILE *stream = arg;
  fclose (stream);
}

283 284
/* Restore point, having saved it as a marker.  */

285
void
286
restore_point_unwind (Lisp_Object location)
287
{
288
  Fgoto_char (location);
Dmitry Antipov's avatar
Dmitry Antipov committed
289
  unchain_marker (XMARKER (location));
290
}
291

Jim Blandy's avatar
Jim Blandy committed
292

293 294 295 296 297 298 299 300 301 302 303
static Lisp_Object Qexpand_file_name;
static Lisp_Object Qsubstitute_in_file_name;
static Lisp_Object Qdirectory_file_name;
static Lisp_Object Qfile_name_directory;
static Lisp_Object Qfile_name_nondirectory;
static Lisp_Object Qunhandled_file_name_directory;
static Lisp_Object Qfile_name_as_directory;
static Lisp_Object Qcopy_file;
static Lisp_Object Qmake_directory_internal;
static Lisp_Object Qmake_directory;
static Lisp_Object Qdelete_directory_internal;
304
Lisp_Object Qdelete_file;
305 306 307
static Lisp_Object Qrename_file;
static Lisp_Object Qadd_name_to_file;
static Lisp_Object Qmake_symbolic_link;
308
Lisp_Object Qfile_exists_p;
309 310 311 312 313
static Lisp_Object Qfile_executable_p;
static Lisp_Object Qfile_readable_p;
static Lisp_Object Qfile_writable_p;
static Lisp_Object Qfile_symlink_p;
static Lisp_Object Qaccess_file;
314
Lisp_Object Qfile_directory_p;
315 316 317 318 319 320 321
static Lisp_Object Qfile_regular_p;
static Lisp_Object Qfile_accessible_directory_p;
static Lisp_Object Qfile_modes;
static Lisp_Object Qset_file_modes;
static Lisp_Object Qset_file_times;
static Lisp_Object Qfile_selinux_context;
static Lisp_Object Qset_file_selinux_context;
322 323
static Lisp_Object Qfile_acl;
static Lisp_Object Qset_file_acl;
324
static Lisp_Object Qfile_newer_than_file_p;
325 326
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
327 328
static Lisp_Object Qverify_visited_file_modtime;
static Lisp_Object Qset_visited_file_modtime;
329

Paul Eggert's avatar
Paul Eggert committed
330
DEFUN ("find-file-name-handler", Ffind_file_name_handler,
331
       Sfind_file_name_handler, 2, 2, 0,
332 333 334 335 336 337 338 339 340
       doc: /* Return FILENAME's handler function for OPERATION, if it has one.
Otherwise, return nil.
A file name is handled if one of the regular expressions in
`file-name-handler-alist' matches it.

If OPERATION equals `inhibit-file-name-operation', then we ignore
any handlers that are members of `inhibit-file-name-handlers',
but we still do run any other handlers.  This lets handlers
use the standard functions without calling themselves recursively.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
341
  (Lisp_Object filename, Lisp_Object operation)
342
{
343
  /* This function must not munge the match data.  */
344
  Lisp_Object chain, inhibited_handlers, result;
345
  ptrdiff_t pos = -1;
346

347
  result = Qnil;
348
  CHECK_STRING (filename);
349

350 351 352 353
  if (EQ (operation, Vinhibit_file_name_operation))
    inhibited_handlers = Vinhibit_file_name_handlers;
  else
    inhibited_handlers = Qnil;
354

355
  for (chain = Vfile_name_handler_alist; CONSP (chain);
356
       chain = XCDR (chain))
357 358
    {
      Lisp_Object elt;
359
      elt = XCAR (chain);
360
      if (CONSP (elt))
361
	{
362
	  Lisp_Object string = XCAR (elt);
363
	  ptrdiff_t match_pos;
364
	  Lisp_Object handler = XCDR (elt);
365 366 367 368
	  Lisp_Object operations = Qnil;

	  if (SYMBOLP (handler))
	    operations = Fget (handler, Qoperations);
369

370
	  if (STRINGP (string)
371 372
	      && (match_pos = fast_string_match (string, filename)) > pos
	      && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
373
	    {
374
	      Lisp_Object tem;
375

376
	      handler = XCDR (elt);
377 378
	      tem = Fmemq (handler, inhibited_handlers);
	      if (NILP (tem))
379 380 381 382
		{
		  result = handler;
		  pos = match_pos;
		}
383
	    }
384
	}
385 386

      QUIT;
387
    }
388
  return result;
389 390
}

Paul Eggert's avatar
Paul Eggert committed
391
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
392 393 394
       1, 1, 0,
       doc: /* Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
395
Otherwise return a directory name.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
396
Given a Unix syntax file name, returns a string ending in slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
397
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
398
{
399
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
400

401
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
402

403 404
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
405
  handler = Ffind_file_name_handler (filename, Qfile_name_directory);
406
  if (!NILP (handler))
407 408 409 410 411
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
412

413 414
  char *beg = SSDATA (filename);
  char const *p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
415

416 417
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
418
	 /* only recognize drive specifier at the beginning */
419 420 421 422
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" and "/:foo" cases correctly  */
	      && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
		  || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
423
#endif
Jim Blandy's avatar
Jim Blandy committed
424 425 426 427
	 ) p--;

  if (p == beg)
    return Qnil;
428
#ifdef DOS_NT
429
  /* Expansion of "c:" to drive and default directory.  */
430 431 432 433 434
  Lisp_Object tem_fn;
  USE_SAFE_ALLOCA;
  SAFE_ALLOCA_STRING (beg, filename);
  p = beg + (p - SSDATA (filename));

435
  if (p[-1] == ':')
436 437
    {
      /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
438 439
      char *res = alloca (MAXPATHLEN + 1);
      char *r = res;
440 441 442

      if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
	{
443
	  memcpy (res, beg, 2);
444 445 446 447
	  beg += 2;
	  r += 2;
	}

448
      if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
449
	{
450 451 452
	  size_t l = strlen (res);

	  if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
453 454 455
	    strcat (res, "/");
	  beg = res;
	  p = beg + strlen (beg);
456
	  dostounix_filename (beg);
457 458
	  tem_fn = make_specified_string (beg, -1, p - beg,
					  STRING_MULTIBYTE (filename));
459
	}
460 461 462 463 464 465
      else
	tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
					STRING_MULTIBYTE (filename));
    }
  else if (STRING_MULTIBYTE (filename))
    {
466
      tem_fn = make_specified_string (beg, -1, p - beg, 1);
467
      dostounix_filename (SSDATA (tem_fn));
468 469 470 471
#ifdef WINDOWSNT
      if (!NILP (Vw32_downcase_file_names))
	tem_fn = Fdowncase (tem_fn);
#endif
472 473 474
    }
  else
    {
475
      dostounix_filename (beg);
476
      tem_fn = make_specified_string (beg, -1, p - beg, 0);
477
    }
478
  SAFE_FREE ();
479
  return tem_fn;
480
#else  /* DOS_NT */
481
  return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
482
#endif	/* DOS_NT */
Jim Blandy's avatar
Jim Blandy committed
483 484
}

Paul Eggert's avatar
Paul Eggert committed
485
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
486
       Sfile_name_nondirectory, 1, 1, 0,
487 488 489 490
       doc: /* Return file name FILENAME sans its directory.
For example, in a Unix-syntax file name,
this is everything after the last slash,
or the entire name if it contains no slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
491
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
492
{
493
  register const char *beg, *p, *end;
494
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
495

496
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
497

498 499
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
500
  handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
501
  if (!NILP (handler))
502 503 504 505 506 507 508
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
					filename);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }
509

510
  beg = SSDATA (filename);
511
  end = p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
512

513 514
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
515
	 /* only recognize drive specifier at beginning */
516 517 518
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" case correctly  */
	      && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
519
#endif
520 521
	 )
    p--;
Jim Blandy's avatar
Jim Blandy committed
522

523
  return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
Jim Blandy's avatar
Jim Blandy committed
524
}
525

Paul Eggert's avatar
Paul Eggert committed
526
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
527
       Sunhandled_file_name_directory, 1, 1, 0,
528 529 530 531 532
       doc: /* Return a directly usable directory name somehow associated with FILENAME.
A `directly usable' directory name is one that may be used without the
intervention of any file handler.
If FILENAME is a directly usable file itself, return
\(file-name-directory FILENAME).
Stefan Monnier's avatar
Stefan Monnier committed
533 534
If FILENAME refers to a file which is not accessible from a local process,
then this should return nil.
535 536
The `call-process' and `start-process' functions use this function to
get a current directory to run processes in.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
537
  (Lisp_Object filename)
538 539 540 541 542
{
  Lisp_Object handler;

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
543
  handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
544
  if (!NILP (handler))
545 546 547 548 549
    {
      Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
550 551 552 553

  return Ffile_name_directory (filename);
}

554 555 556 557
/* Maximum number of bytes that DST will be longer than SRC
   in file_name_as_directory.  This occurs when SRCLEN == 0.  */
enum { file_name_as_directory_slop = 2 };

558 559 560 561
/* Convert from file name SRC of length SRCLEN to directory name in
   DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
   string.  On UNIX, just make sure there is a terminating /.  Return
   the length of DST in bytes.  */
Jim Blandy's avatar
Jim Blandy committed
562

563
static ptrdiff_t
564 565
file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
			bool multibyte)
566 567
{
  if (srclen == 0)
568
    {
569 570 571 572
      dst[0] = '.';
      dst[1] = '/';
      dst[2] = '\0';
      return 2;
573 574
    }

575
  memcpy (dst, src, srclen);
576
  if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
577 578
    dst[srclen++] = DIRECTORY_SEP;
  dst[srclen] = 0;
579
#ifdef DOS_NT
580
  dostounix_filename (dst);
581
#endif
582
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
583 584
}

Paul Eggert's avatar
Paul Eggert committed
585
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Jim Blandy's avatar
Jim Blandy committed
586
       Sfile_name_as_directory, 1, 1, 0,
587
       doc: /* Return a string representing the file name FILE interpreted as a directory.
588 589 590 591
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
The result can be used as the value of `default-directory'
or passed as second argument to `expand-file-name'.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
592
For a Unix-syntax file name, just appends a slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
593
  (Lisp_Object file)
Jim Blandy's avatar
Jim Blandy committed
594 595
{
  char *buf;
596
  ptrdiff_t length;
597 598
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
599

600
  CHECK_STRING (file);
Jim Blandy's avatar
Jim Blandy committed
601
  if (NILP (file))
Jim Blandy's avatar
Jim Blandy committed
602
    return Qnil;
603 604 605

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
606
  handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
607
  if (!NILP (handler))
608 609 610 611 612 613 614
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
					file);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }
615

616 617 618 619
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    file = Fdowncase (file);
#endif
620
  buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
621 622
  length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
				   STRING_MULTIBYTE (file));
623 624 625
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
626 627
}

628 629 630 631
/* Convert from directory name SRC of length SRCLEN to file name in
   DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
   string.  On UNIX, just make sure there isn't a terminating /.
   Return the length of DST in bytes.  */
Jim Blandy's avatar
Jim Blandy committed
632

633
static ptrdiff_t
634
directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
Jim Blandy's avatar
Jim Blandy committed
635 636
{
  /* Process as Unix format: just remove any final slash.
637 638
     But leave "/" and "//" unchanged.  */
  while (srclen > 1
639
#ifdef DOS_NT
640
	 && !IS_ANY_SEP (src[srclen - 2])
641
#endif
642 643 644 645 646 647
	 && IS_DIRECTORY_SEP (src[srclen - 1])
	 && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
    srclen--;

  memcpy (dst, src, srclen);
  dst[srclen] = 0;
648
#ifdef DOS_NT
649
  dostounix_filename (dst);
650
#endif
651
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
652 653
}

Paul Eggert's avatar
Paul Eggert committed
654
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
655 656 657 658 659
       1, 1, 0,
       doc: /* Returns the file name of the directory named DIRECTORY.
This is the name of the file that holds the data for the directory DIRECTORY.
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
660
In Unix-syntax, this function just removes the final slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
661
  (Lisp_Object directory)
Jim Blandy's avatar
Jim Blandy committed
662 663
{
  char *buf;
664
  ptrdiff_t length;
665 666
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
667

668
  CHECK_STRING (directory);
Jim Blandy's avatar
Jim Blandy committed
669

Jim Blandy's avatar
Jim Blandy committed
670
  if (NILP (directory))
Jim Blandy's avatar
Jim Blandy committed
671
    return Qnil;
672 673 674

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
675
  handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
676
  if (!NILP (handler))
677 678 679 680 681 682 683
    {
      Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
					directory);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }
684

685 686 687 688
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    directory = Fdowncase (directory);
#endif
689
  buf = SAFE_ALLOCA (SBYTES (directory) + 1);
690 691
  length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
				STRING_MULTIBYTE (directory));
692 693 694
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
695 696
}

697
static const char make_temp_name_tbl[64] =
698 699 700 701 702 703 704 705 706 707
{
  'A','B','C','D','E','F','G','H',
  'I','J','K','L','M','N','O','P',
  'Q','R','S','T','U','V','W','X',
  'Y','Z','a','b','c','d','e','f',
  'g','h','i','j','k','l','m','n',
  'o','p','q','r','s','t','u','v',
  'w','x','y','z','0','1','2','3',
  '4','5','6','7','8','9','-','_'
};
708

709 710
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;

711
/* Value is a temporary file name starting with PREFIX, a string.
712

713 714 715 716 717
   The Emacs process number forms part of the result, so there is
   no danger of generating a name being used by another process.
   In addition, this function makes an attempt to choose a name
   which has no existing file.  To make this work, PREFIX should be
   an absolute file name.
718

719
   BASE64_P means add the pid as 3 characters in base64
720 721 722 723 724 725 726 727
   encoding.  In this case, 6 characters will be added to PREFIX to
   form the file name.  Otherwise, if Emacs is running on a system
   with long file names, add the pid as a decimal number.

   This function signals an error if no unique file name could be
   generated.  */

Lisp_Object
728
make_temp_name (Lisp_Object prefix, bool base64_p)
Jim Blandy's avatar
Jim Blandy committed
729
{
730
  Lisp_Object val, encoded_prefix;
731
  ptrdiff_t len;
732
  printmax_t pid;
733
  char *p, *data;
734
  char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
735
  int pidlen;
736

737
  CHECK_STRING (prefix);
738 739 740 741 742 743

  /* VAL is created by adding 6 characters to PREFIX.  The first
     three are the PID of this process, in base 64, and the second
     three are incremented if the file already exists.  This ensures
     262144 unique file names per PID per PREFIX.  */

744
  pid = getpid ();
745

746 747 748 749 750 751 752 753 754
  if (base64_p)
    {
      pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidlen = 3;
    }
  else
    {
755
#ifdef HAVE_LONG_FILE_NAMES
756
      pidlen = sprintf (pidbuf, "%"pMd, pid);
757
#else
758 759 760 761
      pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidlen = 3;
762
#endif
763
    }
764

765 766 767
  encoded_prefix = ENCODE_FILE (prefix);
  len = SBYTES (encoded_prefix);
  val = make_uninit_string (len + 3 + pidlen);
768
  data = SSDATA (val);
769
  memcpy (data, SSDATA (encoded_prefix), len);
770 771
  p = data + len;

772
  memcpy (p, pidbuf, pidlen);
773 774 775 776 777
  p += pidlen;

  /* Here we try to minimize useless stat'ing when this function is
     invoked many times successively with the same PREFIX.  We achieve
     this by initializing count to a random value, and incrementing it
Richard M. Stallman's avatar
Richard M. Stallman committed
778 779 780 781 782 783
     afterwards.

     We don't want make-temp-name to be called while dumping,
     because then make_temp_name_count_initialized_p would get set
     and then make_temp_name_count would not be set when Emacs starts.  */

784 785
  if (!make_temp_name_count_initialized_p)
    {
786
      make_temp_name_count = time (NULL);
787 788 789 790 791
      make_temp_name_count_initialized_p = 1;
    }

  while (1)
    {
792
      unsigned num = make_temp_name_count;
793 794 795 796 797

      p[0] = make_temp_name_tbl[num & 63], num >>= 6;
      p[1] = make_temp_name_tbl[num & 63], num >>= 6;
      p[2] = make_temp_name_tbl[num & 63], num >>= 6;

798 799 800 801 802
      /* Poor man's congruential RN generator.  Replace with
         ++make_temp_name_count for debugging.  */
      make_temp_name_count += 25229;
      make_temp_name_count %= 225307;

803
      if (!check_existing (data))