From: Andrew Innes <andrewi@gnu.org>
Date: Tue, 24 Oct 2000 14:45:36 +0000 (+0000)
Subject: (directory_files_internal_unwind): New function.
X-Git-Tag: emacs-pretest-21.0.90~619
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2488aba5ed81e2f7cb006fbbfba94a87dccb65c3;p=emacs.git

(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.
---

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,13 +216,26 @@ 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;
 
@@ -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;