[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 0806075 1/3: Add directory-empty-p and new argument COUNT for dir
|
From: |
Michael Albinus |
|
Subject: |
master 0806075 1/3: Add directory-empty-p and new argument COUNT for directory-files-* |
|
Date: |
Mon, 2 Nov 2020 11:56:15 -0500 (EST) |
branch: master
commit 0806075520939d120a47113f1c121e3d63b34770
Author: Arthur Miller <arthur.miller@live.com>
Commit: Michael Albinus <michael.albinus@gmx.de>
Add directory-empty-p and new argument COUNT for directory-files-*
* doc/lispref/files.texi (Contents of Directories): Mention COUNT
argument of directory-files. Add directory-empty-p.
* etc/NEWS: Mention directory-empty-p and directory-files changes.
* lisp/dired.el (directory-empty-p): New defun.
* lisp/net/ange-ftp.el (ange-ftp-directory-files)
(ange-ftp-directory-files-and-attributes):
* lisp/net/tramp.el (tramp-handle-directory-files)
(tramp-handle-directory-files-and-attributes):
* lisp/net/tramp-adb.el
(tramp-adb-handle-directory-files-and-attributes):
* lisp/net/tramp-rclone.el (tramp-rclone-handle-directory-files):
* lisp/net/tramp-sh.el (tramp-sh-handle-directory-files-and-attributes):
* lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Add new COUNT
argument.
* src/dired.c (directory_files_internal): Implement new
RETURN_COUNT argument.
(Fdirectory_files, Fdirectory_files_and_attributes): Add new COUNT
argument.
* src/lisp.h (directory_files_internal): Add RETURN_COUNT to declaration.
* src/sysdep.c (list_system_processes): Add Qnil to
directory_files_internal call.
* test/src/dired-tests.el (directory-files-and-attributes-tests):
New file.
---
doc/lispref/files.texi | 20 +++++++++
etc/NEWS | 11 +++++
lisp/dired.el | 14 +++++++
lisp/net/ange-ftp.el | 15 +++----
lisp/net/tramp-adb.el | 22 ++++++----
lisp/net/tramp-rclone.el | 4 +-
lisp/net/tramp-sh.el | 7 ++--
lisp/net/tramp-smb.el | 7 +++-
lisp/net/tramp.el | 12 ++++--
src/dired.c | 43 +++++++++++++------
src/lisp.h | 2 +-
src/sysdep.c | 3 +-
test/src/dired-tests.el | 105 +++++++++++++++++++++++++++++++++++++++++++++++
13 files changed, 225 insertions(+), 40 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index fc66d1c..f707fde 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2937,6 +2937,10 @@ you want the utmost possible speed and don't care what
order the files
are processed in. If the order of processing is visible to the user,
then the user will probably be happier if you do sort the names.
+If @var{count} is non-@code{nil}, the function will return names of
+first @var{count} number of files, or names of all files, whichever
+occurs first. @var{count} has to be an integer greater than zero.
+
@example
@group
(directory-files "~lewis")
@@ -2950,6 +2954,22 @@ An error is signaled if @var{directory} is not the name
of a directory
that can be read.
@end defun
+@defun directory-empty-p filename
+This utility function returns t if given @var{filename} is an
+accessible directory and it does not contain any files, i.e. is an
+empty directory. It will ignore '.' and '..' on systems that returns
+them as files in a directory.
+
+As a special case, this function will also return t if
+FILENAME is the empty string (""). This quirk is due to Emacs
+interpreting the empty string (in some cases) as the current
+directory.
+
+Symbolic links to directories count as directories.
+See @var{file-symlink-p} to distinguish symlinks.
+
+@end defun
+
@cindex recursive traverse of directory tree
@defun directory-files-recursively directory regexp &optional
include-directories predicate follow-symlinks
Return all files under @var{directory} whose names match @var{regexp}.
diff --git a/etc/NEWS b/etc/NEWS
index 59a0f26..6c4f1b2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1724,6 +1724,17 @@ This function returns the list of file names of all the
backup files
of its file argument.
+++
+** New utility function 'directory-empty-p'.
+This predicate tests whether a given filename is an accessible
+directory and whether it contains no other directories or files.
+
++++
+** 'directory-files' now takes an additional COUNT parameter.
+The parameter makes 'directory-files' return COUNT first file names
+from a directory. If MATCH is also given, the function will return
+first COUNT file names that match the expression.
+
++++
** The 'count-lines' function now takes an optional parameter to
ignore invisible lines.
diff --git a/lisp/dired.el b/lisp/dired.el
index 08b19a0..5ac2f20 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3016,6 +3016,20 @@ dired-buffers."
;; Tree Dired
;;; utility functions
+(defun directory-empty-p (filename)
+ "Return t if FILENAME names an existing directory containing no
+other files. Return nil if FILENAME does not name a directory, or if
+there was trouble determining whether DIRECTORYNAME is a directory or empty.
+
+As a special case, this function will also return t if FILENAME is the
+empty string (\"\"). This quirk is due to Emacs interpreting the
+empty string (in some cases) as the current directory.
+
+Symbolic links to directories count as directories.
+See `file-symlink-p' to distinguish symlinks. "
+ (and (file-directory-p filename)
+ (null (directory-files
+ filename nil directory-files-no-dot-files-regexp t 1))))
(defun dired-in-this-tree-p (file dir)
;;"Is FILE part of the directory tree starting at DIR?"
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 0cb8d7c..7ce9050 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -3427,8 +3427,7 @@ system TYPE.")
(and (file-directory-p name)
(file-readable-p name)))
-(defun ange-ftp-directory-files (directory &optional full match
- &rest v19-args)
+(defun ange-ftp-directory-files (directory &optional full match nosort count)
(setq directory (expand-file-name directory))
(if (ange-ftp-ftp-name directory)
(progn
@@ -3443,19 +3442,21 @@ system TYPE.")
(if (or (not match) (string-match-p match f))
(setq files
(cons (if full (concat directory f) f) files))))
- (nreverse files)))
- (apply 'ange-ftp-real-directory-files directory full match v19-args)))
+ (nreverse files))
+ (when (natnump count)
+ (setq files (last files count))))
+ (apply 'ange-ftp-real-directory-files directory full match nosort count)))
(defun ange-ftp-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
(setq directory (expand-file-name directory))
(if (ange-ftp-ftp-name directory)
(mapcar
(lambda (file)
(cons file (file-attributes (expand-file-name file directory))))
- (ange-ftp-directory-files directory full match nosort))
+ (ange-ftp-directory-files directory full match nosort count))
(ange-ftp-real-directory-files-and-attributes
- directory full match nosort id-format)))
+ directory full match nosort id-format count)))
(defun ange-ftp-file-attributes (file &optional id-format)
(setq file (expand-file-name file))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3d3b955..e8dbe16 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -301,7 +301,7 @@ ARGUMENTS to pass to the OPERATION."
file-properties)))
(defun tramp-adb-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -311,8 +311,8 @@ ARGUMENTS to pass to the OPERATION."
(with-parsed-tramp-file-name (expand-file-name directory) nil
(copy-tree
(with-tramp-file-property
- v localname (format "directory-files-and-attributes-%s-%s-%s-%s"
- full match id-format nosort)
+ v localname (format "directory-files-and-attributes-%s-%s-%s-%s-%s"
+ full match id-format nosort count)
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
v (format "%s -a -l %s"
@@ -342,11 +342,17 @@ ARGUMENTS to pass to the OPERATION."
(unless nosort
(setq result
(sort result (lambda (x y) (string< (car x) (car y))))))
- (delq nil
- (mapcar (lambda (x)
- (if (or (not match) (string-match-p match (car x)))
- x))
- result)))))))))
+
+ (setq result (delq nil
+ (mapcar (lambda (x) (if (or (not match)
+ (string-match-p
+ match (car x)))
+ x)) result)))
+ (when (natnump count)
+ (setq result (last result count))
+ (nreverse result))
+
+ result)))))))
(defun tramp-adb-get-ls-command (vec)
"Determine `ls' command and its arguments."
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3701bfc..1a7b060 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -301,7 +301,7 @@ file names."
(tramp-rclone-flush-directory-cache v)))
(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -312,7 +312,7 @@ file names."
(with-parsed-tramp-file-name directory nil
(let ((result
(directory-files
- (tramp-rclone-local-file-name directory) full match)))
+ (tramp-rclone-local-file-name directory) full match count)))
;; Massage the result.
(when full
(let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 860641b..7afd6fa 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1701,9 +1701,8 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-get-remote-gid v 'integer)))))))))
;; Directory listings.
-
(defun tramp-sh-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(unless (file-exists-p directory)
@@ -1743,8 +1742,9 @@ ID-FORMAT valid values are `string' and `integer'."
(sort result (lambda (x y) (string< (car x) (car y)))))
;; The scripts could fail, for example with huge file size.
(tramp-handle-directory-files-and-attributes
- directory full match nosort id-format)))))
+ directory full match nosort id-format count)))))
+;; FIXME Fix function to work with count parameter.
(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using a Perl
script."
@@ -1760,6 +1760,7 @@ ID-FORMAT valid values are `string' and `integer'."
(when (stringp object) (tramp-error vec 'file-error object))
object))
+;; FIXME Fix function to work with count parameter.
(defun tramp-do-directory-files-and-attributes-with-stat
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using stat(1)
command."
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c236e1c..b3b6a94 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -689,7 +689,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-error v 'file-error "%s `%s'" (match-string 0)
filename)))))))
(defun tramp-smb-handle-directory-files
- (directory &optional full match nosort)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -703,6 +703,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(delete nil
(mapcar (lambda (x) (when (string-match-p match x) x))
result))))
+
+ ;; return count number of results
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
;; Prepend directory.
(when full
(setq result
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f396647..25fa975 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3116,7 +3116,7 @@ User is always nil."
(setq directory (substring directory 0 -1)))
directory)
-(defun tramp-handle-directory-files (directory &optional full match nosort)
+(defun tramp-handle-directory-files (directory &optional full match nosort
count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -3132,16 +3132,20 @@ User is always nil."
(when (or (null match) (string-match-p match item))
(push (if full (concat directory item) item)
result)))
- (if nosort result (sort result #'string<)))))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (natnump count)
+ (setq result (last file count))
+ (nreverse files)))))
(defun tramp-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(mapcar
(lambda (x)
(cons x (file-attributes
(if full x (expand-file-name x directory)) id-format)))
- (directory-files directory full match nosort)))
+ (directory-files directory full match nosort count)))
(defun tramp-handle-dired-uncache (dir)
"Like `dired-uncache' for Tramp files."
diff --git a/src/dired.c b/src/dired.c
index 8256f26..120934b 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -165,8 +165,16 @@ read_dirent (DIR *dir, Lisp_Object dirname)
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
- Lisp_Object id_format)
+ Lisp_Object id_format, Lisp_Object return_count)
{
+ ptrdiff_t ind = 0, last = MOST_POSITIVE_FIXNUM;
+
+ if (!NILP(return_count))
+ {
+ CHECK_FIXNAT(return_count);
+ last = XFIXNAT (return_count);
+ }
+
if (!NILP (match))
CHECK_STRING (match);
@@ -267,6 +275,10 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
else
finalname = name;
+ if (ind == last)
+ break;
+ ind ++;
+
list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list);
}
@@ -288,7 +300,7 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
}
-DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
+DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 5, 0,
doc: /* Return a list of names of files in DIRECTORY.
There are three optional arguments:
If FULL is non-nil, return absolute file names. Otherwise return names
@@ -297,9 +309,11 @@ If MATCH is non-nil, mention only file names whose
non-directory part
matches the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
Otherwise, the list returned is sorted with `string-lessp'.
- NOSORT is useful if you plan to sort the result yourself. */)
+ NOSORT is useful if you plan to sort the result yourself.
+If COUNT is non-nil and a natural number, the function will return
+ COUNT number of file names (if so many are present). */)
(Lisp_Object directory, Lisp_Object full, Lisp_Object match,
- Lisp_Object nosort)
+ Lisp_Object nosort, Lisp_Object count)
{
directory = Fexpand_file_name (directory, Qnil);
@@ -307,14 +321,15 @@ If NOSORT is non-nil, the list is not sorted--its order
is unpredictable.
call the corresponding file name handler. */
Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files);
if (!NILP (handler))
- return call5 (handler, Qdirectory_files, directory,
- full, match, nosort);
+ return call6 (handler, Qdirectory_files, directory,
+ full, match, nosort, count);
- return directory_files_internal (directory, full, match, nosort, false,
Qnil);
+ return directory_files_internal (directory, full, match, nosort,
+ false, Qnil, count);
}
DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
- Sdirectory_files_and_attributes, 1, 5, 0,
+ Sdirectory_files_and_attributes, 1, 6, 0,
doc: /* Return a list of names of files and their attributes in
DIRECTORY.
Value is a list of the form:
@@ -333,9 +348,11 @@ If NOSORT is non-nil, the list is not sorted--its order is
unpredictable.
ID-FORMAT specifies the preferred format of attributes uid and gid, see
`file-attributes' for further documentation.
On MS-Windows, performance depends on `w32-get-true-file-attributes',
-which see. */)
+which see.
+If COUNT is non-nil and a natural number, the function will return
+ COUNT number of file names (if so many are present). */)
(Lisp_Object directory, Lisp_Object full, Lisp_Object match,
- Lisp_Object nosort, Lisp_Object id_format)
+ Lisp_Object nosort, Lisp_Object id_format, Lisp_Object count)
{
directory = Fexpand_file_name (directory, Qnil);
@@ -344,11 +361,11 @@ which see. */)
Lisp_Object handler
= Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
if (!NILP (handler))
- return call6 (handler, Qdirectory_files_and_attributes,
- directory, full, match, nosort, id_format);
+ return call7 (handler, Qdirectory_files_and_attributes,
+ directory, full, match, nosort, id_format, count);
return directory_files_internal (directory, full, match, nosort,
- true, id_format);
+ true, id_format, count);
}
diff --git a/src/lisp.h b/src/lisp.h
index 45353fb..a3cfb50 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4612,7 +4612,7 @@ extern void syms_of_ccl (void);
extern void syms_of_dired (void);
extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
- bool, Lisp_Object);
+ bool, Lisp_Object, Lisp_Object);
/* Defined in term.c. */
extern int *char_ins_del_vector;
diff --git a/src/sysdep.c b/src/sysdep.c
index f6c0dde..a96de2c 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2892,7 +2892,8 @@ list_system_processes (void)
process. */
procdir = build_string ("/proc");
match = build_string ("[0-9]+");
- proclist = directory_files_internal (procdir, Qnil, match, Qt, false, Qnil);
+ proclist = directory_files_internal (procdir, Qnil, match, Qt,
+ false, Qnil, Qnil);
/* `proclist' gives process IDs as strings. Destructively convert
each string into a number. */
diff --git a/test/src/dired-tests.el b/test/src/dired-tests.el
new file mode 100644
index 0000000..3beb513
--- /dev/null
+++ b/test/src/dired-tests.el
@@ -0,0 +1,105 @@
+;;; dired-tests.el --- Tests for directory-files in dired.c -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Arthur Miller <arthur.miller@live.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These tests check mostly for correct behaviour with COUNT argument.
+
+;;; Code:
+(require 'ert)
+
+(ert-deftest directory-files-tests ()
+ (let ((testdir (expand-file-name "directory-files-test"
+ (temporary-file-directory)))
+ (nod directory-files-no-dot-files-regexp))
+ (unwind-protect
+ (progn
+ (when (file-directory-p testdir)
+ (delete-directory testdir t))
+
+ (make-directory testdir)
+ (when (file-directory-p testdir)
+ ;; directory-empty-p: test non-existent dir
+ (should-not (directory-empty-p "some-imaginary-dir"))
+ (should (= 2 (length (directory-files testdir))))
+ ;; directory-empty-p: test empty dir
+ (should (directory-empty-p testdir))
+ (should-not (directory-files testdir nil nod t 1))
+ (dolist (file '(a b c d))
+ (make-empty-file (expand-file-name (symbol-name file) testdir)))
+ (should (= 6 (length (directory-files testdir))))
+ (should (equal "abcd" (mapconcat 'identity (directory-files
+ testdir nil nod) "")))
+ (should (= 2 (length (directory-files testdir nil "[bc]"))))
+ (should (= 3 (length (directory-files testdir nil nod nil 3))))
+ (dolist (file '(5 4 3 2 1))
+ (make-empty-file (expand-file-name (number-to-string
+ file) testdir)))
+ ;;(should (= 0 (length (directory-files testdir nil "[0-9]" t
-1))))
+ (should (= 5 (length (directory-files testdir nil "[0-9]" t))))
+ (should (= 5 (length (directory-files testdir nil "[0-9]" t 50))))
+ (should-not (directory-empty-p testdir)))
+
+ (delete-directory testdir t)))))
+
+(ert-deftest directory-files-and-attributes-tests ()
+ (let ((testdir (expand-file-name "directory-files-test"
+ (temporary-file-directory)))
+ (nod directory-files-no-dot-files-regexp))
+
+ (unwind-protect
+ (progn
+ (when (file-directory-p testdir)
+ (delete-directory testdir t))
+
+ (make-directory testdir)
+ (when (file-directory-p testdir)
+ (should (= 2 (length (directory-files testdir))))
+ (should-not (directory-files-and-attributes testdir t nod t 1))
+ (dolist (file '(a b c d))
+ (make-directory (expand-file-name (symbol-name file) testdir)))
+ (should (= 6 (length (directory-files-and-attributes testdir))))
+ (dolist (dir (directory-files-and-attributes testdir t nod))
+ (should (file-directory-p (car dir)))
+ (should-not (file-regular-p (car dir))))
+ (should (= 2 (length
+ (directory-files-and-attributes testdir nil
+ "[bc]"))))
+ (should (= 3 (length
+ (directory-files-and-attributes testdir nil nod
+ nil nil 3))))
+ (dolist (file '(5 4 3 2 1))
+ (make-empty-file (expand-file-name (number-to-string file)
+ testdir)))
+ ;; (should (= 0 (length (directory-files-and-attributes testdir nil
+ ;; "[0-9]" t
+ ;; nil -1))))
+ (should (= 5 (length
+ (directory-files-and-attributes testdir nil
+ "[0-9]" t))))
+ (should (= 5 (length
+ (directory-files-and-attributes testdir nil
+ "[0-9]" t
+ nil 50))))))
+ (when (file-directory-p testdir)
+ (delete-directory testdir t)))))
+
+(provide 'dired-tests)
+;;; dired-tests.el ends here