From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Arthur Miller Newsgroups: gmane.emacs.devel Subject: Re: empty-directory predicate, native implementation Date: Sat, 17 Oct 2020 21:03:24 +0200 Message-ID: References: <83y2ka18t7.fsf@gnu.org> <87y2kaj799.fsf@gmx.de> <83blh60wgr.fsf@gnu.org> <87h7qxjh7g.fsf@gmx.de> <878sc8kgy8.fsf@gmx.de> <87imbcls71.fsf@gmx.de> <83eem0zt0b.fsf@gnu.org> <87k0vsrd6m.fsf@gmx.de> <83a6wozs7h.fsf@gnu.org> <87sgafq2e2.fsf@gmx.de> <87h7qvptm3.fsf@gmx.de> <871rhxp8we.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="12846"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: Eli Zaretskii , emacs-devel@gnu.org To: Michael Albinus Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sat Oct 17 21:04:38 2020 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kTrVN-0003DC-Q8 for ged-emacs-devel@m.gmane-mx.org; Sat, 17 Oct 2020 21:04:38 +0200 Original-Received: from localhost ([::1]:60686 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kTrVM-0002bl-R4 for ged-emacs-devel@m.gmane-mx.org; Sat, 17 Oct 2020 15:04:36 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:50462) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kTrUL-0001yH-WA for emacs-devel@gnu.org; Sat, 17 Oct 2020 15:03:34 -0400 Original-Received: from mail-vi1eur05olkn2058.outbound.protection.outlook.com ([40.92.90.58]:21785 helo=EUR05-VI1-obe.outbound.protection.outlook.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kTrUH-0002u6-NR; Sat, 17 Oct 2020 15:03:33 -0400 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=EWmZx2tWvMNtonthrnqPDOzajoCPbA4V99OeARNWVqIsU2oUsGSfrG6iWssL9LZotioSiAoEGMQY4iV8pYCEeJKozKo0/WqYFkeYgOwQ2CoqTiqSRIC5WzosiwM6fWs6IUJvBX7z+z32FX4055Z7OdZsJOaBkFipoBcQMVzwDOml9QlTcWKmnvbwbIsf2TMnDzyH/zmPiuj3Cw8TsqY99GgW6ZpetHpkH8WCiqrQ2ivL7+O52S3ZpIdRenUYltIGKxoC3wdj1lO6HsXcufUdDXvv5WXoTT4l4TRKfsHbhWtlP11kx9pbYYQdGdpvbCkDuA0TV0HPGrm3M4e6FguVsA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=NdOEiJqPUCt9+3ivJ17GXUuYPDk/Hhi+kBY2Pu8Er+U=; b=CTXjimHu8aBgRpcGrva30NghU/p//fGexAhvUkv+2UBpo+d7oGCpi7NkDbsWvW5Rc2Qr6/qyXs4aBL+qVMewQQb7MAOhdQuHpBU2ovxA5fZPkycKIZ643NR0JrHFuNZkspz6PdwUIQh+nV9mJxuPfmR5ywEPZpykhaTrtFhomlnc8aJXtY9NxjuyY0w9TXo5NMHfiyDncdun/Z1+GvmlUzwMp0zdAQJljZESGuEFcRDFBkbREPncd853A1Ujyvw2+N/f63H4ZgP4THWhWe2i7uXZ7oLVBaKuDFxIFoArd4rpyep7oFCw68LYlnXq1Ls0lpwJc5UiiqcvxAmraBVnfw== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=none; dmarc=none; dkim=none; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=live.com; s=selector1; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=NdOEiJqPUCt9+3ivJ17GXUuYPDk/Hhi+kBY2Pu8Er+U=; b=FkNwNGmQVsxfizvjb/5uW4pPXFEaAzeP5r5ibnR0nQBGVqrTfd+vHsoYXGKYR4p15UJAhH7O70akf6s5oMdcA6i9GoucOX7xhmV333KkW5D/LdorMXAYJkc+III5ojjdVmHf4WGZ9qFuIhDwGFHzsWCuaeAlNr4tAmokrTk3nLruNEBgMdn+qVxypWE9aE2x/tEEQqGoeD6YLbuD0pWEgh2Og+LDvtPYWdQ19FQb4dH4u39dcIzr2FZjWEf2WCIfbIdJF+M0U035NkCAvwIKRJKHV/G0tM7SObceVD80sbBg0nUcAZfL3dIwZsQZGu02iQwPH2OK+3YvmIEMcZwwAQ== Original-Received: from DB8EUR05FT012.eop-eur05.prod.protection.outlook.com (2a01:111:e400:fc0f::4f) by DB8EUR05HT166.eop-eur05.prod.protection.outlook.com (2a01:111:e400:fc0f::76) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.3477.23; Sat, 17 Oct 2020 19:03:26 +0000 Original-Received: from VI1PR06MB4526.eurprd06.prod.outlook.com (2a01:111:e400:fc0f::46) by DB8EUR05FT012.mail.protection.outlook.com (2a01:111:e400:fc0f::257) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.3477.21 via Frontend Transport; Sat, 17 Oct 2020 19:03:26 +0000 X-IncomingTopHeaderMarker: OriginalChecksum:A19F8385D3B22739983C0449C10A432890EF9ED8713606939259D9FD160D7B8C; UpperCasedChecksum:5A76154114925378DC460C4116D830684807E830444A061204F96C5D2F071FB7; SizeAsReceived:8310; Count:46 Original-Received: from VI1PR06MB4526.eurprd06.prod.outlook.com ([fe80::187b:196a:cb2d:adf1]) by VI1PR06MB4526.eurprd06.prod.outlook.com ([fe80::187b:196a:cb2d:adf1%5]) with mapi id 15.20.3477.023; Sat, 17 Oct 2020 19:03:26 +0000 In-Reply-To: <871rhxp8we.fsf@gmx.de> (Michael Albinus's message of "Sat, 17 Oct 2020 10:13:37 +0200") X-TMN: [w2NhLiFFtTjfP0cpDUubuiiKCEDEryBX] X-ClientProxiedBy: AM7PR04CA0027.eurprd04.prod.outlook.com (2603:10a6:20b:110::37) To VI1PR06MB4526.eurprd06.prod.outlook.com (2603:10a6:803:ac::17) X-Microsoft-Original-Message-ID: <87k0volloj.fsf@live.com> X-MS-Exchange-MessageSentRepresentingType: 1 Original-Received: from pascal.homepc (90.230.29.56) by AM7PR04CA0027.eurprd04.prod.outlook.com (2603:10a6:20b:110::37) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.3477.21 via Frontend Transport; Sat, 17 Oct 2020 19:03:25 +0000 X-MS-PublicTrafficType: Email X-IncomingHeaderCount: 46 X-EOPAttributedMessage: 0 X-MS-Office365-Filtering-Correlation-Id: 75c46ae6-e14b-4f86-5754-08d872cf5350 X-MS-TrafficTypeDiagnostic: DB8EUR05HT166: X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: z5ofKjRpJqfdVmrkT7qopUZ7oQmEYXs/4S55bfhhoqwmk4w8UJLxrBvSXcnH0FlEifXUucQ7da0FRZeXcsXodFgWUOGJ1f1HuuyufKc+VKCDJlHUutcVgAKURrLUDOEqvBU2qOABwCBqBq7lEZo8E9XJo7mkyEyGzbGtkQYhshqxm6TvKDpKfppzJrHSQCMOQKP/8eVyEOLx5BXFT82Wgw== X-MS-Exchange-AntiSpam-MessageData: rkAv/s0facAQtEdj3WrwufXQFevC34evWImRggslCkLfqXS/5lukgvWiw3QjDkuax1whrBZ+SvI003l2e6PFlaIk9B9gJCXuyBsVdGVRfR61SeZoX+Qi7yUGX1XT0UAdUiwRyyFEnx3CNsXmES+3ow== X-OriginatorOrg: live.com X-MS-Exchange-CrossTenant-Network-Message-Id: 75c46ae6-e14b-4f86-5754-08d872cf5350 X-MS-Exchange-CrossTenant-OriginalArrivalTime: 17 Oct 2020 19:03:25.9023 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: 84df9e7f-e9f6-40af-b435-aaaaaaaaaaaa X-MS-Exchange-CrossTenant-AuthSource: DB8EUR05FT012.eop-eur05.prod.protection.outlook.com X-MS-Exchange-CrossTenant-AuthAs: Anonymous X-MS-Exchange-CrossTenant-FromEntityHeader: Internet X-MS-Exchange-CrossTenant-RMS-PersistedConsumerOrg: 00000000-0000-0000-0000-000000000000 X-MS-Exchange-Transport-CrossTenantHeadersStamped: DB8EUR05HT166 Received-SPF: pass client-ip=40.92.90.58; envelope-from=arthur.miller@live.com; helo=EUR05-VI1-obe.outbound.protection.outlook.com X-detected-operating-system: by eggs.gnu.org: First seen = 2020/10/17 15:03:26 X-ACL-Warn: Detected OS = Windows NT kernel [generic] [fuzzy] X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, MSGID_FROM_MTA_HEADER=0.001, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:257963 Archived-At: --=-=-= Content-Type: text/plain Michael Albinus writes: > Arthur Miller writes: > > Hi Arthur, > >> I have patched handlers; which version should I make patches against: >> current master or latest stable? How would you like patches; each in own >> file? > > The patches shall be towards master. And I don't care, whether they are > just one file, or several ones :-) > >> I will look at ert tests too. > > Thanks. Best regards, Michael. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=directory-files.patch Content-Transfer-Encoding: quoted-printable diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 3b8b4fb3a9..2f15176e79 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2917,7 +2917,7 @@ Contents of Directories the latter case, it can optionally display information about each file, depending on the options passed to the @code{ls} command. =20 -@defun directory-files directory &optional full-name match-regexp nosort +@defun directory-files directory &optional full-name match-regexp nosort c= ount This function returns a list of the names of the files in the directory @var{directory}. By default, the list is in alphabetical order. =20 @@ -2937,6 +2937,13 @@ Contents of Directories 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. =20 +If @var{count} is non-@code{nil}, the function will return first +@var{count} number of files, or all files, whichever occurs +first. @var{count} has to be a natural number (> 0). You can use this +function to short circuit evaluation in case you are just interested to +find if a directory is empty or not (request one file and tell it to +ignore dot-files). + @example @group (directory-files "~lewis") @@ -2946,6 +2953,14 @@ Contents of Directories @end group @end example =20 +@example +@group + (null (directory-files directory-name nil + "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" t 1)) + @result{} nil +@end group +@end example + An error is signaled if @var{directory} is not the name of a directory that can be read. @end defun @@ -2996,7 +3011,7 @@ Contents of Directories non-@code{nil} if that directory is the one it is looking for. @end defun =20 -@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 1838b6b38a..25c54d3dfe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1550,6 +1550,13 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. =0C * Lisp Changes in Emacs 28.1 =20 ++++ +** 'diirectory-files' function can now take an additional count parameter +This option makes directory-files return COUNT first files in +directory. If match is given, the function vill return first COUNT files +that match the expression. The option is useful for checking if +directory is empty since it will check at most 3 files when COUNT =3D 1. + +++ ** 'truncate-string-ellipsis' now uses '=E2=80=A6' by default. Modes that use 'truncate-string-to-width' with non-nil, non-string diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 0cb8d7cb83..335a07914c 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3427,8 +3427,8 @@ ange-ftp-file-accessible-directory-p (and (file-directory-p name) (file-readable-p name))) =20 -(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 @@ -3444,18 +3444,19 @@ ange-ftp-directory-files (setq files (cons (if full (concat directory f) f) files)))) (nreverse files))) - (apply 'ange-ftp-real-directory-files directory full match v19-args))) + (apply 'ange-ftp-real-directory-files directory full match nosort coun= t))) =20 (defun ange-ftp-directory-files-and-attributes - (directory &optional full match nosort id-format) + (directory &optional full match nosort attrs 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 attrs + id_format count)) (ange-ftp-real-directory-files-and-attributes - directory full match nosort id-format))) + directory full match nosort attrs id-format count))) =20 (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 49ecaa58ee..26ec24a075 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -301,7 +301,7 @@ tramp-do-parse-file-attributes-with-ls file-properties))) =20 (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 @@ -312,7 +312,7 @@ tramp-adb-handle-directory-files-and-attributes (copy-tree (with-tramp-file-property v localname (format "directory-files-and-attributes-%s-%s-%s-%s" - full match id-format nosort) + 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" diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 3e96daa7b1..bda3735db4 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -667,7 +667,10 @@ tramp-crypt-handle-delete-file (let (tramp-crypt-enabled) (delete-file (tramp-crypt-encrypt-file-name filename) trash)))) =20 -(defun tramp-crypt-handle-directory-files (directory &optional full match = nosort) +;; This function does not seem to pass match and nosort into +;; directory-files at all; is that intentional or bug? +(defun tramp-crypt-handle-directory-files (directory &optional full + match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) (tramp-error diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 3701bfc22c..787eead807 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -300,8 +300,10 @@ tramp-rclone-handle-delete-file (tramp-flush-file-properties v localname) (tramp-rclone-flush-directory-cache v))) =20 +;; This function did not pass nosort arguemnt into directory-files +;; not sure if intentional or bug (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 +314,8 @@ tramp-rclone-handle-directory-files (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 + nosort 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 15eab0a4de..7a969979ac 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1701,9 +1701,9 @@ tramp-sh-handle-file-ownership-preserved-p (tramp-get-remote-gid v 'integer))))))))) =20 ;; Directory listings. - +;; what about perl & sta -> need to fix list to count? (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,7 +1743,7 @@ tramp-sh-handle-directory-files-and-attributes (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))))) =20 (defun tramp-do-directory-files-and-attributes-with-perl (vec localname &optional id-format) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1b6af2a2e3..62135f514d 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -690,29 +690,36 @@ tramp-smb-handle-delete-file v 'file-error "%s `%s'" (match-string 0) filename)))))) =20 (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 (tramp-dissect-file-name directory) tramp-file-missing "No such file or directory" directory)) - (let ((result (mapcar #'directory-file-name - (file-name-all-completions "" directory)))) - ;; Discriminate with regexp. - (when match - (setq result - (delete nil - (mapcar (lambda (x) (when (string-match-p match x) x)) - result)))) - ;; Prepend directory. - (when full - (setq result - (mapcar - (lambda (x) (format "%s/%s" (directory-file-name directory) x)) - result))) - ;; Sort them if necessary. - (unless nosort (setq result (sort result #'string-lessp))) - result)) + (let ((result nil) + (numres 0)) + (when (or (not count) (> count 0)) + (setq result (mapcar #'directory-file-name + (file-name-all-completions "" directory))) + ;; Discriminate with regexp. + (when match + (setq result + (delete nil + (mapcar (lambda (x) (when (string-match-p match x) x)) + result)))) + + ;; return [0,count) number of results + (setq result (cl-subseq result 0 count)) + + ;; Prepend directory. + (when full + (setq result + (mapcar + (lambda (x) (format "%s/%s" (directory-file-name directory) x)) + result))) + ;; Sort them if necessary. + (unless nosort (setq result (sort result #'string-lessp))) + result))) =20 (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6d44ad23ad..a99af70196 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3114,7 +3114,8 @@ tramp-handle-directory-file-name (setq directory (substring directory 0 -1))) directory) =20 -(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 @@ -3133,13 +3134,13 @@ tramp-handle-directory-files (if nosort result (sort result #'string<))))) =20 (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))) =20 (defun tramp-handle-dired-uncache (dir) "Like `dired-uncache' for Tramp files." diff --git a/src/dired.c b/src/dired.c index 1584b6acf0..1fc8dd27fa 100644 --- a/src/dired.c +++ b/src/dired.c @@ -17,7 +17,6 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ =20 - #include =20 #include @@ -165,8 +164,26 @@ 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 =3D 0, last =3D 0; + + /* check count first for early exit */ + if (FIXNUMP(return_count)) + { + last =3D XFIXNUM (return_count); + if (last <=3D 0) + return Qnil; + } + + if (FIXNATP(return_count)) + { + last =3D XFIXNAT(return_count); + + if (!last) + return Qnil; + } + if (!NILP (match)) CHECK_STRING (match); =20 @@ -267,6 +284,10 @@ directory_files_internal (Lisp_Object directory, Lisp_= Object full, else finalname =3D name; =20 + if (last && ind =3D=3D last) + break; + ind ++; + list =3D Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, li= st); } =20 @@ -287,8 +308,7 @@ directory_files_internal (Lisp_Object directory, Lisp_O= bject full, return list; } =20 - -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 @@ -296,9 +316,12 @@ DEFUN ("directory-files", Fdirectory_files, Sdirectory= _files, 1, 4, 0, If MATCH is non-nil, mention only file names that match 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, the function will return max of COUNT and length + files, where length is number of files in the directory. COUNT has to + be a natural number > 0. */) (Lisp_Object directory, Lisp_Object full, Lisp_Object match, - Lisp_Object nosort) + Lisp_Object nosort, Lisp_Object count) { directory =3D Fexpand_file_name (directory, Qnil); =20 @@ -306,34 +329,38 @@ DEFUN ("directory-files", Fdirectory_files, Sdirector= y_files, 1, 4, 0, call the corresponding file name handler. */ Lisp_Object handler =3D Ffind_file_name_handler (directory, Qdirectory_f= iles); if (!NILP (handler)) - return call5 (handler, Qdirectory_files, directory, - full, match, nosort); + return call6 (handler, Qdirectory_files, directory, + full, match, nosort, count); =20 - return directory_files_internal (directory, full, match, nosort, false, = Qnil); + return directory_files_internal (directory, full, match, nosort, + false, Qnil, count); } =20 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, - Sdirectory_files_and_attributes, 1, 5, 0, - doc: /* Return a list of names of files and their attributes in DIR= ECTORY. + Sdirectory_files_and_attributes, 1, 6, 0, doc + : /* Return a list of names of files and their attributes in DIRECT= ORY. Value is a list of the form: =20 - ((FILE1 . FILE1-ATTRS) (FILE2 . FILE2-ATTRS) ...) +((FILE1 . FILE1-ATTRS) (FILE2 . FILE2-ATTRS) ...) =20 where each FILEn-ATTRS is the attributes of FILEn as returned by `file-attributes'. =20 This function accepts four optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names - that are relative to the specified directory. +that are relative to the specified directory. If MATCH is non-nil, mention only file names that match the regexp MATCH. 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. +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. */) - (Lisp_Object directory, Lisp_Object full, Lisp_Object match, - Lisp_Object nosort, Lisp_Object id_format) +which see. +If COUNT is non-nil, the function will return max of COUNT and length + files, where length is number of files in the directory. COUNT has to + be a natural number > 0. */) +(Lisp_Object directory, Lisp_Object full, Lisp_Object match, + Lisp_Object nosort, Lisp_Object id_format, Lisp_Object count) { directory =3D Fexpand_file_name (directory, Qnil); =20 @@ -342,11 +369,11 @@ DEFUN ("directory-files-and-attributes", Fdirectory_f= iles_and_attributes, Lisp_Object handler =3D Ffind_file_name_handler (directory, Qdirectory_files_and_attribute= s); 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); =20 return directory_files_internal (directory, full, match, nosort, - true, id_format); + true, id_format, count); } =20 =0C diff --git a/src/lisp.h b/src/lisp.h index 45353fbef3..a3cfb5044d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4612,7 +4612,7 @@ maybe_disable_address_randomization (int argc, char *= *argv) 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_Objec= t); =20 /* Defined in term.c. */ extern int *char_ins_del_vector; diff --git a/src/sysdep.c b/src/sysdep.c index f6c0ddee01..9111f1863e 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2892,7 +2892,7 @@ list_system_processes (void) process. */ procdir =3D build_string ("/proc"); match =3D build_string ("[0-9]+"); - proclist =3D directory_files_internal (procdir, Qnil, match, Qt, false, = Qnil); + proclist =3D directory_files_internal (procdir, Qnil, match, Qt, false, = Qnil, Qnil); =20 /* `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 0000000000..3b739e59cc --- /dev/null +++ b/test/src/dired-tests.el @@ -0,0 +1,92 @@ +;;; dired-tests.el --- Tests for directory-files in dired.c -*- lexical-b= inding: t; -*- + +;; Copyright (C) 2015-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: + +;; + +;;; Code: +(require 'ert) + +(ert-deftest directory-files-tests () + (let ((name (expand-file-name "directory-files-test" + (temporary-file-directory))) + ;; nodots expression from dired+ by Drew A. + (nodots "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + + (message name) + (when (file-directory-p name) + (delete-directory name t)) + (make-directory name) + (when (file-directory-p name) + (should (=3D 2 (length (directory-files name)))) + (should-not (directory-files name nil nodots t 1)) + (dolist (file '(a b c d)) + (make-empty-file (expand-file-name (symbol-name file) name))) + (should (=3D 6 (length (directory-files name)))) + (should (equal "abcd" (string-join (directory-files name nil + nodots) ""))) + (should (=3D 2 (length (directory-files name nil "[bc]")))) + (should (=3D 3 (length (directory-files name nil nodots nil 3)))) + (dolist (file '(5 4 3 2 1)) + (make-empty-file (expand-file-name (number-to-string file) name))) + (should (=3D 0 (length (directory-files name nil "[0-9]" t -1)))) + (should (=3D 5 (length (directory-files name nil "[0-9]" t)))) + (should (=3D 5 (length (directory-files name nil "[0-9]" t 50)))) + ))) + +(ert-deftest directory-files-and-attributes-tests () + (let ((name (expand-file-name "directory-files-test" + (temporary-file-directory))) + ;; nodots expression from dired+ by Drew A. + (nodots "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + + (message name) + (when (file-directory-p name) + (delete-directory name t)) + (make-directory name) + (when (file-directory-p name) + (should (=3D 2 (length (directory-files name)))) + (should-not (directory-files-and-attributes name t nodots t 1)) + (dolist (file '(a b c d)) + (make-directory (expand-file-name (symbol-name file) name))) + (should (=3D 6 (length (directory-files-and-attributes name)))) + (dolist (dir (directory-files-and-attributes name t nodots)) + (should (file-directory-p (car dir))) + (should-not (file-regular-p (car dir)))) + (should (=3D 2 (length + (directory-files-and-attributes name nil "[bc]")))) + (should (=3D 3 (length + (directory-files-and-attributes name nil nodots + nil nil 3)))) + (dolist (file '(5 4 3 2 1)) + (make-empty-file (expand-file-name (number-to-string file) name))) + (should (=3D 0 (length + (directory-files-and-attributes name nil + "[0-9]" t 1 -1)))) + (should (=3D 5 (length + (directory-files-and-attributes name nil "[0-9]" t)))) + (should (=3D 5 (length + (directory-files-and-attributes name nil + "[0-9]" t nil 50)))) + ))) + +(provide 'dired-tests) +;;; dired-tests.el ends here --=-=-= Content-Type: text/plain See how this works.I have done patch between two branches. Please check that handlers stuff. I am not sure how to test it, and am not sure I get those correct; especially tramp-crypt. I am using a regular expression from Dired+ by Drew in two places. I have mention it the comment in ert tests, but don't know how to mention it in the example in manual. Maybe remove example, or maybe it can stay without creds? I also discovered that I wasn't covered with FIXNUM all the way; thought it was unsigned int so -1 would be converted into ffffffff, which would just yeild all results. Seems like fixnum is not what I thought so I have added test for <=0 which return nil. Ert test are mostly foxused on new argument. I haven't found something related to dired in test/src so I have created dired-tests.el. If it shoudl be in some other place I can rename it. Best regards /a --=-=-=--