428
+ − 1 /* Lisp functions for making directory listings.
+ − 2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
771
+ − 3 Copyright (C) 2001 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
442
+ − 27 #include "sysfile.h"
+ − 28 #include "sysdir.h"
+ − 29 #include "systime.h"
+ − 30 #include "sysdep.h"
+ − 31 #include "syspwd.h"
428
+ − 32 #include "buffer.h"
+ − 33 #include "commands.h"
+ − 34 #include "elhash.h"
+ − 35 #include "regex.h"
+ − 36 #include "opaque.h"
460
+ − 37 #include "syntax.h"
428
+ − 38
528
+ − 39 #ifdef WIN32_NATIVE
+ − 40 #include "syswindows.h"
+ − 41 #endif
+ − 42
428
+ − 43 Lisp_Object Vcompletion_ignored_extensions;
+ − 44 Lisp_Object Qdirectory_files;
+ − 45 Lisp_Object Qfile_name_completion;
+ − 46 Lisp_Object Qfile_name_all_completions;
+ − 47 Lisp_Object Qfile_attributes;
+ − 48
+ − 49 static Lisp_Object
+ − 50 close_directory_unwind (Lisp_Object unwind_obj)
+ − 51 {
+ − 52 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
771
+ − 53 qxe_closedir (d);
428
+ − 54 free_opaque_ptr (unwind_obj);
+ − 55 return Qnil;
+ − 56 }
+ − 57
+ − 58 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
+ − 59 Return a list of names of files in DIRECTORY.
+ − 60 There are four optional arguments:
+ − 61 If FULL is non-nil, absolute pathnames of the files are returned.
+ − 62 If MATCH is non-nil, only pathnames containing that regexp are returned.
+ − 63 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
+ − 64 NOSORT is useful if you plan to sort the result yourself.
+ − 65 If FILES-ONLY is the symbol t, then only the "files" in the directory
+ − 66 will be returned; subdirectories will be excluded. If FILES-ONLY is not
+ − 67 nil and not t, then only the subdirectories will be returned. Otherwise,
+ − 68 if FILES-ONLY is nil (the default) then both files and subdirectories will
+ − 69 be returned.
+ − 70 */
+ − 71 (directory, full, match, nosort, files_only))
+ − 72 {
+ − 73 /* This function can GC */
+ − 74 DIR *d;
+ − 75 Lisp_Object list = Qnil;
+ − 76 Bytecount directorylen;
+ − 77 Lisp_Object handler;
+ − 78 struct re_pattern_buffer *bufp = NULL;
+ − 79 int speccount = specpdl_depth ();
771
+ − 80 Intbyte *statbuf, *statbuf_tail;
428
+ − 81
+ − 82 struct gcpro gcpro1, gcpro2;
+ − 83 GCPRO2 (directory, list);
+ − 84
+ − 85 /* If the file name has special constructs in it,
+ − 86 call the corresponding file handler. */
+ − 87 handler = Ffind_file_name_handler (directory, Qdirectory_files);
+ − 88 if (!NILP (handler))
+ − 89 {
+ − 90 UNGCPRO;
+ − 91 if (!NILP (files_only))
+ − 92 return call6 (handler, Qdirectory_files, directory, full, match,
+ − 93 nosort, files_only);
+ − 94 else
+ − 95 return call5 (handler, Qdirectory_files, directory, full, match,
+ − 96 nosort);
+ − 97 }
+ − 98
+ − 99 /* #### why do we do Fexpand_file_name after file handlers here,
+ − 100 but earlier everywhere else? */
+ − 101 directory = Fexpand_file_name (directory, Qnil);
+ − 102 directory = Ffile_name_as_directory (directory);
+ − 103 directorylen = XSTRING_LENGTH (directory);
+ − 104
771
+ − 105 statbuf = (Intbyte *) alloca (directorylen + MAXNAMLEN + 1);
428
+ − 106 memcpy (statbuf, XSTRING_DATA (directory), directorylen);
+ − 107 statbuf_tail = statbuf + directorylen;
+ − 108
+ − 109 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
+ − 110 potential regexp cache smashage. It comes before the opendir()
+ − 111 because it might signal an error. */
+ − 112 if (!NILP (match))
+ − 113 {
+ − 114 CHECK_STRING (match);
+ − 115
+ − 116 /* MATCH might be a flawed regular expression. Rather than
+ − 117 catching and signalling our own errors, we just call
+ − 118 compile_pattern to do the work for us. */
446
+ − 119 bufp = compile_pattern (match, 0, Qnil, 0, ERROR_ME);
428
+ − 120 }
+ − 121
+ − 122 /* Now *bufp is the compiled form of MATCH; don't call anything
+ − 123 which might compile a new regexp until we're done with the loop! */
+ − 124
+ − 125 /* Do this opendir after anything which might signal an error.
+ − 126 NOTE: the above comment is old; previously, there was no
+ − 127 unwind-protection in case of error, but now there is. */
771
+ − 128 d = qxe_opendir (XSTRING_DATA (directory));
428
+ − 129 if (!d)
563
+ − 130 report_file_error ("Opening directory", directory);
428
+ − 131
460
+ − 132 regex_match_object = Qt;
+ − 133 regex_emacs_buffer = current_buffer;
+ − 134
428
+ − 135 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
+ − 136
+ − 137 /* Loop reading blocks */
+ − 138 while (1)
+ − 139 {
771
+ − 140 DIRENTRY *dp = qxe_readdir (d);
428
+ − 141 int len;
+ − 142
+ − 143 if (!dp)
+ − 144 break;
+ − 145 len = NAMLEN (dp);
+ − 146 if (DIRENTRY_NONEMPTY (dp)
+ − 147 && (NILP (match)
+ − 148 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
+ − 149 {
+ − 150 if (!NILP (files_only))
+ − 151 {
+ − 152 struct stat st;
+ − 153 int dir_p = 0;
+ − 154
+ − 155 memcpy (statbuf_tail, dp->d_name, len);
+ − 156 statbuf_tail[len] = 0;
+ − 157
771
+ − 158 if (qxe_stat (statbuf, &st) == 0
428
+ − 159 && (st.st_mode & S_IFMT) == S_IFDIR)
+ − 160 dir_p = 1;
+ − 161
+ − 162 if (EQ (files_only, Qt) && dir_p)
+ − 163 continue;
+ − 164 else if (!EQ (files_only, Qt) && !dir_p)
+ − 165 continue;
+ − 166 }
+ − 167
+ − 168 {
+ − 169 Lisp_Object name =
665
+ − 170 make_string ((Intbyte *)dp->d_name, len);
428
+ − 171 if (!NILP (full))
+ − 172 name = concat2 (directory, name);
+ − 173
+ − 174 list = Fcons (name, list);
+ − 175 }
+ − 176 }
+ − 177 }
771
+ − 178 unbind_to (speccount); /* This will close the dir */
428
+ − 179
+ − 180 if (NILP (nosort))
+ − 181 list = Fsort (Fnreverse (list), Qstring_lessp);
+ − 182
+ − 183 RETURN_UNGCPRO (list);
+ − 184 }
+ − 185
+ − 186 static Lisp_Object file_name_completion (Lisp_Object file,
+ − 187 Lisp_Object directory,
+ − 188 int all_flag, int ver_flag);
+ − 189
+ − 190 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
444
+ − 191 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
+ − 192 Return the longest prefix common to all file names in DIRECTORY
+ − 193 that start with PARTIAL-FILENAME.
+ − 194 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
+ − 195 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
428
+ − 196
444
+ − 197 File names which end with any member of `completion-ignored-extensions'
+ − 198 are not considered as possible completions for PARTIAL-FILENAME unless
+ − 199 there is no other possible completion. `completion-ignored-extensions'
+ − 200 is not applied to the names of directories.
428
+ − 201 */
444
+ − 202 (partial_filename, directory))
428
+ − 203 {
+ − 204 /* This function can GC. GC checked 1996.04.06. */
+ − 205 Lisp_Object handler;
+ − 206
+ − 207 /* If the directory name has special constructs in it,
+ − 208 call the corresponding file handler. */
+ − 209 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
+ − 210 if (!NILP (handler))
444
+ − 211 return call3 (handler, Qfile_name_completion, partial_filename, directory);
428
+ − 212
+ − 213 /* If the file name has special constructs in it,
+ − 214 call the corresponding file handler. */
444
+ − 215 handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion);
428
+ − 216 if (!NILP (handler))
444
+ − 217 return call3 (handler, Qfile_name_completion, partial_filename, directory);
428
+ − 218
444
+ − 219 return file_name_completion (partial_filename, directory, 0, 0);
428
+ − 220 }
+ − 221
+ − 222 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
444
+ − 223 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
+ − 224 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
428
+ − 225 */
444
+ − 226 (partial_filename, directory))
428
+ − 227 {
+ − 228 /* This function can GC. GC checked 1997.06.04. */
+ − 229 Lisp_Object handler;
+ − 230 struct gcpro gcpro1;
+ − 231
+ − 232 GCPRO1 (directory);
+ − 233 directory = Fexpand_file_name (directory, Qnil);
+ − 234 /* If the file name has special constructs in it,
+ − 235 call the corresponding file handler. */
+ − 236 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
+ − 237 UNGCPRO;
+ − 238 if (!NILP (handler))
444
+ − 239 return call3 (handler, Qfile_name_all_completions, partial_filename,
428
+ − 240 directory);
+ − 241
444
+ − 242 return file_name_completion (partial_filename, directory, 1, 0);
428
+ − 243 }
+ − 244
+ − 245 static int
+ − 246 file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp,
+ − 247 struct stat *st_addr)
+ − 248 {
+ − 249 Bytecount len = NAMLEN (dp);
+ − 250 Bytecount pos = XSTRING_LENGTH (directory);
+ − 251 int value;
771
+ − 252 Intbyte *fullname = (Intbyte *) alloca (len + pos + 2);
428
+ − 253
+ − 254 memcpy (fullname, XSTRING_DATA (directory), pos);
+ − 255 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
+ − 256 fullname[pos++] = DIRECTORY_SEP;
+ − 257
+ − 258 memcpy (fullname + pos, dp->d_name, len);
+ − 259 fullname[pos + len] = 0;
+ − 260
+ − 261 #ifdef S_IFLNK
+ − 262 /* We want to return success if a link points to a nonexistent file,
+ − 263 but we want to return the status for what the link points to,
+ − 264 in case it is a directory. */
771
+ − 265 value = qxe_lstat (fullname, st_addr);
428
+ − 266 if (S_ISLNK (st_addr->st_mode))
771
+ − 267 qxe_stat (fullname, st_addr);
428
+ − 268 #else
771
+ − 269 value = qxe_stat (fullname, st_addr);
428
+ − 270 #endif
+ − 271 return value;
+ − 272 }
+ − 273
+ − 274 static Lisp_Object
+ − 275 file_name_completion_unwind (Lisp_Object locative)
+ − 276 {
+ − 277 DIR *d;
+ − 278 Lisp_Object obj = XCAR (locative);
+ − 279
+ − 280 if (!NILP (obj))
+ − 281 {
+ − 282 d = (DIR *)get_opaque_ptr (obj);
771
+ − 283 qxe_closedir (d);
428
+ − 284 free_opaque_ptr (obj);
+ − 285 }
+ − 286 free_cons (XCONS (locative));
+ − 287 return Qnil;
+ − 288 }
+ − 289
+ − 290 static Lisp_Object
+ − 291 file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag,
+ − 292 int ver_flag)
+ − 293 {
+ − 294 /* This function can GC */
+ − 295 DIR *d = 0;
+ − 296 int matchcount = 0;
+ − 297 Lisp_Object bestmatch = Qnil;
+ − 298 Charcount bestmatchsize = 0;
+ − 299 struct stat st;
+ − 300 int passcount;
+ − 301 int speccount = specpdl_depth ();
+ − 302 Charcount file_name_length;
+ − 303 Lisp_Object locative;
+ − 304 struct gcpro gcpro1, gcpro2, gcpro3;
+ − 305
+ − 306 GCPRO3 (file, directory, bestmatch);
+ − 307
+ − 308 CHECK_STRING (file);
+ − 309
442
+ − 310 #ifdef WIN32_NATIVE
428
+ − 311 /* Filename completion on Windows ignores case, since Windows
+ − 312 filesystems do. */
+ − 313 specbind (Qcompletion_ignore_case, Qt);
442
+ − 314 #endif /* WIN32_NATIVE */
428
+ − 315
+ − 316 #ifdef FILE_SYSTEM_CASE
+ − 317 file = FILE_SYSTEM_CASE (file);
+ − 318 #endif
+ − 319 directory = Fexpand_file_name (directory, Qnil);
+ − 320 file_name_length = XSTRING_CHAR_LENGTH (file);
+ − 321
+ − 322 /* With passcount = 0, ignore files that end in an ignored extension.
+ − 323 If nothing found then try again with passcount = 1, don't ignore them.
+ − 324 If looking for all completions, start with passcount = 1,
+ − 325 so always take even the ignored ones.
+ − 326
+ − 327 ** It would not actually be helpful to the user to ignore any possible
+ − 328 completions when making a list of them.** */
+ − 329
+ − 330 /* We cannot use close_directory_unwind() because we change the
+ − 331 directory. The old code used to just avoid signaling errors, and
+ − 332 call closedir, but it was wrong, because it made sane handling of
+ − 333 QUIT impossible and, besides, various utility functions like
+ − 334 regexp_ignore_completion_p can signal errors. */
+ − 335 locative = noseeum_cons (Qnil, Qnil);
+ − 336 record_unwind_protect (file_name_completion_unwind, locative);
+ − 337
+ − 338 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
+ − 339 {
771
+ − 340 d = qxe_opendir (XSTRING_DATA (Fdirectory_file_name (directory)));
428
+ − 341 if (!d)
563
+ − 342 report_file_error ("Opening directory", directory);
428
+ − 343 XCAR (locative) = make_opaque_ptr ((void *)d);
+ − 344
+ − 345 /* Loop reading blocks */
+ − 346 while (1)
+ − 347 {
+ − 348 DIRENTRY *dp;
+ − 349 Bytecount len;
+ − 350 /* scmp() works in characters, not bytes, so we have to compute
+ − 351 this value: */
+ − 352 Charcount cclen;
+ − 353 int directoryp;
+ − 354 int ignored_extension_p = 0;
665
+ − 355 Intbyte *d_name;
428
+ − 356
771
+ − 357 dp = qxe_readdir (d);
428
+ − 358 if (!dp) break;
+ − 359
771
+ − 360 /* Cast to Intbyte* is OK, as qxe_readdir() Mule-encapsulates. */
665
+ − 361 d_name = (Intbyte *) dp->d_name;
428
+ − 362 len = NAMLEN (dp);
+ − 363 cclen = bytecount_to_charcount (d_name, len);
+ − 364
+ − 365 QUIT;
+ − 366
+ − 367 if (! DIRENTRY_NONEMPTY (dp)
+ − 368 || cclen < file_name_length
+ − 369 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
+ − 370 continue;
+ − 371
+ − 372 if (file_name_completion_stat (directory, dp, &st) < 0)
+ − 373 continue;
+ − 374
+ − 375 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
+ − 376 if (directoryp)
+ − 377 {
+ − 378 #ifndef TRIVIAL_DIRECTORY_ENTRY
+ − 379 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
+ − 380 #endif
+ − 381 /* "." and ".." are never interesting as completions, but are
+ − 382 actually in the way in a directory containing only one file. */
+ − 383 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
+ − 384 continue;
+ − 385 }
+ − 386 else
+ − 387 {
+ − 388 /* Compare extensions-to-be-ignored against end of this file name */
+ − 389 /* if name is not an exact match against specified string. */
+ − 390 if (!passcount && cclen > file_name_length)
+ − 391 {
+ − 392 Lisp_Object tem;
+ − 393 /* and exit this for loop if a match is found */
+ − 394 EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
+ − 395 {
+ − 396 Lisp_Object elt = XCAR (tem);
+ − 397 Charcount skip;
+ − 398
+ − 399 CHECK_STRING (elt);
+ − 400
+ − 401 skip = cclen - XSTRING_CHAR_LENGTH (elt);
+ − 402 if (skip < 0) continue;
+ − 403
+ − 404 if (0 > scmp (charptr_n_addr (d_name, skip),
+ − 405 XSTRING_DATA (elt),
+ − 406 XSTRING_CHAR_LENGTH (elt)))
+ − 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
+ − 420 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
+ − 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;
+ − 442 bestmatchsize = XSTRING_CHAR_LENGTH (name);
+ − 443 }
+ − 444 NUNGCPRO;
+ − 445 }
+ − 446 else
+ − 447 {
+ − 448 Charcount compare = min (bestmatchsize, cclen);
665
+ − 449 Intbyte *p1 = XSTRING_DATA (bestmatch);
+ − 450 Intbyte *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
+ − 463 < XSTRING_CHAR_LENGTH (bestmatch))
+ − 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
+ − 471 == XSTRING_CHAR_LENGTH (bestmatch)))
+ − 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
+ − 491 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
+ − 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 {
665
+ − 561 Intbyte *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++)
440
+ − 579 xfree (cache->user_names[i].ptr);
+ − 580 xfree (cache->user_names);
+ − 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
+ − 595 free_cons (XCONS (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
+ − 618 user_name_length = XSTRING_CHAR_LENGTH (user);
+ − 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 =
+ − 651 (Intbyte *) xstrdup (pwd->pw_name);
+ − 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 {
665
+ − 719 Intbyte *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;
+ − 746 bestmatchsize = XSTRING_CHAR_LENGTH (name);
+ − 747 }
+ − 748 NUNGCPRO;
+ − 749 }
+ − 750 else
+ − 751 {
+ − 752 Charcount compare = min (bestmatchsize, cclen);
665
+ − 753 Intbyte *p1 = XSTRING_DATA (bestmatch);
+ − 754 Intbyte *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
771
+ − 778 make_directory_hash_table (const Intbyte *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))
771
+ − 791 /* Cast to Intbyte* is OK, as qxe_readdir() Mule-encapsulates. */
665
+ − 792 Fputhash (make_string ((Intbyte *) 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.
+ − 827 7. Size in bytes. (-1, if number is out of range).
+ − 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 {
771
+ − 869 Intbyte *tmpnam = XSTRING_DATA (Ffile_name_nondirectory (filename));
+ − 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);
428
+ − 903 values[7] = make_int ((EMACS_INT) s.st_size);
+ − 904 /* If the size is out of range, give back -1. */
+ − 905 /* #### Fix when Emacs gets bignums! */
+ − 906 if (XINT (values[7]) != s.st_size)
+ − 907 values[7] = make_int (-1);
+ − 908 filemodestring (&s, modes);
665
+ − 909 values[8] = make_string ((Intbyte *) modes, 10);
428
+ − 910 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
+ − 911 {
+ − 912 struct stat sdir;
+ − 913
771
+ − 914 if (!NILP (directory) && qxe_stat (XSTRING_DATA (directory), &sdir) == 0)
428
+ − 915 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
+ − 916 else /* if we can't tell, assume worst */
+ − 917 values[9] = Qt;
+ − 918 }
+ − 919 #else /* file gid will be egid */
+ − 920 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
+ − 921 #endif /* BSD4_2 or BSD4_3 */
+ − 922 values[10] = make_int (s.st_ino);
+ − 923 values[11] = make_int (s.st_dev);
+ − 924 UNGCPRO;
+ − 925 return Flist (countof (values), values);
+ − 926 }
+ − 927
+ − 928
+ − 929 /************************************************************************/
+ − 930 /* initialization */
+ − 931 /************************************************************************/
+ − 932
+ − 933 void
+ − 934 syms_of_dired (void)
+ − 935 {
563
+ − 936 DEFSYMBOL (Qdirectory_files);
+ − 937 DEFSYMBOL (Qfile_name_completion);
+ − 938 DEFSYMBOL (Qfile_name_all_completions);
+ − 939 DEFSYMBOL (Qfile_attributes);
428
+ − 940
+ − 941 DEFSUBR (Fdirectory_files);
+ − 942 DEFSUBR (Ffile_name_completion);
+ − 943 DEFSUBR (Ffile_name_all_completions);
+ − 944 DEFSUBR (Fuser_name_completion);
+ − 945 DEFSUBR (Fuser_name_completion_1);
+ − 946 DEFSUBR (Fuser_name_all_completions);
+ − 947 DEFSUBR (Ffile_attributes);
+ − 948 }
+ − 949
+ − 950 void
+ − 951 vars_of_dired (void)
+ − 952 {
+ − 953 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
+ − 954 *Completion ignores filenames ending in any string in this list.
+ − 955 This variable does not affect lists of possible completions,
+ − 956 but does affect the commands that actually do completions.
770
+ − 957 It is used by the function `file-name-completion'.
428
+ − 958 */ );
+ − 959 Vcompletion_ignored_extensions = Qnil;
+ − 960 }
