X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/aed13378308fae471bf2c11870a456e457166c31..974aae61bbb8c05e0d0fc1a95b419fe596423fd8:/src/dired.c diff --git a/src/dired.c b/src/dired.c index 0a119afb5e..55f96d2888 100644 --- a/src/dired.c +++ b/src/dired.c @@ -1,5 +1,5 @@ /* Lisp functions for making directory listings. - Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001 + Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2004, 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +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, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -26,6 +26,13 @@ Boston, MA 02111-1307, USA. */ #include #include +#ifdef HAVE_PWD_H +#include +#endif +#ifndef VMS +#include +#endif + #include "systime.h" #include @@ -107,7 +114,6 @@ extern void filemodestring P_ ((struct stat *, char *)); 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; @@ -130,14 +136,16 @@ directory_files_internal_unwind (dh) return Qnil; } -/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes. +/* 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. */ + non-zero, 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 (directory, full, match, nosort, attrs) +directory_files_internal (directory, full, match, nosort, attrs, id_format) Lisp_Object directory, full, match, nosort; int attrs; + Lisp_Object id_format; { DIR *d; int directory_nbytes; @@ -153,7 +161,6 @@ directory_files_internal (directory, full, match, nosort, attrs) Ffuncall, and cause a GC. */ 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)) @@ -187,8 +194,8 @@ directory_files_internal (directory, full, match, nosort, attrs) 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); + + d = opendir (SDATA (dirfilename)); if (d == NULL) report_file_error ("Opening directory", Fcons (directory, Qnil)); @@ -199,13 +206,13 @@ directory_files_internal (directory, full, match, nosort, attrs) Fcons (make_number (((unsigned long) d) >> 16), make_number (((unsigned long) d) & 0xffff))); - directory_nbytes = STRING_BYTES (XSTRING (directory)); + directory_nbytes = SBYTES (directory); re_match_object = Qt; /* Decide whether we need to add a directory separator. */ #ifndef VMS if (directory_nbytes == 0 - || !IS_ANY_SEP (XSTRING (directory)->data[directory_nbytes - 1])) + || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) needsep = 1; #endif /* not VMS */ @@ -219,7 +226,7 @@ directory_files_internal (directory, full, match, nosort, attrs) if (dp == NULL && errno == EAGAIN) continue; #endif - + if (dp == NULL) break; @@ -233,11 +240,11 @@ directory_files_internal (directory, full, match, nosort, attrs) 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)); + len = SBYTES (name); /* Now that we have unwind_protect in place, we might as well allow matching to be interrupted. */ @@ -245,7 +252,7 @@ directory_files_internal (directory, full, match, nosort, attrs) QUIT; if (NILP (match) - || (0 <= re_search (bufp, XSTRING (name)->data, len, 0, len, 0))) + || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0))) wanted = 1; immediate_quit = 0; @@ -259,26 +266,26 @@ directory_files_internal (directory, full, match, nosort, attrs) int nchars; fullname = make_uninit_multibyte_string (nbytes, nbytes); - bcopy (XSTRING (directory)->data, XSTRING (fullname)->data, + bcopy (SDATA (directory), SDATA (fullname), directory_nbytes); - + if (needsep) - XSTRING (fullname)->data[directory_nbytes] = DIRECTORY_SEP; - - bcopy (XSTRING (name)->data, - XSTRING (fullname)->data + directory_nbytes + needsep, + SSET (fullname, directory_nbytes, DIRECTORY_SEP); + + bcopy (SDATA (name), + SDATA (fullname) + directory_nbytes + needsep, len); - - nchars = chars_in_text (XSTRING (fullname)->data, nbytes); + + nchars = chars_in_text (SDATA (fullname), nbytes); /* Some bug somewhere. */ if (nchars > nbytes) abort (); - - XSTRING (fullname)->size = nchars; + + STRING_SET_CHARS (fullname, nchars); if (nchars == nbytes) - SET_STRING_BYTES (XSTRING (fullname), -1); - + STRING_SET_UNIBYTE (fullname); + finalname = fullname; } else @@ -296,7 +303,7 @@ directory_files_internal (directory, full, match, nosort, attrs) /* Both Fexpand_file_name and Ffile_attributes can GC. */ decoded_fullname = Fexpand_file_name (name, directory); - fileattrs = Ffile_attributes (decoded_fullname); + fileattrs = Ffile_attributes (decoded_fullname, id_format); list = Fcons (Fcons (finalname, fileattrs), list); UNGCPRO; @@ -328,7 +335,7 @@ directory_files_internal (directory, full, match, nosort, attrs) if (NILP (nosort)) list = Fsort (Fnreverse (list), attrs ? Qfile_attributes_lessp : Qstring_lessp); - + RETURN_UNGCPRO (list); } @@ -345,57 +352,43 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. Lisp_Object directory, full, match, nosort; { Lisp_Object handler; + directory = Fexpand_file_name (directory, Qnil); /* 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 call5 (handler, Qdirectory_files, directory, + full, match, nosort); - return directory_files_internal (directory, full, match, nosort, 0); + return directory_files_internal (directory, full, match, nosort, 0, Qnil); } DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, - Sdirectory_files_and_attributes, 1, 4, 0, + Sdirectory_files_and_attributes, 1, 5, 0, doc: /* Return a list of names of files and their attributes in DIRECTORY. -There are three optional arguments: +There are four optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. If MATCH is non-nil, mention only file names that match the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. - NOSORT is useful if you plan to sort the result yourself. */) - (directory, full, match, nosort) - Lisp_Object directory, full, match, nosort; + NOSORT is useful if you plan to sort the result yourself. +ID-FORMAT specifies the preferred format of attributes uid and gid, see +`file-attributes' for further documentation. */) + (directory, full, match, nosort, id_format) + Lisp_Object directory, full, match, nosort, id_format; { Lisp_Object handler; + directory = Fexpand_file_name (directory, Qnil); /* 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 call6 (handler, Qdirectory_files_and_attributes, + directory, full, match, nosort, id_format); - return directory_files_internal (directory, full, match, nosort, 1); + return directory_files_internal (directory, full, match, nosort, 1, id_format); } @@ -407,7 +400,7 @@ DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion, Returns the longest string common to all file names in DIRECTORY that start with FILE. If there is only one and FILE matches it exactly, returns t. -Returns nil if DIR contains no name starting with FILE. +Returns nil if DIRECTORY contains no name starting with FILE. This function ignores some of the possible completions as determined by the variable `completion-ignored-extensions', which see. */) @@ -519,10 +512,16 @@ file_name_completion (file, dirname, all_flag, ver_flag) for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++) { - d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data); + int inner_count = SPECPDL_INDEX (); + + d = opendir (SDATA (Fdirectory_file_name (encoded_dir))); if (!d) report_file_error ("Opening directory", Fcons (dirname, Qnil)); + record_unwind_protect (directory_files_internal_unwind, + Fcons (make_number (((unsigned long) d) >> 16), + make_number (((unsigned long) d) & 0xffff))); + /* Loop reading blocks */ /* (att3b compiler bug requires do a null comparison this way) */ while (1) @@ -539,12 +538,11 @@ file_name_completion (file, dirname, all_flag, ver_flag) len = NAMLEN (dp); - if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) - goto quit; + QUIT; if (! DIRENTRY_NONEMPTY (dp) - || len < XSTRING (encoded_file)->size - || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data, - XSTRING (encoded_file)->size)) + || len < SCHARS (encoded_file) + || 0 <= scmp (dp->d_name, SDATA (encoded_file), + SCHARS (encoded_file))) continue; if (file_name_completion_stat (encoded_dir, dp, &st) < 0) @@ -561,7 +559,7 @@ 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) + if (!passcount && len > SCHARS (encoded_file)) /* Ignore directories if they match an element of completion-ignored-extensions which ends in a slash. */ for (tem = Vcompletion_ignored_extensions; @@ -575,10 +573,10 @@ file_name_completion (file, dirname, all_flag, ver_flag) /* Need to encode ELT, since scmp compares unibyte strings only. */ elt = ENCODE_FILE (elt); - elt_len = XSTRING (elt)->size - 1; /* -1 for trailing / */ + elt_len = SCHARS (elt) - 1; /* -1 for trailing / */ if (elt_len <= 0) continue; - p1 = XSTRING (elt)->data; + p1 = SDATA (elt); if (p1[elt_len] != '/') continue; skip = len - elt_len; @@ -594,7 +592,7 @@ file_name_completion (file, dirname, all_flag, ver_flag) { /* 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 (encoded_file)->size) + if (!passcount && len > SCHARS (encoded_file)) /* and exit this for loop if a match is found */ for (tem = Vcompletion_ignored_extensions; CONSP (tem); tem = XCDR (tem)) @@ -604,12 +602,12 @@ file_name_completion (file, dirname, all_flag, ver_flag) /* Need to encode ELT, since scmp compares unibyte strings only. */ elt = ENCODE_FILE (elt); - skip = len - XSTRING (elt)->size; + skip = len - SCHARS (elt); if (skip < 0) continue; if (0 <= scmp (dp->d_name + skip, - XSTRING (elt)->data, - XSTRING (elt)->size)) + SDATA (elt), + SCHARS (elt))) continue; break; } @@ -661,13 +659,13 @@ file_name_completion (file, dirname, all_flag, ver_flag) else { bestmatch = name; - bestmatchsize = XSTRING (name)->size; + bestmatchsize = SCHARS (name); } } else { compare = min (bestmatchsize, len); - p1 = XSTRING (bestmatch)->data; + p1 = SDATA (bestmatch); p2 = (unsigned char *) dp->d_name; matchsize = scmp(p1, p2, compare); if (matchsize < 0) @@ -681,8 +679,8 @@ file_name_completion (file, dirname, all_flag, ver_flag) /* 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) + && matchsize + !!directoryp + < SCHARS (bestmatch)) || /* If there is no exact match ignoring case, prefer a match that does not change the case @@ -694,10 +692,10 @@ file_name_completion (file, dirname, all_flag, ver_flag) either both or neither are exact. */ (((matchsize == len) == - (matchsize + !!directoryp - == XSTRING (bestmatch)->size)) - && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size) - && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size))) + (matchsize + !!directoryp + == SCHARS (bestmatch))) + && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file)) + && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file)))) { bestmatch = make_string (dp->d_name, len); if (directoryp) @@ -715,7 +713,8 @@ file_name_completion (file, dirname, all_flag, ver_flag) bestmatchsize = matchsize; } } - closedir (d); + /* This closes the directory. */ + bestmatch = unbind_to (inner_count, bestmatch); } UNGCPRO; @@ -727,7 +726,7 @@ file_name_completion (file, dirname, all_flag, ver_flag) bestmatch = DECODE_FILE (bestmatch); return bestmatch; } - if (matchcount == 1 && bestmatchsize == XSTRING (file)->size) + if (matchcount == 1 && bestmatchsize == SCHARS (file)) return Qt; bestmatch = Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize)); @@ -735,11 +734,6 @@ file_name_completion (file, dirname, all_flag, ver_flag) 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); } /* Compare exactly LEN chars of strings at S1 and S2, @@ -777,7 +771,7 @@ file_name_completion_stat (dirname, dp, st_addr) struct stat *st_addr; { int len = NAMLEN (dp); - int pos = XSTRING (dirname)->size; + int pos = SCHARS (dirname); int value; char *fullname = (char *) alloca (len + pos + 2); @@ -794,7 +788,7 @@ file_name_completion_stat (dirname, dp, st_addr) #endif /* __DJGPP__ > 1 */ #endif /* MSDOS */ - bcopy (XSTRING (dirname)->data, fullname, pos); + bcopy (SDATA (dirname), fullname, pos); #ifndef VMS if (!IS_DIRECTORY_SEP (fullname[pos - 1])) fullname[pos++] = DIRECTORY_SEP; @@ -847,7 +841,7 @@ Returns nil if the file cannot be opened or if there is no version limit. */) filename = Fexpand_file_name (filename, Qnil); fab = cc$rms_fab; xabfhc = cc$rms_xabfhc; - fab.fab$l_fna = XSTRING (filename)->data; + fab.fab$l_fna = SDATA (filename); fab.fab$b_fns = strlen (fab.fab$l_fna); fab.fab$l_xab = (char *) &xabfhc; status = sys$open (&fab, 0, 0); @@ -870,14 +864,21 @@ make_time (time) Fcons (make_number (time & 0177777), Qnil)); } -DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0, +DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0, doc: /* Return a list of attributes of file FILENAME. Value is nil if specified file cannot be opened. -Otherwise, list elements are: + +ID-FORMAT specifies the preferred format of attributes uid and gid (see +below) - valid values are 'string and 'integer. The latter is the default, +but we plan to change that, so you should specify a non-nil value for +ID-FORMAT if you use the returned uid or gid. + +Elements of the attribute list are: 0. t for directory, string (name linked to) for symbolic link, or nil. 1. Number of links to file. - 2. File uid. - 3. File gid. + 2. File uid as a string or an integer. If a string value cannot be + looked up, the integer value is returned. + 3. File gid, likewise. 4. Last access time, as a list of two integers. First integer has high-order 16 bits of time, second has low 16 bits. 5. Last modification time, likewise. @@ -890,21 +891,22 @@ Otherwise, list elements are: this is a cons cell containing two integers: first the high part, then the low 16 bits. 11. Device number. If it is larger than the Emacs integer, this is - a cons cell, similar to the inode number. - -If file does not exist, returns nil. */) - (filename) - Lisp_Object filename; + a cons cell, similar to the inode number. */) + (filename, id_format) + Lisp_Object filename, id_format; { Lisp_Object values[12]; Lisp_Object encoded; struct stat s; + struct passwd *pw; + struct group *gr; #if defined (BSD4_2) || defined (BSD4_3) Lisp_Object dirname; struct stat sdir; #endif char modes[10]; Lisp_Object handler; + struct gcpro gcpro1; filename = Fexpand_file_name (filename, Qnil); @@ -912,11 +914,19 @@ If file does not exist, returns nil. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_attributes); if (!NILP (handler)) - return call2 (handler, Qfile_attributes, filename); + { /* Only pass the extra arg if it is used to help backward compatibility + with old file handlers which do not implement the new arg. --Stef */ + if (NILP (id_format)) + return call2 (handler, Qfile_attributes, filename); + else + return call3 (handler, Qfile_attributes, filename, id_format); + } + GCPRO1 (filename); encoded = ENCODE_FILE (filename); + UNGCPRO; - if (lstat (XSTRING (encoded)->data, &s) < 0) + if (lstat (SDATA (encoded), &s) < 0) return Qnil; switch (s.st_mode & S_IFMT) @@ -931,8 +941,18 @@ If file does not exist, returns nil. */) #endif } values[1] = make_number (s.st_nlink); - values[2] = make_number (s.st_uid); - values[3] = make_number (s.st_gid); + if (NILP (id_format) || EQ (id_format, Qinteger)) + { + values[2] = make_number (s.st_uid); + values[3] = make_number (s.st_gid); + } + else + { + pw = (struct passwd *) getpwuid (s.st_uid); + values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid)); + gr = (struct group *) getgrgid (s.st_gid); + values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid)); + } values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); values[6] = make_time (s.st_ctime); @@ -940,20 +960,24 @@ If file does not exist, returns nil. */) /* If the size is out of range for an integer, return a float. */ if (XINT (values[7]) != s.st_size) values[7] = make_float ((double)s.st_size); + /* If the size is negative, and its type is long, convert it back to + positive. */ + if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long)) + values[7] = make_float ((double) ((unsigned long) s.st_size)); + filemodestring (&s, modes); values[8] = make_string (modes, 10); #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ dirname = Ffile_name_directory (filename); if (! NILP (dirname)) encoded = ENCODE_FILE (dirname); - if (! NILP (dirname) && stat (XSTRING (encoded)->data, &sdir) == 0) + 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 /* BSD4_2 (or BSD4_3) */ - /* 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. */ @@ -1023,3 +1047,6 @@ This variable does not affect lists of possible completions, but does affect the commands that actually do completions. */); Vcompletion_ignored_extensions = Qnil; } + +/* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03 + (do not change this comment) */