X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ec2cfa3449c587fcb9a4f7a694d1763dde52eade..018ba359ab456f6a43f3acea0c15df616aa0ad02:/src/dired.c diff --git a/src/dired.c b/src/dired.c index 376e3cac77..2dc13188b1 100644 --- a/src/dired.c +++ b/src/dired.c @@ -1,11 +1,12 @@ /* Lisp functions for making directory listings. - Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001 + Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -15,7 +16,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #include @@ -24,12 +26,19 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #include +#include "systime.h" +#include + #ifdef VMS #include #include #include #endif +#ifdef HAVE_UNISTD_H +#include +#endif + /* 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 @@ -59,6 +68,8 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #endif #endif /* not NONSYSTEM_DIR_LIBRARY */ +#include + #ifndef MSDOS #define DIRENTRY struct direct @@ -77,13 +88,15 @@ extern struct direct *readdir (); #include "lisp.h" #include "buffer.h" #include "commands.h" - +#include "charset.h" +#include "coding.h" #include "regex.h" /* Returns a search buffer, with a fastmap allocated and ready to go. */ extern struct re_pattern_buffer *compile_pattern (); -#define min(a, b) ((a) < (b) ? (a) : (b)) +/* From filemode.c. Can't go in Lisp.h because of `stat'. */ +extern void filemodestring P_ ((struct stat *, char *)); /* if system does not have symbolic links, it does not have lstat. In that case, use ordinary stat instead. */ @@ -94,192 +107,373 @@ extern struct re_pattern_buffer *compile_pattern (); extern int completion_ignore_case; extern Lisp_Object Vcompletion_regexp_list; +extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system; Lisp_Object Vcompletion_ignored_extensions; Lisp_Object Qcompletion_ignore_case; Lisp_Object Qdirectory_files; +Lisp_Object Qdirectory_files_and_attributes; Lisp_Object Qfile_name_completion; Lisp_Object Qfile_name_all_completions; Lisp_Object Qfile_attributes; +Lisp_Object Qfile_attributes_lessp; -DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, - "Return a list of names of files in DIRECTORY.\n\ -There are three optional arguments:\n\ -If FULL is non-nil, absolute pathnames of the files are returned.\n\ -If MATCH is non-nil, only pathnames containing that regexp are returned.\n\ -If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ - NOSORT is useful if you plan to sort the result yourself.") - (dirname, full, match, nosort) - Lisp_Object dirname, full, match, nosort; -{ - DIR *d; - int dirnamelen; - Lisp_Object list, name, dirfilename; - Lisp_Object handler; - struct re_pattern_buffer *bufp; - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (dirname, Qdirectory_files); - if (!NILP (handler)) - { - Lisp_Object args[6]; +Lisp_Object +directory_files_internal_unwind (dh) + Lisp_Object dh; +{ + DIR *d = (DIR *) ((XINT (XCAR (dh)) << 16) + XINT (XCDR (dh))); + closedir (d); + return Qnil; +} - args[0] = handler; - args[1] = Qdirectory_files; - args[2] = dirname; - args[3] = full; - args[4] = match; - args[5] = nosort; - return Ffuncall (6, args); - } +/* 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. */ - { - struct gcpro gcpro1, gcpro2; +Lisp_Object +directory_files_internal (directory, full, match, nosort, attrs) + Lisp_Object directory, full, match, nosort; + int attrs; +{ + DIR *d; + int directory_nbytes; + Lisp_Object list, dirfilename, encoded_directory; + struct re_pattern_buffer *bufp = NULL; + int needsep = 0; + int count = specpdl_ptr - specpdl; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + DIRENTRY *dp; + int retry_p; - /* Because of file name handlers, these functions might call + /* Because of file name handlers, these functions might call Ffuncall, and cause a GC. */ - GCPRO1 (match); - dirname = Fexpand_file_name (dirname, Qnil); - UNGCPRO; - GCPRO2 (match, dirname); - dirfilename = Fdirectory_file_name (dirname); - UNGCPRO; - } + list = encoded_directory = dirfilename = Qnil; + GCPRO5 (match, directory, list, dirfilename, encoded_directory); + directory = Fexpand_file_name (directory, Qnil); + dirfilename = Fdirectory_file_name (directory); if (!NILP (match)) { CHECK_STRING (match, 3); /* MATCH might be a flawed regular expression. Rather than - catching and signalling our own errors, we just call + catching and signaling our own errors, we just call compile_pattern to do the work for us. */ + /* Pass 1 for the MULTIBYTE arg + because we do make multibyte strings if the contents warrant. */ #ifdef VMS bufp = compile_pattern (match, 0, - buffer_defaults.downcase_table->contents, 0); + buffer_defaults.downcase_table, 0, 1); #else - bufp = compile_pattern (match, 0, 0, 0); + bufp = compile_pattern (match, 0, Qnil, 0, 1); #endif } + /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run + run_pre_post_conversion_on_str which calls Lisp directly and + indirectly. */ + dirfilename = ENCODE_FILE (dirfilename); + encoded_directory = ENCODE_FILE (directory); + /* 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! */ /* Do this opendir after anything which might signal an error; if - an error is signalled while the directory stream is open, we + an error is signaled while the directory stream is open, we have to make sure it gets closed, and setting up an unwind_protect to do so would be a pain. */ + retry: + d = opendir (XSTRING (dirfilename)->data); - if (! d) - report_file_error ("Opening directory", Fcons (dirname, Qnil)); + if (d == NULL) + report_file_error ("Opening directory", Fcons (directory, Qnil)); + + /* Unfortunately, we can now invoke expand-file-name and + file-attributes on filenames, both of which can throw, so we must + do a proper unwind-protect. */ + record_unwind_protect (directory_files_internal_unwind, + Fcons (make_number (((unsigned long) d) >> 16), + make_number (((unsigned long) d) & 0xffff))); + + directory_nbytes = STRING_BYTES (XSTRING (directory)); + re_match_object = Qt; - list = Qnil; - dirnamelen = XSTRING (dirname)->size; + /* Decide whether we need to add a directory separator. */ +#ifndef VMS + if (directory_nbytes == 0 + || !IS_ANY_SEP (XSTRING (directory)->data[directory_nbytes - 1])) + needsep = 1; +#endif /* not VMS */ - /* Loop reading blocks */ - while (1) + /* Loop reading blocks until EOF or error. */ + for (;;) { - DIRENTRY *dp = readdir (d); - int len; + errno = 0; + dp = readdir (d); + +#ifdef EAGAIN + if (dp == NULL && errno == EAGAIN) + continue; +#endif + + if (dp == NULL) + break; - if (!dp) break; - len = NAMLEN (dp); if (DIRENTRY_NONEMPTY (dp)) { + int len; + int wanted = 0; + Lisp_Object name, finalname; + struct gcpro gcpro1, gcpro2; + + len = NAMLEN (dp); + name = finalname = make_unibyte_string (dp->d_name, len); + GCPRO2 (finalname, name); + + /* Note: ENCODE_FILE can GC; it should protect its argument, + though. */ + name = DECODE_FILE (name); + len = STRING_BYTES (XSTRING (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, dp->d_name, len, 0, len, 0))) + || (0 <= re_search (bufp, XSTRING (name)->data, len, 0, len, 0))) + wanted = 1; + + immediate_quit = 0; + + if (wanted) { if (!NILP (full)) { - int afterdirindex = dirnamelen; - int total = len + dirnamelen; - int needsep = 0; + Lisp_Object fullname; + int nbytes = len + directory_nbytes + needsep; + int nchars; + + fullname = make_uninit_multibyte_string (nbytes, nbytes); + bcopy (XSTRING (directory)->data, XSTRING (fullname)->data, + directory_nbytes); + + if (needsep) + XSTRING (fullname)->data[directory_nbytes] = DIRECTORY_SEP; + + bcopy (XSTRING (name)->data, + XSTRING (fullname)->data + directory_nbytes + needsep, + len); + + nchars = chars_in_text (XSTRING (fullname)->data, nbytes); + + /* Some bug somewhere. */ + if (nchars > nbytes) + abort (); + + XSTRING (fullname)->size = nchars; + if (nchars == nbytes) + SET_STRING_BYTES (XSTRING (fullname), -1); + + finalname = fullname; + } + else + finalname = name; - /* Decide whether we need to add a directory separator. */ -#ifndef VMS - if (dirnamelen == 0 - || !IS_ANY_SEP (XSTRING (dirname)->data[dirnamelen - 1])) - needsep = 1; -#endif /* VMS */ + 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; - name = make_uninit_string (total + needsep); - bcopy (XSTRING (dirname)->data, XSTRING (name)->data, - dirnamelen); - if (needsep) - XSTRING (name)->data[afterdirindex++] = DIRECTORY_SEP; - bcopy (dp->d_name, - XSTRING (name)->data + afterdirindex, len); + 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); + + list = Fcons (Fcons (finalname, fileattrs), list); + UNGCPRO; } else - name = make_string (dp->d_name, len); - list = Fcons (name, list); + list = Fcons (finalname, list); } + + UNGCPRO; } } + + retry_p = 0; +#ifdef EINTR + retry_p |= errno == EINTR; +#endif + closedir (d); - if (!NILP (nosort)) - return list; - return Fsort (Fnreverse (list), Qstring_lessp); + + /* Discard the unwind protect. */ + specpdl_ptr = specpdl + count; + + if (retry_p) + { + list = Qnil; + goto retry; + } + + if (NILP (nosort)) + list = Fsort (Fnreverse (list), + attrs ? Qfile_attributes_lessp : Qstring_lessp); + + RETURN_UNGCPRO (list); } + + +DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, + "Return a list of names of files in DIRECTORY.\n\ +There are three optional arguments:\n\ +If FULL is non-nil, return absolute file names. Otherwise return names\n\ + that are relative to the specified directory.\n\ +If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\ +If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ + NOSORT is useful if you plan to sort the result yourself.") + (directory, full, match, nosort) + Lisp_Object directory, full, match, nosort; +{ + Lisp_Object handler; + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (directory, Qdirectory_files); + if (!NILP (handler)) + { + Lisp_Object args[6]; + + args[0] = handler; + args[1] = Qdirectory_files; + args[2] = directory; + args[3] = full; + args[4] = match; + args[5] = nosort; + return Ffuncall (6, args); + } + + return directory_files_internal (directory, full, match, nosort, 0); +} + +DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, Sdirectory_files_and_attributes, 1, 4, 0, + "Return a list of names of files and their attributes in DIRECTORY.\n\ +There are three optional arguments:\n\ +If FULL is non-nil, return absolute file names. Otherwise return names\n\ + that are relative to the specified directory.\n\ +If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\ +If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ + NOSORT is useful if you plan to sort the result yourself.") + (directory, full, match, nosort) + Lisp_Object directory, full, match, nosort; +{ + Lisp_Object handler; + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes); + if (!NILP (handler)) + { + Lisp_Object args[6]; + + args[0] = handler; + args[1] = Qdirectory_files_and_attributes; + args[2] = directory; + args[3] = full; + args[4] = match; + args[5] = nosort; + return Ffuncall (6, args); + } + + return directory_files_internal (directory, full, match, nosort, 1); +} + Lisp_Object file_name_completion (); DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion, 2, 2, 0, - "Complete file name FILE in directory DIR.\n\ + "Complete file name FILE in directory DIRECTORY.\n\ Returns the longest string\n\ -common to all filenames in DIR that start with FILE.\n\ +common to all file names in DIRECTORY that start with FILE.\n\ If there is only one and FILE matches it exactly, returns t.\n\ -Returns nil if DIR contains no name starting with FILE.") - (file, dirname) - Lisp_Object file, dirname; +Returns nil if DIR contains no name starting with FILE.\n\ +\n\ +This function ignores some of the possible completions as\n\ +determined by the variable `completion-ignored-extensions', which see.") + (file, directory) + Lisp_Object file, directory; { Lisp_Object handler; + /* If the directory name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (directory, Qfile_name_completion); + if (!NILP (handler)) + return call3 (handler, Qfile_name_completion, file, directory); + /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (dirname, Qfile_name_completion); + handler = Ffind_file_name_handler (file, Qfile_name_completion); if (!NILP (handler)) - return call3 (handler, Qfile_name_completion, file, dirname); + return call3 (handler, Qfile_name_completion, file, directory); - return file_name_completion (file, dirname, 0, 0); + return file_name_completion (file, directory, 0, 0); } DEFUN ("file-name-all-completions", Ffile_name_all_completions, Sfile_name_all_completions, 2, 2, 0, - "Return a list of all completions of file name FILE in directory DIR.\n\ -These are all file names in directory DIR which begin with FILE.") - (file, dirname) - Lisp_Object file, dirname; + "Return a list of all completions of file name FILE in directory DIRECTORY.\n\ +These are all file names in directory DIRECTORY which begin with FILE.") + (file, directory) + Lisp_Object file, directory; { Lisp_Object handler; + /* If the directory name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (directory, Qfile_name_all_completions); + if (!NILP (handler)) + return call3 (handler, Qfile_name_all_completions, file, directory); + /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions); + handler = Ffind_file_name_handler (file, Qfile_name_all_completions); if (!NILP (handler)) - return call3 (handler, Qfile_name_all_completions, file, dirname); + return call3 (handler, Qfile_name_all_completions, file, directory); - return file_name_completion (file, dirname, 1, 0); + return file_name_completion (file, directory, 1, 0); } +static int file_name_completion_stat (); + Lisp_Object file_name_completion (file, dirname, all_flag, ver_flag) Lisp_Object file, dirname; int all_flag, ver_flag; { DIR *d; - DIRENTRY *dp; - int bestmatchsize, skip; + int bestmatchsize = 0, skip; register int compare, matchsize; unsigned char *p1, *p2; int matchcount = 0; Lisp_Object bestmatch, tem, elt, name; + Lisp_Object encoded_file; + Lisp_Object encoded_dir; struct stat st; int directoryp; int passcount; int count = specpdl_ptr - specpdl; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + + elt = Qnil; #ifdef VMS extern DIRENTRY * readdirver (); @@ -301,9 +495,17 @@ file_name_completion (file, dirname, all_flag, ver_flag) file = FILE_SYSTEM_CASE (file); #endif bestmatch = Qnil; - GCPRO3 (file, dirname, bestmatch); + encoded_file = encoded_dir = Qnil; + GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir); dirname = Fexpand_file_name (dirname, Qnil); + /* Do completion on the encoded file name + because the other names in the directory are (we presume) + encoded likewise. We decode the completed string at the end. */ + encoded_file = ENCODE_FILE (file); + + encoded_dir = ENCODE_FILE (dirname); + /* With passcount = 0, ignore files that end in an ignored extension. If nothing found then try again with passcount = 1, don't ignore them. If looking for all completions, start with passcount = 1, @@ -314,7 +516,8 @@ file_name_completion (file, dirname, all_flag, ver_flag) for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++) { - if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data))) + d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data); + if (!d) report_file_error ("Opening directory", Fcons (dirname, Qnil)); /* Loop reading blocks */ @@ -336,12 +539,12 @@ file_name_completion (file, dirname, all_flag, ver_flag) if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) goto quit; if (! DIRENTRY_NONEMPTY (dp) - || len < XSTRING (file)->size - || 0 <= scmp (dp->d_name, XSTRING (file)->data, - XSTRING (file)->size)) + || len < XSTRING (encoded_file)->size + || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data, + XSTRING (encoded_file)->size)) continue; - if (file_name_completion_stat (dirname, dp, &st) < 0) + if (file_name_completion_stat (encoded_dir, dp, &st) < 0) continue; directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); @@ -355,17 +558,42 @@ file_name_completion (file, dirname, all_flag, ver_flag) actually in the way in a directory contains only one file. */ if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) continue; + if (!passcount && len > XSTRING (encoded_file)->size) + /* Ignore directories if they match an element of + completion-ignored-extensions which ends in a slash. */ + for (tem = Vcompletion_ignored_extensions; + CONSP (tem); tem = XCDR (tem)) + { + int elt_len; + + elt = XCAR (tem); + if (!STRINGP (elt)) + continue; + elt_len = XSTRING (elt)->size - 1; /* -1 for trailing / */ + if (elt_len <= 0) + continue; + p1 = XSTRING (elt)->data; + if (p1[elt_len] != '/') + continue; + skip = len - elt_len; + if (skip < 0) + continue; + + if (0 <= scmp (dp->d_name + skip, p1, elt_len)) + continue; + break; + } } else { /* Compare extensions-to-be-ignored against end of this file name */ /* if name is not an exact match against specified string */ - if (!passcount && len > XSTRING (file)->size) + if (!passcount && len > XSTRING (encoded_file)->size) /* and exit this for loop if a match is found */ for (tem = Vcompletion_ignored_extensions; - CONSP (tem); tem = XCONS (tem)->cdr) + CONSP (tem); tem = XCDR (tem)) { - elt = XCONS (tem)->car; + elt = XCAR (tem); if (!STRINGP (elt)) continue; skip = len - XSTRING (elt)->size; if (skip < 0) continue; @@ -391,9 +619,10 @@ file_name_completion (file, dirname, all_flag, ver_flag) /* Ignore this element if it fails to match all the regexps. */ for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCONS (regexps)->cdr) + regexps = XCDR (regexps)) { - tem = Fstring_match (XCONS (regexps)->car, elt, zero); + tem = Fstring_match (XCAR (regexps), + make_string (dp->d_name, len), zero); if (NILP (tem)) break; } @@ -417,6 +646,7 @@ file_name_completion (file, dirname, all_flag, ver_flag) name = make_string (dp->d_name, len); if (all_flag) { + name = DECODE_FILE (name); bestmatch = Fcons (name, bestmatch); } else @@ -439,6 +669,8 @@ file_name_completion (file, dirname, all_flag, ver_flag) use it as the best match rather than one that is not an exact match. This way, we get the case pattern of the actual match. */ + /* This tests that the current file is an exact match + but BESTMATCH is not (it is too long). */ if ((matchsize == len && matchsize + !!directoryp < XSTRING (bestmatch)->size) @@ -446,15 +678,17 @@ file_name_completion (file, dirname, all_flag, ver_flag) /* If there is no exact match ignoring case, prefer a match that does not change the case of the input. */ + /* If there is more than one exact match aside from + case, and one of them is exact including case, + prefer that one. */ + /* This == checks that, of current file and BESTMATCH, + either both or neither are exact. */ (((matchsize == len) == (matchsize + !!directoryp == XSTRING (bestmatch)->size)) - /* If there is more than one exact match aside from - case, and one of them is exact including case, - prefer that one. */ - && !bcmp (p2, XSTRING (file)->data, XSTRING (file)->size) - && bcmp (p1, XSTRING (file)->data, XSTRING (file)->size))) + && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size) + && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size))) { bestmatch = make_string (dp->d_name, len); if (directoryp) @@ -479,16 +713,27 @@ file_name_completion (file, dirname, all_flag, ver_flag) bestmatch = unbind_to (count, bestmatch); if (all_flag || NILP (bestmatch)) - return bestmatch; + { + if (STRINGP (bestmatch)) + bestmatch = DECODE_FILE (bestmatch); + return bestmatch; + } if (matchcount == 1 && bestmatchsize == XSTRING (file)->size) return Qt; - return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize)); + bestmatch = Fsubstring (bestmatch, make_number (0), + make_number (bestmatchsize)); + /* Now that we got the right initial segment of BESTMATCH, + decode it from the coding system in use. */ + bestmatch = DECODE_FILE (bestmatch); + return bestmatch; + quit: if (d) closedir (d); Vquit_flag = Qnil; return Fsignal (Qquit, Qnil); } +static int file_name_completion_stat (dirname, dp, st_addr) Lisp_Object dirname; DIRENTRY *dp; @@ -499,6 +744,19 @@ file_name_completion_stat (dirname, dp, st_addr) int value; char *fullname = (char *) alloca (len + pos + 2); +#ifdef MSDOS +#if __DJGPP__ > 1 + /* Some fields of struct stat are *very* expensive to compute on MS-DOS, + but aren't required here. Avoid computing the following fields: + st_inode, st_size and st_nlink for directories, and the execute bits + in st_mode for non-directory files with non-standard extensions. */ + + unsigned short save_djstat_flags = _djstat_flags; + + _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE; +#endif /* __DJGPP__ > 1 */ +#endif /* MSDOS */ + bcopy (XSTRING (dirname)->data, fullname, pos); #ifndef VMS if (!IS_DIRECTORY_SEP (fullname[pos - 1])) @@ -516,19 +774,25 @@ file_name_completion_stat (dirname, dp, st_addr) stat (fullname, st_addr); return value; #else - return stat (fullname, st_addr); -#endif + value = stat (fullname, st_addr); +#ifdef MSDOS +#if __DJGPP__ > 1 + _djstat_flags = save_djstat_flags; +#endif /* __DJGPP__ > 1 */ +#endif /* MSDOS */ + return value; +#endif /* S_IFLNK */ } #ifdef VMS DEFUN ("file-name-all-versions", Ffile_name_all_versions, Sfile_name_all_versions, 2, 2, 0, - "Return a list of all versions of file name FILE in directory DIR.") - (file, dirname) - Lisp_Object file, dirname; + "Return a list of all versions of file name FILE in directory DIRECTORY.") + (file, directory) + Lisp_Object file, directory; { - return file_name_completion (file, dirname, 1, 1); + return file_name_completion (file, directory, 1, 1); } DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0, @@ -563,7 +827,7 @@ Returns nil if the file cannot be opened or if there is no version limit.") Lisp_Object make_time (time) - int time; + time_t time; { return Fcons (make_number (time >> 16), Fcons (make_number (time & 0177777), Qnil)); @@ -581,20 +845,27 @@ Otherwise, list elements are:\n\ First integer has high-order 16 bits of time, second has low 16 bits.\n\ 5. Last modification time, likewise.\n\ 6. Last status change time, likewise.\n\ - 7. Size in bytes (-1, if number is out of range).\n\ + 7. Size in bytes.\n\ + This is a floating point number if the size is too large for an integer.\n\ 8. File modes, as a string of ten letters or dashes as in ls -l.\n\ 9. t iff file's gid would change if file were deleted and recreated.\n\ -10. inode number.\n\ -11. Device number.\n\ +10. inode number. If inode number is larger than the Emacs integer,\n\ + this is a cons cell containing two integers: first the high part,\n\ + then the low 16 bits.\n\ +11. Device number. If it is larger than the Emacs integer, this is\n\ + a cons cell, similar to the inode number.\n\ \n\ If file does not exist, returns nil.") (filename) Lisp_Object filename; { Lisp_Object values[12]; - Lisp_Object dirname; + Lisp_Object encoded; struct stat s; +#if defined (BSD4_2) || defined (BSD4_3) + Lisp_Object dirname; struct stat sdir; +#endif char modes[10]; Lisp_Object handler; @@ -606,24 +877,10 @@ If file does not exist, returns nil.") if (!NILP (handler)) return call2 (handler, Qfile_attributes, filename); - if (lstat (XSTRING (filename)->data, &s) < 0) - return Qnil; + encoded = ENCODE_FILE (filename); -#ifdef MSDOS - { - char *tmpnam = XSTRING (Ffile_name_nondirectory (filename))->data; - int l = strlen (tmpnam); - - if (l >= 5 - && S_ISREG (s.st_mode) - && (stricmp (&tmpnam[l - 4], ".com") == 0 - || stricmp (&tmpnam[l - 4], ".exe") == 0 - || stricmp (&tmpnam[l - 4], ".bat") == 0)) - { - s.st_mode |= S_IEXEC; - } - } -#endif /* MSDOS */ + if (lstat (XSTRING (encoded)->data, &s) < 0) + return Qnil; switch (s.st_mode & S_IFMT) { @@ -642,51 +899,71 @@ If file does not exist, returns nil.") values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); values[6] = make_time (s.st_ctime); - values[7] = make_number ((int) s.st_size); - /* If the size is out of range, give back -1. */ + values[7] = make_number (s.st_size); + /* If the size is out of range for an integer, return a float. */ if (XINT (values[7]) != s.st_size) - XSETINT (values[7], -1); + values[7] = make_float ((double)s.st_size); filemodestring (&s, modes); values[8] = make_string (modes, 10); -#ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */ -#define BSD4_2 /* A new meaning to the term `backwards compatibility' */ -#endif -#ifdef BSD4_2 /* file gid will be dir gid */ +#if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ dirname = Ffile_name_directory (filename); - if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0) + if (! NILP (dirname)) + encoded = ENCODE_FILE (dirname); + if (! NILP (dirname) && stat (XSTRING (encoded)->data, &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 */ -#ifdef WINDOWSNT - values[9] = Qnil; /* sorry, no group IDs on NT */ -#else /* not WINDOWSNT */ values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; -#endif /* not WINDOWSNT */ #endif /* BSD4_2 (or BSD4_3) */ -#ifdef BSD4_3 -#undef BSD4_2 /* ok, you can look again without throwing up */ -#endif -#ifdef WINDOWSNT - /* Fill in the inode and device values specially...see nt.c. */ - if (!get_inode_and_device_vals (filename, &values[10], &values[11])) { - return Qnil; - } -#else /* not WINDOWSNT */ - values[10] = make_number (s.st_ino); - values[11] = make_number (s.st_dev); -#endif /* not WINDOWSNT */ + /* Cast -1 to avoid warning if int is not as wide as VALBITS. */ + if (FIXNUM_OVERFLOW_P (s.st_ino)) + /* To allow inode numbers larger than VALBITS, separate the bottom + 16 bits. */ + values[10] = Fcons (make_number (s.st_ino >> 16), + make_number (s.st_ino & 0xffff)); + else + /* But keep the most common cases as integers. */ + values[10] = make_number (s.st_ino); + + /* Likewise for device. */ + if (FIXNUM_OVERFLOW_P (s.st_dev)) + values[11] = Fcons (make_number (s.st_dev >> 16), + make_number (s.st_dev & 0xffff)); + else + values[11] = make_number (s.st_dev); + return Flist (sizeof(values) / sizeof(values[0]), values); } + +DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0, + "Return t if first arg file attributes list is less than second.\n\ +Comparison is in lexicographic order and case is significant.") + (f1, f2) + Lisp_Object f1, f2; +{ + return Fstring_lessp (Fcar (f1), Fcar (f2)); +} +void syms_of_dired () { Qdirectory_files = intern ("directory-files"); + Qdirectory_files_and_attributes = intern ("directory-files-and-attributes"); Qfile_name_completion = intern ("file-name-completion"); Qfile_name_all_completions = intern ("file-name-all-completions"); Qfile_attributes = intern ("file-attributes"); + Qfile_attributes_lessp = intern ("file-attributes-lessp"); + + staticpro (&Qdirectory_files); + staticpro (&Qdirectory_files_and_attributes); + staticpro (&Qfile_name_completion); + staticpro (&Qfile_name_all_completions); + staticpro (&Qfile_attributes); + staticpro (&Qfile_attributes_lessp); defsubr (&Sdirectory_files); + defsubr (&Sdirectory_files_and_attributes); defsubr (&Sfile_name_completion); #ifdef VMS defsubr (&Sfile_name_all_versions); @@ -694,6 +971,7 @@ syms_of_dired () #endif /* VMS */ defsubr (&Sfile_name_all_completions); defsubr (&Sfile_attributes); + defsubr (&Sfile_attributes_lessp); #ifdef VMS Qcompletion_ignore_case = intern ("completion-ignore-case"); @@ -702,6 +980,8 @@ syms_of_dired () DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions, "*Completion ignores filenames ending in any string in this list.\n\ +Directories are ignored if they match any string in this list which\n\ +ends in a slash.\n\ This variable does not affect lists of possible completions,\n\ but does affect the commands that actually do completions."); Vcompletion_ignored_extensions = Qnil;