master c79ea103efd: Add easy customization for dir-locals files (Bug#66702)

[Juri Linkov]

branch: master
commit c79ea103efd6fa3004c14f373305a17c49d6462d
Author: Mauro Aranda <maurooaranda@gmail.com>
Commit: Juri Linkov <juri@linkov.net>

    Add easy customization for dir-locals files (Bug#66702)
    
    * lisp/cus-edit.el (custom--editable-field-p): New utility function.
    (custom-dirlocals-widget, custom-dirlocals-file-widget)
    (custom-dirlocals-commands, custom-dirlocals-tool-bar-map): New
    variables.
    (custom-dirlocals-map, custom-dirlocals-field-map): New keymaps.
    (Custom-dirlocals-menu): New menu.
    (custom-dirlocals-key, custom-dynamic-cons, custom-dirlocals): New
    widgets.
    (custom-dirlocals-maybe-update-cons, custom-dirlocals-symbol-action)
    (custom-dirlocals-change-file, custom-dirlocals--set-widget-vars)
    (custom-dirlocals-get-options, custom-dirlocals-validate): New
    functions.
    (custom-dirlocals-with-buffer): New macro.
    (Custom-dirlocals-revert-buffer, Custom-dirlocals-save)
    (customize-dirlocals): New commands.
    
    * doc/emacs/custom.texi (Directory Variables): Document
    customize-dirlocals.
    
    * etc/NEWS: Announce.
---
 doc/emacs/custom.texi |   5 +
 etc/NEWS              |   5 +
 lisp/cus-edit.el      | 289 ++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 299 insertions(+)

diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index d51912a75da..e2d35863bd0 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1515,6 +1515,11 @@ want to modify.  Although it doesn't have to exist, you 
must enter a
 valid filename, either @file{.dir-locals.el} or
 @file{.dir-locals-2.el}.
 
+@findex customize-dirlocals
+There's also a command to pop up an Easy Customization buffer
+(@pxref{Easy Customization}) to edit directory local variables,
+@code{customize-dirlocals}.
+
 @findex dir-locals-set-class-variables
 @findex dir-locals-set-directory-class
   Another method of specifying directory-local variables is to define
diff --git a/etc/NEWS b/etc/NEWS
index 05fd1b7a390..ed9f1a2124c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -961,6 +961,11 @@ For links in 'webjump-sites' without an explicit URI 
scheme, it was
 previously assumed that they should be prefixed with "http://";.  Such
 URIs are now prefixed with "https://"; instead.
 
+** Customize
++++
+*** New command customize-dirlocals
+This command pops up a buffer to edit the settings in .dir-locals.el
+
 
 * New Modes and Packages in Emacs 30.1
 
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 953b8b8b80f..6442ffeac24 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -512,6 +512,13 @@ WIDGET is the widget to apply the filter entries of MENU 
on."
        (push name result)))
     (nreverse result)))
 
