From: Michael Albinus Date: Mon, 2 Nov 2020 16:56:06 +0000 (+0100) Subject: Fix some glitches in recent directory-files-* changes X-Git-Tag: emacs-28.0.90~5286 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e654b41c6f9eae424736bc8845d92b9dd97ccd3e;p=emacs.git Fix some glitches in recent directory-files-* changes * doc/lispref/files.texi (Contents of Directories): Fix description of directory-files, directory-empty-p and directory-files-and-attributes. * etc/NEWS: Fix entry for directory-files-and-attributes. Fix typos. * lisp/dired.el (directory-empty-p): Move function from here ... * lisp/files.el (directory-empty-p): ... to here. * lisp/net/ange-ftp.el (ange-ftp-directory-files): Call `nreverse' later. * lisp/net/tramp.el (tramp-handle-directory-files): * lisp/net/tramp-adb.el (tramp-adb-handle-directory-files-and-attributes): Do not call `nreverse'. * src/dired.c (Fdirectory_files) (Fdirectory_files_and_attributes): Fix docstrings. * test/src/dired-tests.el: Removed. Tests moved to test/lisp/dired-tests.el. * test/lisp/dired-tests.el (dired-test-bug27899): Tag it :unstable. (dired-test-directory-files) (dired-test-directory-files-and-attributes): New tests. --- diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index f707fde88a8..d49ac42bb46 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2917,7 +2917,7 @@ or display the names in a buffer using the @code{ls} shell command. In the latter case, it can optionally display information about each file, depending on the options passed to the @code{ls} command. -@defun directory-files directory &optional full-name match-regexp nosort +@defun directory-files directory &optional full-name match-regexp nosort count This function returns a list of the names of the files in the directory @var{directory}. By default, the list is in alphabetical order. @@ -2954,20 +2954,14 @@ 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. +@defun directory-empty-p directory +This utility function returns @code{t} if given @var{directory} is an +accessible directory and it does not contain any files, i.e., is an +empty directory. It will ignore @samp{.} and @samp{..} on systems +that return them as files in a directory. Symbolic links to directories count as directories. See @var{file-symlink-p} to distinguish symlinks. - @end defun @cindex recursive traverse of directory tree @@ -3016,7 +3010,7 @@ is called with one argument (the file or directory) and should return non-@code{nil} if that directory is the one it is looking for. @end defun -@defun directory-files-and-attributes directory &optional full-name match-regexp nosort id-format +@defun directory-files-and-attributes directory &optional full-name match-regexp nosort id-format count This is similar to @code{directory-files} in deciding which files to report on and how to report their names. However, instead of returning a list of file names, it returns for each file a diff --git a/etc/NEWS b/etc/NEWS index 5fbe0755fed..4ddb1924935 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1704,34 +1704,34 @@ argument 'ellipsis', will now indicate truncation using '…' when the selected frame can display it, and using "..." otherwise. +++ -*** New command 'make-directory-autoloads'. +** New command 'make-directory-autoloads'. This does the same as the old command 'update-directory-autoloads', but has different semantics: Instead of passing in the output file via the dynamically bound 'generated-autoload-file' variable, the output file is now a explicit parameter. +++ -*** New function 'string-search'. +** New function 'string-search'. This function takes two string parameters and returns the position of the first instance of the former string in the latter. +++ -*** New function 'string-replace'. +** New function 'string-replace'. This function works along the line of 'replace-regexp-in-string', but matching on strings instead of regexps, and does not change the global match state. +++ -*** New function 'process-lines-ignore-status'. +** New function 'process-lines-ignore-status'. This is like 'process-lines', but does not signal an error if the return status is non-zero. 'process-lines-handling-status' has also been added, and takes a callback to handle the return status. --- -*** 'ascii' is now a coding system alias for 'us-ascii'. +** 'ascii' is now a coding system alias for 'us-ascii'. +++ -*** New function 'file-backup-file-names'. +** New function 'file-backup-file-names'. This function returns the list of file names of all the backup files of its file argument. @@ -1744,7 +1744,8 @@ 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. +first COUNT file names that match the expression. The same COUNT +parameter has been added to 'directory-files-and-attributes'. +++ ** The 'count-lines' function now takes an optional parameter to diff --git a/lisp/dired.el b/lisp/dired.el index 5ac2f203347..08b19a02250 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3016,20 +3016,6 @@ 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/files.el b/lisp/files.el index 59bcc3e8a78..e55552a2d9a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -888,6 +888,16 @@ recursion." (push (concat dir "/" file) files))))) (nconc result (nreverse files)))) +(defun directory-empty-p (dir) + "Return t if DIR names an existing directory containing no other files. +Return nil if DIR does not name a directory, or if there was +trouble determining whether DIR is a directory or empty. + +Symbolic links to directories count as directories. +See `file-symlink-p' to distinguish symlinks." + (and (file-directory-p dir) + (null (directory-files dir nil directory-files-no-dot-files-regexp t 1)))) + (defvar module-file-suffix) (defun load-file (file) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 7ce90504ba3..15322219eff 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3442,9 +3442,9 @@ system TYPE.") (if (or (not match) (string-match-p match f)) (setq files (cons (if full (concat directory f) f) files)))) - (nreverse files)) - (when (natnump count) - (setq files (last files count)))) + (when (natnump count) + (setq files (last files count))) + (nreverse files))) (apply 'ange-ftp-real-directory-files directory full match nosort count))) (defun ange-ftp-directory-files-and-attributes diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index e8dbe1618d0..8ccbe412f2b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -344,14 +344,14 @@ ARGUMENTS to pass to the OPERATION." (sort result (lambda (x y) (string< (car x) (car y)))))) (setq result (delq nil - (mapcar (lambda (x) (if (or (not match) - (string-match-p - match (car x))) - x)) result))) + (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)) - + (setq result (last result count))) result))))))) (defun tramp-adb-get-ls-command (vec) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7afd6fac47d..915ce2f6a65 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1701,6 +1701,7 @@ 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 count) "Like `directory-files-and-attributes' for Tramp files." @@ -1744,7 +1745,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-handle-directory-files-and-attributes directory full match nosort id-format count))))) -;; FIXME Fix function to work with count parameter. +;; 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,7 +1761,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. +;; 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 b3b6a94e9cc..3220e516050 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -704,7 +704,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapcar (lambda (x) (when (string-match-p match x) x)) result)))) - ;; return count number of results + ;; Return count number of results. (when (and (natnump count) (> count 0)) (setq result (nbutlast result (- (length result) count)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 25fa9754881..ce0a2b54ff5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3135,8 +3135,8 @@ User is always nil." (unless nosort (setq result (sort result #'string<))) (when (natnump count) - (setq result (last file count)) - (nreverse files))))) + (setq result (last result count))) + result))) (defun tramp-handle-directory-files-and-attributes (directory &optional full match nosort id-format count) diff --git a/src/dired.c b/src/dired.c index 120934bfe74..039dd68c177 100644 --- a/src/dired.c +++ b/src/dired.c @@ -169,9 +169,9 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, { ptrdiff_t ind = 0, last = MOST_POSITIVE_FIXNUM; - if (!NILP(return_count)) + if (!NILP (return_count)) { - CHECK_FIXNAT(return_count); + CHECK_FIXNAT (return_count); last = XFIXNAT (return_count); } @@ -302,7 +302,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, 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: +There are four optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. If MATCH is non-nil, mention only file names whose non-directory part @@ -338,7 +338,7 @@ Value is a list of the form: where each FILEn-ATTRS is the attributes of FILEn as returned by `file-attributes'. -This function accepts four optional arguments: +This function accepts five optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. If MATCH is non-nil, mention only file names whose non-directory part @@ -347,10 +347,10 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. NOSORT is useful if you plan to sort the result yourself. 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. If COUNT is non-nil and a natural number, the function will return - COUNT number of file names (if so many are present). */) + COUNT number of file names (if so many are present). +On MS-Windows, performance depends on `w32-get-true-file-attributes', +which see. */) (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format, Lisp_Object count) { diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index cec533ddfaa..66f8ed95b89 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -293,6 +293,7 @@ (ert-deftest dired-test-bug27899 () "Test for https://debbugs.gnu.org/27899 ." + :tags '(:unstable) (dired (list (expand-file-name "src" source-directory) "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c")) (let ((orig dired-hide-details-mode)) @@ -440,6 +441,81 @@ (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted. (advice-remove 'read-answer 'dired-test-bug27940-advice)))) +(ert-deftest dired-test-directory-files () + "Test for `directory-files'." + (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 dired-test-directory-files-and-attributes () + "Test for `directory-files-and-attributes'." + (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 diff --git a/test/src/dired-tests.el b/test/src/dired-tests.el deleted file mode 100644 index 3beb51366f7..00000000000 --- a/test/src/dired-tests.el +++ /dev/null @@ -1,105 +0,0 @@ -;;; dired-tests.el --- Tests for directory-files in dired.c -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Free Software Foundation, Inc. - -;; Author: Arthur Miller -;; 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 . - -;;; 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