This repository has been archived on 2024-10-22. You can view files and clone it, but cannot push or open issues or pull requests.
spacemacs/core/core-customization.el
Arif Er 00f9ab19ac chore: update copyright headers to 2022
The script used to identify and update the change is added into the GitHub
workflows script directory. A workflow action can be created to trigger the
script to update the headers on the first of every new year. Possibly a task for
a consequent PR.
2022-06-03 17:32:20 +02:00

194 lines
8.7 KiB
EmacsLisp

;;; core-customization.el --- Spacemacs Core File -*- lexical-binding: t -*-
;;
;; Copyright (c) 2012-2022 Sylvain Benner & Contributors
;;
;; Author: Eugene "JAremko" Yaremenko <w3techplayground@gmail.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(require 'validate)
(require 'seq)
(eval-when-compile (require 'cl-lib))
(defalias 'spacemacs-customization//validate 'validate-value)
(defvar spacemacs-customization--current-group nil
"Used to auto-set `spacemacs|defc' group.")
(defgroup spacemacs-layers nil
"Spacemacs layers customizations."
:group 'spacemacs
:prefix 'spacemacs-layers-)
(defgroup spacemacs--uncustomizable nil
"Dummy group that contains variables that can't be customized."
:group 'spacemacs--phony-group)
(defgroup spacemacs-dotspacemacs-init nil
"Dotspacemacs init customizations."
:group 'spacemacs--uncustomizable)
(defgroup spacemacs-dotspacemacs-layers nil
"Dotspacemacs layers customizations."
:group 'spacemacs--uncustomizable)
(defconst spacemacs-customization-uncustomizable-groups
'(spacemacs--uncustomizable
spacemacs-dotspacemacs-init
spacemacs-dotspacemacs-layers)
"List of variable groups that can't be customized.")
(defmacro spacemacs|defc (symbol standard doc type &optional group-override safe)
"Spacemacs flavored `defcustom' for .spacemacs configurations.
SYMBOL is the variable name; it should not be quoted.
STANDARD is an expression specifying the variable's standard value.
DOC is a doc-string.
TYPE should be a widget type for editing the symbol's value.
See Info node `(elisp) Customization Types' for a list of
base types and useful composite types.
GROUP-OVERRIDE should be provided if you don't want Spacemacs to infer the
configuration group from the currently configured layer name.
SAFE should either be a function or t to be set to
safe-local-variable property. When it's t, use TYPE to determine
the safety.
NOTE: Use interactive function `spacemacs/customization-valid-p' to test if a
variable has a proper type. In interactive mode it will also `message'
variable's symbol, value and type - so you can call this function with a
similar .spacemacs variable and use its type as an example.
NOTE: Spacemacs checks variables using validate.el package. Currently it
doesn't support: `:inline', `plist', `coding-system', `color', `hook',
`restricted-sexp' types so more general ones should be used instead.
NOTE: Variables defined with a group listed in
`spacemacs-customization-uncustomizable-groups' won't appear in
`spacemacs' customization subgroups. Also their doc-string won't provide
customization menu link when viewed via `describe-variable'."
(declare (indent defun) (doc-string 3) (debug (name body)))
`(let ((group (or ,group-override
spacemacs-customization--current-group
'spacemacs--uncustomizable)))
(put ',symbol 'spacemacs-customization--variable t)
(custom-declare-variable
',symbol
;; Took this from the `defcustom' implementation.
,(if lexical-binding
``(funcall #',(lambda () ,standard))
`',standard)
,(format "%s\n\nTYPE: %s\n" doc type)
:type ,type
:group group)
(pcase ,safe
('t (put ',symbol 'safe-local-variable
(apply-partially 'spacemacs-customization//get-variable-validator
',symbol)))
((pred functionp) (put ',symbol 'safe-local-variable ,safe)))
(when (memq group spacemacs-customization-uncustomizable-groups)
;; HACK: This will make `custom-variable-p' return nil
;; so the `describe-variable' function won't add customization
;; link. Will there be the reckoning? Will see!
(put ',symbol 'standard-value nil)
(put ',symbol 'custom-autoload nil))))
(defun spacemacs/customization-valid-p (var-symbol)
"Return t if VAR-SYMBOL is a spacemacs custom variable with valid value.
Emits message with the result when called interactively."
(interactive "v")
(let* ((defc? (get var-symbol 'spacemacs-customization--variable))
(val (symbol-value var-symbol))
(type (custom-variable-type var-symbol))
(valid? (and defc? (validate-value val type t))))
(when (called-interactively-p 'interactive)
(if valid?
(message "symbol: \"%s\" value: \"%s\" type: \"%s\" is valid."
var-symbol val type)
(if defc?
(condition-case err (validate-value val type) (error (message err)))
(message "%s is not Spacemacs customization variable" var-symbol))))
valid?))
(defun spacemacs-customization//get-variable-validator (var-symbol val)
"Check the validity of VAL for the spacemacs custom variable VAR-SYMBOL.
Return t if VAL is valid, and return an error when VAL is invalid or when
VAR-SYMBOL is not a spacemacs custom variable.
This function should be used with `apply-partially', and be set to the
`safe-local-variable' perperty of VAR-SYMBOL. `apply-partially' returns a
validation function that takes one argument and validate it against the scheme
of VAR-SYMBOL.
When loading local variables, `safe-local-variable-p' would call the validation
function, and it would demote any error to a message and a nil return value.
Thus it returns t when VAL is valid and nil otherwise."
(if-let* ((_ (get var-symbol 'spacemacs-customization--variable))
(type (custom-variable-type var-symbol)))
(or (validate-value val type nil) t)
(user-error "%s is not a Spacemacs customization variable" var-symbol)))
(defun spacemacs-customization//group-variables (group-symbol)
"Given customization group symbol get its variables."
(let (ret-val)
(cl-labels ((rec (gs)
(cl-dolist (el (get gs 'custom-group))
(cl-case (cadr el)
(custom-variable (push (car el) ret-val))
(custom-group (rec (car el)))))))
(rec group-symbol))
ret-val))
(defun spacemacs-customization//validate-group-vars (group-symbol)
"Given customization group symbol validate its variables."
(dolist (var (spacemacs-customization//group-variables group-symbol))
(let ((val (symbol-value var))
(type (custom-variable-type var)))
(condition-case err (validate-value val type)
(error (error (concat "Variable: \"%s\" "
"has value: \"%s\" "
"that doesn't match its type: \"%s\". "
"Validator message: \"%s\"")
var val type err))))))
(defun spacemacs-customization//validate-dotspacemacs-init-vars ()
"Validate variables set in `dotspacemacs/init' function."
(spacemacs-customization//validate-group-vars 'spacemacs-dotspacemacs-init))
(defun spacemacs-customization//validate-dotspacemacs-layers-vars ()
"Validate variables set in `dotspacemacs/layers' function."
(spacemacs-customization//validate-group-vars 'spacemacs-dotspacemacs-layers))
(defun spacemacs-customization//create-layer-group (layer-name category-name)
"Create customization group heirarchy for the LAYER-NAME configurations.
Layers customization group symbol is returned."
(let* ((category-group-name (format "spacemacs-layers-%s" category-name))
(layer-group-name (format "%s-%s" category-group-name layer-name))
(category-group-symbol (intern category-group-name)))
(custom-declare-group category-group-symbol
nil
(format "Spacemacs %s category customizations."
category-name)
:group 'spacemacs-layers
:prefix (intern (concat category-group-name "-")))
(custom-declare-group
(intern layer-group-name)
nil
(format "Spacemacs %s layer customizations." layer-name)
:group category-group-symbol
:prefix (intern (concat category-group-name "-"
layer-group-name "-")))))
(provide 'core-customization)