From 397d01be969045c71cce44e640c4c990253e2105 Mon Sep 17 00:00:00 2001 From: syl20bnr Date: Sat, 7 Feb 2015 20:09:38 -0500 Subject: [PATCH] New macro spacemacs/define-micro-state Resolves #552 --- core/core-micro-states.el | 80 +++++++++++++++++++++++++++++++++++++ core/core-spacemacs-mode.el | 1 + spacemacs/packages.el | 56 +++++++++++++------------- 3 files changed, 109 insertions(+), 28 deletions(-) create mode 100644 core/core-micro-states.el diff --git a/core/core-micro-states.el b/core/core-micro-states.el new file mode 100644 index 000000000..4ae987eb9 --- /dev/null +++ b/core/core-micro-states.el @@ -0,0 +1,80 @@ +;;; -*- lexical-binding: t -*- +;;; core-micro-states.el --- Spacemacs Core File +;; +;; Copyright (c) 2012-2014 Sylvain Benner +;; Copyright (c) 2014-2015 Sylvain Benner & Contributors +;; +;; Author: Sylvain Benner +;; URL: https://github.com/syl20bnr/spacemacs +;; +;; This file is not part of GNU Emacs. +;; +;;; License: GPLv3 + +(defmacro spacemacs/define-micro-state (name &rest props) + "Define a micro-state called NAME. + +NAME is a symbol. + +Available PROPS: + +`:on-enter BODY' + Evaluate BODY when the micro-state is switched on. + +`:on-exit BODY' + Evaluate BODDY when leaving the micro-state. + +`:bindings EXPRESSIONS' + One or several EXPRESSIONS with the form (STRING SYMBOL) where STRING + is a key to bound to the function SYMBOL." + (declare (indent 1)) + (let* ((func (intern (format "spacemacs/%s-micro-state" (symbol-name name)))) + (on-enter (spacemacs/mplist-get props :on-enter)) + (on-exit (spacemacs/mplist-get props :on-exit)) + (bindings (spacemacs/mplist-get props :bindings)) + (wrappers (spacemacs//micro-state-create-wrappers name bindings)) + (keymap-body (spacemacs//micro-state-fill-map-sexps wrappers))) + `(defun ,func () + ,(format "%s micro-state." (symbol-name name)) + (interactive) + ,@on-enter + (,(if (version< emacs-version "24.4") + 'set-temporary-overlay-map + 'set-transient-map) + (let ((map (make-sparse-keymap))) + ,@keymap-body map) ',(spacemacs//micro-state-create-exit-func + name wrappers on-exit))))) + +(defun spacemacs//micro-state-create-wrappers (name bindings) + "Return an alist (key wrapper) for each binding in BINDINGS." + (mapcar (lambda (x) + (apply 'spacemacs//micro-state-create-wrapper + name x)) bindings)) + +(defun spacemacs//micro-state-create-wrapper (name key func) + "Create a wrapper of FUNC and return a tuple (KEY wrapper)." + (let* ((wrapper-name (intern (format "spacemacs//%s-%s" (symbol-name name) + (symbol-name func)))) + (wrapper-func (eval `(defun ,wrapper-name () + "Auto-generated function" + (interactive) + (call-interactively ',func))))) + (cons key wrapper-func))) + +(defun spacemacs//micro-state-fill-map-sexps (wrappers) + "Return a list of `define-key' sexp to fill the micro-state temporary map." + (mapcar (lambda (x) `(define-key map ,(car x) ',(cdr x))) + wrappers)) + +(defun spacemacs//micro-state-create-exit-func (name wrappers on-exit) + "Return a function to execute when leaving the micro-state." + (let ((func (intern (format "spacemacs//%s-on-exit" name)))) + (eval `(defun ,func () + "Function executed after each micro-state command." + (if (reduce (lambda (x y) (or x y)) + (mapcar (lambda (x) + (eq this-command (cdr x))) ',wrappers) + :initial-value nil) + 't ,@on-exit nil))))) + +(provide 'core-micro-states) diff --git a/core/core-spacemacs-mode.el b/core/core-spacemacs-mode.el index 57b765897..72edeb95c 100644 --- a/core/core-spacemacs-mode.el +++ b/core/core-spacemacs-mode.el @@ -118,6 +118,7 @@ "Create the special buffer for `spacemacs-mode' and perform startup initialization." (require 'core-toggles) + (require 'core-micro-states) (switch-to-buffer (get-buffer-create spacemacs-buffer-name)) (spacemacs-mode) (add-hook 'after-init-hook 'spacemacs/goto-link-line)) diff --git a/spacemacs/packages.el b/spacemacs/packages.el index 321bf8bb9..6453b08b3 100644 --- a/spacemacs/packages.el +++ b/spacemacs/packages.el @@ -1165,11 +1165,12 @@ which require an initialization must be listed explicitly in the list.") "fh" 'helm-find-files "fr" 'helm-recentf "" 'helm-apropos) - (defcustom spacemacs-helm-micro-state-color (face-attribute - 'error :foreground) - "Background color of helm header when helm micro-state is activated." - :type 'color - :group 'spacemacs)) + (when dotspacemacs-helm-micro-state + (defcustom spacemacs-helm-micro-state-color (face-attribute + 'error :foreground) + "Background color of helm header when helm micro-state is activated." + :type 'color + :group 'spacemacs))) :config (progn @@ -1209,13 +1210,11 @@ which require an initialization must be listed explicitly in the list.") (evil-leader/set-key-for-mode 'shell-mode "mH" 'spacemacs/helm-shell-history) (when dotspacemacs-helm-micro-state - (defun spacemacs/helm-navigation-micro-state () - "Set a temporary overlay map to navigate in a helm buffer." - (interactive) + (defun spacemacs//on-enter-helm-navigation () + "Initialization of helm micro-state." (set-face-attribute 'helm-header nil :background spacemacs-helm-micro-state-color) - ;; deactivate TAB during the micro-state (any key can be used to exit ;; the micro-state but this one seems to be a better choice so it ;; deserves a special treatment) @@ -1227,25 +1226,10 @@ which require an initialization must be listed explicitly in the list.") (dotimes (n 10) (define-key helm-map (number-to-string n) `(lambda () (interactive) (helm-select-nth-action - ,(% (+ n 9) 10))))) - (set-temporary-overlay-map - (let ((map (make-sparse-keymap))) - (define-key map "?" 'helm-help) - (define-key map "a" 'helm-select-action) - (define-key map "g" 'helm-beginning-of-buffer) - (define-key map "G" 'helm-end-of-buffer) - (define-key map "h" 'helm-previous-source) - (define-key map "j" 'helm-next-line) - (define-key map "k" 'helm-previous-line) - (define-key map "l" 'helm-next-source) - (define-key map "t" 'helm-toggle-visible-mark) - (define-key map "T" 'helm-toggle-all-marks) - (define-key map "v" 'helm-execute-persistent-action) - map) t 'spacemacs/on-exit-helm-micro-state)) + ,(% (+ n 9) 10)))))) - (defun spacemacs/on-exit-helm-micro-state () - "Action to perform when switching back to helm insert state." - (interactive) + (defun spacemacs//on-exit-helm-micro-state () + "Action to perform when exiting helm micor-state." ;; restore helm key map (define-key helm-map (kbd "C-i") 'spacemacs/helm-navigation-micro-state) @@ -1258,7 +1242,23 @@ which require an initialization must be listed explicitly in the list.") (set-face-attribute 'helm-header nil :background (face-attribute 'header-line :background))) - (spacemacs/on-exit-helm-micro-state)) + (spacemacs//on-exit-helm-micro-state) + + (spacemacs/define-micro-state helm-navigation + :on-enter (spacemacs//on-enter-helm-navigation) + :on-exit (spacemacs//on-exit-helm-micro-state) + :bindings + ("?" helm-help) + ("a" helm-select-action) + ("g" helm-beginning-of-buffer) + ("G" helm-end-of-buffer) + ("h" helm-previous-source) + ("j" helm-next-line) + ("k" helm-previous-line) + ("l" helm-next-source) + ("t" helm-toggle-visible-mark) + ("T" helm-toggle-all-marks) + ("v" helm-execute-persistent-action))) (eval-after-load "helm-mode" ; required '(spacemacs|hide-lighter helm-mode)))))