├── .gitignore ├── Cask ├── Makefile ├── README.md ├── state-tests.el └── state.el /.gitignore: -------------------------------------------------------------------------------- 1 | todo.org 2 | .dir-locals.el 3 | dist 4 | .cask 5 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source melpa) 2 | (package-file "state.el") 3 | 4 | (files "state.el" "README.md") 5 | (development 6 | (depends-on "test-simple")) 7 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CASK ?= cask 2 | EMACS ?= emacs 3 | DIST ?= dist 4 | EMACSFLAGS = --batch -Q 5 | EMACSBATCH = $(EMACS) $(EMACSFLAGS) 6 | 7 | VERSION := $(shell EMACS=$(EMACS) $(CASK) version) 8 | PKG_DIR := $(shell EMACS=$(EMACS) $(CASK) package-directory) 9 | PROJ_ROOT := $(shell dirname $(realpath $(lastword $(MAKEFILE_LIST)))) 10 | 11 | EMACS_D = ~/.emacs.d 12 | USER_ELPA_D = $(EMACS_D)/elpa 13 | 14 | SRCS = state.el 15 | TESTS = $(wildcard tests/*.el) 16 | TAR = $(DIST)/state-$(VERSION).tar 17 | 18 | 19 | .PHONY: all install uninstall reinstall clean-all clean test 20 | all : $(PKG_DIR) $(TAR) 21 | 22 | install : $(TAR) 23 | $(EMACSBATCH) -l package -f package-initialize \ 24 | --eval '(package-install-file "$(PROJ_ROOT)/$(TAR)")' 25 | 26 | uninstall : 27 | rm -rf $(USER_ELPA_D)/state-* 28 | 29 | test: 30 | ${CASK} exec ${EMACS} ${EMACSFLAGS} -l state-tests.el 31 | 32 | reinstall : clean uninstall install 33 | 34 | clean-all : clean 35 | rm -rf $(PKG_DIR) 36 | 37 | clean : 38 | rm -f *.elc 39 | rm -rf $(DIST) 40 | rm -f *-pkg.el 41 | 42 | $(PKG_DIR) : Cask 43 | $(CASK) install 44 | touch $(PKG_DIR) 45 | 46 | $(TAR) : $(DIST) 47 | $(CASK) package 48 | 49 | $(DIST) : 50 | mkdir $(DIST) 51 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # state 2 | 3 | This library allows you to switch back and forth between predefined 4 | workspaces. It allows you for example to press C-c s g to 5 | switch to `gnus` in fullscreen. When you are done with `gnus` your can 6 | switch back to where you were by pressing the same keystroke. 7 | Similarly, you can take a quick peek at your `*Messages*` buffer by 8 | pressing C-s s m and return to where you were by pressing the 9 | same keystroke. 10 | 11 | ## Installation 12 | 13 | Make sure the file `state.el` is in your load path and put the 14 | following in your `.emacs`: 15 | ```lisp 16 | (require 'state) 17 | (state-global-mode 1) 18 | ``` 19 | 20 | ## Simple buffer switching 21 | 22 | To define a new state, you need to use the macro `state-define-state`. 23 | The simplest switch is a switch to a buffer. For example the 24 | `*Messages*` buffer: 25 | ```lisp 26 | (state-define-state 27 | message 28 | :key "m" 29 | :switch "*Messages*") 30 | ``` 31 | The first argument to `state-define-state` is a unique symbol 32 | identifying the state. The rest is a property list. For a simple 33 | buffer switching state we have to specify the key to press to switch 34 | to that buffer and the name of the buffer we want to switch to. We 35 | could have specified the path of a file as well. Pressing C-c s 36 | m switches to the `*Messages*` buffer. Pressing it again 37 | switches back to where you were. 38 | 39 | ## General case 40 | 41 | If your workspace is not a simple file or if you want a different 42 | behaviour when switching to it, you have to specify yourself several 43 | properties. 44 | - The `:in` property is used to charaterize the state and should 45 | return a non-nil value if we are currently in this workspace and nil 46 | otherwise. 47 | - The `:exist` property tells if the workspace has been created. We no 48 | longer need to call the create property. 49 | - The `:create` property is used to create your workspace if it does 50 | not exist already. For example, if there is no `gnus` buffer for the 51 | `gnus` state. 52 | - The `:switch` property is performing the actual switch. 53 | - The `:bound` property is used to make a state only accessible from 54 | another state. It is useful for example to have dedicated terminal 55 | buffer for a project. 56 | 57 | ## Examples 58 | 59 | Some examples taken from my [emacs configuration](https://github.com/thisirs/dotemacs): 60 | - A simple switch to the `*scratch*` buffer: 61 | ```lisp 62 | (state-define-state 63 | scratch 64 | :key "s" 65 | :switch "*scratch*") 66 | ``` 67 | - To my timeline with `twittering-mode`: 68 | ```lisp 69 | (state-define-state 70 | twit 71 | :key "t" 72 | :in (and (require 'twittering-mode nil t) (twittering-buffer-p)) 73 | :switch twit) 74 | ``` 75 | - Switching to my `init-*.el` files: 76 | ```lisp 77 | (state-define-state 78 | emacs 79 | :key "e" 80 | :in "~/.emacs.d/init" 81 | :create (find-file "~/.emacs.d/init.el")) 82 | ``` 83 | - Switching to a terminal dedicated to the `emacs` state: 84 | ```lisp 85 | (state-define-state 86 | emacs-term 87 | :key "z" 88 | :bound emacs 89 | :exist (get-buffer "*ansi-term (dotemacs)*") 90 | :in (equal (buffer-name) "*ansi-term (dotemacs)*") 91 | :switch (state-switch-buffer-other-window "*ansi-term (dotemacs)*") 92 | :create (ansi-term "/bin/zsh" "ansi-term (dotemacs)")) 93 | ``` 94 | - Switching to a general purpose terminal: 95 | ```lisp 96 | (state-define-state 97 | term 98 | :key "z" 99 | :exist (get-buffer "*ansi-term*") 100 | :in (equal (buffer-name) "*ansi-term*") 101 | :switch (state-switch-buffer-other-window "*ansi-term*") 102 | :create (ansi-term "/bin/zsh")) 103 | ``` 104 | - Switching to `gnus`: 105 | ```lisp 106 | (state-define-state 107 | gnus 108 | :key "g" 109 | :in (memq major-mode 110 | '(message-mode 111 | gnus-group-mode 112 | gnus-summary-mode 113 | gnus-article-mode)) 114 | :exist gnus-alive-p 115 | :create gnus) 116 | ``` 117 | - For ERC users, switching to ERC and cycling through ERC buffers by 118 | pressing i repeatedly: 119 | ```lisp 120 | (state-define-state 121 | erc 122 | :key "i" 123 | :in (memq (current-buffer) 124 | (erc-buffer-list)) 125 | :switch (erc-start-or-switch 1) 126 | :keep (erc-track-switch-buffer 0)) 127 | ``` 128 | with `erc-start-or-switch` being 129 | ```lisp 130 | (defun erc-start-or-switch (arg) 131 | "Connect to ERC, or switch to last active buffer" 132 | (interactive "P") 133 | (if (and (get-buffer "irc.freenode.net:6667") 134 | (erc-server-process-alive (get-buffer "irc.freenode.net:6667"))) 135 | (erc-track-switch-buffer 1) 136 | (when (or arg (y-or-n-p "Start ERC? ")) 137 | (erc :server "irc.freenode.net" 138 | :port 6667 139 | :nick "thisirs" 140 | :password (secrets-get-secret "Default" "NickServ"))))) 141 | ``` 142 | - A context-aware switch to associated repl. Pressing C-c s j 143 | in an emacs-lisp file switches to `ielm`. Same for `MATLAB`, `python` 144 | and `ruby` files. 145 | ```lisp 146 | (defmacro state-define-repl (name key buffer-name from create) 147 | `(state-define-state 148 | ,name 149 | :bound ,from 150 | :key ,key 151 | :exist (get-buffer ,buffer-name) 152 | :in (equal (buffer-name) ,buffer-name) 153 | :switch (state-switch-buffer-other-window ,buffer-name) 154 | :create (progn 155 | (switch-to-buffer-other-window (current-buffer)) 156 | ,create))) 157 | 158 | (state-define-repl elisp-repl "j" "*ielm*" (eq major-mode 'emacs-lisp-mode) (ielm)) 159 | (state-define-repl matlab-repl "j" "*MATLAB*" (eq major-mode 'matlab-mode) (matlab-shell)) 160 | (state-define-repl python-repl "j" "*Python*" (eq major-mode 'python-mode) (run-python "/usr/bin/python2.7")) 161 | (state-define-repl ruby-repl "j" "*ruby*" (eq major-mode 'ruby-mode) (inf-ruby)) 162 | ``` 163 | -------------------------------------------------------------------------------- /state-tests.el: -------------------------------------------------------------------------------- 1 | ;;;; (executable-interpret (format "emacs -batch -L %s -l %s" (file-name-directory (locate-library "test-simple.elc")) buffer-file-name)) 2 | (require 'test-simple) 3 | (test-simple-start) 4 | 5 | (assert-t (load-file "./state.el") "Can't load ./state.el") 6 | 7 | (note "state-define-state") 8 | 9 | (assert-equal '(define-key state-prefix-map (kbd "0") 10 | (lambda () 11 | "Switch to state `test'" 12 | (interactive) 13 | (state--do-switch "0"))) 14 | (macroexpand '(state-define-state test 15 | :key "0" 16 | :in fake))) 17 | 18 | (defmacro setq-state (var &rest args) 19 | "[Test helper]Define state and set it to VAR" 20 | `(progn 21 | (state-define-state ,var ,@args) 22 | (setq ,var (state--get-state-by-name ',var)))) 23 | (put 'setq-state 'lisp-indent-function 1) 24 | 25 | (setq-state in-directory 26 | :key "a" 27 | :in "~/.emacs.d/") 28 | 29 | (setq-state in-file 30 | :key "b" 31 | :in "~/.emacs.d/init.el") 32 | (setq-state switch-file 33 | :key "c" 34 | :switch "~/.emacs.d/init.el") 35 | 36 | (setq-state switch-buf 37 | :key "d" 38 | :switch "*scratch*") 39 | 40 | (setq-state in-sexp 41 | :key "e" 42 | :in (ignore 1)) 43 | (setq-state in-and-switch 44 | :key "f" 45 | :in "in" 46 | :switch "switch") 47 | 48 | (fset 'func-in 'ignore) 49 | (setq-state create-in-exist-switch-before 50 | :key "g" 51 | :create func-create 52 | :in func-in 53 | :exist func-exist 54 | :switch func-switch 55 | :before func-before) 56 | 57 | (note "state-define-state:state-key") 58 | (assert-raises error 59 | (state-define-state no-key :switch func-switch) 60 | "no key") 61 | (assert-equal "a" (state-key in-directory)) 62 | 63 | (note "state-define-state:state-create") 64 | (assert-equal 'func-create (state-create create-in-exist-switch-before)) 65 | 66 | (assert-equal '(state--create-in-directory "~/.emacs.d/") 67 | (state-create in-directory)) 68 | (assert-equal '(state--create-in-file "~/.emacs.d/init.el") 69 | (state-create in-file)) 70 | (assert-equal '(state--create-switch-file "~/.emacs.d/init.el") 71 | (state-create switch-file)) 72 | (assert-equal '(state--create-switch-buffer "*scratch*") 73 | (state-create switch-buf)) 74 | (assert-equal '(state--create-switch-buffer "switch") 75 | (state-create in-and-switch)) 76 | 77 | 78 | (note "state-define-state:state-in") 79 | (assert-equal 'func-in (state-in create-in-exist-switch-before)) 80 | (assert-equal '(state--in-in-file "~/.emacs.d/") 81 | (state-in in-directory)) 82 | (assert-equal '(state--in-switch-file "~/.emacs.d/init.el") 83 | (state-in switch-file)) 84 | (assert-equal '(state--in-switch-buffer "*scratch*") 85 | (state-in switch-buf)) 86 | (assert-equal '(state--in-in-file "in") 87 | (state-in in-and-switch)) 88 | (assert-raises error 89 | (state-define-state err 90 | :key "E" 91 | :switch func) 92 | "no in") 93 | 94 | (note "state-define-state:state-exist") 95 | (assert-equal 'func-exist (state-exist create-in-exist-switch-before)) 96 | (assert-equal '(state--exist-in-file "~/.emacs.d/") 97 | (state-exist in-directory)) 98 | (assert-equal '(state--exist-switch-buffer "*scratch*") 99 | (state-exist switch-buf)) 100 | (assert-equal '(state--exist-in-file "in") 101 | (state-exist in-and-switch)) 102 | 103 | (note "state-define-state:state-switch") 104 | (assert-equal 'func-switch (state-switch create-in-exist-switch-before)) 105 | (assert-equal '(state--switch-in-file "~/.emacs.d/" 'in-directory) 106 | (state-switch in-directory)) 107 | (assert-equal '(state--switch-switch-file "~/.emacs.d/init.el") 108 | (state-switch switch-file)) 109 | (assert-equal '(state--switch-switch-buffer "*scratch*") 110 | (state-switch switch-buf)) 111 | (assert-equal '(state--switch-default 'in-sexp) 112 | (state-switch in-sexp)) 113 | (assert-equal '(state--switch-switch-buffer "switch") 114 | (state-switch in-and-switch)) 115 | 116 | (note "state-define-state:state-before") 117 | (assert-equal 'func-before (state-before create-in-exist-switch-before)) 118 | (assert-equal '(state--before-default 'in-directory) 119 | (state-before in-directory)) 120 | 121 | (note "priority:bound") 122 | (state-define-state 1 :key "C-a" :in "a" :bound 1 :priority 10) 123 | (state-define-state 2 :key "C-a" :in "a" :bound 1) 124 | (assert-equal '(2) (mapcar 'state-name (state--select-states "C-a" 'default))) 125 | 126 | (state-define-state 3 :key "C-b" :in "a" :bound 1 :priority 10) 127 | (state-define-state 4 :key "C-b" :in "a" :bound 1 :priority 5) 128 | (state-define-state 5 :key "C-b" :in "a" :bound 1 :priority 7) 129 | (assert-equal '(4) (mapcar 'state-name (state--select-states "C-b" 'default))) 130 | 131 | (state-define-state 6 :key "C-c" :in "a" :bound 1 :priority 10) 132 | (state-define-state 7 :key "C-c" :in "a" :bound 1 :priority 5) 133 | (state-define-state 8 :key "C-c" :in "a" :bound 1 :priority 5) 134 | (assert-equal '(7 8) (sort (mapcar 'state-name (state--select-states "C-c" 'default)) '<)) 135 | 136 | 137 | (note "priority:unbound") 138 | (state-define-state 9 :key "C-d" :in "a" :priority 10) 139 | (state-define-state 10 :key "C-d" :in "a") 140 | (assert-equal '(9 10) (sort (mapcar 'state-name (state--select-states "C-d" 'default)) '<)) 141 | 142 | (note "priority:bound and unbound") 143 | (state-define-state 11 :key "C-d" :in "a" :bound 1 :priority 9999) 144 | (assert-equal '(11) (sort (mapcar 'state-name (state--select-states "C-d" 'default)) '<)) 145 | 146 | (note "state--get-state-in") 147 | (set-buffer "*scratch*") 148 | (assert-equal switch-buf (state--get-state-in)) 149 | 150 | (note "state--do-switch: new state") 151 | (setq-state another-switch-buf 152 | :key "A" 153 | :switch "*another-scratch*") 154 | (setq scratch-winconf (current-window-configuration)) 155 | (state--do-switch "A") 156 | (assert-equal another-switch-buf (state--get-state-in)) 157 | ;; save previous state to origin 158 | (assert-equal 'switch-buf (state-origin another-switch-buf)) 159 | ;; save window configuration before switching state 160 | (assert-equal scratch-winconf (state-current switch-buf)) 161 | 162 | (note "state--do-switch: same state (switch to previous state)") 163 | (state--do-switch "A") 164 | (assert-equal switch-buf (state--get-state-in)) 165 | 166 | (note "state--do-switch: switch back") 167 | (state--do-switch "A") 168 | (assert-equal another-switch-buf (state--get-state-in)) 169 | 170 | (note "state--do-switch: call flow") 171 | 172 | (setq-state exist-test-state 173 | :key "B" 174 | :exist (progn (push 'Bexist flow) t) 175 | :switch (push 'Bswitch flow) 176 | :before (push 'Bbefore flow) 177 | :create (push 'Bcreate flow) 178 | :in (push 'Bin flow) 179 | :switch (push 'Bswitch flow)) 180 | (setq-state not-exist-in-state 181 | :key "C" 182 | :exist (progn (push 'Cexist flow) nil) 183 | :switch (push 'Cswitch flow) 184 | :before (push 'Cbefore flow) 185 | :create (push 'Ccreate flow) 186 | :in (progn (push 'Cin flow) t) 187 | :switch (push 'Cswitch flow)) 188 | (setq-state not-exist-not-in-state 189 | :key "D" 190 | :exist (progn (push 'Dexist flow) nil) 191 | :switch (push 'Dswitch flow) 192 | :before (push 'Dbefore flow) 193 | :create (push 'Dcreate flow) 194 | :in (progn (push 'Din flow) nil) 195 | :switch (push 'Dswitch flow)) 196 | 197 | (cl-letf (((symbol-function 'state--get-state-in) 198 | (lambda () state--default-state))) 199 | (let (flow) ; 200 | (state--do-switch (state-key exist-test-state)) 201 | (assert-equal '(Bexist Bswitch Bbefore) (reverse flow))) 202 | (let (flow) 203 | (state--do-switch (state-key not-exist-in-state)) 204 | (assert-equal '(Cexist Ccreate Cin Cbefore) (reverse flow))) 205 | (let (flow) 206 | (state--do-switch (state-key not-exist-not-in-state)) 207 | (assert-equal '(Dexist Dcreate Din Dswitch Dbefore) (reverse flow)))) 208 | 209 | (end-tests) 210 | -------------------------------------------------------------------------------- /state.el: -------------------------------------------------------------------------------- 1 | ;;; state.el --- Quick navigation between workspaces -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2013-2017 Sylvain Rousseau 4 | 5 | ;; Author: Sylvain Rousseau 6 | ;; Keywords: convenience, workspaces 7 | ;; Package-Requires: ((emacs "24")) 8 | ;; Package-Version: 0.1 9 | ;; URL: https://github.com/thisirs/state.git 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;; This library allows you to switch back and forth between predefined 26 | ;; workspaces. See the README file for more information. 27 | 28 | ;;; Installation: 29 | 30 | ;; (require 'state) 31 | ;; (state-global-mode 1) 32 | 33 | ;; There is no predefined workspaces to switch to. To switch back and 34 | ;; forth to the *Messages* buffer by pressing C-c s m: 35 | 36 | ;; (state-define-state 37 | ;; message 38 | ;; :key "m" 39 | ;; :switch "*Messages*") 40 | 41 | ;; See full documentation on https://github.com/thisirs/state#state 42 | 43 | ;;; Code: 44 | 45 | (require 'cl-lib) 46 | 47 | ;;; Compatibility 48 | (unless (functionp 'cl-struct-slot-info) 49 | (defun cl-struct-slot-info (struct-type) 50 | "Return a list of slot names of struct STRUCT-TYPE. 51 | Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a 52 | slot name symbol and OPTS is a list of slot options given to 53 | `cl-defstruct'. Dummy slots that represent the struct name 54 | and slots skipped by :initial-offset may appear in the list." 55 | (get struct-type 'cl-struct-slots)) 56 | (put 'cl-struct-slot-info 'side-effect-free t)) 57 | 58 | ;;; Customization 59 | (defgroup state nil 60 | "Quick navigation between workspaces" 61 | :prefix "state-" 62 | :group 'convenience) 63 | 64 | (defcustom state-keymap-prefix (kbd "C-c s") 65 | "The prefix command for state's keymap. 66 | The value of this variable is checked as part of loading state mode. 67 | After that, changing the prefix key requires manipulating `state-mode-map'." 68 | :type 'string 69 | :group 'state) 70 | 71 | ;;; Core 72 | (cl-defstruct state 73 | "Structure representing a state. 74 | Slots: 75 | 76 | `name' 77 | Symbol identifying the state. 78 | `key' 79 | Key used to switch to this state. 80 | `switch' 81 | Form that performs the switch. 82 | `exist' 83 | Form that tells if the state is existing. 84 | `create' 85 | Form to create the state. 86 | `in' 87 | Form that returns true if we are in this state. 88 | `bound' 89 | If non-nil, this state is accessible only from another state. 90 | `priority' 91 | Priority of state if there is more than one we want to switch to. 92 | `keep' 93 | What to do when we keep pressing the key after switching. 94 | `before' 95 | Action to perform before switching to another state. 96 | `origin' 97 | Store state symbol name we are coming from. 98 | `current' 99 | Data used to restore this state; usually a wconf." 100 | name key switch exist create in bound priority keep before origin current) 101 | 102 | (defvar state--states nil 103 | "List of all defined states.") 104 | 105 | (defvar state--default-state 106 | (make-state :name 'default 107 | :switch '(state--switch-default 'default) 108 | :before '(state--before-default 'default)) 109 | "Default state when not in any other state.") 110 | 111 | (defconst state-min-priority -100000 112 | "Lowest value of priority, ie. highest priority.") 113 | 114 | (defun state--message (msg &rest args) 115 | (if (minibufferp) 116 | (apply #'minibuffer-message msg args) 117 | (apply #'message msg args))) 118 | 119 | (defun state--filter (collection slot pred-or-value) 120 | "Return all states found in COLLECTION with SLOT's value satisfying PRED-OR-VALUE. 121 | 122 | If PRED-OR-VALUE is a function, call it with slot's value as 123 | first argument. Otherwise, compare slot's value with `equal'." 124 | (unless (memq slot (mapcar #'car (cl-struct-slot-info 'state))) 125 | (error "Unknown slot name: %s" slot)) 126 | (let ((predicate (if (functionp pred-or-value) 127 | pred-or-value 128 | (lambda (v) (equal pred-or-value v))))) 129 | (cl-remove-if-not 130 | (lambda (state) 131 | (funcall predicate (funcall (intern (format "state-%s" slot)) state))) 132 | collection))) 133 | 134 | (defun state--get-state-by-name (name) 135 | "Return a state object with name NAME found in `state--states'. 136 | 137 | If NAME is equal to `default', return the default state 138 | `state--default-state', nil otherwise." 139 | (if (stringp name) (setq name (intern name))) 140 | (if (eq name 'default) 141 | state--default-state 142 | (cl-find-if (lambda (state) (eq name (state-name state))) state--states))) 143 | 144 | (defun state--get-state-in () 145 | "Return the current state or default state if not in any." 146 | (or (cl-find-if (lambda (state) (state-call state 'in)) state--states) 147 | state--default-state)) 148 | 149 | (defun state-call (state slot &rest args) 150 | "Call or eval the value of slot SLOT in state STATE. Call with 151 | ARGS if supplied." 152 | (let ((value (funcall (intern (format "state-%s" slot)) state))) 153 | (if (functionp value) 154 | (apply value args) 155 | (eval value)))) 156 | 157 | (defun state--select-states (key from-name) 158 | "Return states to switch to when KEY is pressed and when coming from FROM-NAME." 159 | (let* ((states (state--filter state--states 'key key)) 160 | (unbound (state--filter states 'bound 'not)) 161 | (bound (state--filter states 'bound 162 | (lambda (v) 163 | (cond ((symbolp v) 164 | (eq v from-name)) 165 | ((functionp v) 166 | (funcall v)) 167 | (t 168 | (eval v))))))) 169 | (if bound 170 | (cl-loop for state in bound 171 | collect (cons (state-priority state) state) into pairs 172 | collect (state-priority state) into priorities 173 | finally return 174 | (mapcar 'cdr (cl-remove-if-not 175 | (lambda (pair) (= (apply 'min priorities) (car pair))) 176 | pairs))) 177 | unbound))) 178 | 179 | (defun state--do-switch (key) 180 | "Perform the switch process when KEY is pressed." 181 | (let* ((from (state--get-state-in)) 182 | (to (state--choose-state-to-switch key from))) 183 | (if (eq to from) 184 | (state--switch-back from) 185 | (state--switch-to to from key)))) 186 | 187 | (defun state--choose-state-to-switch (key from) 188 | "Return state to switch to by pressing KEY when coming from FROM. 189 | 190 | Return FROM if we are switching back. Otherwise, return state 191 | described by KEY, asking the user if there is more than one 192 | state." 193 | (let ((states (if (equal key (state-key from)) 194 | (list from) 195 | (state--select-states key (state-name from))))) 196 | (cond ((not states) 197 | (error "Non-existent state")) 198 | ((= 1 (length states)) 199 | (car states)) 200 | (t 201 | (state--get-state-by-name 202 | (completing-read "Choose state: " (mapcar 'state-name states) 203 | nil t)))))) 204 | 205 | (defun state--switch-back (from) 206 | "Perform the actual switch back to state FROM." 207 | (state-call from 'before) 208 | (let ((origin (state-origin from))) 209 | (if (not origin) 210 | (user-error "Not coming from anywhere") 211 | (let ((wconf (state-current (state--get-state-by-name origin)))) 212 | (if (not (window-configuration-p wconf)) 213 | (user-error "No wconf stored for `%s' state" origin) 214 | (set-window-configuration wconf) 215 | (if (eq origin 'default) 216 | (state--message "Back to default state") 217 | (state--message "Back to `%s' state" origin))))))) 218 | 219 | (defun state--switch-to (to from key) 220 | "Perform the actual switch to state TO coming from FROM by 221 | pressing KEY." 222 | ;; Not switching back but switching to, so save original state 223 | (setf (state-origin to) (state-name from)) 224 | 225 | ;; Save current wconf to restore it if we switch back 226 | (setf (state-current from) (current-window-configuration)) 227 | 228 | ;; Executes any other user defined "before" form 229 | (state-call from 'before) 230 | 231 | (cond ((state-call to 'exist) 232 | (state-call to 'switch) 233 | (state-call to 'before)) 234 | (t 235 | (state-call to 'create) 236 | (unless (state-call to 'in) 237 | (state-call to 'switch)) 238 | (state-call to 'before))) 239 | (state--message "Switched to `%s' state" (state-name to)) 240 | 241 | ;; If keep in non-nil install transient keymap 242 | (if (state-keep to) 243 | (set-transient-map 244 | (let ((map (make-sparse-keymap))) 245 | (define-key map (kbd key) 246 | (lambda () 247 | (interactive) 248 | (state-call to 'keep to))) 249 | map) t))) 250 | 251 | ;;; Autoload as a defun to avoid too early autoloading 252 | ;;;###autoload (autoload 'state-define-state "state") 253 | (defmacro state-define-state (name &rest args) 254 | "Define a new state named NAME with property list ARGS. 255 | 256 | :name Symbol representing the state. 257 | 258 | :key String of length 1 used as a key in keymap `state-mode-map' 259 | to switch to the state. 260 | 261 | :in Field that is used to say if emacs currently displays the 262 | state. If it is a string, return non-nil if current buffer is 263 | visiting a file that is an ancestor of that string. If it is a 264 | form or function, call it. 265 | 266 | :switch Field that is used to perform the actual switch. It is 267 | called if it is a function or a form. If it is a valid path, 268 | switch to a buffer visiting that file or switch to the buffer 269 | with that name. If that field is not specified, infer a suitable 270 | one if :in is a string. 271 | 272 | :exist Function or form called to say if the state exists. Some 273 | states might require a set up when first called. :exist is used 274 | to say if that set up has already been made. 275 | 276 | :create Function or form called to create the state. It is linked 277 | to the :exist property. When the state does not exists, :create 278 | is called. 279 | 280 | :before Function or form called just before switching. It allows 281 | the current state to save its state. By default, it saves the 282 | current windows configuration. 283 | 284 | :bound Field saying if the current state should only be 285 | accessible from another state. It is the name of another state or 286 | a form to be called. 287 | 288 | :priority A number indicating the priority of a state when 289 | several states hold the same key. The state with the lowest 290 | priority is preferred. If several states have the same lowest 291 | priority, ask the user to choose. By convention, nil is of 292 | infinite priority. 293 | 294 | :keep A form or function that is called if we keep pressing the 295 | key after switching. Leave nil is you don't want this feature." 296 | (declare (indent defun)) 297 | (let ((state (or (state--get-state-by-name name) (make-state))) 298 | (key (plist-get args :key)) 299 | (switch (plist-get args :switch)) 300 | (before (plist-get args :before)) 301 | (in (plist-get args :in)) 302 | (bound (plist-get args :bound)) 303 | (priority (plist-get args :priority)) 304 | (exist (plist-get args :exist)) 305 | (keep (plist-get args :keep)) 306 | (create (plist-get args :create)) 307 | (defun-sym (intern (format "state--switch-to-%s" name)))) 308 | 309 | (setf (state-name state) name) 310 | (if key 311 | (setf (state-key state) key) 312 | (error "No property key defined")) 313 | (setf (state-priority state) (or priority state-min-priority)) 314 | (setf (state-bound state) bound) 315 | (setf (state-keep state) keep) 316 | (setf (state-create state) (state--rewrite-create create in switch)) 317 | (setf (state-in state) (state--rewrite-in in switch)) 318 | (setf (state-exist state) (state--rewrite-exist exist in switch)) 319 | (setf (state-switch state) (state--rewrite-switch switch name in)) 320 | (setf (state-before state) (state--rewrite-before before name)) 321 | (setf (state-current state) nil) 322 | 323 | `(progn 324 | (unless (state--get-state-by-name ',name) 325 | (add-to-list 'state--states ,state)) 326 | 327 | ;; Define command switching to NAME 328 | (defun ,defun-sym () 329 | ,(format "Switch to state `%s'" name) 330 | (interactive) 331 | (state--do-switch ,key)) 332 | 333 | ;; And bind it to KEY 334 | (define-key state-prefix-map (kbd ,key) ',defun-sym)))) 335 | 336 | (defun state--rewrite-create (create in switch) 337 | "Return a modified CREATE propery based on IN or SWITCH. 338 | 339 | If CREATE is nil, infer one base on SWITCH or IN properties if 340 | they are strings. Otherwise leave nil." 341 | (cond (create) 342 | ((and (stringp switch) (file-name-absolute-p switch)) 343 | `(state--create-switch-file ,switch)) 344 | ((stringp switch) 345 | `(state--create-switch-buffer ,switch)) 346 | ((and (stringp in) (file-directory-p in)) 347 | `(state--create-in-directory ,in)) 348 | ((stringp in) 349 | `(state--create-in-file ,in)))) 350 | 351 | (fset 'state--create-in-directory 'dired-noselect) 352 | (fset 'state--create-in-file 'dired-noselect) 353 | (fset 'state--create-switch-file 'find-file-noselect) 354 | (fset 'state--create-switch-buffer 'get-buffer-create) 355 | 356 | 357 | (defun state--rewrite-in (in switch) 358 | "Return a modified IN property based on SWITCH." 359 | (cond ((stringp in) 360 | `(state--in-in-file ,in)) 361 | (in) 362 | ((and (stringp switch) (file-name-absolute-p switch)) 363 | `(state--in-switch-file ,switch)) 364 | ((stringp switch) 365 | `(state--in-switch-buffer ,switch)) 366 | ((null in) 367 | (error "No :in property or not able to infer one")))) 368 | 369 | (defun state--buffer-file-name-prefix-p (buf prefix) 370 | "Return true if buffer BUF is visiting a file whose filename is 371 | prefixed by PREFIX. If no filename, use `default-directory' instead." 372 | (string-prefix-p 373 | (file-truename prefix) 374 | (let ((bfn (or (buffer-file-name buf) default-directory "/"))) 375 | (if (file-remote-p bfn) 376 | bfn 377 | (file-truename bfn))))) 378 | 379 | (defun state--in-in-file (in) 380 | (state--buffer-file-name-prefix-p (current-buffer) in)) 381 | 382 | (defun state--in-switch-file (switch) 383 | (eq (current-buffer) (find-buffer-visiting switch))) 384 | 385 | (defun state--in-switch-buffer (switch) 386 | (eq (current-buffer) (get-buffer switch))) 387 | 388 | (defun state--rewrite-exist (exist in switch) 389 | "Return a modified EXIST property based on IN or SWITCH. 390 | 391 | If the EXIST property is nil, infer one base on SWITCH or IN if 392 | they are strings. Otherwise leave nil." 393 | (cond (exist) 394 | ((stringp in) 395 | `(state--exist-in-file ,in)) 396 | ((stringp switch) 397 | `(state--exist-switch-buffer ,switch)))) 398 | 399 | (defun state--find-file-name-prefix-buffer (prefix) 400 | (cl-find-if (lambda (buf) (state--buffer-file-name-prefix-p buf prefix)) 401 | (buffer-list))) 402 | 403 | (fset 'state--exist-in-file 'state--find-file-name-prefix-buffer) 404 | (fset 'state--exist-switch-buffer 'get-buffer) 405 | 406 | (defun state--rewrite-switch (switch name in) 407 | "Return a modified SWITCH property based on NAME or IN." 408 | (cond ((and (stringp switch) (file-name-absolute-p switch)) 409 | `(state--switch-switch-file ,switch)) 410 | ((stringp switch) 411 | `(state--switch-switch-buffer ,switch)) 412 | (switch) 413 | ((stringp in) 414 | `(state--switch-in-file ,in ',name)) 415 | (t 416 | `(state--switch-default ',name)))) 417 | 418 | (defun state--switch-switch-file (switch) 419 | (if current-prefix-arg 420 | (switch-to-buffer-other-window 421 | (find-file-noselect switch)) 422 | (find-file-existing switch))) 423 | 424 | (defun state--switch-switch-buffer (switch) 425 | (if current-prefix-arg 426 | (switch-to-buffer-other-window switch) 427 | (switch-to-buffer switch))) 428 | 429 | (defun state--switch-in-file (in name) 430 | (let ((state (state--get-state-by-name name))) 431 | (if (window-configuration-p (state-current state)) 432 | (set-window-configuration (state-current state)) 433 | (let ((buffer (or (state--find-file-name-prefix-buffer in) 434 | (and (file-directory-p in) 435 | (dired-noselect in)) 436 | (error "Unable to switch to `%s' state" name)))) 437 | (delete-other-windows) 438 | (switch-to-buffer buffer))))) 439 | 440 | (defun state--switch-default (name) 441 | (let ((state (state--get-state-by-name name))) 442 | (if (window-configuration-p (state-current state)) 443 | (set-window-configuration (state-current state))))) 444 | 445 | (defun state--rewrite-before (before name) 446 | "Return a modified BEFORE property based on NAME." 447 | (or before `(state--before-default ',name))) 448 | 449 | (defun state--before-default (name) 450 | "Default :before property base on NAME of state. 451 | 452 | Store the current window configuration in the slot curent." 453 | (let ((state (state--get-state-by-name name))) 454 | (when state 455 | (setf (state-current state) (current-window-configuration))))) 456 | 457 | (defun state-mode-default-state (&optional arg) 458 | "Called when a keystroke is not bound to a state." 459 | (interactive "P") 460 | (if arg 461 | (eval `(state-define-state ,(format "inline-%S" last-input-event) 462 | :key ,(char-to-string last-input-event) 463 | :switch ,(buffer-name))) 464 | (message "Undefined state"))) 465 | 466 | ;;; Minor mode 467 | (defvar state-prefix-map 468 | (let ((keymap (make-sparse-keymap))) 469 | (define-key keymap [t] #'state-mode-default-state) 470 | keymap) 471 | "Prefix map for state mode.") 472 | 473 | (defvar state-mode-map 474 | (let ((map (make-sparse-keymap))) 475 | (define-key map state-keymap-prefix state-prefix-map) 476 | map) 477 | "Keymap for state mode.") 478 | 479 | ;;;###autoload 480 | (define-minor-mode state-mode 481 | "Minor mode to switch between workspaces." 482 | :lighter " St" 483 | :keymap state-mode-map) 484 | 485 | ;;;###autoload 486 | (define-globalized-minor-mode state-global-mode 487 | state-mode 488 | state-on) 489 | 490 | ;;;###autoload 491 | (defun state-on () 492 | "Enable State minor mode." 493 | (state-mode 1)) 494 | 495 | ;;; Utility function 496 | (defun state-switch-buffer-other-window (buf) 497 | "Select window BUF is shown, otherwise display BUF in other window." 498 | (if (get-buffer-window buf) 499 | (select-window (get-buffer-window buf)) 500 | (switch-to-buffer-other-window buf))) 501 | 502 | (provide 'state) 503 | 504 | ;;; state.el ends here 505 | --------------------------------------------------------------------------------