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