X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5725bd2cc0e691dadc31bd958f210b1bbcf17c49..bba90ab24e80476efcad6b6a770fd5fda522a621:/src/dired.c diff --git a/src/dired.c b/src/dired.c index 771230717e..0e37568f21 100644 --- a/src/dired.c +++ b/src/dired.c @@ -1,5 +1,6 @@ /* Lisp functions for making directory listings. - Copyright (C) 1985-1986, 1993-1994, 1999-2012 Free Software Foundation, Inc. + Copyright (C) 1985-1986, 1993-1994, 1999-2013 Free Software + Foundation, Inc. This file is part of GNU Emacs. @@ -22,7 +23,6 @@ along with GNU Emacs. If not, see . */ #include #include #include -#include #ifdef HAVE_PWD_H #include @@ -30,46 +30,13 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include -/* The d_nameln member of a struct dirent includes the '\0' character - on some systems, but not on others. What's worse, you can't tell - at compile-time which one it will be, since it really depends on - the sort of system providing the filesystem you're reading from, - not the system you are running on. Paul Eggert - says this occurs when Emacs is running on a - SunOS 4.1.2 host, reading a directory that is remote-mounted from a - Solaris 2.1 host and is in a native Solaris 2.1 filesystem. - - Since applying strlen to the name always works, we'll just do that. */ -#define NAMLEN(p) strlen (p->d_name) - -#ifdef HAVE_DIRENT_H - #include -#define DIRENTRY struct dirent - -#else /* not HAVE_DIRENT_H */ - -#include -#include - -#define DIRENTRY struct direct - -extern DIR *opendir (char *); -extern struct direct *readdir (DIR *); - -#endif /* HAVE_DIRENT_H */ - #include #include -#ifdef MSDOS -#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) -#else -#define DIRENTRY_NONEMPTY(p) ((p)->d_ino) -#endif - #include "lisp.h" #include "systime.h" #include "character.h" @@ -88,7 +55,57 @@ static Lisp_Object Qfile_attributes; static Lisp_Object Qfile_attributes_lessp; static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); +static Lisp_Object file_attributes (int, char const *, Lisp_Object); +/* Return the number of bytes in DP's name. */ +static ptrdiff_t +dirent_namelen (struct dirent *dp) +{ +#ifdef _D_EXACT_NAMLEN + return _D_EXACT_NAMLEN (dp); +#else + return strlen (dp->d_name); +#endif +} + +static DIR * +open_directory (char const *name, int *fdp) +{ + DIR *d; + int fd, opendir_errno; + + block_input (); + +#ifdef DOS_NT + /* Directories cannot be opened. The emulation assumes that any + file descriptor other than AT_FDCWD corresponds to the most + recently opened directory. This hack is good enough for Emacs. */ + fd = 0; + d = opendir (name); + opendir_errno = errno; +#else + fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0); + if (fd < 0) + { + opendir_errno = errno; + d = 0; + } + else + { + d = fdopendir (fd); + opendir_errno = errno; + if (! d) + close (fd); + } +#endif + + unblock_input (); + + *fdp = fd; + errno = opendir_errno; + return d; +} + #ifdef WINDOWSNT Lisp_Object directory_files_internal_w32_unwind (Lisp_Object arg) @@ -101,29 +118,32 @@ directory_files_internal_w32_unwind (Lisp_Object arg) static Lisp_Object directory_files_internal_unwind (Lisp_Object dh) { - DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer; - BLOCK_INPUT; + DIR *d = XSAVE_POINTER (dh, 0); + block_input (); closedir (d); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes. - When ATTRS is zero, return a list of directory filenames; when - non-zero, return a list of directory filenames and their attributes. + If not ATTRS, return a list of directory filenames; + if ATTRS, return a list of directory filenames and their attributes. In the latter case, ID_FORMAT is passed to Ffile_attributes. */ Lisp_Object -directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format) +directory_files_internal (Lisp_Object directory, Lisp_Object full, + Lisp_Object match, Lisp_Object nosort, bool attrs, + Lisp_Object id_format) { DIR *d; + int fd; ptrdiff_t directory_nbytes; Lisp_Object list, dirfilename, encoded_directory; struct re_pattern_buffer *bufp = NULL; - int needsep = 0; + bool needsep = 0; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - DIRENTRY *dp; + struct dirent *dp; #ifdef WINDOWSNT Lisp_Object w32_save = Qnil; #endif @@ -163,9 +183,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ - BLOCK_INPUT; - d = opendir (SSDATA (dirfilename)); - UNBLOCK_INPUT; + d = open_directory (SSDATA (dirfilename), &fd); if (d == NULL) report_file_error ("Opening directory", Fcons (directory, Qnil)); @@ -173,7 +191,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ record_unwind_protect (directory_files_internal_unwind, - make_save_value (d, 0)); + make_save_pointer (d)); #ifdef WINDOWSNT if (attrs) @@ -208,110 +226,92 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m /* Loop reading blocks until EOF or error. */ for (;;) { + ptrdiff_t len; + bool wanted = 0; + Lisp_Object name, finalname; + struct gcpro gcpro1, gcpro2; + errno = 0; dp = readdir (d); + if (!dp) + { + if (errno == EAGAIN || errno == EINTR) + { + QUIT; + continue; + } + break; + } - if (dp == NULL && (0 -#ifdef EAGAIN - || errno == EAGAIN -#endif -#ifdef EINTR - || errno == EINTR -#endif - )) - { QUIT; continue; } + len = dirent_namelen (dp); + name = finalname = make_unibyte_string (dp->d_name, len); + GCPRO2 (finalname, name); + + /* Note: DECODE_FILE can GC; it should protect its argument, + though. */ + name = DECODE_FILE (name); + len = SBYTES (name); + + /* Now that we have unwind_protect in place, we might as well + allow matching to be interrupted. */ + immediate_quit = 1; + QUIT; + + if (NILP (match) + || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) + wanted = 1; - if (dp == NULL) - break; + immediate_quit = 0; - if (DIRENTRY_NONEMPTY (dp)) + if (wanted) { - ptrdiff_t len; - int wanted = 0; - Lisp_Object name, finalname; - struct gcpro gcpro1, gcpro2; + if (!NILP (full)) + { + Lisp_Object fullname; + ptrdiff_t nbytes = len + directory_nbytes + needsep; + ptrdiff_t nchars; - len = NAMLEN (dp); - name = finalname = make_unibyte_string (dp->d_name, len); - GCPRO2 (finalname, name); + fullname = make_uninit_multibyte_string (nbytes, nbytes); + memcpy (SDATA (fullname), SDATA (directory), + directory_nbytes); - /* Note: DECODE_FILE can GC; it should protect its argument, - though. */ - name = DECODE_FILE (name); - len = SBYTES (name); + if (needsep) + SSET (fullname, directory_nbytes, DIRECTORY_SEP); - /* Now that we have unwind_protect in place, we might as well - allow matching to be interrupted. */ - immediate_quit = 1; - QUIT; + memcpy (SDATA (fullname) + directory_nbytes + needsep, + SDATA (name), len); - if (NILP (match) - || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) - wanted = 1; + nchars = chars_in_text (SDATA (fullname), nbytes); - immediate_quit = 0; + /* Some bug somewhere. */ + if (nchars > nbytes) + emacs_abort (); - if (wanted) - { - if (!NILP (full)) - { - Lisp_Object fullname; - ptrdiff_t nbytes = len + directory_nbytes + needsep; - ptrdiff_t nchars; - - fullname = make_uninit_multibyte_string (nbytes, nbytes); - memcpy (SDATA (fullname), SDATA (directory), - directory_nbytes); - - if (needsep) - SSET (fullname, directory_nbytes, DIRECTORY_SEP); - - memcpy (SDATA (fullname) + directory_nbytes + needsep, - SDATA (name), len); - - nchars = chars_in_text (SDATA (fullname), nbytes); - - /* Some bug somewhere. */ - if (nchars > nbytes) - abort (); - - STRING_SET_CHARS (fullname, nchars); - if (nchars == nbytes) - STRING_SET_UNIBYTE (fullname); - - finalname = fullname; - } - else - finalname = name; - - if (attrs) - { - /* Construct an expanded filename for the directory entry. - Use the decoded names for input to Ffile_attributes. */ - Lisp_Object decoded_fullname, fileattrs; - struct gcpro gcpro1, gcpro2; - - decoded_fullname = fileattrs = Qnil; - GCPRO2 (decoded_fullname, fileattrs); - - /* Both Fexpand_file_name and Ffile_attributes can GC. */ - decoded_fullname = Fexpand_file_name (name, directory); - fileattrs = Ffile_attributes (decoded_fullname, id_format); - - list = Fcons (Fcons (finalname, fileattrs), list); - UNGCPRO; - } - else - list = Fcons (finalname, list); + STRING_SET_CHARS (fullname, nchars); + if (nchars == nbytes) + STRING_SET_UNIBYTE (fullname); + + finalname = fullname; } + else + finalname = name; - UNGCPRO; + if (attrs) + { + Lisp_Object fileattrs + = file_attributes (fd, dp->d_name, id_format); + list = Fcons (Fcons (finalname, fileattrs), list); + } + else + list = Fcons (finalname, list); } + + UNGCPRO; } - BLOCK_INPUT; + block_input (); closedir (d); - UNBLOCK_INPUT; + unblock_input (); #ifdef WINDOWSNT if (attrs) Vw32_get_true_file_attributes = w32_save; @@ -381,9 +381,8 @@ which see. */) } -static Lisp_Object file_name_completion - (Lisp_Object file, Lisp_Object dirname, int all_flag, int ver_flag, - Lisp_Object predicate); +static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool, + Lisp_Object); DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion, 2, 3, 0, @@ -415,7 +414,7 @@ determined by the variable `completion-ignored-extensions', which see. */) if (!NILP (handler)) return call4 (handler, Qfile_name_completion, file, directory, predicate); - return file_name_completion (file, directory, 0, 0, predicate); + return file_name_completion (file, directory, 0, predicate); } DEFUN ("file-name-all-completions", Ffile_name_all_completions, @@ -439,16 +438,18 @@ These are all file names in directory DIRECTORY which begin with FILE. */) if (!NILP (handler)) return call3 (handler, Qfile_name_all_completions, file, directory); - return file_name_completion (file, directory, 1, 0, Qnil); + return file_name_completion (file, directory, 1, Qnil); } -static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr); +static int file_name_completion_stat (int, struct dirent *, struct stat *); static Lisp_Object Qdefault_directory; static Lisp_Object -file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int ver_flag, Lisp_Object predicate) +file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, + Lisp_Object predicate) { DIR *d; + int fd; ptrdiff_t bestmatchsize = 0; int matchcount = 0; /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded. @@ -458,11 +459,11 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v Lisp_Object encoded_file; Lisp_Object encoded_dir; struct stat st; - int directoryp; - /* If includeall is zero, exclude files in completion-ignored-extensions as + bool directoryp; + /* If not INCLUDEALL, exclude files in completion-ignored-extensions as well as "." and "..". Until shown otherwise, assume we can't exclude anything. */ - int includeall = 1; + bool includeall = 1; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; @@ -483,52 +484,47 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v on the encoded file name. */ encoded_file = STRING_MULTIBYTE (file) ? ENCODE_FILE (file) : file; - encoded_dir = ENCODE_FILE (dirname); + encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname)); - BLOCK_INPUT; - d = opendir (SSDATA (Fdirectory_file_name (encoded_dir))); - UNBLOCK_INPUT; + d = open_directory (SSDATA (encoded_dir), &fd); if (!d) report_file_error ("Opening directory", Fcons (dirname, Qnil)); record_unwind_protect (directory_files_internal_unwind, - make_save_value (d, 0)); + make_save_pointer (d)); /* Loop reading blocks */ /* (att3b compiler bug requires do a null comparison this way) */ while (1) { - DIRENTRY *dp; + struct dirent *dp; ptrdiff_t len; - int canexclude = 0; + bool canexclude = 0; errno = 0; dp = readdir (d); - if (dp == NULL && (0 -# ifdef EAGAIN - || errno == EAGAIN -# endif -# ifdef EINTR - || errno == EINTR -# endif - )) - { QUIT; continue; } - - if (!dp) break; + if (!dp) + { + if (errno == EAGAIN || errno == EINTR) + { + QUIT; + continue; + } + break; + } - len = NAMLEN (dp); + len = dirent_namelen (dp); QUIT; - if (! DIRENTRY_NONEMPTY (dp) - || len < SCHARS (encoded_file) + if (len < SCHARS (encoded_file) || 0 <= scmp (dp->d_name, SSDATA (encoded_file), SCHARS (encoded_file))) continue; - if (file_name_completion_stat (encoded_dir, dp, &st) < 0) + if (file_name_completion_stat (fd, dp, &st) < 0) continue; - directoryp = S_ISDIR (st.st_mode); + directoryp = S_ISDIR (st.st_mode) != 0; tem = Qnil; /* If all_flag is set, always include all. It would not actually be helpful to the user to ignore any possible @@ -702,10 +698,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v name, zero, make_number (compare), completion_ignore_case ? Qt : Qnil); - ptrdiff_t matchsize - = (EQ (cmp, Qt) ? compare - : XINT (cmp) < 0 ? - XINT (cmp) - 1 - : XINT (cmp) - 1); + ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1; if (completion_ignore_case) { @@ -716,7 +709,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v /* This tests that the current file is an exact match but BESTMATCH is not (it is too long). */ if ((matchsize == SCHARS (name) - && matchsize + !!directoryp < SCHARS (bestmatch)) + && matchsize + directoryp < SCHARS (bestmatch)) || /* If there is no exact match ignoring case, prefer a match that does not change the case @@ -728,7 +721,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, int v either both or neither are exact. */ (((matchsize == SCHARS (name)) == - (matchsize + !!directoryp == SCHARS (bestmatch))) + (matchsize + directoryp == SCHARS (bestmatch))) && (cmp = Fcompare_strings (name, zero, make_number (SCHARS (file)), file, zero, @@ -805,13 +798,9 @@ scmp (const char *s1, const char *s2, ptrdiff_t len) } static int -file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr) +file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr) { - ptrdiff_t len = NAMLEN (dp); - ptrdiff_t pos = SCHARS (dirname); int value; - USE_SAFE_ALLOCA; - char *fullname = SAFE_ALLOCA (len + pos + 2); #ifdef MSDOS /* Some fields of struct stat are *very* expensive to compute on MS-DOS, @@ -824,23 +813,15 @@ file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_ad _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE; #endif /* MSDOS */ - memcpy (fullname, SDATA (dirname), pos); - if (!IS_DIRECTORY_SEP (fullname[pos - 1])) - fullname[pos++] = DIRECTORY_SEP; - - memcpy (fullname + pos, dp->d_name, len); - fullname[pos + len] = 0; - /* We want to return success if a link points to a nonexistent file, but we want to return the status for what the link points to, in case it is a directory. */ - value = lstat (fullname, st_addr); + value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW); if (value == 0 && S_ISLNK (st_addr->st_mode)) - stat (fullname, st_addr); + fstatat (fd, dp->d_name, st_addr, 0); #ifdef MSDOS _djstat_flags = save_djstat_flags; #endif /* MSDOS */ - SAFE_FREE (); return value; } @@ -850,7 +831,7 @@ stat_uname (struct stat *st) #ifdef WINDOWSNT return st->st_uname; #else - struct passwd *pw = (struct passwd *) getpwuid (st->st_uid); + struct passwd *pw = getpwuid (st->st_uid); if (pw) return pw->pw_name; @@ -865,7 +846,7 @@ stat_gname (struct stat *st) #ifdef WINDOWSNT return st->st_gname; #else - struct group *gr = (struct group *) getgrgid (st->st_gid); + struct group *gr = getgrgid (st->st_gid); if (gr) return gr->gr_name; @@ -899,7 +880,7 @@ Elements of the attribute list are: 7. Size in bytes. This is a floating point number if the size is too large for an integer. 8. File modes, as a string of ten letters or dashes as in ls -l. - 9. t if file's gid would change if file were deleted and recreated. + 9. An unspecified value, present only for backward compatibility. 10. inode number. If it is larger than what an Emacs integer can hold, this is of the form (HIGH . LOW): first the high bits, then the low 16 bits. If even HIGH is too large for an Emacs integer, this is instead of the form @@ -918,21 +899,8 @@ On some FAT-based filesystems, only the date of last access is recorded, so last access time will always be midnight of that day. */) (Lisp_Object filename, Lisp_Object id_format) { - Lisp_Object values[12]; Lisp_Object encoded; - struct stat s; -#ifdef BSD4_2 - Lisp_Object dirname; - struct stat sdir; -#endif /* BSD4_2 */ - - /* An array to hold the mode string generated by filemodestring, - including its terminating space and null byte. */ - char modes[sizeof "-rwxr-xr-x "]; - Lisp_Object handler; - struct gcpro gcpro1; - char *uname = NULL, *gname = NULL; filename = Fexpand_file_name (filename, Qnil); @@ -948,23 +916,50 @@ so last access time will always be midnight of that day. */) return call3 (handler, Qfile_attributes, filename, id_format); } - GCPRO1 (filename); encoded = ENCODE_FILE (filename); - UNGCPRO; + return file_attributes (AT_FDCWD, SSDATA (encoded), id_format); +} + +static Lisp_Object +file_attributes (int fd, char const *name, Lisp_Object id_format) +{ + Lisp_Object values[12]; + struct stat s; + int lstat_result; + + /* An array to hold the mode string generated by filemodestring, + including its terminating space and null byte. */ + char modes[sizeof "-rwxr-xr-x "]; + + char *uname = NULL, *gname = NULL; + +#ifdef WINDOWSNT + /* We usually don't request accurate owner and group info, because + it can be very expensive on Windows to get that, and most callers + of 'lstat' don't need that. But here we do want that information + to be accurate. */ + w32_stat_get_owner_group = 1; +#endif + + lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW); + +#ifdef WINDOWSNT + w32_stat_get_owner_group = 0; +#endif - if (lstat (SSDATA (encoded), &s) < 0) + if (lstat_result < 0) return Qnil; - values[0] = (S_ISLNK (s.st_mode) ? Ffile_symlink_p (filename) + values[0] = (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name) : S_ISDIR (s.st_mode) ? Qt : Qnil); values[1] = make_number (s.st_nlink); if (!(NILP (id_format) || EQ (id_format, Qinteger))) { - BLOCK_INPUT; + block_input (); uname = stat_uname (&s); gname = stat_gname (&s); - UNBLOCK_INPUT; + unblock_input (); } if (uname) values[2] = DECODE_SYSTEM (build_string (uname)); @@ -989,17 +984,7 @@ so last access time will always be midnight of that day. */) filemodestring (&s, modes); values[8] = make_string (modes, 10); -#ifdef BSD4_2 /* file gid will be dir gid */ - dirname = Ffile_name_directory (filename); - if (! NILP (dirname)) - encoded = ENCODE_FILE (dirname); - if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0) - values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; - else /* if we can't tell, assume worst */ - values[9] = Qt; -#else /* file gid will be egid */ - values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; -#endif /* not BSD4_2 */ + values[9] = Qt; values[10] = INTEGER_TO_CONS (s.st_ino); values[11] = INTEGER_TO_CONS (s.st_dev);