Auto-suggesting Packages

[Philip Kaludercic <philipk@posteo.net>]

[-- Attachment #1: Type: text/plain, Size: 229 bytes --]


I posted a patch like this a few months back and forgot about it, but
Sacha's Emacs News this weeks reminded me again.  I took the code and
changed the default behaviour to indicate a package can be installed in
the mode line:


[-- Attachment #2: Type: text/plain, Size: 6665 bytes --]

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 868373f46c2..0c94a1df1cf 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -4533,6 +4533,155 @@ package-get-version
             (or (lm-header "package-version")
                 (lm-header "version")))))))))
 
+\f
+;;;; Autosuggest
+
+(defvar package-autosuggest-database
+  '((sml-mode auto-mode-alist "\\.sml\\'")
+    (lua-mode auto-mode-alist "\\.lua\\'" )
+    (ada-mode auto-mode-alist "\\.ada\\'")
+    ;; ...
+    ;;
+    ;; this is just for testing, in practice I think this data should
+    ;; be generated and bundled with Emacs, and would ideally be
+    ;; loaded in at compile-time.  When the "archive-contents" file
+    ;; format is updated, we can include more information in there
+    ;; that would be added to this database.
+    )
+  "Database of hints for packages to suggest installing.")
+
+(define-minor-mode package-autosuggest-mode
+  "Enable the automatic suggestion and installation of packages."
+  :init-value 'mode-line :global t
+  :type '(choice (const :tag "Indicate in mode line" mode-line)
+                 (const :tag "Always prompt" always)
+                 (const :tag "Prompt only once" once)
+                 (const :tag "Indicate with message" message)
+                 (const :tag "Do not suggest anything" nil))
+  (funcall (if package-autosuggest-mode #'add-hook #'remove-hook)
+           'after-change-major-mode-hook
+           #'package--autosuggest-after-change-mode))
+
+(defun package--suggestion-applies-p (pkg-sug)
+  "Check if a suggestion PKG-SUG is applicable to the current buffer."
+  (pcase pkg-sug
+    (`(,(pred package-installed-p) . _) nil)
+    ((or `(,_ auto-mode-alist ,ext _)
+         `(,_ auto-mode-alist ,ext))
+     (and (string-match-p ext (buffer-name)) t))
+    ((or `(,_ magic-mode-alist ,mag _)
+         `(,_ magic-mode-alist ,mag))
+     (save-restriction
+       (widen)
+       (save-excursion
+         (goto-char (point-min))
+         (looking-at-p mag))))
+    ((or `(,_ interpreter-mode-alist ,magic _)
+         `(,_ interpreter-mode-alist ,magic))
+     (save-restriction
+       (widen)
+       (save-excursion
+         (goto-char (point-min))
+         (and (looking-at auto-mode-interpreter-regexp)
+              (string-match-p
+               (concat "\\`" (file-name-nondirectory (match-string 2)) "\\'")
+               magic)))))))
+
+(defun package--autosuggest-find-candidates ()
+  "Return a list of packages that might be interesting the current buffer."
+  (and package-autosuggest-mode
+       (let (suggetions)
+         (dolist (sug package-autosuggest-database)
+           (when (package--suggestion-applies-p sug)
+             (push sug suggetions)))
+         suggetions)))
+
+(defun package--autosuggest-install-and-enable (pkg-sug)
+  "Install and enable a package suggestion PKG-ENT.
+PKG-SUG has the same form as an element of
+`package-autosuggest-database'."
+  (package-install (car pkg-sug))
+  (with-demoted-errors "Failed to enable: %S"
+    (dolist (buf (buffer-list))
+      (with-current-buffer buf
+        (when (and (eq major-mode 'fundamental-mode) (buffer-file-name)
+                   (package--suggestion-applies-p pkg-sug))
+          (funcall-interactively (or (cadddr pkg-sug) (car pkg-sug))))))))
+
+(defvar package--autosuggest-suggested '()
+  "List of packages that have already been suggested.")
+
+(defvar package--autosugest-line-format
+  '(:eval (package--autosugest-line-format)))
+(put 'package--autosugest-line-format 'risky-local-variable t)
+
+(defface package-autosuggest-face
+  '((t :inherit (success)))
+  "Face to use in the mode line to highlight suggested packages."
+  :version "30.1")
+
+(defun package--autosugest-line-format ()
+  "Generate a mode-line string to indicate a suggested package."
+  `(,@(and-let* (((eq package-autosuggest-mode 'mode-line))
+                 (avail (seq-difference (package--autosuggest-find-candidates)
+                                        package--autosuggest-suggested)))
+        (propertize
+         (format "Install %s?"
+                 (mapconcat
+                  #'symbol-name
+                  (delete-dups (mapcar #'car avail))
+                  ", "))
+         'face 'package-autosuggest-face
+         'mouse-face 'mode-line-highlight
+         'help-echo "Click to install suggested package."
+         'keymap (let ((map (make-sparse-keymap)))
+                   (define-key map [mode-line down-mouse-1] #'package-autosuggest)
+                   map)))))
+
+(add-to-list 'mode-line-misc-info
+             `(package-autosuggest-mode ("" package--autosugest-line-format)))
+
+(defun package--autosuggest-after-change-mode ()
+  "Hook function to suggest packages for installation."
+  (when-let ((avail (seq-difference (package--autosuggest-find-candidates)
+                                    package--autosuggest-suggested))
+             (pkgs (mapconcat #'symbol-name
+                              (delete-dups (mapcar #'car avail))
+                              ", ")))
+    (add-to-list 'mode-line-misc-info
+                 `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
+    (pcase package-autosuggest-mode
+      ('mode-line
+       (force-mode-line-update t))
+      ('always
+       (when (yes-or-no-p (format "Install suggested packages (%s)?" pkgs))
+         (mapc #'package--autosuggest-install-and-enable avail)))
+      ('once
+       (when (yes-or-no-p (format "Install suggested packages (%s)?" pkgs))
+         (mapc #'package--autosuggest-install-and-enable avail))
+       (setq package--autosuggest-suggested (append avail  package--autosuggest-suggested)))
+      ('message
+       (message
+        (substitute-command-keys
+         (format "Found suggested packages: %s.  Install using  \\[package-autosuggest]"
+                 pkgs)))))))
+
+(defun package-autosuggest ()
+  "Prompt the user for suggested packages."
+  (interactive)
+  (let* ((avail (or (package--autosuggest-find-candidates)
+                    (user-error "No suggestions found")))
+         (pkgs (completing-read-multiple
+                "Install suggested packages: " avail
+                nil t
+                (mapconcat #'symbol-name
+                           (delete-dups (mapcar #'car avail))
+                           ",")))
+         (choice (concat "\\`" (regexp-opt pkgs) "\\'")))
+    (dolist (ent avail)
+      (when (string-match-p choice (symbol-name (car ent)))
+        (package--autosuggest-install-and-enable ent)))))
+
 \f
 ;;;; Quickstart: precompute activation actions for faster start up.
 

[-- Attachment #3: Type: text/plain, Size: 449 bytes --]


One annoyance I cannot resolve right now is that when I click on the
mode line, it calls `package-autosuggest' that attempts to confirm the
installation wish using `completing-read-multiple' with an initial input
(so everything the user needs to do is to press enter).  But due to the
mouse-click, it appears the minibuffer is not selected, which can be
confusing.  Adding a `switch-to-minibuffer' didn't help either.  Does
anyone know what to do?