Mercurial > hg > xemacs-beta

comparison src/dired.c @ 195:a2f645c6b9f8 r20-3b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b24
author cvs
date Mon, 13 Aug 2007 09:59:05 +0200
parents 3d6bfa290dbd
children 41ff10fd062f
comparison
equal deleted inserted replaced
194:2947057885e5 195:a2f645c6b9f8
25 25
26 #include "buffer.h" 26 #include "buffer.h"
27 #include "commands.h" 27 #include "commands.h"
28 #include "elhash.h" 28 #include "elhash.h"
29 #include "regex.h" 29 #include "regex.h"
30 #include "opaque.h"
30 31
31 #include "sysfile.h" 32 #include "sysfile.h"
32 #include "sysdir.h" 33 #include "sysdir.h"
33 34
34 Lisp_Object Vcompletion_ignored_extensions; 35 Lisp_Object Vcompletion_ignored_extensions;
36 Lisp_Object Qdirectory_files; 37 Lisp_Object Qdirectory_files;
37 Lisp_Object Qfile_name_completion; 38 Lisp_Object Qfile_name_completion;
38 Lisp_Object Qfile_name_all_completions; 39 Lisp_Object Qfile_name_all_completions;
39 Lisp_Object Qfile_attributes; 40 Lisp_Object Qfile_attributes;
40 41
42 static Lisp_Object
43 close_directory_fd (Lisp_Object unwind_obj)
44 {
45 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
46 closedir (d);
47 free_opaque_ptr (unwind_obj);
48 return Qnil;
49 }
50
41 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /* 51 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
42 Return a list of names of files in DIRECTORY. 52 Return a list of names of files in DIRECTORY.
43 There are four optional arguments: 53 There are four optional arguments:
44 If FULL is non-nil, absolute pathnames of the files are returned. 54 If FULL is non-nil, absolute pathnames of the files are returned.
45 If MATCH is non-nil, only pathnames containing that regexp are returned. 55 If MATCH is non-nil, only pathnames containing that regexp are returned.
53 */ 63 */
54 (dirname, full, match, nosort, files_only)) 64 (dirname, full, match, nosort, files_only))
55 { 65 {
56 /* This function can GC. GC checked 1997.04.06. */ 66 /* This function can GC. GC checked 1997.04.06. */
57 DIR *d; 67 DIR *d;
58 Bytecount dirname_length; 68 Bytecount name_as_dir_length;
59 Lisp_Object list, name, dirfilename = Qnil; 69 Lisp_Object list, name, dirfilename = Qnil;
60 Lisp_Object handler; 70 Lisp_Object handler;
61 struct re_pattern_buffer *bufp = NULL; 71 struct re_pattern_buffer *bufp = NULL;
62 72 Lisp_Object name_as_dir = Qnil;
63 char statbuf [MAXNAMLEN+2]; 73 int speccount = specpdl_depth ();
64 char *statbuf_tail; 74 char *statbuf, *statbuf_tail;
65 Lisp_Object tail_cons = Qnil; 75
66 char slashfilename[MAXNAMLEN+2]; 76 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
67 char *filename = slashfilename; 77 GCPRO4 (dirname, name_as_dir, dirfilename, list);
68
69 struct gcpro gcpro1, gcpro2, gcpro3;
70 GCPRO3 (dirname, dirfilename, tail_cons);
71 78
72 /* If the file name has special constructs in it, 79 /* If the file name has special constructs in it,
73 call the corresponding file handler. */ 80 call the corresponding file handler. */
74 handler = Ffind_file_name_handler (dirname, Qdirectory_files); 81 handler = Ffind_file_name_handler (dirname, Qdirectory_files);
75 if (!NILP (handler)) 82 if (!NILP (handler))
85 92
86 /* #### why do we do Fexpand_file_name after file handlers here, 93 /* #### why do we do Fexpand_file_name after file handlers here,
87 but earlier everywhere else? */ 94 but earlier everywhere else? */
88 dirname = Fexpand_file_name (dirname, Qnil); 95 dirname = Fexpand_file_name (dirname, Qnil);
89 dirfilename = Fdirectory_file_name (dirname); 96 dirfilename = Fdirectory_file_name (dirname);
90 97 name_as_dir = Ffile_name_as_directory (dirname);
91 { 98
92 /* XEmacs: this should come before the opendir() because it might error. */ 99 name_as_dir_length = XSTRING_LENGTH (name_as_dir);
93 Lisp_Object name_as_dir = Ffile_name_as_directory (dirname); 100 statbuf = alloca (name_as_dir_length + MAXNAMLEN + 1);
94 CHECK_STRING (name_as_dir); 101 memcpy (statbuf, XSTRING_DATA (name_as_dir), name_as_dir_length);
95 memcpy (statbuf, ((char *) XSTRING_DATA (name_as_dir)), 102 statbuf_tail = statbuf + name_as_dir_length;
96 XSTRING_LENGTH (name_as_dir));
97 statbuf_tail = statbuf + XSTRING_LENGTH (name_as_dir);
98 }
99 103
100 /* XEmacs: this should come after Ffile_name_as_directory() to avoid 104 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
101 potential regexp cache smashage. This should come before the 105 potential regexp cache smashage. It comes before the opendir()
102 opendir() because it might signal an error. 106 because it might signal an error. */
103 */
104 if (!NILP (match)) 107 if (!NILP (match))
105 { 108 {
106 CHECK_STRING (match); 109 CHECK_STRING (match);
107 110
108 /* MATCH might be a flawed regular expression. Rather than 111 /* MATCH might be a flawed regular expression. Rather than
109 catching and signalling our own errors, we just call 112 catching and signalling our own errors, we just call
110 compile_pattern to do the work for us. */ 113 compile_pattern to do the work for us. */
111 #ifdef VMS
112 bufp =
113 compile_pattern (match, 0,
114 (char *) MIRROR_DOWNCASE_TABLE_AS_STRING
115 (XBUFFER (Vbuffer_defaults)), 0, ERROR_ME);
116 #else
117 bufp = compile_pattern (match, 0, 0, 0, ERROR_ME); 114 bufp = compile_pattern (match, 0, 0, 0, ERROR_ME);
118 #endif
119 } 115 }
120 116
121 /* Now *bufp is the compiled form of MATCH; don't call anything 117 /* Now *bufp is the compiled form of MATCH; don't call anything
122 which might compile a new regexp until we're done with the loop! */ 118 which might compile a new regexp until we're done with the loop! */
123 119
124 /* Do this opendir after anything which might signal an error; if 120 /* Do this opendir after anything which might signal an error;
125 an error is signalled while the directory stream is open, we 121 previosly, there was no unwind-protection in case of error, but
126 have to make sure it gets closed, and setting up an 122 now there is. */
127 unwind_protect to do so would be a pain. */
128 d = opendir ((char *) XSTRING_DATA (dirfilename)); 123 d = opendir ((char *) XSTRING_DATA (dirfilename));
129 if (! d) 124 if (! d)
130 report_file_error ("Opening directory", list1 (dirname)); 125 report_file_error ("Opening directory", list1 (dirname));
131 126
127 record_unwind_protect (close_directory_fd, make_opaque_ptr ((void *)d));
128
132 list = Qnil; 129 list = Qnil;
133 tail_cons = Qnil;
134 dirname_length = XSTRING_LENGTH (dirname);
135 #ifndef VMS
136 if (dirname_length == 0
137 || !IS_ANY_SEP (XSTRING_BYTE (dirname, dirname_length - 1)))
138 {
139 *filename++ = DIRECTORY_SEP;
140 dirname_length++;
141 }
142 #endif /* VMS */
143 130
144 /* Loop reading blocks */ 131 /* Loop reading blocks */
145 while (1) 132 while (1)
146 { 133 {
147 DIRENTRY *dp = readdir (d); 134 DIRENTRY *dp = readdir (d);
150 if (!dp) break; 137 if (!dp) break;
151 len = NAMLEN (dp); 138 len = NAMLEN (dp);
152 if (DIRENTRY_NONEMPTY (dp)) 139 if (DIRENTRY_NONEMPTY (dp))
153 { 140 {
154 int result; 141 int result;
155 Lisp_Object oinhibit_quit = Vinhibit_quit;
156 strncpy (filename, dp->d_name, len);
157 filename[len] = 0;
158 /* re_search can now QUIT, so prevent it to avoid
159 filedesc lossage */
160 Vinhibit_quit = Qt;
161 result = (NILP (match) 142 result = (NILP (match)
162 || (0 <= re_search (bufp, filename, len, 0, len, 0))); 143 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0)));
163 Vinhibit_quit = oinhibit_quit;
164 if (result) 144 if (result)
165 { 145 {
166 if (!NILP (files_only)) 146 if (!NILP (files_only))
167 { 147 {
168 int dir_p; 148 int dir_p;
169 struct stat st; 149 struct stat st;
170 150 char *cur_statbuf = statbuf;
171 memcpy (statbuf_tail, filename, len); 151 char *cur_statbuf_tail = statbuf_tail;
172 statbuf_tail [len] = 0; 152
173 153 /* A trick: we normally use the buffer created by
174 if (stat (statbuf, &st) < 0) 154 alloca. However, if the filename is too big
155 (meaning MAXNAMLEN lies on the system), we'll use
156 a malloced buffer, and free it. */
157 if (len > MAXNAMLEN)
158 {
159 cur_statbuf = (char *) xmalloc (name_as_dir_length
160 + len + 1);
161 memcpy (cur_statbuf, statbuf, name_as_dir_length);
162 cur_statbuf_tail = cur_statbuf + name_as_dir_length;
163 }
164 memcpy (cur_statbuf_tail, dp->d_name, len);
165 cur_statbuf_tail [len] = 0;
166
167 if (stat (cur_statbuf, &st) < 0)
175 dir_p = 0; 168 dir_p = 0;
176 else 169 else
177 dir_p = ((st.st_mode & S_IFMT) == S_IFDIR); 170 dir_p = ((st.st_mode & S_IFMT) == S_IFDIR);
171
172 if (cur_statbuf != statbuf)
173 xfree (cur_statbuf);
178 174
179 if (EQ (files_only, Qt) && dir_p) 175 if (EQ (files_only, Qt) && dir_p)
180 continue; 176 continue;
181 else if (!EQ (files_only, Qt) && !dir_p) 177 else if (!EQ (files_only, Qt) && !dir_p)
182 continue; 178 continue;
183 } 179 }
184 180
185 if (!NILP (full)) 181 if (!NILP (full))
186 name = concat2 (dirname, build_string (slashfilename)); 182 name = concat2 (name_as_dir,
183 make_string ((Bufbyte *)dp->d_name, len));
187 else 184 else
188 name = make_string ((Bufbyte *) filename, len); 185 name = make_string ((Bufbyte *)dp->d_name, len);
189 186
190 if (NILP (tail_cons)) 187 list = Fcons (name, list);
191 {
192 list = list1 (name);
193 tail_cons = list;
194 }
195 else
196 {
197 XCDR (tail_cons) = list1 (name);
198 tail_cons = XCDR (tail_cons);
199 }
200 } 188 }
201 } 189 }
202 } 190 }
203 closedir (d); 191 unbind_to (speccount, Qnil); /* This will close the dir */
204 UNGCPRO;
205 if (!NILP (nosort)) 192 if (!NILP (nosort))
206 return list; 193 RETURN_UNGCPRO (list);
207 return Fsort (Fnreverse (list), Qstring_lessp); 194 else
195 RETURN_UNGCPRO (Fsort (Fnreverse (list), Qstring_lessp));
208 } 196 }
209 197
210 static Lisp_Object file_name_completion (Lisp_Object file, 198 static Lisp_Object file_name_completion (Lisp_Object file,
211 Lisp_Object dirname, 199 Lisp_Object dirname,
212 int all_flag, int ver_flag); 200 int all_flag, int ver_flag);