Changes
[emacs.git] / .emacs.d / elisp / local / framegroups.el
1 ;;; framegroups.el --- Workspaces for emacs using frames. -*- lexical-binding: t -*-
2
3 ;; Author: Fox Kiester
4 ;; URL: https://github.com/noctuid/framegroups.el
5 ;; Created: April 6, 2018
6 ;; Keywords: convenience, window, window-configuration, frames
7 ;; Package-Requires: ((cl-lib "0.5"))
8 ;; Version: 0.1
9
10 ;; This file is not part of GNU Emacs.
11
12 ;; This program is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26 ;; A workspace package that uses frames.
27
28 ;; For more information see the README in the online repository.
29
30 ;;; Code:
31 (require 'cl-lib)
32
33 ;; * Settings
34 (defgroup framegroups nil
35 "Provide commands for using frames as named workspaces."
36 :group 'convenience
37 :prefix "fg-")
38
39 (defcustom fg-hide-with-xdotool t
40 "Whether to hide the old frame when switching to a new one.
41 This only works on X and requires xdotool to be installed."
42 :group 'framegroups
43 :type 'boolean)
44
45 (defcustom fg-switch-with-xdotool t
46 "Whether to use xdotool instead of `select-frame-set-input-focus'.
47 This only works on X and requires xdotool to be installed."
48 :group 'framegroups
49 :type 'boolean)
50
51 (defcustom fg-auto-create t
52 "Whether to automatically create non-existent framegroups.
53 If the existing frame has not been managed by this package (i.e. it does not
54 have a framegroup name), `fg-switch-to-frame' will use `fg-rename-frame' instead
55 of `fg-create-frame'."
56 :group 'framegroups
57 :type 'boolean)
58
59 (defcustom fg-create-hook nil
60 "Hook run after creating a new frame.
61 Currently each function will be passed the name of the new frame. More arguments
62 may be added in the future, so please include &rest _ in the function argument
63 list."
64 :type 'hook
65 :group 'framegroups)
66
67 (defcustom fg-after-switch-hook nil
68 "Hook run after switching to another frame with `fg-switch-to-frame'.
69 Currently each function will be passed the name of the new frame. More arguments
70 may be added in the future, so please include &rest _ in the function argument
71 list."
72 :type 'hook
73 :group 'framegroups)
74
75 ;; * Helper Functions
76 (defun fg--wid (&optional frame)
77 "Return the window id of FRAME.
78 When FRAME is nil, return the window id of the current frame."
79 (cdr (assq 'outer-window-id (frame-parameters frame))))
80
81 (defun fg--name (&optional frame)
82 "Return the framegroup name of FRAME.
83 When FRAME is nil, return the name of the current frame."
84 (cdr (assq 'fg-name (frame-parameters frame))))
85
86 ;; used as exists-p as well
87 (defun fg--frame-names ()
88 "Return all existing framegroup names."
89 (delq nil (cl-loop for frame in (frame-list)
90 collect (fg--name frame))))
91
92 (defvar fg--last-name nil
93 "Holds the name of the last framegroup.")
94
95 (defun fg--save-last ()
96 "Stor the current framegroup name."
97 (let ((current-name (fg--name)))
98 (when current-name
99 (setq fg--last-name current-name))))
100
101 (defun fg--get-frame (name)
102 "Return the frame with the framegroup name NAME or nil."
103 (cl-dolist (frame (frame-list))
104 (when (string= (fg--name frame) name)
105 (cl-return frame))))
106
107 (defun fg--use-xdotool-to-hide-p ()
108 "Return whether xdotool should be used to unmap frames."
109 (and fg-hide-with-xdotool
110 (eq window-system 'x)
111 (executable-find "xdotool")))
112
113 (defun fg--use-xdotool-to-switch-p ()
114 "Return whether xdotool should be used to activate/switch frames."
115 (and fg-switch-with-xdotool
116 (eq window-system 'x)
117 (executable-find "xdotool")))
118
119 ;; * Commands
120 ;;;###autoload
121 (defun fg-rename-frame (name)
122 "Rename the current frame's framegroup name to NAME."
123 (interactive (list (read-string "Name: ")))
124 (set-frame-parameter nil 'fg-name name)
125 (run-hook-with-args 'fg-create-hook name))
126
127 ;;;###autoload
128 (defun fg-create-frame (name &optional background)
129 "Create and return new frame with the framegroup name NAME.
130 When BACKGROUND is non-nil unmap the newly created frame with xdotool."
131 (interactive (list (read-string "Name: ")))
132 (when (fg--get-frame name)
133 (error "Framegroup %s already exists" name))
134 (fg--save-last)
135 (when (and (fg--use-xdotool-to-hide-p)
136 (not background))
137 (start-process "fg-switch" nil "xdotool" "windowunmap" (fg--wid)))
138 (let ((frame (make-frame (list (cons 'fg-name name)))))
139 (when (and (fg--use-xdotool-to-hide-p)
140 background)
141 (start-process "fg-bg" nil "xdotool" "windowunmap" (fg--wid frame)))
142 (with-selected-frame frame
143 (run-hook-with-args 'fg-create-hook name))
144 frame))
145
146 ;;;###autoload
147 (defun fg-switch-to-frame (name)
148 "Swith to the frame with the framegroup name NAME."
149 (interactive (list (completing-read
150 "Switch to frame: "
151 (delete (fg--name) (fg--frame-names)))))
152 (when (string= name (fg--name))
153 (error "Already on framegroup %s" name))
154 (let* ((frame (fg--get-frame name))
155 (old-wid (fg--wid))
156 (target-wid (fg--wid frame)))
157 (cond
158 (frame
159 (fg--save-last)
160 (cond ((fg--use-xdotool-to-hide-p)
161 (start-process "fg-switch" nil "xdotool" "windowunmap" old-wid
162 "windowmap" target-wid "windowactivate" target-wid))
163 ((fg--use-xdotool-to-switch-p)
164 (start-process "fg-switch" nil "xdotool" "windowmap" target-wid
165 "windowactivate" target-wid))
166 (t
167 (select-frame-set-input-focus frame)))
168 (with-selected-frame frame
169 (run-hook-with-args 'fg-after-switch-hook (fg--name frame))))
170 (t
171 (unless fg-auto-create
172 (error "Framegroup %s does not exist" name))
173 (if (fg--name)
174 (fg-create-frame name)
175 (fg-rename-frame name))))))
176
177 ;;;###autoload
178 (defun fg-switch-to-last-frame ()
179 "Switch to the previously focused framegroup frame."
180 (interactive)
181 (if fg--last-name
182 (fg-switch-to-frame fg--last-name)
183 (error "No last frame")))
184
185 ;;;###autoload
186 (defmacro fg-switch (name)
187 "Create and return a command to switch to the framegroup named NAME."
188 (let ((func-name (intern (concat "fg-switch-to-frame-" name))))
189 `(progn
190 (defun ,func-name ()
191 ,(format "Switch to the framegroup named %s." name)
192 (interactive)
193 (fg-switch-to-frame ,name))
194 #',func-name)))
195
196 ;; * Modeline Integration
197 ;;;###autoload
198 (defun fg-mode-line-string ()
199 "Return the framegroup name formatted for the mode line."
200 (let ((name (fg--name)))
201 (when name
202 (format "(fg: %s) " (fg--name)))))
203
204 ;; * Desktop Integration
205 ;;;###autoload
206 (defun fg-unmap-other-frames ()
207 "Unmap all frames besides the selected one."
208 (when (fg--use-xdotool-to-hide)
209 (let ((inhibit-redisplay t))
210 (dolist (frame (frame-list))
211 (unless (eq frame (selected-frame))
212 (start-process "fg-unmap" nil "xdotool" "windowunmap"
213 (fg--wid frame)))))))
214
215 ;;;###autoload
216 (defun fg-desktop-setup (&optional undo)
217 "Unmap all but the last focused frame when restoring session with desktop.el"
218 (if undo
219 (remove-hook 'desktop-after-read-hook #'fg-unmap-other-frames)
220 (add-hook 'desktop-after-read-hook #'fg-unmap-other-frames)))
221
222 (provide 'framegroups)
223 ;;; framegroups.el ends here