;;; core-toggle.el --- Spacemacs Core File -*- lexical-binding: t -*- ;; ;; Copyright (c) 2012-2022 Sylvain Benner & Contributors ;; ;; Author: Sylvain Benner ;; 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 . (require 'core-funcs) (defvar spacemacs-toggles '() "List of all declared toggles. The structure of an element is a property list (name :func FUNCTION :doc STRING :key STRING).") (defmacro spacemacs|add-toggle (name &rest props) "Add a toggle with NAME symbol. This macro creates the following functions: - spacemacs/toggle-NAME switches on or off depending on the current state - spacemacs/toggle-NAME-on only switches on if currently disabled - spacemacs/toggle-NAME-off only switches off if currently enabled - spacemacs/toggle-NAME-status returns non-nil if the toggle is on Additional sets of functions are created when the toggle is major mode specific (i.e. it uses the keyword `:evil-leader-for-mode'): - spacemacs/toggle-NAME-register-on-hook-MODE to add a hook to call the toggle on function - spacemacs/toggle-NAME-on-unregister-hook-MODE to remove the hook - spacemacs/toggle-NAME-on-register-hooks to add hooks for all supported major modes - spacemacs/toggle-NAME-on-unregister-hooks to remove all the hooks Available PROPS: `:status EXPRESSION' The EXPRESSION to evaluate to get the current status of the toggle. `:if EXPRESSION' If this EXPRESSION evaluate to nil then no attempt to update the toggle status will be performed. `:on BODY' Evaluate BODY when the toggle is switched on. `:off BODY' Evaluate BODY when the toggle is switched off. `:documentation STRING' STRING describes what the toggle does. `:prefix SYMBOL' SYMBOL is bound to the raw value of prefix-arg (same as calling (interactive \"P\")) in the wrapper function. `:on-message EXPRESSION' EXPRESSION is evaluated and displayed when the \"on\" toggle is activated. `:off-message EXPRESSION' EXPRESSION is evaluated and displayed when the \"off\" toggle is activated. `:mode SYMBOL' If given, must be a minor mode. This overrides `:on', `:off' and `:status'. All properties supported by `spacemacs//create-key-binding-form' can be used." (declare (indent 1)) (let* ((wrapper-func (intern (format "spacemacs/toggle-%s" (symbol-name name)))) (wrapper-func-status (intern (format "%s-status" wrapper-func))) (wrapper-func-on (intern (format "%s-on" wrapper-func))) (wrapper-func-off (intern (format "%s-off" wrapper-func))) (mode (plist-get props :mode)) (status (or mode (plist-get props :status))) (condition (plist-get props :if)) (doc (plist-get props :documentation)) (on-body (if mode `((,mode)) (spacemacs/mplist-get-values props :on))) (off-body (if mode `((,mode -1)) (spacemacs/mplist-get-values props :off))) (prefix-arg-var (plist-get props :prefix)) (on-message (plist-get props :on-message)) (off-message (plist-get props :off-message)) (evil-leader-for-mode (spacemacs/mplist-get-values props :evil-leader-for-mode)) (supported-modes-string (mapconcat (lambda (x) (symbol-name (car x))) evil-leader-for-mode ", ")) (bindkeys (spacemacs//create-key-binding-form props wrapper-func)) ;; we evaluate condition and status only if they are a list or ;; a bound symbol (status-eval `(and (or (and (symbolp ',status) (boundp ',status)) (listp ',status)) ,status)) (condition-eval (if condition `(and (or (and (symbolp ',condition) (boundp ',condition)) (listp ',condition)) ,condition) t))) `(progn (let ((properties (append '(:function ,wrapper-func :predicate ,wrapper-func-status) ',props)) (cell (assq ',name spacemacs-toggles))) (if cell (setcdr cell properties) (push (cons ',name properties) spacemacs-toggles))) ;; toggle function (defun ,wrapper-func ,(if prefix-arg-var (list prefix-arg-var) ()) ,(format "Toggle %s on and off.%s" (symbol-name name) (if doc (concat "\n\n" doc) "")) ,(if prefix-arg-var '(interactive "P") '(interactive)) (if ,condition-eval ;; check if current buffer major mode supports the toggle (if (and ',evil-leader-for-mode (not (assq major-mode ',evil-leader-for-mode))) (message (concat "Toggle: %S\n" "This toggle is not supported with major mode: %S\n" "Supported major modes are: %s") ',name major-mode ,supported-modes-string ) (if (,wrapper-func-status) (progn ,@off-body (when (called-interactively-p 'any) (message ,(or off-message (format "%s disabled." name))))) ,@on-body (when (called-interactively-p 'any) (message ,(or on-message (format "%s enabled." name)))))) (message (concat "Toggle: %S\n" "This toggle is not supported.") ',name))) ;; predicate function (defun ,wrapper-func-status () ,(format "Check if %s is on." (symbol-name name)) (and ,condition-eval ,status-eval)) ;; Only define on or off functions when status is available ,@(when status `( ;; on function (defun ,wrapper-func-on () ,(format "Toggle %s on." (symbol-name name)) (interactive) (unless (,wrapper-func-status) (,wrapper-func))) ;; off function (defun ,wrapper-func-off () ,(format "Toggle %s off." (symbol-name name)) (interactive) (when (,wrapper-func-status) (,wrapper-func))) ;; on and off functions for each mode specific toggles ,@(when evil-leader-for-mode (let ((wrapper-func-register-hooks (intern (format "%s-register-hooks" wrapper-func-on))) (wrapper-func-unregister-hooks (intern (format "%s-unregister-hooks" wrapper-func-on))) wrapper-mode-funcs) ;; register all hooks to turn on toggle (push `(defun ,wrapper-func-register-hooks () ,(format (concat "Register hooks to toggle %s on for all " "supported buffers.\n" "Supported buffer major modes are: %s") (symbol-name name) supported-modes-string) (interactive) (dolist (m ',(mapcar 'car evil-leader-for-mode)) (let ((mode-hook (intern (format "%s-hook" m)))) (add-hook mode-hook ',wrapper-func-on)))) wrapper-mode-funcs) ;; unregister all hooks to turn on toggle (push `(defun ,wrapper-func-unregister-hooks () ,(format (concat "Unregister hooks to toggle %s on for all" " supported buffers.\n" "Supported buffer major modes are: %s") (symbol-name name) supported-modes-string) (interactive) (dolist (m ',(mapcar 'car evil-leader-for-mode)) (let ((mode-hook (intern (format "%s-hook" m)))) (remove-hook mode-hook ',wrapper-func-on)))) wrapper-mode-funcs) (dolist (m (mapcar 'car evil-leader-for-mode)) (let* ((mode-hook (intern (format "%s-hook" m))) (wrapper-func-register-hook (intern (format "%s-register-hook-%s" wrapper-func-on m))) (wrapper-func-unregister-hook (intern (format "%s-unregister-hook-%s" wrapper-func-on m)))) ;; register hook to turn on toggle (push `(defun ,wrapper-func-register-hook () ,(format (concat "Register hook to toggle %s on for " "all `%s' buffers.") (symbol-name name) m) (interactive) (add-hook ',mode-hook ',wrapper-func-on)) wrapper-mode-funcs) ;; unregister hook to turn on toggle (push `(defun ,wrapper-func-unregister-hook () ,(format (concat "Unregister hook to toggle %s off for" " all `%s' buffers.") (symbol-name name) m) (interactive) (remove-hook ',mode-hook ',wrapper-func-on)) wrapper-mode-funcs))) wrapper-mode-funcs)))) ,@bindkeys))) (provide 'core-toggle)