mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source 
* 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.
This commit is contained in:
Mauro Aranda 2023-10-23 09:45:12 -03:00 • committed by Juri Linkov
parent e81e625ab8
commit c79ea103ef
3 changed files with 299 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

5
doc/emacs/custom.texi
View file

@ -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

5
etc/NEWS
View file

@ -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

289
lisp/cus-edit.el
View file

@ -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