Infrastructure for packages to suggest customizations

[Philip Kaludercic <philipk@posteo.net>]

[-- Attachment #1.1: Type: text/plain, Size: 2141 bytes --]


Hi,

in the recent discussion on reserving a keymap for packages, I proposed
extending package.el to support a sort of formal specification of what a
user should or could customize. As there were some supportive comments,
I attempted to improve on an earlier proof-of-concept[0], resulting in
the attached patch.

This introduces the following changes:

- User option `package-query-suggestions', to enable or disable these
  suggestions. I have disabled this feature by default, because it might
  be annoying. It is probably better for template-configurations or a
  theme to enable it.

- Variable pacakge-configuration-suggestions, that packages add their
  suggestions to. Here's an example how this could look like for avy:

    ;;;###autoload
    (add-to-list 'pacakge-configuration-suggestions
		 `(avy (key "Avy's entry-point are commands like avy-goto-char\
    that have to be bound globally"
			    ,(kbd "C-:")
			    avy-goto-char)))

  Beside keys, one can currently also specify options and hook. It might
  be worth distinguishing between options and global minor-modes.

- Function package-suggest-configuration, that generates the
  configuration. It is automatically called by package-install, but can
  also be invoked manually.

There are a few things I am not satisfied with, such as that the default
behaviour for package-suggest-configuration is to just append the
generated configuration to `custom-file' or `user-init-file'. Part of my
intention was to generate code that can easily be changed and adapted by
the user (unlike custom-set-variables), so I don't analyse the files
themselves. This might not look nice in some cases, but then again,
these people are probably not the ones using this feature

Another point is that package-suggest-configuration has an option such
that the command will not change anything (PREVIEW, activated with a
prefix argument). I was wondering if it would make sense to make this
the default behaviour whenever the command is invoked interactively.

[0] https://lists.gnu.org/archive/html/help-gnu-emacs/2021-02/msg00305.html

Interested in your comments,
           Philip K.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Add-package-suggest-configuration.patch --]
[-- Type: text/x-patch, Size: 9642 bytes --]

From 4d6737ac59b3d9319a8d94b45ab514d92bd771e4 Mon Sep 17 00:00:00 2001
From: Philip K <philipk@posteo.net>
Date: Thu, 11 Feb 2021 16:30:09 +0100
Subject: [PATCH] Add package-suggest-configuration

