sqrtminusone.github.io/org/load-tree.el

(defmacro my/load-history--iter-load-history (&rest body)
  "Iterate through `load-history'.

The following are bound in BODY in the process:
- file-item is one item in `load-history' providing a feature, given
  that it's not \"-autoloads\";
- provide-symbol is the feature name, provided by the item;
- requires is the list of feature, required by the item."
  `(dolist (file-item load-history)
     (let (provide-symbol requires)
       (dolist (symbol-item (cdr file-item))
         (pcase (car-safe symbol-item)
           ('require (push (cdr symbol-item) requires))
           ('provide (setq provide-symbol (cdr symbol-item)))))
       (when (and provide-symbol
                  (not (string-match-p
                        (rx "-autoloads" eos)
                        (symbol-name provide-symbol))))
         ,@body))))

(defun my/load-history--get-feature-required-by ()
  "Get the hashmap of which features were required by which.

The key is the feature name; the value is the list of features in
which it was required."
  (let ((feature-required-by (make-hash-table)))
    (my/load-history--iter-load-history
     (dolist (require-symbol requires)
       (puthash require-symbol
                (cons provide-symbol
                      (gethash require-symbol feature-required-by))
                feature-required-by)))
    feature-required-by))

(defun my/load-history--get-feature-tree (feature-name feature-hash &optional found-features)
  "Get the tree of features with FEATURE-NAME as the root.

FEATURE-HASH is the hashmap with features as keys and lists of
features as values.

FOUND-FEATURES is the recursive paratemer to avoid infinite loop.

The output is a cons cell, with the car being the feature name
and the cdr being a list cons cell of the same kind."
  (unless found-features
    (setq found-features (make-hash-table)))
  (puthash feature-name t found-features)
  (prog1
      (cons feature-name
            (mapcar
             (lambda (dependent-feature-name)
               (if (gethash dependent-feature-name found-features)
                   (cons dependent-feature-name 'loop)
                 (my/load-history--get-feature-tree
                  dependent-feature-name feature-hash found-features)))
             (gethash feature-name feature-hash)))
    (remhash feature-name found-features)))

(setq use-package-compute-statistics t)

(defun my/load-history--narrow-tree-by-use-package (tree)
  "Leave only features managed by `use-package' in TREE."
  (when (= (hash-table-count use-package-statistics) 0)
    (user-error "use-package-statistics is empty"))
  (if (eq (cdr tree) 'loop)
      (cons (car tree) nil)
    (let (res)
      (dolist (child (cdr tree))
        (let ((found-p (gethash (car child) use-package-statistics))
              (child-narrowed (my/load-history--narrow-tree-by-use-package child)))
          (if found-p
              (push child-narrowed res)
            (dolist (grandchild (cdr child-narrowed))
              (push grandchild res)))))
      (cons (car tree)
            (seq-uniq
             (nreverse res)
             (lambda (a b)
               (eq (car a) (car b))))))))

(defun my/load-history--render-feature-tree-recur (tree &optional level)
  "Render the feature tree recursively.

TREE is the output of `my/load-history--get-feature-tree'.  LEVEL is
the recursion level."
  (unless level (setq level 1))
  (insert (make-string level ?*) " " (symbol-name (car tree)))
  (if (eq (cdr tree) 'loop)
      (insert ": loop\n")
    (insert "\n")
    (dolist (feature (cdr tree))
      (my/load-history--render-feature-tree-recur feature (1+ level)))))

(defvar my/load-history-tree-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map outline-mode-map)
    (define-key map (kbd "q") (lambda () (interactive) (quit-window t)))
    (when (fboundp #'evil-define-key*)
      (evil-define-key* '(normal motion) map
        (kbd "TAB") #'outline-toggle-children
        "q" (lambda () (interactive) (quit-window t))))
    map))

(define-derived-mode my/load-history-tree-mode outline-mode "Load Tree"
  "Display load tree."
  (setq-local buffer-read-only t))

(defun my/completing-read-features-or-packages ()
  "Read a feature name or a `use-package'-package from the minibuffer.

The choice depends on the value of the prefix argument."
  (intern
   (if (equal current-prefix-arg '(4))
       (completing-read "Package: " (cl-loop for p being the hash-keys of
                                             use-package-statistics
                                             collect p))
     (completing-read "Feature: " features))))

(defun my/load-history-feature-dependents (feature-name &optional narrow-use-package)
  "Display the tree of features that depend on FEATURE-NAME.

If NARROW-USE-PACKAGE is non-nil, only show the features that are
managed by `use-package'."
  (interactive (list (my/completing-read-features-or-packages)
                     (equal current-prefix-arg '(4))))
  (let* ((feature-required-by (my/load-history--get-feature-required-by))
         (tree (my/load-history--get-feature-tree feature-name feature-required-by))
         (buffer (generate-new-buffer (format "*feature-dependents-%s*" feature-name))))
    (when narrow-use-package
      (setq tree (my/load-history--narrow-tree-by-use-package tree)))
    (with-current-buffer buffer
      (my/load-history--render-feature-tree-recur tree)
      (my/load-history-tree-mode)
      (goto-char (point-min)))
    (switch-to-buffer buffer)))

(defun my/load-history--get-feature-requires ()
  "Get the hashmap of which features require which.

The key is the feature name; the value is the list of features it
requires."
  (let ((feature-requires (make-hash-table)))
    (my/load-history--iter-load-history
     (dolist (require-symbol requires)
       (puthash provide-symbol
                (cons require-symbol
                      (gethash provide-symbol feature-requires))
                feature-requires)))
    feature-requires))

(defun my/load-history-feature-dependencies (feature-name &optional narrow-use-package)
  "Display the tree of features that FEATURE-NAME depends on.

If NARROW-USE-PACKAGE is non-nil, only show the features that are
managed by `use-package'."
  (interactive (list (my/completing-read-features-or-packages)
                     (equal current-prefix-arg '(4))))
  (let* ((feature-requires (my/load-history--get-feature-requires))
         (tree (my/load-history--get-feature-tree feature-name feature-requires))
         (buffer (generate-new-buffer (format "*feature-dependencies-%s*" feature-name))))
    (when narrow-use-package
      (setq tree (my/load-history--narrow-tree-by-use-package tree)))
    (with-current-buffer buffer
      (my/load-history--render-feature-tree-recur tree)
      (my/load-history-tree-mode)
      (goto-char (point-min)))
    (switch-to-buffer buffer)))

(require 'dired)

(eval-when-compile
  (require 'dired))

(defun my-function-with-dired ()
  "Do something important with dired."
  (interactive)
  (require 'dired))