From 1da9a207669a3cf5d27ac1dd61543c1492e05360 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Fri, 31 Mar 2017 17:27:08 +0900 Subject: [PATCH] dired-mark-suffix: New command Now dired-mark-extension prepends '.' to extension when not present. Add command dired-mark-suffix to preserve the previous behaviour (Bug#25942). * lisp/dired-x.el (dired-mark-suffix): New command; mark files ending in a given suffix. (dired--mark-suffix-interactive-spec): New defun. (dired-mark-extension, dired-mark-suffix): Use it. * doc/misc/dired-x.texi (Advanced Mark Commands): Update manual. * test/lisp/dired-x-tests.el: New test suite; add test for these features. ; * etc/NEWS (Incompatible Lisp Changes in Emacs 26.1): ; Mention these changes. --- doc/misc/dired-x.texi | 18 ++++++-- etc/NEWS | 7 +++- lisp/dired-x.el | 85 +++++++++++++++++++++++++------------- test/lisp/dired-x-tests.el | 53 ++++++++++++++++++++++++ 4 files changed, 129 insertions(+), 34 deletions(-) create mode 100644 test/lisp/dired-x-tests.el diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 1e6f4b03bb0..bf103256f29 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -721,15 +721,27 @@ variable @code{window-min-height}. @item dired-mark-extension @findex dired-mark-extension Mark all files with a certain extension for use in later commands. A @samp{.} -is not automatically prepended to the string entered, you must type it -explicitly. -If invoked with prefix argument @kbd{C-u}, this command unmark files instead. +is automatically prepended to the string entered when not present. +If invoked with prefix argument @kbd{C-u}, this command unmarks files instead. If called with the @kbd{C-u C-u} prefix, asks for a character to use as the marker, and marks files with it. When called from Lisp, @var{extension} may also be a list of extensions and an optional argument @var{marker-char} specifies the marker used. +@item dired-mark-suffix +@findex dired-mark-suffix +Mark all files with a certain suffix for use in later commands. A @samp{.} +is not automatically prepended to the string entered, you must type it +explicitly. This is different from @var{dired-mark-extension} which prepends +a @samp{.} if not present. +If invoked with prefix argument @kbd{C-u}, this command unmarks files instead. +If called with the @kbd{C-u C-u} prefix, asks for a character to use +as the marker, and marks files with it. + +When called from Lisp, @var{suffix} may also be a list of suffixes +and an optional argument @var{marker-char} specifies the marker used. + @item dired-flag-extension @findex dired-flag-extension Flag all files with a certain extension for deletion. A @samp{.} is diff --git a/etc/NEWS b/etc/NEWS index cd98f533998..bfd7d2bd32a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -471,8 +471,6 @@ where to place point after C-c M-r and C-c M-s. --- *** Messages from CMake are now recognized. -** Dired - +++ *** A new option 'dired-always-read-filesystem' default to nil. If non-nil, buffers visiting files are reverted before search them; @@ -758,6 +756,11 @@ processes on exit. * Incompatible Lisp Changes in Emacs 26.1 ++++ +*** Command 'dired-mark-extension' now automatically prepends a '.' to the +extension when not present. The new command 'dired-mark-suffix' behaves +similarly but it doesn't prepend a '.'. + +++ ** Certain cond/pcase/cl-case forms are now compiled using a faster jump table implementation. This uses a new bytecode op `switch', which isn't diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 6c8fb0e7dae..527685acf37 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -332,46 +332,73 @@ See also the functions: ;;; EXTENSION MARKING FUNCTIONS. +(defun dired--mark-suffix-interactive-spec () + (let* ((default + (let ((file (dired-get-filename nil t))) + (when file + (file-name-extension file)))) + (suffix + (read-string (format "%s extension%s: " + (if (equal current-prefix-arg '(4)) + "UNmarking" + "Marking") + (if default + (format " (default %s)" default) + "")) nil nil default)) + (marker + (pcase current-prefix-arg + ('(4) ?\s) + ('(16) + (let* ((dflt (char-to-string dired-marker-char)) + (input (read-string + (format + "Marker character to use (default %s): " dflt) + nil nil dflt))) + (aref input 0))) + (_ dired-marker-char)))) + (list suffix marker))) + ;; Mark files with some extension. (defun dired-mark-extension (extension &optional marker-char) "Mark all files with a certain EXTENSION for use in later commands. -A `.' is *not* automatically prepended to the string entered. +A `.' is automatically prepended to EXTENSION when not present. EXTENSION may also be a list of extensions instead of a single one. Optional MARKER-CHAR is marker to use. Interactively, ask for EXTENSION. Prefixed with one C-u, unmark files instead. Prefixed with two C-u's, prompt for MARKER-CHAR and mark files with it." - (interactive - (let* ((default - (let ((file (dired-get-filename nil t))) - (when file - (file-name-extension file)))) - (suffix - (read-string (format "%s extension%s: " - (if (equal current-prefix-arg '(4)) - "UNmarking" - "Marking") - (if default - (format " (default %s)" default) - "")) nil nil default)) - (marker - (pcase current-prefix-arg - ('(4) ?\s) - ('(16) - (let* ((dflt (char-to-string dired-marker-char)) - (input (read-string - (format - "Marker character to use (default %s): " dflt) - nil nil dflt))) - (aref input 0))) - (_ dired-marker-char)))) - (list suffix marker))) - (or (listp extension) - (setq extension (list extension))) + (interactive (dired--mark-suffix-interactive-spec)) + (unless (listp extension) + (setq extension (list extension))) + (dired-mark-files-regexp + (concat ".";; don't match names with nothing but an extension + "\\(" + (mapconcat + (lambda (x) + (regexp-quote + (if (string-prefix-p "." x) x (concat "." x)))) + extension "\\|") + "\\)$") + marker-char)) + +;; Mark files ending with some suffix. +(defun dired-mark-suffix (suffix &optional marker-char) + "Mark all files with a certain SUFFIX for use in later commands. +A `.' is *not* automatically prepended to the string entered; see +also `dired-mark-extension', which is similar but automatically +prepends `.' when not present. +SUFFIX may also be a list of suffixes instead of a single one. +Optional MARKER-CHAR is marker to use. +Interactively, ask for SUFFIX. +Prefixed with one C-u, unmark files instead. +Prefixed with two C-u's, prompt for MARKER-CHAR and mark files with it." + (interactive (dired--mark-suffix-interactive-spec)) + (unless (listp suffix) + (setq suffix (list suffix))) (dired-mark-files-regexp (concat ".";; don't match names with nothing but an extension "\\(" - (mapconcat 'regexp-quote extension "\\|") + (mapconcat 'regexp-quote suffix "\\|") "\\)$") marker-char)) diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el new file mode 100644 index 00000000000..e8352a4ecaf --- /dev/null +++ b/test/lisp/dired-x-tests.el @@ -0,0 +1,53 @@ +;;; dired-x-tests.el --- Test suite for dired-x. -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Code: +(require 'ert) +(require 'dired-x) + + +(ert-deftest dired-test-bug25942 () + "Test for http://debbugs.gnu.org/25942 ." + (let* ((dirs (list "Public" "Music")) + (files (list ".bashrc" "bar.c" "foo.c" "c" ".c")) + (all-but-c + (sort + (append (copy-sequence dirs) + (delete "c" (copy-sequence files))) + #'string<)) + (dir (make-temp-file "Bug25942" 'dir)) + (extension "c")) + (unwind-protect + (progn + (dolist (d dirs) + (make-directory (expand-file-name d dir))) + (dolist (f files) + (write-region nil nil (expand-file-name f dir))) + (dired dir) + (dired-mark-extension extension) + (should (equal '("bar.c" "foo.c") + (sort (dired-get-marked-files 'local) #'string<))) + (dired-unmark-all-marks) + (dired-mark-suffix extension) + (should (equal all-but-c + (sort (dired-get-marked-files 'local) #'string<)))) + (delete-directory dir 'recursive)))) + +(provide 'dired-x-tests) +;; dired-x-tests.el ends here -- 2.39.2