---
 lisp/emacs-lisp/package.el | 154 +++++++++++++++++++++++++++++++++----
 1 file changed, 140 insertions(+), 14 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 90b7b88d58..a7c957dccd 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -146,7 +146,9 @@
 (require 'cl-lib)
 (eval-when-compile (require 'subr-x))
 (eval-when-compile (require 'epg))      ;For setf accessors.
+(eval-when-compile (require 'pcase))
 (require 'seq)
+(require 'rmc)
 
 (require 'tabulated-list)
 (require 'macroexp)
@@ -424,6 +426,13 @@ package-archive-column-width
   :type 'number
   :version "28.1")
 
+(defcustom package-query-suggestions nil
+  "How to treat configuration suggestions by packages.
+If non-nil, ask the user if they are interested in what a package
+has to suggest.  Otherwise ignore the suggestions."
+  :type 'boolean
+  :version "28.1")
+
 \f
 ;;; `package-desc' object definition
 ;; This is the struct used internally to represent packages.
@@ -2087,6 +2096,135 @@ package--archives-initialize
   (unless package-archive-contents
     (package-refresh-contents)))
 
+(defvar pacakge-configuration-suggestions nil
+  "An alist of advertised default configuration.
+Each entry has the form (PACKAGE . SUGGESTIONS), where PACAKGE is a
+symbol designating the package, and SUGGESTIONS is another alist.
+SUGGESTIONS have the form (TYPE EXPLAIN . DATA), where TYPE says
+what kind of a suggestion is being made, EXPLAIN is a string that
+legitimatises the suggestion and DATA is the content of the
+suggestion.  Currently, the following values for TYPE are
+understood:
+
+- `key', where DATA has the form (KEY FUNCTION).  It suggests
+  binding FUNCTION globally to KEY, unless KEY is already bound.
+  KEY is passed to the function `kbd'.
+
+- `option', where DATA has the form (OPT VAL).  It setting the
+  symbol OPT to the value VAL.
+
+- `hook', where DATA has the form (HOOK FUNCTION).  It suggests
+  adding FUNCTION to the hook HOOK.
+
+All other values for TYPE are ignored.")
+
+(defun package--query-name (&optional kind verb)
+  "Query the user for a package name.
+If KIND is nil, prompt for all kinds of packages.  If KIND is
+`installed' only prompt for installed packages.  If KIND is
+`not-installed', only prompt for packages that have not been
+installed.  VERB modified to prompt."
+  ;; Initialize the package system to get the list of package
+  ;; symbols for completion.
+  (package--archives-initialize)
+  (intern (completing-read
+           (format "%s package: " (or verb "Select"))
+           (delq nil (mapcar (lambda (elt)
+                               (when (cond
+                                      ((eq kind 'installed)
+                                       (package-installed-p (car elt)))
+                                      ((eq kind 'not-installed)
+                                       (not (package-installed-p (car elt))))
+                                      ((null kind))
+                                      (t (error "Invalid kind")))
+                                 (symbol-name (car elt))))
+                             package-archive-contents))
+           nil t)))
+
+(defun package--show-explanation (doc)
+  "Show explanation DOC in a help buffer."
+  (ignore-errors (kill-buffer "*explain*"))
+  (with-current-buffer (get-buffer-create "*explain*")
+    (erase-buffer)
+    (with-help-window (current-buffer)
+      (princ (substitute-command-keys doc)))))
+
+(defun package-suggest-configuration (package &optional preview)
+  "Query the user to automatically configure PACKAGE.
+If PREVIEW is non-nil, do not save and load the new
+customization."
+  (interactive (list (package--query-name 'installed) current-prefix-arg))
+  (when (or (called-interactively-p 'any) package-query-suggestions)
+    (with-temp-buffer
+      (let ((standard-output (current-buffer)))
+        (unless (cdr (assq package pacakge-configuration-suggestions))
+          (message "Nothing to configure."))
+        (dolist (sug (cdr (assq package pacakge-configuration-suggestions)))
+          (terpri nil t)
+          (save-window-excursion        ;restore explain buffers
+            (pcase sug
+              (`(key ,explain ,key ,command)
+               (unless (or (where-is-internal command) (key-binding key))
+                 (let ((key (cl-loop
+                             for ch = (read-multiple-choice
+		                       (format "%s suggests binding `%s' to %s.  Do you want to bind it? "
+                                               package command (key-description key))
+		                       '((?y "yes" "Bind command to the suggested key")
+		                         (?n "no" "Ignore the suggestion")
+		                         (?e "explain" "Ask the package why is suggests this")
+		                         (?o "other" "Bind key to a different key")))
+                             when (eq (car ch) ?y) return key
+                             when (eq (car ch) ?n) return nil
+                             when (eq (car ch) ?e) do (package--show-explanation explain)
+                             when (eq (car ch) ?o) do
+                             (let* ((alt (read-key-sequence "Bind to: " ))
+                                    (bound (key-binding alt)))
+                               (if (not bound)
+                                   (cl-return alt)
+                                 (message "%s is already bound to %s"
+                                          (key-description alt)
+                                          (key-binding alt))
+                                 (sit-for 2))))))
+                   (when key
+                     (prin1 `(global-set-key
+                              (kbd ,(key-description key))
+                              #',command))))))
+              (`(option ,explain ,option ,value)
+               (when (cl-loop
+                      for ch = (read-multiple-choice
+		                (format "%s suggests setting the option `%s' to %s.  Do you want to set it? "
+                                        package option value)
+		                '((?y "yes" "Set the option")
+		                  (?n "no" "Ignore the suggestion")
+		                  (?e "explain" "Ask the package why is suggests this")))
+                      when (eq (car ch) ?y) return t
+                      when (eq (car ch) ?n) return nil
+                      when (eq (car ch) ?e) do (package--show-explanation explain))
+                 (prin1 `(customize-set-variable ',option ,value))))
+              (`(hook ,explain ,hook ,function)
+               (when (cl-loop
+                      for ch = (read-multiple-choice
+		                (format "%s suggests adding `%s' to %s.  Do you want to add it? "
+                                        package function hook)
+		                '((?y "yes" "Add to hook")
+		                  (?n "no" "Ignore the suggestion")
+		                  (?e "explain" "Ask the package why is suggests this")))
+                      when (eq (car ch) ?y) return t
+                      when (eq (car ch) ?n) return nil
+                      when (eq (car ch) ?e) do (package--show-explanation explain))
+                 (prin1 `(add-hook ',hook #',function)))))))
+        (when (/= (point-min) (point-max))
+          (if preview
+              (let ((buf (get-buffer-create (format "*suggested configuration for %s*"
+                                                    package))))
+                (with-current-buffer buf
+                  (emacs-lisp-mode))
+                (copy-to-buffer buf (point-min) (point-max))
+                (pop-to-buffer buf))
+            (eval-buffer)
+            (append-to-file (point-min) (point-max)
+                            (or custom-file user-init-file))))))))
+
 ;;;###autoload
 (defun package-install (pkg &optional dont-select)
   "Install the package PKG.
@@ -2103,20 +2241,7 @@ package-install
 
 If PKG is a `package-desc' and it is already installed, don't try
 to install it but still mark it as selected."
-  (interactive
-   (progn
-     ;; Initialize the package system to get the list of package
-     ;; symbols for completion.
-     (package--archives-initialize)
-     (list (intern (completing-read
-                    "Install package: "
-                    (delq nil
-                          (mapcar (lambda (elt)
-                                    (unless (package-installed-p (car elt))
-                                      (symbol-name (car elt))))
-                                  package-archive-contents))
-                    nil t))
-           nil)))
+  (interactive (list (package--query-name 'not-installed "Install")))
   (package--archives-initialize)
   (add-hook 'post-command-hook #'package-menu--post-refresh)
   (let ((name (if (package-desc-p pkg)
@@ -2134,6 +2259,7 @@ package-install
         (progn
           (package-download-transaction transaction)
           (package--quickstart-maybe-refresh)
+          (with-local-quit (package-suggest-configuration pkg))
           (message  "Package `%s' installed." name))
       (message "`%s' is already installed" name))))
 
-- 
2.29.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 686 bytes --]