emacs/code/elpa/dired-collapse-20210403.1230/dired-collapse.el

;;; dired-collapse.el --- Collapse unique nested paths in dired listing -*- lexical-binding: t -*-

;; Copyright (C) 2017 Matúš Goljer

;; Author: Matúš Goljer <matus.goljer@gmail.com>
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
;; Version: 1.1.0
;; Package-Version: 20210403.1230
;; Package-Commit: 7c0ef09d57a80068a11edc74c3568e5ead5cc15a
;; Created: 15th July 2017
;; Package-requires: ((dash "2.10.0") (f "0.19.0") (dired-hacks-utils "0.0.1"))
;; Keywords: files

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Often times we find ourselves in a situation where a single file
;; or directory is nested in a chain of nested directories with no
;; other content.  This is sometimes due to various mandatory
;; layouts demanded by packaging tools or tools generating these
;; deeply-nested "unique" paths to disambiguate architectures or
;; versions (but we often use only one anyway).  If the user wants
;; to access these directories they have to quite needlessly
;; drill-down through varying number of "uninteresting" directories
;; to get to the content.

;; This minor mode is in main inspired by how GitHub renders these
;; paths: if there is a chain of directories where each one only has
;; one child, they are concatenated together and shown on the first
;; level in this collapsed form.  When the user clicks this
;; collapsed directory they are immediately brought to the deepest
;; directory with some actual content.

;; To enable or disable this functionality use `dired-collapse-mode'
;; to toggle it for the current dired buffer.

;; If the deepest directory contains only a single file this file is
;; displayed instead of the last directory.  This way we can get
;; directly to the file itself.  This is often helpful with config
;; files which are stored in their own directories, for example in
;; `~/.config/foo/config' and similar situations.

;; The files or directories re-inserted in this manner will also
;; have updated permissions, file sizes and modification dates so
;; they truly correspond to the properties of the file being shown.

;; The path to the deepest file is dimmed with the `shadow' face so
;; that it does not distract but at the same time is still available
;; for inspection.

;; The mode is integrated with `dired-rainbow' so the nested files
;; are properly colored according to user's rules.

;;; Code:

(require 'dash)
(require 'dired)
(require 'f)
(require 'dired-hacks-utils)

(defgroup dired-collapse ()
  "Collapse unique nested paths in dired listing."
  :group 'dired-hacks
  :prefix "dired-collapse-")

(defcustom dired-collapse-remote nil
  "If non-nil, enable `dired-collapse' in remote (TRAMP) buffers."
  :type 'boolean
  :group 'dired-collapse)

;;;###autoload
(define-minor-mode dired-collapse-mode
  "Toggle collapsing of unique nested paths in Dired."
  :group 'dired-collapse
  :lighter ""
  (if dired-collapse-mode
      (progn
        (add-hook 'dired-after-readin-hook 'dired-collapse 'append 'local)
        (add-hook 'dired-subtree-after-insert-hook 'dired-collapse 'append 'local)
        ;; collapse the buffer only if it is not empty (= we haven't
        ;; yet read in the current directory)
        (unless (= (buffer-size) 0)
          (dired-collapse)))
    (remove-hook 'dired-after-readin-hook 'dired-collapse 'local)
    (remove-hook 'dired-subtree-after-insert-hook 'dired-collapse 'local)
    (revert-buffer)))

(defun dired-collapse--replace-file (file)
  "Replace file on the current line with FILE."
  (delete-region (line-beginning-position) (1+ (line-end-position)))
  (insert "  ")
  (insert-directory file dired-listing-switches nil nil)
  (forward-line -1)
  (dired-align-file (line-beginning-position) (1+ (line-end-position)))
  (-when-let (replaced-file (dired-utils-get-filename))
    (when (file-remote-p replaced-file)
      (while (search-forward (dired-current-directory) (line-end-position) t)
        (replace-match "")))))

(defun dired-collapse--create-ov (&optional to-eol)
  "Create the shadow overlay which marks the collapsed path.

If TO-EOL is non-nil, extend the overlay over the whole
filename (for example when the final directory is empty)."
  (save-excursion
    (dired-move-to-filename)
    (let* ((beg (point))
           (end (save-excursion
                  (dired-move-to-end-of-filename)
                  (if to-eol
                      (point)
                    (1+ (search-backward "/")))))
           (ov (make-overlay beg end)))
      (overlay-put ov 'face 'shadow)
      ov)))

(defun dired-collapse ()
  "Collapse unique nested paths in dired listing."
  (when (or (not (file-remote-p default-directory)) dired-collapse-remote)
    (-let* (;; dired-hide-details-mode hides details by assigning a special invisibility text property
            ;; to them, while dired-collapse requires all the details. So we disable invisibility here
            ;; temporarily.
            (buffer-invisibility-spec nil)
            (inhibit-read-only t))
      (save-excursion
        (goto-char (point-min))
        (while (not (eobp))
          (when (and (looking-at-p dired-re-dir)
                     (not (member (dired-utils-get-filename 'no-dir) (list "." "..")))
                     (not (eolp)))
            (let ((path (dired-utils-get-filename))
                  files)
              (while (and (file-directory-p path)
                          (file-accessible-directory-p path)
                          (setq files (f-entries path))
                          (= 1 (length files)))
                (setq path (car files)))
              (if (and (not files)
                       (equal path (dired-utils-get-filename)))
                  (dired-collapse--create-ov 'to-eol)
                (setq path (s-chop-prefix (dired-current-directory) path))
                (when (string-match-p "/" path)
                  (let ((default-directory (dired-current-directory)))
                    (dired-collapse--replace-file path))
                  (dired-insert-set-properties (line-beginning-position) (line-end-position))
                  (dired-collapse--create-ov (= 0 (length files)))))))
          (forward-line 1))))))

(provide 'dired-collapse)
;;; dired-collapse.el ends here