New macro spacemacs/define-micro-state

Resolves #552

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 <sylvain.benner@gmail.com>
+;; 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)

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

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
         "<f1>" '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)))))