├── .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 |
--------------------------------------------------------------------------------