X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ebb9e16f9893959a7a8036ed62b41e0667320874..7a13e8946b124f8265adf07e28315076c7801902:/src/dired.c diff --git a/src/dired.c b/src/dired.c index a3b02f089f..b8ba01b5ed 100644 --- a/src/dired.c +++ b/src/dired.c @@ -1,5 +1,5 @@ /* Lisp functions for making directory listings. - Copyright (C) 1985, 1986 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -18,32 +18,60 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +#include + #include #include #include -#include "config.h" +#ifdef VMS +#include +#include +#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 + 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 SYSV_SYSTEM_DIR #include #define DIRENTRY struct dirent -#define NAMLEN(p) strlen (p->d_name) -#else +#else /* not SYSV_SYSTEM_DIR */ #ifdef NONSYSTEM_DIR_LIBRARY #include "ndir.h" #else /* not NONSYSTEM_DIR_LIBRARY */ +#ifdef MSDOS +#include +#else #include +#endif #endif /* not NONSYSTEM_DIR_LIBRARY */ +#ifndef MSDOS #define DIRENTRY struct direct -#define NAMLEN(p) p->d_namlen extern DIR *opendir (); extern struct direct *readdir (); +#endif /* not MSDOS */ +#endif /* not SYSV_SYSTEM_DIR */ + +#ifdef MSDOS +#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) +#else +#define DIRENTRY_NONEMPTY(p) ((p)->d_ino) #endif #include "lisp.h" @@ -52,6 +80,9 @@ extern struct direct *readdir (); #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)) /* if system does not have symbolic links, it does not have lstat. @@ -61,9 +92,15 @@ extern struct direct *readdir (); #define lstat stat #endif -Lisp_Object Vcompletion_ignored_extensions; +extern int completion_ignore_case; +extern Lisp_Object Vcompletion_regexp_list; +Lisp_Object Vcompletion_ignored_extensions; Lisp_Object Qcompletion_ignore_case; +Lisp_Object Qdirectory_files; +Lisp_Object Qfile_name_completion; +Lisp_Object Qfile_name_all_completions; +Lisp_Object Qfile_attributes; DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, "Return a list of names of files in DIRECTORY.\n\ @@ -77,7 +114,38 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ { DIR *d; int length; - Lisp_Object list, name; + 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]; + + args[0] = handler; + args[1] = Qdirectory_files; + args[2] = dirname; + args[3] = full; + args[4] = match; + args[5] = nosort; + return Ffuncall (6, args); + } + + { + struct gcpro gcpro1, gcpro2; + + /* 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; + } if (!NILP (match)) { @@ -87,15 +155,22 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ catching and signalling our own errors, we just call compile_pattern to do the work for us. */ #ifdef VMS - compile_pattern (match, &searchbuf, 0 - buffer_defaults.downcase_table->contents); + bufp = compile_pattern (match, 0, + buffer_defaults.downcase_table->contents); #else - compile_pattern (match, &searchbuf, 0, 0); + bufp = compile_pattern (match, 0, 0); #endif } - dirname = Fexpand_file_name (dirname, Qnil); - if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data))) + /* 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 + have to make sure it gets closed, and setting up an + unwind_protect to do so would be a pain. */ + d = opendir (XSTRING (dirfilename)->data); + if (! d) report_file_error ("Opening directory", Fcons (dirname, Qnil)); list = Qnil; @@ -109,10 +184,10 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\ if (!dp) break; len = NAMLEN (dp); - if (dp->d_ino) + if (DIRENTRY_NONEMPTY (dp)) { if (NILP (match) - || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0))) + || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))) { if (!NILP (full)) { @@ -158,13 +233,14 @@ Returns nil if DIR contains no name starting with FILE.") (file, dirname) Lisp_Object file, dirname; { - /* Don't waste time trying to complete a null string. - Besides, this case happens when user is being asked for - a directory name and has supplied one ending in a /. - We would not want to add anything in that case - even if there are some unique characters in that directory. */ - if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0) - return file; + Lisp_Object handler; + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (dirname, Qfile_name_completion); + if (!NILP (handler)) + return call3 (handler, Qfile_name_completion, file, dirname); + return file_name_completion (file, dirname, 0, 0); } @@ -175,22 +251,17 @@ These are all file names in directory DIR which begin with FILE.") (file, dirname) Lisp_Object file, dirname; { - return file_name_completion (file, dirname, 1, 0); -} + Lisp_Object handler; -#ifdef VMS + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions); + if (!NILP (handler)) + return call3 (handler, Qfile_name_all_completions, file, dirname); -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 file_name_completion (file, dirname, 1, 1); + return file_name_completion (file, dirname, 1, 0); } -#endif /* VMS */ - Lisp_Object file_name_completion (file, dirname, all_flag, ver_flag) Lisp_Object file, dirname; @@ -207,6 +278,8 @@ file_name_completion (file, dirname, all_flag, ver_flag) int directoryp; int passcount; int count = specpdl_ptr - specpdl; + struct gcpro gcpro1, gcpro2, gcpro3; + #ifdef VMS extern DIRENTRY * readdirver (); @@ -223,8 +296,12 @@ file_name_completion (file, dirname, all_flag, ver_flag) CHECK_STRING (file, 0); #endif /* not VMS */ - dirname = Fexpand_file_name (dirname, Qnil); +#ifdef FILE_SYSTEM_CASE + file = FILE_SYSTEM_CASE (file); +#endif bestmatch = Qnil; + GCPRO3 (file, dirname, bestmatch); + dirname = Fexpand_file_name (dirname, Qnil); /* With passcount = 0, ignore files that end in an ignored extension. If nothing found then try again with passcount = 1, don't ignore them. @@ -257,7 +334,7 @@ file_name_completion (file, dirname, all_flag, ver_flag) if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) goto quit; - if (!dp->d_ino + if (! DIRENTRY_NONEMPTY (dp) || len < XSTRING (file)->size || 0 <= scmp (dp->d_name, XSTRING (file)->data, XSTRING (file)->size)) @@ -268,7 +345,17 @@ file_name_completion (file, dirname, all_flag, ver_flag) directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); tem = Qnil; - if (!directoryp) + if (directoryp) + { +#ifndef TRIVIAL_DIRECTORY_ENTRY +#define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, "..")) +#endif + /* "." and ".." are never interesting as completions, but are + actually in the way in a directory contains only one file. */ + if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) + continue; + } + else { /* Compare extensions-to-be-ignored against end of this file name */ /* if name is not an exact match against specified string */ @@ -278,7 +365,7 @@ file_name_completion (file, dirname, all_flag, ver_flag) CONSP (tem); tem = XCONS (tem)->cdr) { elt = XCONS (tem)->car; - if (XTYPE (elt) != Lisp_String) continue; + if (!STRINGP (elt)) continue; skip = len - XSTRING (elt)->size; if (skip < 0) continue; @@ -290,57 +377,105 @@ file_name_completion (file, dirname, all_flag, ver_flag) } } - /* Unless an ignored-extensions match was found, - process this name as a completion */ - if (passcount || !CONSP (tem)) + /* If an ignored-extensions match was found, + don't process this name as a completion. */ + if (!passcount && CONSP (tem)) + continue; + + if (!passcount) { - /* Update computation of how much all possible completions match */ + Lisp_Object regexps; + Lisp_Object zero; + XSETFASTINT (zero, 0); + + /* Ignore this element if it fails to match all the regexps. */ + for (regexps = Vcompletion_regexp_list; CONSP (regexps); + regexps = XCONS (regexps)->cdr) + { + tem = Fstring_match (XCONS (regexps)->car, elt, zero); + if (NILP (tem)) + break; + } + if (CONSP (regexps)) + continue; + } - matchcount++; + /* Update computation of how much all possible completions match */ - if (all_flag || NILP (bestmatch)) + matchcount++; + + if (all_flag || NILP (bestmatch)) + { + /* This is a possible completion */ + if (directoryp) { - /* This is a possible completion */ - if (directoryp) - { - /* This completion is a directory; make it end with '/' */ - name = Ffile_name_as_directory (make_string (dp->d_name, len)); - } - else - name = make_string (dp->d_name, len); - if (all_flag) - { - bestmatch = Fcons (name, bestmatch); - } - else - { - bestmatch = name; - bestmatchsize = XSTRING (name)->size; - } + /* This completion is a directory; make it end with '/' */ + name = Ffile_name_as_directory (make_string (dp->d_name, len)); } else + name = make_string (dp->d_name, len); + if (all_flag) { - compare = min (bestmatchsize, len); - p1 = XSTRING (bestmatch)->data; - p2 = (unsigned char *) dp->d_name; - matchsize = scmp(p1, p2, compare); - if (matchsize < 0) - matchsize = compare; - /* If this dirname all matches, - see if implicit following slash does too. */ - if (directoryp - && compare == matchsize - && bestmatchsize > matchsize - && p1[matchsize] == '/') - matchsize++; - bestmatchsize = min (matchsize, bestmatchsize); + bestmatch = Fcons (name, bestmatch); } + else + { + bestmatch = name; + bestmatchsize = XSTRING (name)->size; + } + } + else + { + compare = min (bestmatchsize, len); + p1 = XSTRING (bestmatch)->data; + p2 = (unsigned char *) dp->d_name; + matchsize = scmp(p1, p2, compare); + if (matchsize < 0) + matchsize = compare; + if (completion_ignore_case) + { + /* If this is an exact match except for case, + 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. */ + if ((matchsize == len + && matchsize + !!directoryp + < XSTRING (bestmatch)->size) + || + /* If there is no exact match ignoring case, + prefer a match that does not change the case + of the input. */ + (((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))) + { + bestmatch = make_string (dp->d_name, len); + if (directoryp) + bestmatch = Ffile_name_as_directory (bestmatch); + } + } + + /* If this dirname all matches, see if implicit following + slash does too. */ + if (directoryp + && compare == matchsize + && bestmatchsize > matchsize + && p1[matchsize] == '/') + matchsize++; + bestmatchsize = matchsize; } } closedir (d); } - unbind_to (count, Qnil); + UNGCPRO; + bestmatch = unbind_to (count, bestmatch); if (all_flag || NILP (bestmatch)) return bestmatch; @@ -360,6 +495,7 @@ file_name_completion_stat (dirname, dp, st_addr) { int len = NAMLEN (dp); int pos = XSTRING (dirname)->size; + int value; char *fullname = (char *) alloca (len + pos + 2); bcopy (XSTRING (dirname)->data, fullname, pos); @@ -371,9 +507,59 @@ file_name_completion_stat (dirname, dp, st_addr) bcopy (dp->d_name, fullname + pos, len); fullname[pos + len] = 0; +#ifdef S_IFLNK + /* 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); + stat (fullname, st_addr); + return value; +#else return stat (fullname, st_addr); +#endif } +#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 file_name_completion (file, dirname, 1, 1); +} + +DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0, + "Return the maximum number of versions allowed for FILE.\n\ +Returns nil if the file cannot be opened or if there is no version limit.") + (filename) + Lisp_Object filename; +{ + Lisp_Object retval; + struct FAB fab; + struct RAB rab; + struct XABFHC xabfhc; + int status; + + filename = Fexpand_file_name (filename, Qnil); + fab = cc$rms_fab; + xabfhc = cc$rms_xabfhc; + fab.fab$l_fna = XSTRING (filename)->data; + fab.fab$b_fns = strlen (fab.fab$l_fna); + fab.fab$l_xab = (char *) &xabfhc; + status = sys$open (&fab, 0, 0); + if (status != RMS$_NORMAL) /* Probably non-existent file */ + return Qnil; + sys$close (&fab, 0, 0); + if (xabfhc.xab$w_verlimit == 32767) + return Qnil; /* No version limit */ + else + return make_number (xabfhc.xab$w_verlimit); +} + +#endif /* VMS */ + Lisp_Object make_time (time) int time; @@ -394,13 +580,13 @@ 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.\n\ + 7. Size in bytes (-1, if number is out of range).\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\ \n\ -If file does not exists, returns nil.") +If file does not exist, returns nil.") (filename) Lisp_Object filename; { @@ -409,11 +595,35 @@ If file does not exists, returns nil.") struct stat s; struct stat sdir; char modes[10]; + Lisp_Object handler; filename = Fexpand_file_name (filename, Qnil); + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (filename, Qfile_attributes); + if (!NILP (handler)) + return call2 (handler, Qfile_attributes, filename); + if (lstat (XSTRING (filename)->data, &s) < 0) return Qnil; +#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 */ + switch (s.st_mode & S_IFMT) { default: @@ -431,16 +641,18 @@ If file does not exists, returns nil.") values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); values[6] = make_time (s.st_ctime); - /* perhaps we should set this to most-positive-fixnum if it is too large? */ - values[7] = make_number (s.st_size); + values[7] = make_number ((int) s.st_size); + /* If the size is out of range, give back -1. */ + if (XINT (values[7]) != s.st_size) + XSETINT (values[7], -1); 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 compatability' */ +#define BSD4_2 /* A new meaning to the term `backwards compatibility' */ #endif #ifdef BSD4_2 /* file gid will be dir gid */ dirname = Ffile_name_directory (filename); - if (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0) + if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0) values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; else /* if we can't tell, assume worst */ values[9] = Qt; @@ -457,10 +669,16 @@ If file does not exists, returns nil.") syms_of_dired () { + Qdirectory_files = intern ("directory-files"); + Qfile_name_completion = intern ("file-name-completion"); + Qfile_name_all_completions = intern ("file-name-all-completions"); + Qfile_attributes = intern ("file-attributes"); + defsubr (&Sdirectory_files); defsubr (&Sfile_name_completion); #ifdef VMS defsubr (&Sfile_name_all_versions); + defsubr (&Sfile_version_limit); #endif /* VMS */ defsubr (&Sfile_name_all_completions); defsubr (&Sfile_attributes);