Mercurial > hg > xemacs-beta

comparison src/dired.c @ 209:41ff10fd062f r20-4b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents a2f645c6b9f8
children 262b8bb4a523
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
38 Lisp_Object Qfile_name_completion; 38 Lisp_Object Qfile_name_completion;
39 Lisp_Object Qfile_name_all_completions; 39 Lisp_Object Qfile_name_all_completions;
40 Lisp_Object Qfile_attributes; 40 Lisp_Object Qfile_attributes;
41 41
42 static Lisp_Object 42 static Lisp_Object
43 close_directory_fd (Lisp_Object unwind_obj) 43 close_directory_unwind (Lisp_Object unwind_obj)
44 { 44 {
45 DIR *d = (DIR *)get_opaque_ptr (unwind_obj); 45 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
46 closedir (d); 46 closedir (d);
47 free_opaque_ptr (unwind_obj); 47 free_opaque_ptr (unwind_obj);
48 return Qnil; 48 return Qnil;
122 now there is. */ 122 now there is. */
123 d = opendir ((char *) XSTRING_DATA (dirfilename)); 123 d = opendir ((char *) XSTRING_DATA (dirfilename));
124 if (! d) 124 if (! d)
125 report_file_error ("Opening directory", list1 (dirname)); 125 report_file_error ("Opening directory", list1 (dirname));
126 126
127 record_unwind_protect (close_directory_fd, make_opaque_ptr ((void *)d)); 127 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
128 128
129 list = Qnil; 129 list = Qnil;
130 130
131 /* Loop reading blocks */ 131 /* Loop reading blocks */
132 while (1) 132 while (1)
149 struct stat st; 149 struct stat st;
150 char *cur_statbuf = statbuf; 150 char *cur_statbuf = statbuf;
151 char *cur_statbuf_tail = statbuf_tail; 151 char *cur_statbuf_tail = statbuf_tail;
152 152
153 /* A trick: we normally use the buffer created by 153 /* A trick: we normally use the buffer created by
154 alloca. However, if the filename is too big 154 alloca. However, if the filename is too big
155 (meaning MAXNAMLEN lies on the system), we'll use 155 (meaning MAXNAMLEN is wrong or useless on the
156 a malloced buffer, and free it. */ 156 system), we'll use a malloced buffer, and free
157 it. */
157 if (len > MAXNAMLEN) 158 if (len > MAXNAMLEN)
158 { 159 {
159 cur_statbuf = (char *) xmalloc (name_as_dir_length 160 cur_statbuf = (char *) xmalloc (name_as_dir_length
160 + len + 1); 161 + len + 1);
161 memcpy (cur_statbuf, statbuf, name_as_dir_length); 162 memcpy (cur_statbuf, statbuf, name_as_dir_length);
178 continue; 179 continue;
179 } 180 }
180 181
181 if (!NILP (full)) 182 if (!NILP (full))
182 name = concat2 (name_as_dir, 183 name = concat2 (name_as_dir,
183 make_string ((Bufbyte *)dp->d_name, len)); 184 make_ext_string ((Bufbyte *)dp->d_name,
185 len, FORMAT_BINARY));
184 else 186 else
185 name = make_string ((Bufbyte *)dp->d_name, len); 187 name = make_ext_string ((Bufbyte *)dp->d_name,
188 len, FORMAT_BINARY);
186 189
187 list = Fcons (name, list); 190 list = Fcons (name, list);
188 } 191 }
189 } 192 }
190 } 193 }
267 Bytecount pos = XSTRING_LENGTH (dirname); 270 Bytecount pos = XSTRING_LENGTH (dirname);
268 int value; 271 int value;
269 char *fullname = (char *) alloca (len + pos + 2); 272 char *fullname = (char *) alloca (len + pos + 2);
270 273
271 memcpy (fullname, XSTRING_DATA (dirname), pos); 274 memcpy (fullname, XSTRING_DATA (dirname), pos);
272 #ifndef VMS
273 if (!IS_DIRECTORY_SEP (fullname[pos - 1])) 275 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
274 fullname[pos++] = DIRECTORY_SEP; 276 fullname[pos++] = DIRECTORY_SEP;
275 #endif
276 277
277 memcpy (fullname + pos, dp->d_name, len); 278 memcpy (fullname + pos, dp->d_name, len);
278 fullname[pos + len] = 0; 279 fullname[pos + len] = 0;
279 280
280 #ifdef S_IFLNK 281 #ifdef S_IFLNK
308 309
309 GCPRO3 (file, dirname, bestmatch); 310 GCPRO3 (file, dirname, bestmatch);
310 311
311 CHECK_STRING (file); 312 CHECK_STRING (file);
312 313
314 /* #### The following is valid not only for VMS, but for NT too. */
313 #ifdef VMS 315 #ifdef VMS
314 /* Filename completion on VMS ignores case, since VMS filesys does. */ 316 /* Filename completion on VMS ignores case, since VMS filesys does. */
315 specbind (Qcompletion_ignore_case, Qt); 317 specbind (Qcompletion_ignore_case, Qt);
316 318
317 if (ver_flag) 319 if (ver_flag)
522 { 524 {
523 while ((dp = readdir (d))) 525 while ((dp = readdir (d)))
524 { 526 {
525 len = NAMLEN (dp); 527 len = NAMLEN (dp);
526 if (DIRENTRY_NONEMPTY (dp)) 528 if (DIRENTRY_NONEMPTY (dp))
527 Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash); 529 Fputhash (make_ext_string ((Bufbyte *) dp->d_name, len,
530 FORMAT_BINARY), Qt, hash);
528 } 531 }
529 closedir (d); 532 closedir (d);
530 } 533 }
531 return hash; 534 return hash;
532 } 535 }
533
534 #ifdef VMS
535
536 DEFUN ("file-name-all-versions", Ffile_name_all_versions, 2, 2, 0, /*
537 Return a list of all versions of file name FILE in directory DIR.
538 */
539 (file, dirname))
540 {
541 /* This function can GC */
542 return file_name_completion (file, dirname, 1, 1);
543 }
544
545 DEFUN ("file-version-limit", Ffile_version_limit, 1, 1, 0, /*
546 Return the maximum number of versions allowed for FILE.
547 Returns nil if the file cannot be opened or if there is no version limit.
548 */
549 (filename))
550 {
551 /* This function can GC */
552 Lisp_Object retval;
553 struct FAB fab;
554 struct RAB rab;
555 struct XABFHC xabfhc;
556 int status;
557
558 filename = Fexpand_file_name (filename, Qnil);
559 CHECK_STRING (filename);
560 fab = cc$rms_fab;
561 xabfhc = cc$rms_xabfhc;
562 fab.fab$l_fna = XSTRING_DATA (filename);
563 fab.fab$b_fns = strlen (fab.fab$l_fna);
564 fab.fab$l_xab = (char *) &xabfhc;
565 status = sys$open (&fab, 0, 0);
566 if (status != RMS$_NORMAL) /* Probably non-existent file */
567 return Qnil;
568 sys$close (&fab, 0, 0);
569 if (xabfhc.xab$w_verlimit == 32767)
570 return Qnil; /* No version limit */
571 else
572 return make_int (xabfhc.xab$w_verlimit);
573 }
574
575 #endif /* VMS */
576
577 536
578 Lisp_Object 537 Lisp_Object
579 wasteful_word_to_lisp (unsigned int item) 538 wasteful_word_to_lisp (unsigned int item)
580 { 539 {
581 /* Compatibility: in other versions, file-attributes returns a LIST 540 /* Compatibility: in other versions, file-attributes returns a LIST
711 defsymbol (&Qfile_name_all_completions, "file-name-all-completions"); 670 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
712 defsymbol (&Qfile_attributes, "file-attributes"); 671 defsymbol (&Qfile_attributes, "file-attributes");
713 672
714 DEFSUBR (Fdirectory_files); 673 DEFSUBR (Fdirectory_files);
715 DEFSUBR (Ffile_name_completion); 674 DEFSUBR (Ffile_name_completion);
716 #ifdef VMS
717 DEFSUBR (Ffile_name_all_versions);
718 DEFSUBR (Ffile_version_limit);
719 #endif /* VMS */
720 DEFSUBR (Ffile_name_all_completions); 675 DEFSUBR (Ffile_name_all_completions);
721 DEFSUBR (Ffile_attributes); 676 DEFSUBR (Ffile_attributes);
722 } 677 }
723 678
724 void 679 void