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