Mercurial > hg > xemacs-beta
annotate src/dired.c @ 5090:0ca81354c4c7
Further frame-geometry cleanups
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-03 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Intro to Window and Frame Geometry):
* internals/internals.texi (The Paned Area):
* internals/internals.texi (The Displayable Area):
Update to make note of e.g. the fact that the bottom gutter is
actually above the minibuffer.
src/ChangeLog addition:
2010-03-03 Ben Wing <ben@xemacs.org>
* emacs.c:
* emacs.c (assert_equal_failed):
* lisp.h:
* lisp.h (assert_equal):
New fun assert_equal, asserting that two values == each other, and
printing out both values upon failure.
* frame-gtk.c (gtk_initialize_frame_size):
* frame-impl.h:
* frame-impl.h (FRAME_TOP_INTERNAL_BORDER_START):
* frame-impl.h (FRAME_BOTTOM_INTERNAL_BORDER_START):
* frame-impl.h (FRAME_LEFT_INTERNAL_BORDER_START):
* frame-impl.h (FRAME_PANED_TOP_EDGE):
* frame-impl.h (FRAME_NONPANED_SIZE):
* frame-x.c (x_initialize_frame_size):
* frame.c:
* gutter.c (get_gutter_coords):
* gutter.c (calculate_gutter_size):
* gutter.h:
* gutter.h (WINDOW_REAL_TOP_GUTTER_BOUNDS):
* gutter.h (FRAME_TOP_GUTTER_BOUNDS):
* input-method-xlib.c:
* input-method-xlib.c (XIM_SetGeometry):
* redisplay-output.c (clear_left_border):
* redisplay-output.c (clear_right_border):
* redisplay-output.c (redisplay_output_pixmap):
* redisplay-output.c (redisplay_clear_region):
* redisplay-output.c (redisplay_clear_top_of_window):
* redisplay-output.c (redisplay_clear_to_window_end):
* redisplay-xlike-inc.c (XLIKE_clear_frame):
* redisplay.c:
* redisplay.c (UPDATE_CACHE_RETURN):
* redisplay.c (pixel_to_glyph_translation):
* toolbar.c (update_frame_toolbars_geometry):
* window.c (Fwindow_pixel_edges):
Get rid of some redundant macros. Consistently use the
FRAME_TOP_*_START, FRAME_RIGHT_*_END, etc. format. Rename
FRAME_*_BORDER_* to FRAME_*_INTERNAL_BORDER_*. Comment out
FRAME_BOTTOM_* for gutters and the paned area due to the
uncertainty over where the paned area actually begins. (Eventually
we should probably move the gutters outside the minibuffer so that
the paned area is contiguous.) Use FRAME_PANED_* more often in the
code to make things clearer.
Update the diagram to show that the bottom gutter is inside the
minibuffer (!) and that there are "junk boxes" when you have left
and/or right gutters (dead boxes that are mistakenly left uncleared,
unlike the corresponding scrollbar dead boxes). Update the text
appropriately to cover the bottom gutter position, etc.
Rewrite gutter-geometry code to use the FRAME_*_GUTTER_* in place of
equivalent expressions referencing other frame elements, to make the
code more portable in case we move around the gutter location.
Cleanup FRAME_*_GUTTER_BOUNDS() in gutter.h.
Add some #### GEOM! comments where I think code is incorrect --
typically, it wasn't fixed up properly when the gutter was added.
Some cosmetic changes.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Wed, 03 Mar 2010 05:07:47 -0600 |
parents | 16112448d484 |
children | 99f8ebc082d9 861f2601a38b |
rev | line source |
---|---|
428 | 1 /* Lisp functions for making directory listings. |
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. | |
826 | 3 Copyright (C) 2001, 2002 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: FSF 19.30. */ | |
23 | |
24 #include <config.h> | |
25 #include "lisp.h" | |
26 | |
27 #include "buffer.h" | |
28 #include "commands.h" | |
29 #include "elhash.h" | |
800 | 30 #include "opaque.h" |
428 | 31 #include "regex.h" |
460 | 32 #include "syntax.h" |
800 | 33 #include "sysdep.h" |
34 | |
35 #include "sysdir.h" | |
36 #include "sysfile.h" | |
37 #include "syspwd.h" | |
38 #include "systime.h" | |
428 | 39 |
528 | 40 #ifdef WIN32_NATIVE |
41 #include "syswindows.h" | |
42 #endif | |
43 | |
428 | 44 Lisp_Object Vcompletion_ignored_extensions; |
45 Lisp_Object Qdirectory_files; | |
46 Lisp_Object Qfile_name_completion; | |
47 Lisp_Object Qfile_name_all_completions; | |
48 Lisp_Object Qfile_attributes; | |
49 | |
50 static Lisp_Object | |
51 close_directory_unwind (Lisp_Object unwind_obj) | |
52 { | |
53 DIR *d = (DIR *)get_opaque_ptr (unwind_obj); | |
771 | 54 qxe_closedir (d); |
428 | 55 free_opaque_ptr (unwind_obj); |
56 return Qnil; | |
57 } | |
58 | |
59 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /* | |
60 Return a list of names of files in DIRECTORY. | |
61 There are four optional arguments: | |
62 If FULL is non-nil, absolute pathnames of the files are returned. | |
2297 | 63 If MATCH is non-nil, only pathnames whose basename contain that regexp are |
64 returned. | |
428 | 65 If NOSORT is non-nil, the list is not sorted--its order is unpredictable. |
66 NOSORT is useful if you plan to sort the result yourself. | |
67 If FILES-ONLY is the symbol t, then only the "files" in the directory | |
68 will be returned; subdirectories will be excluded. If FILES-ONLY is not | |
69 nil and not t, then only the subdirectories will be returned. Otherwise, | |
70 if FILES-ONLY is nil (the default) then both files and subdirectories will | |
71 be returned. | |
72 */ | |
73 (directory, full, match, nosort, files_only)) | |
74 { | |
75 /* This function can GC */ | |
76 DIR *d; | |
77 Lisp_Object list = Qnil; | |
78 Bytecount directorylen; | |
79 Lisp_Object handler; | |
80 struct re_pattern_buffer *bufp = NULL; | |
81 int speccount = specpdl_depth (); | |
867 | 82 Ibyte *statbuf, *statbuf_tail; |
428 | 83 |
84 struct gcpro gcpro1, gcpro2; | |
85 GCPRO2 (directory, list); | |
86 | |
87 /* If the file name has special constructs in it, | |
88 call the corresponding file handler. */ | |
89 handler = Ffind_file_name_handler (directory, Qdirectory_files); | |
90 if (!NILP (handler)) | |
91 { | |
92 UNGCPRO; | |
93 if (!NILP (files_only)) | |
94 return call6 (handler, Qdirectory_files, directory, full, match, | |
95 nosort, files_only); | |
96 else | |
97 return call5 (handler, Qdirectory_files, directory, full, match, | |
98 nosort); | |
99 } | |
100 | |
101 /* #### why do we do Fexpand_file_name after file handlers here, | |
102 but earlier everywhere else? */ | |
103 directory = Fexpand_file_name (directory, Qnil); | |
104 directory = Ffile_name_as_directory (directory); | |
105 directorylen = XSTRING_LENGTH (directory); | |
106 | |
2367 | 107 statbuf = alloca_ibytes (directorylen + MAXNAMLEN + 1); |
428 | 108 memcpy (statbuf, XSTRING_DATA (directory), directorylen); |
109 statbuf_tail = statbuf + directorylen; | |
110 | |
111 /* XEmacs: this should come after Ffile_name_as_directory() to avoid | |
112 potential regexp cache smashage. It comes before the opendir() | |
113 because it might signal an error. */ | |
114 if (!NILP (match)) | |
115 { | |
116 CHECK_STRING (match); | |
117 | |
118 /* MATCH might be a flawed regular expression. Rather than | |
119 catching and signalling our own errors, we just call | |
120 compile_pattern to do the work for us. */ | |
826 | 121 bufp = compile_pattern (match, 0, Qnil, Qnil, 0, 0, ERROR_ME); |
428 | 122 } |
123 | |
124 /* Now *bufp is the compiled form of MATCH; don't call anything | |
125 which might compile a new regexp until we're done with the loop! */ | |
126 | |
127 /* Do this opendir after anything which might signal an error. | |
128 NOTE: the above comment is old; previously, there was no | |
129 unwind-protection in case of error, but now there is. */ | |
771 | 130 d = qxe_opendir (XSTRING_DATA (directory)); |
428 | 131 if (!d) |
563 | 132 report_file_error ("Opening directory", directory); |
428 | 133 |
134 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d)); | |
135 | |
136 /* Loop reading blocks */ | |
137 while (1) | |
138 { | |
771 | 139 DIRENTRY *dp = qxe_readdir (d); |
428 | 140 int len; |
826 | 141 struct syntax_cache scache_struct; |
142 struct syntax_cache *scache = &scache_struct; | |
428 | 143 |
144 if (!dp) | |
145 break; | |
146 len = NAMLEN (dp); | |
147 if (DIRENTRY_NONEMPTY (dp) | |
148 && (NILP (match) | |
826 | 149 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0, Qnil, 0, |
150 scache)))) | |
428 | 151 { |
152 if (!NILP (files_only)) | |
153 { | |
154 struct stat st; | |
155 int dir_p = 0; | |
156 | |
157 memcpy (statbuf_tail, dp->d_name, len); | |
158 statbuf_tail[len] = 0; | |
159 | |
771 | 160 if (qxe_stat (statbuf, &st) == 0 |
428 | 161 && (st.st_mode & S_IFMT) == S_IFDIR) |
162 dir_p = 1; | |
163 | |
164 if (EQ (files_only, Qt) && dir_p) | |
165 continue; | |
166 else if (!EQ (files_only, Qt) && !dir_p) | |
167 continue; | |
168 } | |
169 | |
170 { | |
171 Lisp_Object name = | |
867 | 172 make_string ((Ibyte *)dp->d_name, len); |
428 | 173 if (!NILP (full)) |
174 name = concat2 (directory, name); | |
175 | |
176 list = Fcons (name, list); | |
177 } | |
178 } | |
179 } | |
771 | 180 unbind_to (speccount); /* This will close the dir */ |
428 | 181 |
182 if (NILP (nosort)) | |
183 list = Fsort (Fnreverse (list), Qstring_lessp); | |
184 | |
185 RETURN_UNGCPRO (list); | |
186 } | |
187 | |
188 static Lisp_Object file_name_completion (Lisp_Object file, | |
189 Lisp_Object directory, | |
190 int all_flag, int ver_flag); | |
191 | |
192 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /* | |
444 | 193 Complete file name PARTIAL-FILENAME in directory DIRECTORY. |
194 Return the longest prefix common to all file names in DIRECTORY | |
195 that start with PARTIAL-FILENAME. | |
196 If there is only one and PARTIAL-FILENAME matches it exactly, return t. | |
197 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME. | |
428 | 198 |
444 | 199 File names which end with any member of `completion-ignored-extensions' |
200 are not considered as possible completions for PARTIAL-FILENAME unless | |
201 there is no other possible completion. `completion-ignored-extensions' | |
202 is not applied to the names of directories. | |
428 | 203 */ |
444 | 204 (partial_filename, directory)) |
428 | 205 { |
206 /* This function can GC. GC checked 1996.04.06. */ | |
207 Lisp_Object handler; | |
208 | |
209 /* If the directory name has special constructs in it, | |
210 call the corresponding file handler. */ | |
211 handler = Ffind_file_name_handler (directory, Qfile_name_completion); | |
212 if (!NILP (handler)) | |
444 | 213 return call3 (handler, Qfile_name_completion, partial_filename, directory); |
428 | 214 |
215 /* If the file name has special constructs in it, | |
216 call the corresponding file handler. */ | |
444 | 217 handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion); |
428 | 218 if (!NILP (handler)) |
444 | 219 return call3 (handler, Qfile_name_completion, partial_filename, directory); |
428 | 220 |
444 | 221 return file_name_completion (partial_filename, directory, 0, 0); |
428 | 222 } |
223 | |
224 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /* | |
444 | 225 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY. |
226 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME. | |
428 | 227 */ |
444 | 228 (partial_filename, directory)) |
428 | 229 { |
230 /* This function can GC. GC checked 1997.06.04. */ | |
231 Lisp_Object handler; | |
232 struct gcpro gcpro1; | |
233 | |
234 GCPRO1 (directory); | |
235 directory = Fexpand_file_name (directory, Qnil); | |
236 /* If the file name has special constructs in it, | |
237 call the corresponding file handler. */ | |
238 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions); | |
239 UNGCPRO; | |
240 if (!NILP (handler)) | |
444 | 241 return call3 (handler, Qfile_name_all_completions, partial_filename, |
428 | 242 directory); |
243 | |
444 | 244 return file_name_completion (partial_filename, directory, 1, 0); |
428 | 245 } |
246 | |
247 static int | |
248 file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp, | |
249 struct stat *st_addr) | |
250 { | |
251 Bytecount len = NAMLEN (dp); | |
252 Bytecount pos = XSTRING_LENGTH (directory); | |
253 int value; | |
2367 | 254 Ibyte *fullname = alloca_ibytes (len + pos + 2); |
428 | 255 |
256 memcpy (fullname, XSTRING_DATA (directory), pos); | |
257 if (!IS_DIRECTORY_SEP (fullname[pos - 1])) | |
258 fullname[pos++] = DIRECTORY_SEP; | |
259 | |
260 memcpy (fullname + pos, dp->d_name, len); | |
261 fullname[pos + len] = 0; | |
262 | |
263 #ifdef S_IFLNK | |
264 /* We want to return success if a link points to a nonexistent file, | |
265 but we want to return the status for what the link points to, | |
266 in case it is a directory. */ | |
771 | 267 value = qxe_lstat (fullname, st_addr); |
428 | 268 if (S_ISLNK (st_addr->st_mode)) |
771 | 269 qxe_stat (fullname, st_addr); |
428 | 270 #else |
771 | 271 value = qxe_stat (fullname, st_addr); |
428 | 272 #endif |
273 return value; | |
274 } | |
275 | |
276 static Lisp_Object | |
277 file_name_completion_unwind (Lisp_Object locative) | |
278 { | |
279 DIR *d; | |
280 Lisp_Object obj = XCAR (locative); | |
281 | |
282 if (!NILP (obj)) | |
283 { | |
284 d = (DIR *)get_opaque_ptr (obj); | |
771 | 285 qxe_closedir (d); |
428 | 286 free_opaque_ptr (obj); |
287 } | |
853 | 288 free_cons (locative); |
428 | 289 return Qnil; |
290 } | |
291 | |
292 static Lisp_Object | |
293 file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag, | |
2286 | 294 int UNUSED (ver_flag)) |
428 | 295 { |
296 /* This function can GC */ | |
297 DIR *d = 0; | |
298 int matchcount = 0; | |
299 Lisp_Object bestmatch = Qnil; | |
300 Charcount bestmatchsize = 0; | |
301 struct stat st; | |
302 int passcount; | |
303 int speccount = specpdl_depth (); | |
304 Charcount file_name_length; | |
305 Lisp_Object locative; | |
306 struct gcpro gcpro1, gcpro2, gcpro3; | |
307 | |
308 GCPRO3 (file, directory, bestmatch); | |
309 | |
310 CHECK_STRING (file); | |
311 | |
442 | 312 #ifdef WIN32_NATIVE |
428 | 313 /* Filename completion on Windows ignores case, since Windows |
314 filesystems do. */ | |
315 specbind (Qcompletion_ignore_case, Qt); | |
442 | 316 #endif /* WIN32_NATIVE */ |
428 | 317 |
318 #ifdef FILE_SYSTEM_CASE | |
319 file = FILE_SYSTEM_CASE (file); | |
320 #endif | |
321 directory = Fexpand_file_name (directory, Qnil); | |
826 | 322 file_name_length = string_char_length (file); |
428 | 323 |
324 /* With passcount = 0, ignore files that end in an ignored extension. | |
325 If nothing found then try again with passcount = 1, don't ignore them. | |
326 If looking for all completions, start with passcount = 1, | |
327 so always take even the ignored ones. | |
328 | |
329 ** It would not actually be helpful to the user to ignore any possible | |
330 completions when making a list of them.** */ | |
331 | |
332 /* We cannot use close_directory_unwind() because we change the | |
333 directory. The old code used to just avoid signaling errors, and | |
334 call closedir, but it was wrong, because it made sane handling of | |
335 QUIT impossible and, besides, various utility functions like | |
336 regexp_ignore_completion_p can signal errors. */ | |
337 locative = noseeum_cons (Qnil, Qnil); | |
338 record_unwind_protect (file_name_completion_unwind, locative); | |
339 | |
340 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++) | |
341 { | |
771 | 342 d = qxe_opendir (XSTRING_DATA (Fdirectory_file_name (directory))); |
428 | 343 if (!d) |
563 | 344 report_file_error ("Opening directory", directory); |
428 | 345 XCAR (locative) = make_opaque_ptr ((void *)d); |
346 | |
347 /* Loop reading blocks */ | |
348 while (1) | |
349 { | |
350 DIRENTRY *dp; | |
351 Bytecount len; | |
352 /* scmp() works in characters, not bytes, so we have to compute | |
353 this value: */ | |
354 Charcount cclen; | |
355 int directoryp; | |
356 int ignored_extension_p = 0; | |
867 | 357 Ibyte *d_name; |
428 | 358 |
771 | 359 dp = qxe_readdir (d); |
428 | 360 if (!dp) break; |
361 | |
867 | 362 /* Cast to Ibyte* is OK, as qxe_readdir() Mule-encapsulates. */ |
363 d_name = (Ibyte *) dp->d_name; | |
428 | 364 len = NAMLEN (dp); |
365 cclen = bytecount_to_charcount (d_name, len); | |
366 | |
367 QUIT; | |
368 | |
369 if (! DIRENTRY_NONEMPTY (dp) | |
370 || cclen < file_name_length | |
371 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length)) | |
372 continue; | |
373 | |
4808
53071486ff7a
Ignore file-too-large conditions when stat()ing a file for dired. The size
Jerry James <james@xemacs.org>
parents:
4406
diff
changeset
|
374 /* Ignore file-too-large conditions; the mode is still filled in. */ |
53071486ff7a
Ignore file-too-large conditions when stat()ing a file for dired. The size
Jerry James <james@xemacs.org>
parents:
4406
diff
changeset
|
375 if (file_name_completion_stat (directory, dp, &st) < 0 && |
53071486ff7a
Ignore file-too-large conditions when stat()ing a file for dired. The size
Jerry James <james@xemacs.org>
parents:
4406
diff
changeset
|
376 errno != EOVERFLOW) |
53071486ff7a
Ignore file-too-large conditions when stat()ing a file for dired. The size
Jerry James <james@xemacs.org>
parents:
4406
diff
changeset
|
377 continue; |
428 | 378 |
379 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); | |
380 if (directoryp) | |
381 { | |
382 #ifndef TRIVIAL_DIRECTORY_ENTRY | |
383 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, "..")) | |
384 #endif | |
385 /* "." and ".." are never interesting as completions, but are | |
386 actually in the way in a directory containing only one file. */ | |
387 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) | |
388 continue; | |
389 } | |
390 else | |
391 { | |
392 /* Compare extensions-to-be-ignored against end of this file name */ | |
393 /* if name is not an exact match against specified string. */ | |
394 if (!passcount && cclen > file_name_length) | |
395 { | |
396 /* and exit this for loop if a match is found */ | |
2367 | 397 EXTERNAL_LIST_LOOP_2 (elt, Vcompletion_ignored_extensions) |
428 | 398 { |
399 Charcount skip; | |
400 | |
401 CHECK_STRING (elt); | |
402 | |
826 | 403 skip = cclen - string_char_length (elt); |
428 | 404 if (skip < 0) continue; |
405 | |
867 | 406 if (0 > scmp (itext_n_addr (d_name, skip), |
428 | 407 XSTRING_DATA (elt), |
826 | 408 string_char_length (elt))) |
428 | 409 { |
410 ignored_extension_p = 1; | |
411 break; | |
412 } | |
413 } | |
414 } | |
415 } | |
416 | |
417 /* If an ignored-extensions match was found, | |
418 don't process this name as a completion. */ | |
419 if (!passcount && ignored_extension_p) | |
420 continue; | |
421 | |
814 | 422 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, len)) |
428 | 423 continue; |
424 | |
425 /* Update computation of how much all possible completions match */ | |
426 matchcount++; | |
427 | |
428 if (all_flag || NILP (bestmatch)) | |
429 { | |
430 Lisp_Object name = Qnil; | |
431 struct gcpro ngcpro1; | |
432 NGCPRO1 (name); | |
433 /* This is a possible completion */ | |
434 name = make_string (d_name, len); | |
435 if (directoryp) /* Completion is a directory; end it with '/' */ | |
436 name = Ffile_name_as_directory (name); | |
437 if (all_flag) | |
438 { | |
439 bestmatch = Fcons (name, bestmatch); | |
440 } | |
441 else | |
442 { | |
443 bestmatch = name; | |
826 | 444 bestmatchsize = string_char_length (name); |
428 | 445 } |
446 NUNGCPRO; | |
447 } | |
448 else | |
449 { | |
450 Charcount compare = min (bestmatchsize, cclen); | |
867 | 451 Ibyte *p1 = XSTRING_DATA (bestmatch); |
452 Ibyte *p2 = d_name; | |
428 | 453 Charcount matchsize = scmp (p1, p2, compare); |
454 | |
455 if (matchsize < 0) | |
456 matchsize = compare; | |
457 if (completion_ignore_case) | |
458 { | |
459 /* If this is an exact match except for case, | |
460 use it as the best match rather than one that is not | |
461 an exact match. This way, we get the case pattern | |
462 of the actual match. */ | |
463 if ((matchsize == cclen | |
464 && matchsize + !!directoryp | |
826 | 465 < string_char_length (bestmatch)) |
428 | 466 || |
467 /* If there is no exact match ignoring case, | |
468 prefer a match that does not change the case | |
469 of the input. */ | |
470 (((matchsize == cclen) | |
471 == | |
472 (matchsize + !!directoryp | |
826 | 473 == string_char_length (bestmatch))) |
428 | 474 /* If there is more than one exact match aside from |
475 case, and one of them is exact including case, | |
476 prefer that one. */ | |
477 && 0 > scmp_1 (p2, XSTRING_DATA (file), | |
478 file_name_length, 0) | |
479 && 0 <= scmp_1 (p1, XSTRING_DATA (file), | |
480 file_name_length, 0))) | |
481 { | |
482 bestmatch = make_string (d_name, len); | |
483 if (directoryp) | |
484 bestmatch = Ffile_name_as_directory (bestmatch); | |
485 } | |
486 } | |
487 | |
488 /* If this directory all matches, | |
489 see if implicit following slash does too. */ | |
490 if (directoryp | |
491 && compare == matchsize | |
492 && bestmatchsize > matchsize | |
867 | 493 && IS_ANY_SEP (itext_ichar_n (p1, matchsize))) |
428 | 494 matchsize++; |
495 bestmatchsize = matchsize; | |
496 } | |
497 } | |
771 | 498 qxe_closedir (d); |
428 | 499 free_opaque_ptr (XCAR (locative)); |
500 XCAR (locative) = Qnil; | |
501 } | |
502 | |
771 | 503 unbind_to (speccount); |
428 | 504 |
505 UNGCPRO; | |
506 | |
507 if (all_flag || NILP (bestmatch)) | |
508 return bestmatch; | |
509 if (matchcount == 1 && bestmatchsize == file_name_length) | |
510 return Qt; | |
511 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); | |
512 } | |
513 | |
514 | |
515 static Lisp_Object user_name_completion (Lisp_Object user, | |
516 int all_flag, | |
517 int *uniq); | |
518 | |
519 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /* | |
444 | 520 Complete user name from PARTIAL-USERNAME. |
521 Return the longest prefix common to all user names starting with | |
522 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches | |
523 it exactly, returns t. Return nil if there is no user name starting | |
524 with PARTIAL-USERNAME. | |
428 | 525 */ |
444 | 526 (partial_username)) |
428 | 527 { |
444 | 528 return user_name_completion (partial_username, 0, NULL); |
428 | 529 } |
530 | |
531 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /* | |
444 | 532 Complete user name from PARTIAL-USERNAME. |
428 | 533 |
534 This function is identical to `user-name-completion', except that | |
535 the cons of the completion and an indication of whether the | |
536 completion was unique is returned. | |
537 | |
444 | 538 The car of the returned value is the longest prefix common to all user |
539 names that start with PARTIAL-USERNAME. If there is only one and | |
540 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if | |
541 there is no user name starting with PARTIAL-USERNAME. The cdr of the | |
542 result is non-nil if and only if the completion returned in the car | |
543 was unique. | |
428 | 544 */ |
444 | 545 (partial_username)) |
428 | 546 { |
547 int uniq; | |
444 | 548 Lisp_Object completed = user_name_completion (partial_username, 0, &uniq); |
428 | 549 return Fcons (completed, uniq ? Qt : Qnil); |
550 } | |
551 | |
552 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /* | |
444 | 553 Return a list of all user name completions from PARTIAL-USERNAME. |
554 These are all the user names which begin with PARTIAL-USERNAME. | |
428 | 555 */ |
444 | 556 (partial_username)) |
428 | 557 { |
444 | 558 return user_name_completion (partial_username, 1, NULL); |
428 | 559 } |
560 | |
440 | 561 struct user_name |
562 { | |
867 | 563 Ibyte *ptr; |
647 | 564 Bytecount len; |
440 | 565 }; |
566 | |
567 struct user_cache | |
568 { | |
569 struct user_name *user_names; | |
428 | 570 int length; |
571 int size; | |
572 EMACS_TIME last_rebuild_time; | |
573 }; | |
574 static struct user_cache user_cache; | |
575 | |
576 static void | |
577 free_user_cache (struct user_cache *cache) | |
578 { | |
579 int i; | |
580 for (i = 0; i < cache->length; i++) | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4808
diff
changeset
|
581 xfree (cache->user_names[i].ptr); |
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4808
diff
changeset
|
582 xfree (cache->user_names); |
440 | 583 xzero (*cache); |
428 | 584 } |
585 | |
586 static Lisp_Object | |
440 | 587 user_name_completion_unwind (Lisp_Object cache_incomplete_p) |
428 | 588 { |
528 | 589 #ifndef WIN32_NATIVE |
440 | 590 endpwent (); |
591 speed_up_interrupts (); | |
528 | 592 #endif |
428 | 593 |
440 | 594 if (! NILP (XCAR (cache_incomplete_p))) |
595 free_user_cache (&user_cache); | |
596 | |
853 | 597 free_cons (cache_incomplete_p); |
428 | 598 |
599 return Qnil; | |
600 } | |
601 | |
440 | 602 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */ |
428 | 603 |
604 static Lisp_Object | |
605 user_name_completion (Lisp_Object user, int all_flag, int *uniq) | |
606 { | |
607 /* This function can GC */ | |
608 int matchcount = 0; | |
609 Lisp_Object bestmatch = Qnil; | |
610 Charcount bestmatchsize = 0; | |
611 Charcount user_name_length; | |
612 EMACS_TIME t; | |
613 int i; | |
614 struct gcpro gcpro1, gcpro2; | |
615 | |
616 GCPRO2 (user, bestmatch); | |
617 | |
618 CHECK_STRING (user); | |
619 | |
826 | 620 user_name_length = string_char_length (user); |
428 | 621 |
622 /* Cache user name lookups because it tends to be quite slow. | |
623 * Rebuild the cache occasionally to catch changes */ | |
624 EMACS_GET_TIME (t); | |
440 | 625 if (user_cache.user_names && |
428 | 626 (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time) |
440 | 627 > USER_CACHE_TTL)) |
628 free_user_cache (&user_cache); | |
428 | 629 |
440 | 630 if (!user_cache.user_names) |
428 | 631 { |
528 | 632 #ifndef WIN32_NATIVE |
428 | 633 struct passwd *pwd; |
528 | 634 #else |
635 DWORD entriesread; | |
636 DWORD totalentries; | |
637 DWORD resume_handle = 0; | |
638 #endif | |
639 | |
440 | 640 Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil); |
641 int speccount = specpdl_depth (); | |
642 | |
528 | 643 record_unwind_protect (user_name_completion_unwind, cache_incomplete_p); |
644 #ifndef WIN32_NATIVE | |
428 | 645 slow_down_interrupts (); |
646 setpwent (); | |
771 | 647 while ((pwd = qxe_getpwent ())) |
428 | 648 { |
649 QUIT; | |
440 | 650 DO_REALLOC (user_cache.user_names, user_cache.size, |
651 user_cache.length + 1, struct user_name); | |
771 | 652 user_cache.user_names[user_cache.length].ptr = |
867 | 653 (Ibyte *) xstrdup (pwd->pw_name); |
771 | 654 user_cache.user_names[user_cache.length].len = strlen (pwd->pw_name); |
440 | 655 user_cache.length++; |
428 | 656 } |
528 | 657 #else |
531 | 658 if (xNetUserEnum) |
528 | 659 { |
531 | 660 do |
528 | 661 { |
531 | 662 USER_INFO_0 *bufptr; |
663 NET_API_STATUS status_status_statui_statum_statu; | |
664 int i; | |
665 | |
666 QUIT; | |
667 status_status_statui_statum_statu = | |
668 xNetUserEnum (NULL, 0, 0, (LPBYTE *) &bufptr, 1024, | |
669 &entriesread, &totalentries, &resume_handle); | |
670 if (status_status_statui_statum_statu != NERR_Success && | |
671 status_status_statui_statum_statu != ERROR_MORE_DATA) | |
672 invalid_operation ("Error enumerating users", | |
673 make_int (GetLastError ())); | |
647 | 674 for (i = 0; i < (int) entriesread; i++) |
531 | 675 { |
676 DO_REALLOC (user_cache.user_names, user_cache.size, | |
677 user_cache.length + 1, struct user_name); | |
771 | 678 TO_INTERNAL_FORMAT (C_STRING, |
679 bufptr[i].usri0_name, | |
531 | 680 MALLOC, |
681 (user_cache. | |
682 user_names[user_cache.length].ptr, | |
683 user_cache. | |
684 user_names[user_cache.length].len), | |
771 | 685 Qmswindows_unicode); |
531 | 686 user_cache.length++; |
687 } | |
688 xNetApiBufferFree (bufptr); | |
528 | 689 } |
531 | 690 while (entriesread != totalentries); |
528 | 691 } |
546 | 692 else /* Win 9x */ |
693 { | |
694 Extbyte name[2 * (UNLEN + 1)]; | |
695 DWORD length = sizeof (name); | |
696 | |
771 | 697 if (qxeGetUserName (name, &length)) |
546 | 698 { |
699 DO_REALLOC (user_cache.user_names, user_cache.size, | |
700 user_cache.length + 1, struct user_name); | |
701 TO_INTERNAL_FORMAT (C_STRING, name, | |
702 MALLOC, | |
703 (user_cache. | |
704 user_names[user_cache.length].ptr, | |
705 user_cache. | |
706 user_names[user_cache.length].len), | |
707 Qmswindows_tstr); | |
708 user_cache.length++; | |
709 } | |
710 } | |
528 | 711 #endif |
712 | |
440 | 713 XCAR (cache_incomplete_p) = Qnil; |
771 | 714 unbind_to (speccount); |
440 | 715 |
428 | 716 EMACS_GET_TIME (user_cache.last_rebuild_time); |
717 } | |
718 | |
719 for (i = 0; i < user_cache.length; i++) | |
720 { | |
867 | 721 Ibyte *u_name = user_cache.user_names[i].ptr; |
440 | 722 Bytecount len = user_cache.user_names[i].len; |
428 | 723 /* scmp() works in chars, not bytes, so we have to compute this: */ |
724 Charcount cclen = bytecount_to_charcount (u_name, len); | |
725 | |
726 QUIT; | |
727 | |
728 if (cclen < user_name_length | |
729 || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0)) | |
730 continue; | |
731 | |
732 matchcount++; /* count matching completions */ | |
733 | |
734 if (all_flag || NILP (bestmatch)) | |
735 { | |
736 Lisp_Object name = Qnil; | |
737 struct gcpro ngcpro1; | |
738 NGCPRO1 (name); | |
739 /* This is a possible completion */ | |
740 name = make_string (u_name, len); | |
741 if (all_flag) | |
742 { | |
743 bestmatch = Fcons (name, bestmatch); | |
744 } | |
745 else | |
746 { | |
747 bestmatch = name; | |
826 | 748 bestmatchsize = string_char_length (name); |
428 | 749 } |
750 NUNGCPRO; | |
751 } | |
752 else | |
753 { | |
754 Charcount compare = min (bestmatchsize, cclen); | |
867 | 755 Ibyte *p1 = XSTRING_DATA (bestmatch); |
756 Ibyte *p2 = u_name; | |
428 | 757 Charcount matchsize = scmp_1 (p1, p2, compare, 0); |
758 | |
759 if (matchsize < 0) | |
760 matchsize = compare; | |
761 | |
762 bestmatchsize = matchsize; | |
763 } | |
764 } | |
765 | |
766 UNGCPRO; | |
767 | |
768 if (uniq) | |
769 *uniq = (matchcount == 1); | |
770 | |
771 if (all_flag || NILP (bestmatch)) | |
772 return bestmatch; | |
773 if (matchcount == 1 && bestmatchsize == user_name_length) | |
774 return Qt; | |
775 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); | |
776 } | |
777 | |
778 | |
779 Lisp_Object | |
867 | 780 make_directory_hash_table (const Ibyte *path) |
428 | 781 { |
782 DIR *d; | |
771 | 783 if ((d = qxe_opendir (path))) |
428 | 784 { |
785 DIRENTRY *dp; | |
786 Lisp_Object hash = | |
787 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | |
788 | |
771 | 789 while ((dp = qxe_readdir (d))) |
428 | 790 { |
791 Bytecount len = NAMLEN (dp); | |
792 if (DIRENTRY_NONEMPTY (dp)) | |
867 | 793 /* Cast to Ibyte* is OK, as qxe_readdir() Mule-encapsulates. */ |
794 Fputhash (make_string ((Ibyte *) dp->d_name, len), Qt, hash); | |
428 | 795 } |
771 | 796 qxe_closedir (d); |
428 | 797 return hash; |
798 } | |
799 else | |
800 return Qnil; | |
801 } | |
802 | |
707 | 803 #if 0 |
804 /* ... never used ... should use list2 directly anyway ... */ | |
805 /* NOTE: This function can never return a negative value. */ | |
428 | 806 Lisp_Object |
807 wasteful_word_to_lisp (unsigned int item) | |
808 { | |
809 /* Compatibility: in other versions, file-attributes returns a LIST | |
810 of two 16 bit integers... */ | |
811 Lisp_Object cons = word_to_lisp (item); | |
812 XCDR (cons) = Fcons (XCDR (cons), Qnil); | |
813 return cons; | |
814 } | |
707 | 815 #endif |
428 | 816 |
817 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /* | |
818 Return a list of attributes of file FILENAME. | |
819 Value is nil if specified file cannot be opened. | |
820 Otherwise, list elements are: | |
821 0. t for directory, string (name linked to) for symbolic link, or nil. | |
822 1. Number of links to file. | |
823 2. File uid. | |
824 3. File gid. | |
825 4. Last access time, as a list of two integers. | |
826 First integer has high-order 16 bits of time, second has low 16 bits. | |
827 5. Last modification time, likewise. | |
828 6. Last status change time, likewise. | |
4406
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
829 7. Size in bytes. (-1, if number out of range and no bignum support.) |
428 | 830 8. File modes, as a string of ten letters or dashes as in ls -l. |
831 9. t iff file's gid would change if file were deleted and recreated. | |
832 10. inode number. | |
833 11. Device number. | |
834 | |
835 If file does not exist, returns nil. | |
836 */ | |
837 (filename)) | |
838 { | |
839 /* This function can GC. GC checked 1997.06.04. */ | |
840 Lisp_Object values[12]; | |
841 Lisp_Object directory = Qnil; | |
842 struct stat s; | |
843 char modes[10]; | |
844 Lisp_Object handler; | |
845 struct gcpro gcpro1, gcpro2; | |
846 | |
847 GCPRO2 (filename, directory); | |
848 filename = Fexpand_file_name (filename, Qnil); | |
849 | |
850 /* If the file name has special constructs in it, | |
851 call the corresponding file handler. */ | |
852 handler = Ffind_file_name_handler (filename, Qfile_attributes); | |
853 if (!NILP (handler)) | |
854 { | |
855 UNGCPRO; | |
856 return call2 (handler, Qfile_attributes, filename); | |
857 } | |
858 | |
771 | 859 if (qxe_lstat (XSTRING_DATA (filename), &s) < 0) |
428 | 860 { |
861 UNGCPRO; | |
862 return Qnil; | |
863 } | |
864 | |
865 #ifdef BSD4_2 | |
866 directory = Ffile_name_directory (filename); | |
867 #endif | |
868 | |
442 | 869 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */ |
428 | 870 { |
867 | 871 Ibyte *tmpnam = XSTRING_DATA (Ffile_name_nondirectory (filename)); |
771 | 872 Bytecount l = qxestrlen (tmpnam); |
428 | 873 |
874 if (l >= 5 | |
875 && S_ISREG (s.st_mode) | |
771 | 876 && (qxestrcasecmp (&tmpnam[l - 4], ".com") == 0 || |
877 qxestrcasecmp (&tmpnam[l - 4], ".exe") == 0 || | |
878 qxestrcasecmp (&tmpnam[l - 4], ".bat") == 0)) | |
428 | 879 { |
880 s.st_mode |= S_IEXEC; | |
881 } | |
882 } | |
442 | 883 #endif |
428 | 884 |
885 switch (s.st_mode & S_IFMT) | |
886 { | |
887 default: | |
888 values[0] = Qnil; | |
889 break; | |
890 case S_IFDIR: | |
891 values[0] = Qt; | |
892 break; | |
893 #ifdef S_IFLNK | |
894 case S_IFLNK: | |
895 values[0] = Ffile_symlink_p (filename); | |
896 break; | |
897 #endif | |
898 } | |
899 values[1] = make_int (s.st_nlink); | |
900 values[2] = make_int (s.st_uid); | |
901 values[3] = make_int (s.st_gid); | |
707 | 902 values[4] = make_time (s.st_atime); |
903 values[5] = make_time (s.st_mtime); | |
904 values[6] = make_time (s.st_ctime); | |
4406
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
905 |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
906 #ifndef HAVE_BIGNUM |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
907 values[7] = make_integer (NUMBER_FITS_IN_AN_EMACS_INT (s.st_size) ? |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
908 (EMACS_INT)s.st_size : -1); |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
909 #else |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
910 values[7] = make_integer (s.st_size); |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
911 #endif |
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
912 |
428 | 913 filemodestring (&s, modes); |
867 | 914 values[8] = make_string ((Ibyte *) modes, 10); |
428 | 915 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ |
916 { | |
917 struct stat sdir; | |
918 | |
771 | 919 if (!NILP (directory) && qxe_stat (XSTRING_DATA (directory), &sdir) == 0) |
428 | 920 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; |
921 else /* if we can't tell, assume worst */ | |
922 values[9] = Qt; | |
923 } | |
924 #else /* file gid will be egid */ | |
925 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; | |
926 #endif /* BSD4_2 or BSD4_3 */ | |
927 values[10] = make_int (s.st_ino); | |
928 values[11] = make_int (s.st_dev); | |
929 UNGCPRO; | |
930 return Flist (countof (values), values); | |
931 } | |
932 | |
933 | |
934 /************************************************************************/ | |
935 /* initialization */ | |
936 /************************************************************************/ | |
937 | |
938 void | |
939 syms_of_dired (void) | |
940 { | |
563 | 941 DEFSYMBOL (Qdirectory_files); |
942 DEFSYMBOL (Qfile_name_completion); | |
943 DEFSYMBOL (Qfile_name_all_completions); | |
944 DEFSYMBOL (Qfile_attributes); | |
428 | 945 |
946 DEFSUBR (Fdirectory_files); | |
947 DEFSUBR (Ffile_name_completion); | |
948 DEFSUBR (Ffile_name_all_completions); | |
949 DEFSUBR (Fuser_name_completion); | |
950 DEFSUBR (Fuser_name_completion_1); | |
951 DEFSUBR (Fuser_name_all_completions); | |
952 DEFSUBR (Ffile_attributes); | |
953 } | |
954 | |
955 void | |
956 vars_of_dired (void) | |
957 { | |
958 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /* | |
959 *Completion ignores filenames ending in any string in this list. | |
960 This variable does not affect lists of possible completions, | |
961 but does affect the commands that actually do completions. | |
770 | 962 It is used by the function `file-name-completion'. |
428 | 963 */ ); |
964 Vcompletion_ignored_extensions = Qnil; | |
965 } |