(Fprimitive_undo): Check veracity of delta,start,end.
[bpt/emacs.git] / src / dired.c
index d21cb65..e833ceb 100644 (file)
@@ -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
      Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -26,6 +26,13 @@ Boston, MA 02111-1307, USA.  */
 #include <sys/types.h>
 #include <sys/stat.h>
 
+#ifdef VMS
+#include "vms-pwd.h"
+#else
+#include <pwd.h>
+#include <grp.h>
+#endif
+
 #include "systime.h"
 #include <errno.h>
 
@@ -130,21 +137,23 @@ 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;
   Lisp_Object list, dirfilename, encoded_directory;
   struct re_pattern_buffer *bufp = NULL;
   int needsep = 0;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   DIRENTRY *dp;
   int retry_p;
@@ -153,7 +162,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 +195,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 +207,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 +227,7 @@ directory_files_internal (directory, full, match, nosort, attrs)
       if (dp == NULL && errno == EAGAIN)
        continue;
 #endif
-      
+
       if (dp == NULL)
        break;
 
@@ -233,11 +241,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 +253,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 +267,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 +304,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 +336,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 +353,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);
 }
 
 \f
@@ -473,7 +467,7 @@ file_name_completion (file, dirname, all_flag, ver_flag)
   struct stat st;
   int directoryp;
   int passcount;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 
   elt = Qnil;
@@ -519,10 +513,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 +539,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 +560,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;
@@ -572,10 +571,13 @@ file_name_completion (file, dirname, all_flag, ver_flag)
                    elt = XCAR (tem);
                    if (!STRINGP (elt))
                      continue;
-                   elt_len = XSTRING (elt)->size - 1; /* -1 for trailing / */
+                   /* Need to encode ELT, since scmp compares unibyte
+                      strings only.  */
+                   elt = ENCODE_FILE (elt);
+                   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;
@@ -591,19 +593,22 @@ 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))
                  {
                    elt = XCAR (tem);
                    if (!STRINGP (elt)) continue;
-                   skip = len - XSTRING (elt)->size;
+                   /* Need to encode ELT, since scmp compares unibyte
+                      strings only.  */
+                   elt = ENCODE_FILE (elt);
+                   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;
                  }
@@ -655,13 +660,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)
@@ -675,8 +680,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
@@ -688,10 +693,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)
@@ -709,7 +714,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;
@@ -721,7 +727,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));
@@ -729,11 +735,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,
@@ -771,7 +772,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);
 
@@ -788,7 +789,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;
@@ -841,7 +842,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);
@@ -864,14 +865,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.
@@ -884,15 +892,15 @@ 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;
@@ -906,11 +914,17 @@ 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);
+    }
 
   encoded = ENCODE_FILE (filename);
 
-  if (lstat (XSTRING (encoded)->data, &s) < 0)
+  if (lstat (SDATA (encoded), &s) < 0)
     return Qnil;
 
   switch (s.st_mode & S_IFMT)
@@ -925,8 +939,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);
@@ -934,20 +958,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.  */
@@ -1017,3 +1045,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) */