tree: add more?

org/2024-07-11-load-tree.org

@@ -1,4 +1,5 @@
 #+HUGO_SECTION: posts
+#+PROPERTY: header-args:emacs-lisp :tangle load-tree.el
 #+HUGO_BASE_DIR: ../
 #+TITLE: Determining package dependency tree in Emacs
 #+DATE: 2024-07-11
@@ -15,7 +16,7 @@ The post describes how to determine package dependency tree, using the built-in
 * Prior work
 Somehow it has been particularly hard to find anything on that topic.
 
-I started with advising =require= (yes, Emacs allows to do that), but then I had found the built-in [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Where-Defined.html#index-load_002dhistory][load-history]]. The variable is an alist, with each item describing one loaded library, including =require= and =provide= forms:
+I started with advising =require= (yes, Emacs allows to do that), but then I had found the built-in [[https://www.gnu.org/software/emacs/manual/html_node/emacs-lisp/Where-Defined.html#index-load_002dhistory][load-history]]. The variable is an alist, with each item describing one loaded library, including =require= and =provide= forms:
 #+begin_example
 (("<file-name>/foo.el" (require . bar) (require . baz) (provide . foo)) ...)
 #+end_example
@@ -32,7 +33,7 @@ Let the key be the feature symbol, and the value the list of features which requ
 
 Also, I'll extract the iteration over =load-history= into a macro because I want to reuse it later.
 
-#+begin_src elisp
+#+begin_src emacs-lisp
 (defmacro my/load-history--iter-load-history (&rest body)
   "Iterate through `load-history'.
 
@@ -70,7 +71,7 @@ which it was required."
 
 This graph can be converted to the tree by taking one feature as a root and traversing every possible path, excluding loops. This will create a lot of duplicate nodes, but it's fine for our purposes.
 
-#+begin_src elisp
+#+begin_src emacs-lisp
 (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.
 
@@ -96,7 +97,7 @@ and the cdr being a list cons cell of the same kind."
     (remhash feature-name found-features)))
 #+end_src
 
-This feature tree is already interesting, but for me it's also helpful to find the subset of the tree managed by [[https://github.com/jwiegley/use-package][use-package]]. For instance, I used this to figure out why opening an elisp buffer loads =org-mode= (spolier: [[https://github.com/abo-abo/lispy/blob/fe44efd21573868638ca86fc8313241148fabbe3/lispy.el#L143][lispy]] -> [[https://github.com/abo-abo/zoutline/blob/32857c6c4b9b0bcbed14d825a10b91a98d5fed0a/zoutline.el#L26][zoutline]] -> org).
+This feature tree is already interesting, but for me it's also helpful to find the subset of the tree managed by [[https://github.com/jwiegley/use-package][use-package]]. For instance, I used this to figure out why opening an emacs-lisp buffer loads =org-mode= (spolier: [[https://github.com/abo-abo/lispy/blob/fe44efd21573868638ca86fc8313241148fabbe3/lispy.el#L143][lispy]] -> [[https://github.com/abo-abo/zoutline/blob/32857c6c4b9b0bcbed14d825a10b91a98d5fed0a/zoutline.el#L26][zoutline]] -> org).
 
 Fortunately, =use-package= has built-in [[https://github.com/jwiegley/use-package?tab=readme-ov-file#gathering-statistics][statistics functionality]]. To turn it on, set the following variable:
 #+begin_src emacs-lisp
@@ -165,7 +166,7 @@ I'll also make a derived mode from =outline-mode= to redefine =q= and =TAB= and
 
 Now, putting all of this together.
 
-The completing-read function prompts the user either with a [[https://www.gnu.org/software/emacs/manual/html_node/elisp/Named-Features.html#index-features-1][list of features]] or with the list of use-package packages.
+The completing-read function prompts the user either with a [[https://www.gnu.org/software/emacs/manual/html_node/emacs-lisp/Named-Features.html#index-features-1][list of features]] or with the list of use-package packages.
 
 #+begin_src emacs-lisp
 (defun my/completing-read-features-or-packages ()
@@ -236,3 +237,49 @@ managed by `use-package'."
 #+end_src
 
 * Usage and results
+So we have two entrypoints:
+
+- =M-x my/load-history-feature-dependents= to list features / packages that depend on the selected one;
+- =M-x my/load-history-feature-dependencies= to list features / packages that the selected one depends on.
+
+For instance, running =C-u M-x my/load-history-feature-dependents= on =dired= on my config yields the following:
+#+begin_example
+,* dired
+,** counsel...
+,** doc-view...
+,** telega...
+,** diredfl...
+,** dired-subtree...
+,** all-the-icons-dired...
+,** dired-git-info...
+,** avy-dired...
+,** org-contacts...
+,** org-ref...
+,** notmuch...
+,** magit...
+,** code-review...
+,** lyrics-fetcher...
+#+end_example
+
+Apparently, [[https://github.com/abo-abo/swiper/blob/master/counsel.el#L48][counsel is responsible]] for loading =dired= at startup. The package isn't merely autoloaded because I call =counsel-mode=.
+
+If you're developing a package, here's one way to work around that. Instead of requiring every feature at the start of the package like this:
+#+begin_src emacs-lisp
+(require 'dired)
+#+end_src
+
+Use =eval-when-compile=:
+#+begin_src emacs-lisp
+(eval-when-compile
+  (require 'dired))
+#+end_src
+
+And =require= the feature where it's needed:
+#+begin_src emacs-lisp
+(defun my-function-with-dired ()
+  "Do something important with dired."
+  (interactive)
+  (require 'dired))
+#+end_src
+
+I'd guess =counsel= doesn't do this because it depends on =dired= too heavily.

org/load-tree.el

@@ -0,0 +1,177 @@
+(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))