(menu-bar-update-yank-menu): If string is too long,
[bpt/emacs.git] / src / dired.c
index 2b2b5dc..d012eaa 100644 (file)
@@ -1,5 +1,5 @@
 /* Lisp functions for making directory listings.
-   Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -18,12 +18,12 @@ along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 
+#include <config.h>
+
 #include <stdio.h>
 #include <sys/types.h>
 #include <sys/stat.h>
 
-#include <config.h>
-
 #ifdef VMS
 #include <string.h>
 #include <rms.h>
@@ -80,8 +80,8 @@ extern struct direct *readdir ();
 
 #include "regex.h"
 
-/* A search buffer, with a fastmap allocated and ready to go.  */
-extern struct re_pattern_buffer searchbuf;
+/* 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))
 
@@ -93,12 +93,10 @@ extern struct re_pattern_buffer searchbuf;
 #endif
 
 extern int completion_ignore_case;
-extern Lisp_Object Ffind_file_name_handler ();
+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;
@@ -118,10 +116,11 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
   int length;
   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);
+  handler = Ffind_file_name_handler (dirname, Qdirectory_files);
   if (!NILP (handler))
     {
       Lisp_Object args[6];
@@ -156,14 +155,14 @@ 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, 0);
 #else
-      compile_pattern (match, &searchbuf, 0, 0);
+      bufp = compile_pattern (match, 0, 0, 0);
 #endif
     }
 
-  /* Now searchbuf is the compiled form of MATCH; don't call anything
+  /* 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
@@ -188,7 +187,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
       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))
                {
@@ -196,7 +195,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
                  int total = len + index;
 #ifndef VMS
                  if (length == 0
-                     || XSTRING (dirname)->data[length - 1] != '/')
+                     || !IS_ANY_SEP (XSTRING (dirname)->data[length - 1]))
                    total++;
 #endif /* VMS */
 
@@ -205,8 +204,8 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
                         index);
 #ifndef VMS
                  if (length == 0
-                     || XSTRING (dirname)->data[length - 1] != '/')
-                   XSTRING (name)->data[index++] = '/';
+                     || IS_ANY_SEP (XSTRING (dirname)->data[length - 1]))
+                   XSTRING (name)->data[index++] = DIRECTORY_SEP;
 #endif /* VMS */
                  bcopy (dp->d_name, XSTRING (name)->data + index, len);
                }
@@ -235,17 +234,10 @@ Returns nil if DIR contains no name starting with FILE.")
      Lisp_Object file, dirname;
 {
   Lisp_Object handler;
-  /* 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;
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (dirname);
+  handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
   if (!NILP (handler))
     return call3 (handler, Qfile_name_completion, file, dirname);
 
@@ -263,7 +255,7 @@ These are all file names in directory DIR which begin with FILE.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (dirname);
+  handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
   if (!NILP (handler))
     return call3 (handler, Qfile_name_all_completions, file, dirname);
 
@@ -308,7 +300,6 @@ file_name_completion (file, dirname, all_flag, ver_flag)
   file = FILE_SYSTEM_CASE (file);
 #endif
   bestmatch = Qnil;
-  dirname = Qnil;
   GCPRO3 (file, dirname, bestmatch);
   dirname = Fexpand_file_name (dirname, Qnil);
 
@@ -354,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 */
@@ -364,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;
 
@@ -376,80 +377,98 @@ 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);
 
-             matchcount++;
+             /* 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;
+           }
+
+         /* 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 (completion_ignore_case)
+                 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)))
                    {
-                     /* 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);
-                       }
+                     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;
                }
+
+             /* If this dirname all matches, see if implicit following
+                slash does too.  */
+             if (directoryp
+                 && compare == matchsize
+                 && bestmatchsize > matchsize
+                 && IS_ANY_SEP (p1[matchsize]))
+               matchsize++;
+             bestmatchsize = matchsize;
            }
        }
       closedir (d);
@@ -476,19 +495,25 @@ 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);
 #ifndef VMS
-  if (fullname[pos - 1] != '/')
-    fullname[pos++] = '/';
+  if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
+    fullname[pos++] = DIRECTORY_SEP;
 #endif
 
   bcopy (dp->d_name, fullname + pos, len);
   fullname[pos + len] = 0;
 
 #ifdef S_IFLNK
-  return lstat (fullname, st_addr);
+  /* 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
@@ -576,7 +601,7 @@ If file does not exist, returns nil.")
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (filename);
+  handler = Ffind_file_name_handler (filename, Qfile_attributes);
   if (!NILP (handler))
     return call2 (handler, Qfile_attributes, filename);
 
@@ -616,7 +641,7 @@ 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 (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);
@@ -632,13 +657,24 @@ If file does not exist, returns nil.")
   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
+  /* NT inodes are 64 bits, so we need to dance a little...  */
+  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 */
   return Flist (sizeof(values) / sizeof(values[0]), values);
 }
 \f