Re: PROPOSAL: Repurpose one key and reserve it for third-party packages

[Philip K.]

"Philip K." <philipk@posteo.net> writes:

> All in all, I don't have a problem with Emacs being able to support it,
> but as I've shown with the example in my last message, it doesn't need
> to be done automatically, nor does it require a separate key. It's
> ultimately up to the user what he or she wants to do, and clever
> behind-your-back customization seems more harmful and confusing than the
> current state of affairs.

Just for the sake of it, this is a draft of how this could look like:

From 3e78e4e61462f116a56224e0750401e9b9596e1f 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 | 99 ++++++++++++++++++++++++++++++++------
 1 file changed, 85 insertions(+), 14 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 90b7b88d58..6ddd363003 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -145,6 +145,7 @@
 
 (require 'cl-lib)
 (eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'pcase))
 (eval-when-compile (require 'epg))      ;For setf accessors.
 (require 'seq)
 
@@ -2087,6 +2088,88 @@ package--archives-initialize
   (unless package-archive-contents
     (package-refresh-contents)))
 
+(defcustom package-ignore-suggestions nil
+  "Should package-"
+  :type '(choice (const :tag "Ask the user" nil)
+                 (const :tag "Never ask" t)
+                 (set :tag "Ignore certain suggestions"
+                      (const :tag "Keybindings" key)
+                      (const :tag "User Options" option)
+                      (const :tag "Hooks" hook)))
+  :version "28.1")
+
+(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 . DATA), where TYPE says
+what kind of a suggestion is being made 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-suggest-configuration (package &optional dont-load)
+  "Query the user to automatically configure PACKAGE.
+If DONT-LOAD is non-nil, do not load the new customization."
+  (interactive (list (package--query-name 'installed) current-prefix-arg))
+  (unless (and (not (called-interactively-p 'any))
+               (eq package-ignore-suggestions t))
+    (let ((temp-buffer-show-function #'ignore)
+          (save-silently t))
+      (with-temp-buffer
+        (with-output-to-temp-buffer (current-buffer)
+          (dolist (sug (cdr (assq package pacakge-configuration-suggestions)))
+            (unless (memq (car sug) package-ignore-suggestions)
+              (terpri nil t)
+              (pcase sug
+                (`(key ,key ,fn)
+                 (when (yes-or-no-p (format "Bind %s to \"%s\"?" fn key))
+                   (prin1 `(global-set-key (kbd ,key) #',fn))))
+                (`(option ,opt ,val)
+                 (when (yes-or-no-p (format "Set option %s to %S?" opt val))
+                   (prin1 `(customize-set-variable ',opt ,val))))
+                (`(hook ,hook ,fn)
+                 (when (yes-or-no-p (format "Add %s to hook %S?" fn hook))
+                   (prin1 `(add-hook ',hook #',fn)))))))
+          (unless dont-load
+            (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 +2186,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 +2204,7 @@ package-install
         (progn
           (package-download-transaction transaction)
           (package--quickstart-maybe-refresh)
+          (package-suggest-configuration pkg)
           (message  "Package `%s' installed." name))
       (message "`%s' is already installed" name))))
 
-- 
2.29.2

-- 
        Philip K.

signature.asc
Description: PGP signature