(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
(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
projects / emacs.git / commitdiff