+(defun custom--editable-field-p (widget)
+  "Non-nil if WIDGET is an editable-field widget, or inherits from it."
+  (let ((type (widget-type widget)))
+    (while (and type (not (eq type 'editable-field)))
+      (setq type (widget-type (get type 'widget-type))))
+    type))
+
 ;;; Unlispify.
 
 (defvar custom-prefix-list nil
@@ -5692,6 +5699,288 @@ This stores EXP (without evaluating it) as the saved 
spec for SYMBOL."
           (prin1 value (current-buffer)))
         (insert ")\n")))))
 
+;;; Directory Local Variables.
+;; The following code provides an Easy Customization interface to manage
+;; `.dir-locals.el' files.
+;; The main command is `customize-dirlocals'.  It presents a Custom-like buffer
+;; but with a few tweaks.  Variables are inserted in a repeat widget, and
+;; update its associated widget (the one for editing the value) upon the user
+;; hitting RET or TABbing out of it.
+;; This is unlike the `cus-theme.el' interface for editing themes, that prompts
+;; the user for the variable to then create the appropriate widget.
+(defvar-local custom-dirlocals-widget nil
+  "Widget that holds the dir-locals customizations.")
+
+(defvar-local custom-dirlocals-file-widget nil
+  "Widget that holds the name of the dir-locals file being customized.")
+
+(defvar-keymap custom-dirlocals-map
+  :doc "Keymap used in the \"*Customize Dirlocals*\" buffer."
+  :full t
+  :parent widget-keymap
+  "SPC"     #'scroll-up-command
+  "S-SPC"   #'scroll-down-command
+  "DEL"     #'scroll-down-command
+  "C-x C-s" #'Custom-dirlocals-save
+  "q"       #'Custom-buffer-done
+  "n"       #'widget-forward
+  "p"       #'widget-backward)
+
+(defvar custom-dirlocals-field-map
+  (let ((map (copy-keymap custom-field-keymap)))
+    (define-key map "\C-x\C-s" #'Custom-dirlocals-save)
+    (define-key map "\C-m" #'widget-field-activate)
+    map)
+  "Keymap for the editable fields in the \"*Customize Dirlocals*\" buffer .")
+
+(defvar custom-dirlocals-commands
+  '((" Save Settings " Custom-dirlocals-save t
+     "Save Settings to the dir-locals file." "save" "Save" t)
+    (" Undo Edits " Custom-dirlocals-revert-buffer t
+     "Revert buffer, undoing any editions."
+     "refresh" "Undo" t)
+    (" Help for Customize " Custom-help t "Get help for using Customize."
+     "help" "Help" t)
+    (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit" t))
+  "Alist of specifications for Customize menu items, tool bar icons and 
buttons.
+See `custom-commands' for further explanation.")
+
+(easy-menu-define
+  Custom-dirlocals-menu (list custom-dirlocals-map
+                              custom-dirlocals-field-map)
+  "Menu used in dirlocals customization buffers."
+  (nconc (list "Custom"
+               (customize-menu-create 'customize))
+         (mapcar (lambda (arg)
+                   (let ((tag     (nth 0 arg))
+                         (command (nth 1 arg))
+                         (visible (nth 2 arg))
+                         (help    (nth 3 arg))
+                         (active  (nth 6 arg)))
+                     (vector tag command :visible (eval visible)
+                             :active `(eq t ',active)
+                             :help help)))
+                 custom-dirlocals-commands)))
+
+(defvar custom-dirlocals-tool-bar-map nil
+  "Keymap for the toolbar in \"*Customize Dirlocals*\" buffer.")
+
+(define-widget 'custom-dirlocals-key 'menu-choice
+  "Menu to choose between possible keys in a dir-locals file.
+
+Possible values are nil, a symbol (standing for a major mode) or a directory
+name."
+  :tag "Specification"
+  :value nil
+  :help-echo "Select a key for the dir-locals specification."
+  :args '((const :tag "All modes" nil)
+          (symbol :tag "Major mode" fundamental-mode)
+          (directory :tag "Subdirectory")))
+
+(define-widget 'custom-dynamic-cons 'cons
+  "A cons widget that changes its 2nd type based on the 1st type."
+  :value-create #'custom-dynamic-cons-value-create)
+
+(defun custom-dynamic-cons-value-create (widget)
+  "Select an appropriate 2nd type for the cons WIDGET and create WIDGET.
+
+The appropriate types are:
+- A symbol, if the value to represent is a minor-mode.
+- A boolean, if the value to represent is either the unibyte value or the
+  subdirs value.
+- A widget type suitable for editing a variable, in case of specifying a
+  variable's value.
+- A sexp widget, if none of the above happens."
+  (let* ((args (widget-get widget :args))
+         (value (widget-get widget :value))
+         (val (car value)))
+    (cond
+     ((eq val 'mode) (setf (nth 1 args)
+                           '(symbol :keymap custom-dirlocals-field-map
+                                    :tag "Minor mode")))
+     ((eq val 'unibyte) (setf (nth 1 args) '(boolean)))
+     ((eq val 'subdirs) (setf (nth 1 args) '(boolean)))
+     ((custom-variable-p val)
+      (let ((w (widget-convert (custom-variable-type val))))
+        (when (custom--editable-field-p w)
+          (widget-put w :keymap custom-dirlocals-field-map))
+        (setf (nth 1 args) w)))
+     (t (setf (nth 1 args) '(sexp :keymap custom-dirlocals-field-map))))
+    (widget-put (nth 0 args) :keymap custom-dirlocals-field-map)
+    (widget-group-value-create widget)))
+
+(defun custom-dirlocals-maybe-update-cons ()
+  "If focusing out from the first widget in a cons widget, update its value."
+  (when-let ((w (widget-at)))
+    (when (widget-get w :custom-dirlocals-symbol)
+      (widget-value-set (widget-get w :parent)
+                        (cons (widget-value w) ""))
+      (widget-setup))))
+
+(define-widget 'custom-dirlocals 'editable-list
+  "An editable list to edit settings in a dir-locals file."
+  :entry-format "%i %d %v"
+  :insert-button-args '(:help-echo "Insert new specification here.")
+  :append-button-args '(:help-echo "Append new specification here.")
+  :delete-button-args '(:help-echo "Delete this specification.")
+  :args '((group :format "%v"
+                 custom-dirlocals-key
+                 (repeat
+                  :tag "Settings"
+                  :inline t
+                  (custom-dynamic-cons
+                   :tag "Setting"
+                   (symbol :action custom-dirlocals-symbol-action
+                           :custom-dirlocals-symbol t)
+                   ;; Will change according to the option being customized.
+                   (sexp :tag "Value"))))))
+
+(defun custom-dirlocals-symbol-action (widget &optional _event)
+  "Action for the symbol WIDGET.
+
+Sets the value of its parent, a cons widget, in order to create an
+appropriate widget to edit the value of WIDGET.
+
+Moves point into the widget that holds the value."
+  (setq widget (or widget (widget-at)))
+  (widget-value-set (widget-get widget :parent)
+                    (cons (widget-value widget) ""))
+  (widget-setup)
+  (widget-forward 1))
+
+(defun custom-dirlocals-change-file (widget &optional _event)
+  "Switch to a buffer to customize the dir-locals file in WIDGET."
+  (customize-dirlocals (expand-file-name (widget-value widget))))
+
+(defun custom-dirlocals--set-widget-vars ()
+  "Set local variables for the Widget library."
+  (custom--initialize-widget-variables)
+  (add-hook 'widget-forward-hook #'custom-dirlocals-maybe-update-cons nil t))
+
+(defmacro custom-dirlocals-with-buffer (&rest body)
+  "Arrange to execute BODY in a \"*Customize Dirlocals*\" buffer."
+  ;; We don't use `custom-buffer-create' because the settings here
+  ;; don't go into the `custom-file'.
+  `(progn
+     (switch-to-buffer "*Customize Dirlocals*")
+     (kill-all-local-variables)
+     (let ((inhibit-read-only t))
+       (erase-buffer))
+     (remove-overlays)
+     (custom-dirlocals--set-widget-vars)
+     ,@body
+     (setq-local tool-bar-map
+                 (or custom-dirlocals-tool-bar-map
+                     ;; Set up `custom-dirlocals-tool-bar-map'.
+                     (let ((map (make-sparse-keymap)))
+                       (mapc
+                        (lambda (arg)
+                          (tool-bar-local-item-from-menu
+                           (nth 1 arg) (nth 4 arg) map custom-dirlocals-map
+                           :label (nth 5 arg)))
+                        custom-dirlocals-commands)
+                       (setq custom-dirlocals-tool-bar-map map))))
+     (setq-local revert-buffer-function #'Custom-dirlocals-revert-buffer)
+     (use-local-map custom-dirlocals-map)
+     (widget-setup)))
+
+(defun custom-dirlocals-get-options ()
+  "Return all options inside a custom-dirlocals widget."
+  (let* ((groups (widget-get custom-dirlocals-widget :children))
+         (repeats (mapcar (lambda (group)
+                            (nth 1 (widget-get group :children)))
+                          groups)))
+    (mapcan (lambda (repeat)
+              (mapcar (lambda (w)
+                        (nth 1 (widget-get w :children)))
+                      (widget-get repeat :children)))
+            repeats)))
+
+(defun custom-dirlocals-validate ()
+  "Non-nil if all customization options validate.
+
+If at least an option doesn't validate, signals an error and moves point
+to the widget with the invalid value."
+  (dolist (opt (custom-dirlocals-get-options))
+    (when-let ((w (widget-apply opt :validate)))
+      (goto-char (widget-get w :from))
+      (error "%s" (widget-get w :error))))
+  t)
+
+(defun Custom-dirlocals-revert-buffer (&rest _ignored)
+  "Revert the buffer for Directory Local Variables customization."
+  (interactive)
+  (customize-dirlocals (widget-get custom-dirlocals-file-widget :value)))
+
+(defun Custom-dirlocals-save (&rest _ignore)
+  "Save the settings to the dir-locals file being customized."
+  (interactive)
+  (when (custom-dirlocals-validate)
+    (let* ((file (widget-value custom-dirlocals-file-widget))
+           (old (widget-get custom-dirlocals-widget :value))
+           (dirlocals (widget-value custom-dirlocals-widget)))
+      (dolist (spec old)
+        (let ((mode (car spec))
+              (settings (cdr spec)))
+          (dolist (setting settings)
+            (delete-dir-local-variable mode (car setting) file))))
+      (dolist (spec dirlocals)
+        (let ((mode (car spec))
+              (settings (cdr spec)))
+          (dolist (setting (reverse settings))
+            (when (memq (car setting) '(mode eval))
+              (delete-dir-local-variable mode (car setting) file))
+            (add-dir-local-variable mode (car setting) (cdr setting) file)))))
+    ;; Write the dir-locals file and kill its buffer, to come back to
+    ;; our own buffer.
+    (write-file (expand-file-name buffer-file-name) nil)
+    (kill-buffer)))
+
+;;;###autoload
+(defun customize-dirlocals (&optional filename)
+  "Customize Directory Local Variables in the current directory.
+
+With optional argument FILENAME non-nil, customize the `.dir-locals.el' file
+that FILENAME specifies."
+  (interactive)
+  (let* ((file (or filename (expand-file-name ".dir-locals.el")))
+         (dirlocals (when (file-exists-p file)
+                      (with-current-buffer (find-file-noselect file)
+                        (goto-char (point-min))
+                        (prog1
+                            (condition-case _
+                                (read (current-buffer))
+                              (end-of-file nil))
+                          (kill-buffer))))))
+    (custom-dirlocals-with-buffer
+     (widget-insert
+      "This buffer is for customizing the Directory Local Variables in:\n")
+     (setq custom-dirlocals-file-widget
+           (widget-create `(file :action ,#'custom-dirlocals-change-file
+                                 ,file)))
+     (widget-insert
+      (substitute-command-keys
+       "
+To select another file, edit the above field and hit RET.
+
+After you enter a user option name under the symbol field,
+be sure to press \\`RET' or \\`TAB', so that the field that holds the
+value changes to an appropriate field for the option.
+
+Type \\`C-x C-s' when you've finished editing it, to save the
+settings to the file."))
+     (widget-insert "\n\n\n")
+     (widget-create 'push-button :tag " Revert "
+                    :action #'Custom-dirlocals-revert-buffer)
+     (widget-insert " ")
+     (widget-create 'push-button :tag " Save Settings "
+                    :action #'Custom-dirlocals-save)
+     (widget-insert "\n\n")
+     (setq custom-dirlocals-widget
+           (widget-create 'custom-dirlocals :value dirlocals))
+     (setq default-directory (file-name-directory file))
+     (goto-char (point-min)))))
+
 (provide 'cus-edit)
 
 ;;; cus-edit.el ends here