packages: extra functions related to package.el

1 files changed, 65 insertions, 0 deletions

diff --git a/emacs/elisp/my-packages-extra.el b/emacs/elisp/my-packages-extra.el
new file mode 100644
index 0000000..de37752
--- /dev/null
+++ b/emacs/elisp/my-packages-extra.el
@@ -0,0 +1,65 @@
+;;; my-packages-extra.el --- Provides additional functions related to
+;;; packages
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'package)
+
+;; Original idea: https://www.manueluberti.eu/emacs/2021/09/01/package-report/
+(defun my/package-report ()
+  "Report total package counts grouped by archive."
+  (interactive)
+  (package-refresh-contents)
+  (my/display-package-report
+   (let* ((arch-pkgs (my/archive-packages))
+          (counts (seq-sort-by #'cdr #'> (my/archive-counts arch-pkgs)))
+          (by-arch (seq-group-by #'car arch-pkgs)))
+     (concat
+      (format "Total packages: %s\n\n" (apply #'+ (mapcar #'cdr counts)))
+      (mapconcat
+       (lambda (archive)
+         (concat "• "
+                 (format "%s (%s)" (car archive) (cdr archive))
+                 ": "
+                 (mapconcat (lambda (ap-pair) (cdr ap-pair))
+                            (alist-get (car archive) by-arch)
+                            ", ")))
+       counts
+       "\n\n")))))
+
+(defun my/display-package-report (output)
+  "Display OUTPUT in a popup buffer."
+  (let ((buffer-name "*package-report*"))
+    (with-help-window buffer-name
+      (with-current-buffer buffer-name
+        (visual-line-mode 1)
+        (erase-buffer)
+        (insert output)
+        (goto-char (point-min))))))
+
+(defun my/archive-packages ()
+  "Return a list of (archive . package) cons cells."
+  (seq-reduce
+   (lambda (res package)
+     (let ((archive (package-desc-archive
+                     (cadr (assq package package-archive-contents))))
+           (pkg (symbol-name package)))
+       (push (cons archive pkg) res)))
+   (mapcar #'car package-alist)
+   nil))
+
+(defun my/archive-counts (arch-pkgs)
+  "Return a list of cons cells from alist ARCH-PKGS.
+The cars are package archives, the cdrs are the number of
+packages installed from each archive."
+  (seq-reduce
+   (lambda (counts key)
+     (cons (cons key (+ 1 (or (cdr (assoc key counts)) 0)))
+           (assoc-delete-all key counts)))
+   (mapcar #'car arch-pkgs)
+   nil))
+
+(provide 'my-packages-extra)
+;;; my-packages-extra.el ends here