(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 97995aca06..0dc6d23e0b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2000-10-24  Andrew Innes  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* window.c (size_window): Prevent setting window's width or
diff --git a/src/dired.c b/src/dired.c
index e0dce3ae46..4c9383691a 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;