emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/helm 9e0f7eb966 1/3: Add helm-ff-mark-similar-files comman


From: ELPA Syncer
Subject: [nongnu] elpa/helm 9e0f7eb966 1/3: Add helm-ff-mark-similar-files command
Date: Thu, 6 Oct 2022 02:58:49 -0400 (EDT)

branch: elpa/helm
commit 9e0f7eb9669e12d52b222581f6650c8c8d370fd7
Author: Thierry Volpiatto <thievol@posteo.net>
Commit: Thierry Volpiatto <thievol@posteo.net>

    Add helm-ff-mark-similar-files command
---
 helm-files.el | 32 ++++++++++++++++++++++++++++++++
 helm-lib.el   | 24 ++++++++++++++++++++++++
 2 files changed, 56 insertions(+)

diff --git a/helm-files.el b/helm-files.el
index 568d8e0ba8..969fcedee6 100644
--- a/helm-files.el
+++ b/helm-files.el
@@ -188,6 +188,7 @@ This is used only as a let binding.")
     (define-key map (kbd "M-C")           'helm-ff-run-copy-file)
     (when (executable-find "rsync")
       (define-key map (kbd "M-V")         'helm-ff-run-rsync-file))
+    (define-key map (kbd "C-M-SPC")       'helm-ff-mark-similar-files)
     (define-key map (kbd "C-M-c")         'helm-ff-run-mcp)
     (define-key map (kbd "M-B")           'helm-ff-run-byte-compile-file)
     (define-key map (kbd "M-L")           'helm-ff-run-load-file)
@@ -2579,6 +2580,37 @@ Emacs and even the whole system as it eats all memory."
       (helm-ff-toggle-basename))))
 (put 'helm-ff-run-toggle-basename 'helm-only t)
 
+(defun helm-ff-mark-similar-files-1 ()
+  "Mark similar files.
+Files are considered similar if they have the same face and same
+extension."
+  (with-helm-window
+    (let* ((src  (helm-get-current-source))
+           (file (helm-get-selection nil 'withprop src))
+           (face (get-text-property 3 'face file))
+           (ext  (file-name-extension file)))
+      (helm--map-candidates-in-source
+       src #'helm-make-visible-mark
+       (lambda (cand)
+         (and (eq (get-text-property 3 'face cand) face)
+              (equal ext (file-name-extension cand)))))
+      (helm-mark-current-line)
+      (helm-display-mode-line src t)
+      (when helm-marked-candidates
+        (message "%s candidates marked" (length helm-marked-candidates))
+        (set-window-margins (selected-window) 1)))))
+
+(defun helm-ff-mark-similar-files ()
+    "Mark all files similar to selection."
+  (interactive)
+  (with-helm-alive-p
+    (let ((marked (helm-marked-candidates)))
+      (if (and (>= (length marked) 1)
+               (with-helm-window helm-visible-mark-overlays))
+          (helm-unmark-all)
+          (helm-ff-mark-similar-files-1)))))
+(put 'helm-ff-mark-similar-filess 'helm-only t)
+
 (defun helm-reduce-file-name-1 (fname level)
   ;; This is the old version of helm-reduce-file-name, we still use it
   ;; with ftp fnames as expand-file-name is not working as expected
diff --git a/helm-lib.el b/helm-lib.el
index 99b528ea9d..56a824f1f6 100644
--- a/helm-lib.el
+++ b/helm-lib.el
@@ -1447,6 +1447,30 @@ Argument ALIST is an alist of associated major modes."
             (eq (car (rassq cdr-o-assoc-mode alist))
                 cur-maj-mode)))))
 
+;;; Source processing
+;;
+(defun helm--map-candidates-in-source (src fn pred)
+  "Map over all candidates in SRC and execute FN if PRED returns non nil.
+Arg FN is a function called with no arg and PRED is a function called
+with current candidate as arg."
+  (save-excursion
+    (goto-char (helm-get-previous-header-pos))
+    (helm-next-line)
+    (let* ((next-head (helm-get-next-header-pos))
+           (end       (and next-head
+                           (save-excursion
+                             (goto-char next-head)
+                             (forward-line -1)
+                             (point))))
+           (maxpoint  (or end (point-max))))
+      (while (< (point) maxpoint)
+        (helm-mark-current-line)
+        (let ((cand (helm-get-selection nil 'withprop src)))
+          (when (and (not (helm-this-visible-mark))
+                     (funcall pred cand))
+            (funcall fn)))
+        (forward-line 1) (end-of-line)))))
+
 ;;; Files routines
 ;;
 (defun helm-file-name-sans-extension (filename)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]