Mercurial > hg > xemacs-beta
annotate src/dired.c @ 4614:afbfad080ddd
The URLs in our current config.guess and config.sub files are obsolete.
Update to the latest upstream release to get correct URLs, as well as fixes
and enhancements to those scripts.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Wed, 11 Feb 2009 11:09:35 -0700 |
| parents | 5998e37dc35e |
| children | 53071486ff7a |
| 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 | |
| 374 if (file_name_completion_stat (directory, dp, &st) < 0) | |
| 375 continue; | |
| 376 | |
| 377 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); | |
| 378 if (directoryp) | |
| 379 { | |
| 380 #ifndef TRIVIAL_DIRECTORY_ENTRY | |
| 381 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, "..")) | |
| 382 #endif | |
| 383 /* "." and ".." are never interesting as completions, but are | |
| 384 actually in the way in a directory containing only one file. */ | |
| 385 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) | |
| 386 continue; | |
| 387 } | |
| 388 else | |
| 389 { | |
| 390 /* Compare extensions-to-be-ignored against end of this file name */ | |
| 391 /* if name is not an exact match against specified string. */ | |
| 392 if (!passcount && cclen > file_name_length) | |
| 393 { | |
| 394 /* and exit this for loop if a match is found */ | |
| 2367 | 395 EXTERNAL_LIST_LOOP_2 (elt, Vcompletion_ignored_extensions) |
| 428 | 396 { |
| 397 Charcount skip; | |
| 398 | |
| 399 CHECK_STRING (elt); | |
| 400 | |
| 826 | 401 skip = cclen - string_char_length (elt); |
| 428 | 402 if (skip < 0) continue; |
| 403 | |
| 867 | 404 if (0 > scmp (itext_n_addr (d_name, skip), |
| 428 | 405 XSTRING_DATA (elt), |
| 826 | 406 string_char_length (elt))) |
| 428 | 407 { |
| 408 ignored_extension_p = 1; | |
| 409 break; | |
| 410 } | |
| 411 } | |
| 412 } | |
| 413 } | |
| 414 | |
| 415 /* If an ignored-extensions match was found, | |
| 416 don't process this name as a completion. */ | |
| 417 if (!passcount && ignored_extension_p) | |
| 418 continue; | |
| 419 | |
| 814 | 420 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, len)) |
| 428 | 421 continue; |
| 422 | |
| 423 /* Update computation of how much all possible completions match */ | |
| 424 matchcount++; | |
| 425 | |
| 426 if (all_flag || NILP (bestmatch)) | |
| 427 { | |
| 428 Lisp_Object name = Qnil; | |
| 429 struct gcpro ngcpro1; | |
| 430 NGCPRO1 (name); | |
| 431 /* This is a possible completion */ | |
| 432 name = make_string (d_name, len); | |
| 433 if (directoryp) /* Completion is a directory; end it with '/' */ | |
| 434 name = Ffile_name_as_directory (name); | |
| 435 if (all_flag) | |
| 436 { | |
| 437 bestmatch = Fcons (name, bestmatch); | |
| 438 } | |
| 439 else | |
| 440 { | |
| 441 bestmatch = name; | |
| 826 | 442 bestmatchsize = string_char_length (name); |
| 428 | 443 } |
| 444 NUNGCPRO; | |
| 445 } | |
| 446 else | |
| 447 { | |
| 448 Charcount compare = min (bestmatchsize, cclen); | |
| 867 | 449 Ibyte *p1 = XSTRING_DATA (bestmatch); |
| 450 Ibyte *p2 = d_name; | |
| 428 | 451 Charcount matchsize = scmp (p1, p2, compare); |
| 452 | |
| 453 if (matchsize < 0) | |
| 454 matchsize = compare; | |
| 455 if (completion_ignore_case) | |
| 456 { | |
| 457 /* If this is an exact match except for case, | |
| 458 use it as the best match rather than one that is not | |
| 459 an exact match. This way, we get the case pattern | |
| 460 of the actual match. */ | |
| 461 if ((matchsize == cclen | |
| 462 && matchsize + !!directoryp | |
| 826 | 463 < string_char_length (bestmatch)) |
| 428 | 464 || |
| 465 /* If there is no exact match ignoring case, | |
| 466 prefer a match that does not change the case | |
| 467 of the input. */ | |
| 468 (((matchsize == cclen) | |
| 469 == | |
| 470 (matchsize + !!directoryp | |
| 826 | 471 == string_char_length (bestmatch))) |
| 428 | 472 /* If there is more than one exact match aside from |
| 473 case, and one of them is exact including case, | |
| 474 prefer that one. */ | |
| 475 && 0 > scmp_1 (p2, XSTRING_DATA (file), | |
| 476 file_name_length, 0) | |
| 477 && 0 <= scmp_1 (p1, XSTRING_DATA (file), | |
| 478 file_name_length, 0))) | |
| 479 { | |
| 480 bestmatch = make_string (d_name, len); | |
| 481 if (directoryp) | |
| 482 bestmatch = Ffile_name_as_directory (bestmatch); | |
| 483 } | |
| 484 } | |
| 485 | |
| 486 /* If this directory all matches, | |
| 487 see if implicit following slash does too. */ | |
| 488 if (directoryp | |
| 489 && compare == matchsize | |
| 490 && bestmatchsize > matchsize | |
| 867 | 491 && IS_ANY_SEP (itext_ichar_n (p1, matchsize))) |
| 428 | 492 matchsize++; |
| 493 bestmatchsize = matchsize; | |
| 494 } | |
| 495 } | |
| 771 | 496 qxe_closedir (d); |
| 428 | 497 free_opaque_ptr (XCAR (locative)); |
| 498 XCAR (locative) = Qnil; | |
| 499 } | |
| 500 | |
| 771 | 501 unbind_to (speccount); |
| 428 | 502 |
| 503 UNGCPRO; | |
| 504 | |
| 505 if (all_flag || NILP (bestmatch)) | |
| 506 return bestmatch; | |
| 507 if (matchcount == 1 && bestmatchsize == file_name_length) | |
| 508 return Qt; | |
| 509 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); | |
| 510 } | |
| 511 | |
| 512 | |
| 513 static Lisp_Object user_name_completion (Lisp_Object user, | |
| 514 int all_flag, | |
| 515 int *uniq); | |
| 516 | |
| 517 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /* | |
| 444 | 518 Complete user name from PARTIAL-USERNAME. |
| 519 Return the longest prefix common to all user names starting with | |
| 520 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches | |
| 521 it exactly, returns t. Return nil if there is no user name starting | |
| 522 with PARTIAL-USERNAME. | |
| 428 | 523 */ |
| 444 | 524 (partial_username)) |
| 428 | 525 { |
| 444 | 526 return user_name_completion (partial_username, 0, NULL); |
| 428 | 527 } |
| 528 | |
| 529 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /* | |
| 444 | 530 Complete user name from PARTIAL-USERNAME. |
| 428 | 531 |
| 532 This function is identical to `user-name-completion', except that | |
| 533 the cons of the completion and an indication of whether the | |
| 534 completion was unique is returned. | |
| 535 | |
| 444 | 536 The car of the returned value is the longest prefix common to all user |
| 537 names that start with PARTIAL-USERNAME. If there is only one and | |
| 538 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if | |
| 539 there is no user name starting with PARTIAL-USERNAME. The cdr of the | |
| 540 result is non-nil if and only if the completion returned in the car | |
| 541 was unique. | |
| 428 | 542 */ |
| 444 | 543 (partial_username)) |
| 428 | 544 { |
| 545 int uniq; | |
| 444 | 546 Lisp_Object completed = user_name_completion (partial_username, 0, &uniq); |
| 428 | 547 return Fcons (completed, uniq ? Qt : Qnil); |
| 548 } | |
| 549 | |
| 550 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /* | |
| 444 | 551 Return a list of all user name completions from PARTIAL-USERNAME. |
| 552 These are all the user names which begin with PARTIAL-USERNAME. | |
| 428 | 553 */ |
| 444 | 554 (partial_username)) |
| 428 | 555 { |
| 444 | 556 return user_name_completion (partial_username, 1, NULL); |
| 428 | 557 } |
| 558 | |
| 440 | 559 struct user_name |
| 560 { | |
| 867 | 561 Ibyte *ptr; |
| 647 | 562 Bytecount len; |
| 440 | 563 }; |
| 564 | |
| 565 struct user_cache | |
| 566 { | |
| 567 struct user_name *user_names; | |
| 428 | 568 int length; |
| 569 int size; | |
| 570 EMACS_TIME last_rebuild_time; | |
| 571 }; | |
| 572 static struct user_cache user_cache; | |
| 573 | |
| 574 static void | |
| 575 free_user_cache (struct user_cache *cache) | |
| 576 { | |
| 577 int i; | |
| 578 for (i = 0; i < cache->length; i++) | |
| 1726 | 579 xfree (cache->user_names[i].ptr, Ibyte *); |
| 580 xfree (cache->user_names, struct user_name *); | |
| 440 | 581 xzero (*cache); |
| 428 | 582 } |
| 583 | |
| 584 static Lisp_Object | |
| 440 | 585 user_name_completion_unwind (Lisp_Object cache_incomplete_p) |
| 428 | 586 { |
| 528 | 587 #ifndef WIN32_NATIVE |
| 440 | 588 endpwent (); |
| 589 speed_up_interrupts (); | |
| 528 | 590 #endif |
| 428 | 591 |
| 440 | 592 if (! NILP (XCAR (cache_incomplete_p))) |
| 593 free_user_cache (&user_cache); | |
| 594 | |
| 853 | 595 free_cons (cache_incomplete_p); |
| 428 | 596 |
| 597 return Qnil; | |
| 598 } | |
| 599 | |
| 440 | 600 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */ |
| 428 | 601 |
| 602 static Lisp_Object | |
| 603 user_name_completion (Lisp_Object user, int all_flag, int *uniq) | |
| 604 { | |
| 605 /* This function can GC */ | |
| 606 int matchcount = 0; | |
| 607 Lisp_Object bestmatch = Qnil; | |
| 608 Charcount bestmatchsize = 0; | |
| 609 Charcount user_name_length; | |
| 610 EMACS_TIME t; | |
| 611 int i; | |
| 612 struct gcpro gcpro1, gcpro2; | |
| 613 | |
| 614 GCPRO2 (user, bestmatch); | |
| 615 | |
| 616 CHECK_STRING (user); | |
| 617 | |
| 826 | 618 user_name_length = string_char_length (user); |
| 428 | 619 |
| 620 /* Cache user name lookups because it tends to be quite slow. | |
| 621 * Rebuild the cache occasionally to catch changes */ | |
| 622 EMACS_GET_TIME (t); | |
| 440 | 623 if (user_cache.user_names && |
| 428 | 624 (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time) |
| 440 | 625 > USER_CACHE_TTL)) |
| 626 free_user_cache (&user_cache); | |
| 428 | 627 |
| 440 | 628 if (!user_cache.user_names) |
| 428 | 629 { |
| 528 | 630 #ifndef WIN32_NATIVE |
| 428 | 631 struct passwd *pwd; |
| 528 | 632 #else |
| 633 DWORD entriesread; | |
| 634 DWORD totalentries; | |
| 635 DWORD resume_handle = 0; | |
| 636 #endif | |
| 637 | |
| 440 | 638 Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil); |
| 639 int speccount = specpdl_depth (); | |
| 640 | |
| 528 | 641 record_unwind_protect (user_name_completion_unwind, cache_incomplete_p); |
| 642 #ifndef WIN32_NATIVE | |
| 428 | 643 slow_down_interrupts (); |
| 644 setpwent (); | |
| 771 | 645 while ((pwd = qxe_getpwent ())) |
| 428 | 646 { |
| 647 QUIT; | |
| 440 | 648 DO_REALLOC (user_cache.user_names, user_cache.size, |
| 649 user_cache.length + 1, struct user_name); | |
| 771 | 650 user_cache.user_names[user_cache.length].ptr = |
| 867 | 651 (Ibyte *) xstrdup (pwd->pw_name); |
| 771 | 652 user_cache.user_names[user_cache.length].len = strlen (pwd->pw_name); |
| 440 | 653 user_cache.length++; |
| 428 | 654 } |
| 528 | 655 #else |
| 531 | 656 if (xNetUserEnum) |
| 528 | 657 { |
| 531 | 658 do |
| 528 | 659 { |
| 531 | 660 USER_INFO_0 *bufptr; |
| 661 NET_API_STATUS status_status_statui_statum_statu; | |
| 662 int i; | |
| 663 | |
| 664 QUIT; | |
| 665 status_status_statui_statum_statu = | |
| 666 xNetUserEnum (NULL, 0, 0, (LPBYTE *) &bufptr, 1024, | |
| 667 &entriesread, &totalentries, &resume_handle); | |
| 668 if (status_status_statui_statum_statu != NERR_Success && | |
| 669 status_status_statui_statum_statu != ERROR_MORE_DATA) | |
| 670 invalid_operation ("Error enumerating users", | |
| 671 make_int (GetLastError ())); | |
| 647 | 672 for (i = 0; i < (int) entriesread; i++) |
| 531 | 673 { |
| 674 DO_REALLOC (user_cache.user_names, user_cache.size, | |
| 675 user_cache.length + 1, struct user_name); | |
| 771 | 676 TO_INTERNAL_FORMAT (C_STRING, |
| 677 bufptr[i].usri0_name, | |
| 531 | 678 MALLOC, |
| 679 (user_cache. | |
| 680 user_names[user_cache.length].ptr, | |
| 681 user_cache. | |
| 682 user_names[user_cache.length].len), | |
| 771 | 683 Qmswindows_unicode); |
| 531 | 684 user_cache.length++; |
| 685 } | |
| 686 xNetApiBufferFree (bufptr); | |
| 528 | 687 } |
| 531 | 688 while (entriesread != totalentries); |
| 528 | 689 } |
| 546 | 690 else /* Win 9x */ |
| 691 { | |
| 692 Extbyte name[2 * (UNLEN + 1)]; | |
| 693 DWORD length = sizeof (name); | |
| 694 | |
| 771 | 695 if (qxeGetUserName (name, &length)) |
| 546 | 696 { |
| 697 DO_REALLOC (user_cache.user_names, user_cache.size, | |
| 698 user_cache.length + 1, struct user_name); | |
| 699 TO_INTERNAL_FORMAT (C_STRING, name, | |
| 700 MALLOC, | |
| 701 (user_cache. | |
| 702 user_names[user_cache.length].ptr, | |
| 703 user_cache. | |
| 704 user_names[user_cache.length].len), | |
| 705 Qmswindows_tstr); | |
| 706 user_cache.length++; | |
| 707 } | |
| 708 } | |
| 528 | 709 #endif |
| 710 | |
| 440 | 711 XCAR (cache_incomplete_p) = Qnil; |
| 771 | 712 unbind_to (speccount); |
| 440 | 713 |
| 428 | 714 EMACS_GET_TIME (user_cache.last_rebuild_time); |
| 715 } | |
| 716 | |
| 717 for (i = 0; i < user_cache.length; i++) | |
| 718 { | |
| 867 | 719 Ibyte *u_name = user_cache.user_names[i].ptr; |
| 440 | 720 Bytecount len = user_cache.user_names[i].len; |
| 428 | 721 /* scmp() works in chars, not bytes, so we have to compute this: */ |
| 722 Charcount cclen = bytecount_to_charcount (u_name, len); | |
| 723 | |
| 724 QUIT; | |
| 725 | |
| 726 if (cclen < user_name_length | |
| 727 || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0)) | |
| 728 continue; | |
| 729 | |
| 730 matchcount++; /* count matching completions */ | |
| 731 | |
| 732 if (all_flag || NILP (bestmatch)) | |
| 733 { | |
| 734 Lisp_Object name = Qnil; | |
| 735 struct gcpro ngcpro1; | |
| 736 NGCPRO1 (name); | |
| 737 /* This is a possible completion */ | |
| 738 name = make_string (u_name, len); | |
| 739 if (all_flag) | |
| 740 { | |
| 741 bestmatch = Fcons (name, bestmatch); | |
| 742 } | |
| 743 else | |
| 744 { | |
| 745 bestmatch = name; | |
| 826 | 746 bestmatchsize = string_char_length (name); |
| 428 | 747 } |
| 748 NUNGCPRO; | |
| 749 } | |
| 750 else | |
| 751 { | |
| 752 Charcount compare = min (bestmatchsize, cclen); | |
| 867 | 753 Ibyte *p1 = XSTRING_DATA (bestmatch); |
| 754 Ibyte *p2 = u_name; | |
| 428 | 755 Charcount matchsize = scmp_1 (p1, p2, compare, 0); |
| 756 | |
| 757 if (matchsize < 0) | |
| 758 matchsize = compare; | |
| 759 | |
| 760 bestmatchsize = matchsize; | |
| 761 } | |
| 762 } | |
| 763 | |
| 764 UNGCPRO; | |
| 765 | |
| 766 if (uniq) | |
| 767 *uniq = (matchcount == 1); | |
| 768 | |
| 769 if (all_flag || NILP (bestmatch)) | |
| 770 return bestmatch; | |
| 771 if (matchcount == 1 && bestmatchsize == user_name_length) | |
| 772 return Qt; | |
| 773 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); | |
| 774 } | |
| 775 | |
| 776 | |
| 777 Lisp_Object | |
| 867 | 778 make_directory_hash_table (const Ibyte *path) |
| 428 | 779 { |
| 780 DIR *d; | |
| 771 | 781 if ((d = qxe_opendir (path))) |
| 428 | 782 { |
| 783 DIRENTRY *dp; | |
| 784 Lisp_Object hash = | |
| 785 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | |
| 786 | |
| 771 | 787 while ((dp = qxe_readdir (d))) |
| 428 | 788 { |
| 789 Bytecount len = NAMLEN (dp); | |
| 790 if (DIRENTRY_NONEMPTY (dp)) | |
| 867 | 791 /* Cast to Ibyte* is OK, as qxe_readdir() Mule-encapsulates. */ |
| 792 Fputhash (make_string ((Ibyte *) dp->d_name, len), Qt, hash); | |
| 428 | 793 } |
| 771 | 794 qxe_closedir (d); |
| 428 | 795 return hash; |
| 796 } | |
| 797 else | |
| 798 return Qnil; | |
| 799 } | |
| 800 | |
| 707 | 801 #if 0 |
| 802 /* ... never used ... should use list2 directly anyway ... */ | |
| 803 /* NOTE: This function can never return a negative value. */ | |
| 428 | 804 Lisp_Object |
| 805 wasteful_word_to_lisp (unsigned int item) | |
| 806 { | |
| 807 /* Compatibility: in other versions, file-attributes returns a LIST | |
| 808 of two 16 bit integers... */ | |
| 809 Lisp_Object cons = word_to_lisp (item); | |
| 810 XCDR (cons) = Fcons (XCDR (cons), Qnil); | |
| 811 return cons; | |
| 812 } | |
| 707 | 813 #endif |
| 428 | 814 |
| 815 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /* | |
| 816 Return a list of attributes of file FILENAME. | |
| 817 Value is nil if specified file cannot be opened. | |
| 818 Otherwise, list elements are: | |
| 819 0. t for directory, string (name linked to) for symbolic link, or nil. | |
| 820 1. Number of links to file. | |
| 821 2. File uid. | |
| 822 3. File gid. | |
| 823 4. Last access time, as a list of two integers. | |
| 824 First integer has high-order 16 bits of time, second has low 16 bits. | |
| 825 5. Last modification time, likewise. | |
| 826 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
|
827 7. Size in bytes. (-1, if number out of range and no bignum support.) |
| 428 | 828 8. File modes, as a string of ten letters or dashes as in ls -l. |
| 829 9. t iff file's gid would change if file were deleted and recreated. | |
| 830 10. inode number. | |
| 831 11. Device number. | |
| 832 | |
| 833 If file does not exist, returns nil. | |
| 834 */ | |
| 835 (filename)) | |
| 836 { | |
| 837 /* This function can GC. GC checked 1997.06.04. */ | |
| 838 Lisp_Object values[12]; | |
| 839 Lisp_Object directory = Qnil; | |
| 840 struct stat s; | |
| 841 char modes[10]; | |
| 842 Lisp_Object handler; | |
| 843 struct gcpro gcpro1, gcpro2; | |
| 844 | |
| 845 GCPRO2 (filename, directory); | |
| 846 filename = Fexpand_file_name (filename, Qnil); | |
| 847 | |
| 848 /* If the file name has special constructs in it, | |
| 849 call the corresponding file handler. */ | |
| 850 handler = Ffind_file_name_handler (filename, Qfile_attributes); | |
| 851 if (!NILP (handler)) | |
| 852 { | |
| 853 UNGCPRO; | |
| 854 return call2 (handler, Qfile_attributes, filename); | |
| 855 } | |
| 856 | |
| 771 | 857 if (qxe_lstat (XSTRING_DATA (filename), &s) < 0) |
| 428 | 858 { |
| 859 UNGCPRO; | |
| 860 return Qnil; | |
| 861 } | |
| 862 | |
| 863 #ifdef BSD4_2 | |
| 864 directory = Ffile_name_directory (filename); | |
| 865 #endif | |
| 866 | |
| 442 | 867 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */ |
| 428 | 868 { |
| 867 | 869 Ibyte *tmpnam = XSTRING_DATA (Ffile_name_nondirectory (filename)); |
| 771 | 870 Bytecount l = qxestrlen (tmpnam); |
| 428 | 871 |
| 872 if (l >= 5 | |
| 873 && S_ISREG (s.st_mode) | |
| 771 | 874 && (qxestrcasecmp (&tmpnam[l - 4], ".com") == 0 || |
| 875 qxestrcasecmp (&tmpnam[l - 4], ".exe") == 0 || | |
| 876 qxestrcasecmp (&tmpnam[l - 4], ".bat") == 0)) | |
| 428 | 877 { |
| 878 s.st_mode |= S_IEXEC; | |
| 879 } | |
| 880 } | |
| 442 | 881 #endif |
| 428 | 882 |
| 883 switch (s.st_mode & S_IFMT) | |
| 884 { | |
| 885 default: | |
| 886 values[0] = Qnil; | |
| 887 break; | |
| 888 case S_IFDIR: | |
| 889 values[0] = Qt; | |
| 890 break; | |
| 891 #ifdef S_IFLNK | |
| 892 case S_IFLNK: | |
| 893 values[0] = Ffile_symlink_p (filename); | |
| 894 break; | |
| 895 #endif | |
| 896 } | |
| 897 values[1] = make_int (s.st_nlink); | |
| 898 values[2] = make_int (s.st_uid); | |
| 899 values[3] = make_int (s.st_gid); | |
| 707 | 900 values[4] = make_time (s.st_atime); |
| 901 values[5] = make_time (s.st_mtime); | |
| 902 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
|
903 |
|
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
904 #ifndef HAVE_BIGNUM |
|
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
905 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
|
906 (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
|
907 #else |
|
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
908 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
|
909 #endif |
|
5998e37dc35e
Use bignums if necessary for file size in #'file-attributes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2367
diff
changeset
|
910 |
| 428 | 911 filemodestring (&s, modes); |
| 867 | 912 values[8] = make_string ((Ibyte *) modes, 10); |
| 428 | 913 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ |
| 914 { | |
| 915 struct stat sdir; | |
| 916 | |
| 771 | 917 if (!NILP (directory) && qxe_stat (XSTRING_DATA (directory), &sdir) == 0) |
| 428 | 918 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; |
| 919 else /* if we can't tell, assume worst */ | |
| 920 values[9] = Qt; | |
| 921 } | |
| 922 #else /* file gid will be egid */ | |
| 923 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; | |
| 924 #endif /* BSD4_2 or BSD4_3 */ | |
| 925 values[10] = make_int (s.st_ino); | |
| 926 values[11] = make_int (s.st_dev); | |
| 927 UNGCPRO; | |
| 928 return Flist (countof (values), values); | |
| 929 } | |
| 930 | |
| 931 | |
| 932 /************************************************************************/ | |
| 933 /* initialization */ | |
| 934 /************************************************************************/ | |
| 935 | |
| 936 void | |
| 937 syms_of_dired (void) | |
| 938 { | |
| 563 | 939 DEFSYMBOL (Qdirectory_files); |
| 940 DEFSYMBOL (Qfile_name_completion); | |
| 941 DEFSYMBOL (Qfile_name_all_completions); | |
| 942 DEFSYMBOL (Qfile_attributes); | |
| 428 | 943 |
| 944 DEFSUBR (Fdirectory_files); | |
| 945 DEFSUBR (Ffile_name_completion); | |
| 946 DEFSUBR (Ffile_name_all_completions); | |
| 947 DEFSUBR (Fuser_name_completion); | |
| 948 DEFSUBR (Fuser_name_completion_1); | |
| 949 DEFSUBR (Fuser_name_all_completions); | |
| 950 DEFSUBR (Ffile_attributes); | |
| 951 } | |
| 952 | |
| 953 void | |
| 954 vars_of_dired (void) | |
| 955 { | |
| 956 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /* | |
| 957 *Completion ignores filenames ending in any string in this list. | |
| 958 This variable does not affect lists of possible completions, | |
| 959 but does affect the commands that actually do completions. | |
| 770 | 960 It is used by the function `file-name-completion'. |
| 428 | 961 */ ); |
| 962 Vcompletion_ignored_extensions = Qnil; | |
| 963 } |