[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Infrastructure for packages to suggest customizations
From: |
Philip Kaludercic |
Subject: |
Infrastructure for packages to suggest customizations |
Date: |
Tue, 16 Feb 2021 02:12:17 +0100 |
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.
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")
+
;;; `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
signature.asc
Description: PGP signature
- Infrastructure for packages to suggest customizations,
Philip Kaludercic <=