(directory_files_internal_unwind): New function.

(directory_files_internal): Use it to ensure closedir is called
even if expand-file-name or file-attributes throw, eg. because of
a user interrupt.  Also enable immediate_quit while calling
re_search, so that matching can be interrupted as well.

2 files changed, 44 insertions, 0 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 97995aca06b..0dc6d23e0ba 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2000-10-24  Andrew Innes  <andrewi@gnu.org>
+
+        * dired.c (directory_files_internal_unwind): New function.
+        (directory_files_internal): Use it to ensure closedir is called
+        even if expand-file-name or file-attributes throw, eg. because of
+        a user interrupt.  Also enable immediate_quit while calling
+        re_search, so that matching can be interrupted as well.
+
 2000-10-24  Gerd Moellmann  <gerd@gnu.org>
 
         * window.c (size_window): Prevent setting window's width or
diff --git a/src/dired.c b/src/dired.c
index e0dce3ae46e..4c9383691a8 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -118,6 +118,16 @@ Lisp_Object Qfile_name_all_completions;
 Lisp_Object Qfile_attributes;
 Lisp_Object Qfile_attributes_lessp;
 
+
+Lisp_Object
+directory_files_internal_unwind (dh)
+     Lisp_Object dh;
+{
+  DIR *d = (DIR *) ((XINT (XCAR (dh)) << 16) + XINT (XCDR (dh)));
+  closedir (d);
+  return Qnil;
+}
+
 /* 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.  */
@@ -133,6 +143,7 @@ directory_files_internal (directory, full, match, nosort, attrs)
   Lisp_Object handler;
   struct re_pattern_buffer *bufp = NULL;
   int needsep = 0;
+  int count = specpdl_ptr - specpdl;
   struct gcpro gcpro1, gcpro2;
 
   /* Because of file name handlers, these functions might call
@@ -176,6 +187,13 @@ directory_files_internal (directory, full, match, nosort, attrs)
   if (! d)
     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)));
+
   list = Qnil;
   dirnamelen = STRING_BYTES (XSTRING (directory));
   re_match_object = Qt;
@@ -198,14 +216,27 @@ directory_files_internal (directory, full, match, nosort, attrs)
       if (DIRENTRY_NONEMPTY (dp))
         {
           int len;
+          int wanted = 0;
 
           len = NAMLEN (dp);
           name = DECODE_FILE (make_string (dp->d_name, len));
           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, XSTRING (name)->data, len, 0, len, 0)))
             {
+              wanted = 1;
+            }
+
+          immediate_quit = 0;
+
+          if (wanted)
+            {
               Lisp_Object finalname;
 
               finalname = name;
@@ -251,7 +282,12 @@ directory_files_internal (directory, full, match, nosort, attrs)
             }
         }
     }
+
   closedir (d);
+
+  /* Discard the unwind protect.  */
+  specpdl_ptr = specpdl + count;
+
   UNGCPRO;
   if (!NILP (nosort))
     return list;