add package dependencies

2025-07-06 21:26:51 +02:00
parent 65dedd3df8
commit 807d0f28f6
23 changed files with 8249 additions and 0 deletions
--- a/lisp/dirvish/dirvish-collapse.el
+++ b/lisp/dirvish/dirvish-collapse.el
@@ -0,0 +1,87 @@
+;;; dirvish-collapse.el --- Collapse unique nested paths -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2025 Alex Lu
+;; Author : Alex Lu <https://github.com/alexluigit>
+;; Keywords: files, convenience
+;; Homepage: https://github.com/alexluigit/dirvish
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;;; Commentary:
+
+;; Provides `collapse' attribute to reveal unique nested paths.
+
+;;; Code:
+
+(require 'dirvish)
+
+(defface dirvish-collapse-dir-face
+  '((t (:inherit dired-directory)))
+  "Face used for directories in `collapse' attribute."
+  :group 'dirvish)
+
+(defface dirvish-collapse-empty-dir-face
+  '((t (:inherit shadow)))
+  "Face used for empty directories in `collapse' attribute."
+  :group 'dirvish)
+
+(defface dirvish-collapse-file-face
+  '((t (:inherit default)))
+  "Face used for files in `collapse' attribute."
+  :group 'dirvish)
+
+(defcustom dirvish-collapse-separator "|"
+  "Separator string for `collapse' attribute."
+  :group 'dirvish :type 'string)
+
+(defun dirvish-collapse--cache (f-name)
+  "Cache collapse state for file F-NAME."
+  (dirvish-attribute-cache f-name :collapse
+    (let ((path f-name) should-collapse files dirp)
+      (while (and (setq dirp (file-directory-p path))
+                  (setq files (ignore-errors (directory-files path)))
+                  (= 3 (length files))
+                  ;; Don't collapse "." and ".."
+                  (not (or (string-suffix-p ".." path)
+                           (string-suffix-p "/." path))))
+        (setq should-collapse t
+              path (expand-file-name
+                    (car (remove "." (remove ".." files)))
+                    path)))
+      (cond
+       ((and (eq (length files) 2) (not should-collapse)) (cons 'empty t))
+       (should-collapse
+        (let* ((path (substring path (1+ (length f-name))))
+               (segs (split-string path "/"))
+               (head (format "%s%s%s" dirvish-collapse-separator
+                             (mapconcat #'concat (butlast segs)
+                                        dirvish-collapse-separator)
+                             dirvish-collapse-separator))
+               (tail (car (last segs)))
+               (tail-face (if dirp 'dirvish-collapse-dir-face
+                            'dirvish-collapse-file-face)))
+          (and (equal head (format "%s%s" dirvish-collapse-separator
+                                   dirvish-collapse-separator))
+               (setq head dirvish-collapse-separator))
+          (add-face-text-property
+           0 (length head) 'dirvish-collapse-dir-face nil head)
+          (add-face-text-property 0 (length tail) tail-face nil tail)
+          (cons head tail)))
+       (t (cons nil nil))))))
+
+(dirvish-define-attribute collapse
+  "Collapse unique nested paths."
+  :when (and (not (dirvish-prop :fd-info))
+             (not (dirvish-prop :remote)))
+  (when-let* ((cache (dirvish-collapse--cache f-name))
+              (head (car cache))
+              (tail (cdr cache)))
+    (if (eq head 'empty)
+        (let ((ov (make-overlay f-beg f-end)))
+          (overlay-put ov 'face 'dirvish-collapse-empty-dir-face)
+          `(ov . ,ov))
+      (let* ((str (concat head tail)))
+        (add-face-text-property 0 (length str) hl-face nil str)
+        `(left . ,str)))))
+
+(provide 'dirvish-collapse)
+;;; dirvish-collapse.el ends here