-
Notifications
You must be signed in to change notification settings - Fork 20
/
bufler-workspace-tabs.el
238 lines (204 loc) · 10.8 KB
/
bufler-workspace-tabs.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
;;; bufler-workspace-tabs.el --- Bufler workspace tabs -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Adam Porter
;; Author: Adam Porter <adam@alphapapa.net>
;; URL: https://github.com/alphapapa/bufler.el
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This provides a global minor mode that uses the new `tab-bar-mode'
;; and `tab-line-mode' in Emacs 27+ to show Bufler workspaces and
;; buffers, respectively.
;;; Code:
;;;; Requirements
(require 'map)
;; These are only present on Emacs 27+, so don't error if not found.
(require 'tab-bar nil t)
(require 'tab-line nil t)
;;;;; Compatibility
(eval-when-compile
(when (version< emacs-version "27.1")
;; Since tab-bar and tab-line are only present on Emacs 27+, we have to
;; declare several variables and functions to avoid byte-compiler warnings.
;; NOTE: Some compile warnings will happen on Emacs 26, but that's okay.
(defvar tab-bar-tabs-function)
(defvar tab-bar-close-button)
(defvar tab-bar-close-button-show)
(defvar tab-bar-separator)
(defvar tab-line-tabs-function)
;; Because the mode isn't necessarily defined.
(defvar bufler-workspace-tabs-mode)
(defvar bufler-workspace-tabs-mode-saved-settings)
(defvar bufler-workspace-tabs-tab-separator)
(declare-function tab-bar-mode "ext:tab-bar" t t)
(declare-function tab-bar--current-tab-index "ext:tab-bar" t t)
(declare-function tab-bar--tab "ext:tab-bar" t t)
(declare-function tab-bar-tabs "ext:tab-bar" t t)
(declare-function global-tab-line-mode "ext:tab-line" t t)
(declare-function tab-line-tabs-window-buffers "ext:tab-line" t t)
(declare-function bufler-workspace-tabs--tab-bar-select-tab "ext:bufler-workspace" t t)
(declare-function bufler-workspace-buffers "ext:bufler-workspace" t t)
(declare-function bufler-workspace-tabs "ext:bufler-workspace" t t)
(declare-function bufler-workspace-tabs-mode "ext:bufler-workspace" t t)))
;;;; Functionality
;; FIXME: Autoloading this whole form causes the generated autoloads
;; file to be considered the source file for everything defined in it.
;; I wonder if something like this could work in bufler-workspace.el:
;; ;;;###autoload
;; (when (require 'tab-bar nil t)
;; (require 'bufler-workspace-tabs))
;;;; Variables
(defvar bufler-workspace-tabs-mode-saved-settings
'((tab-bar-separator . nil) (tab-bar-close-button-show . nil))
"Settings saved from before `bufler-workspace-tabs-mode' was activated.
Used to restore them when the mode is disabled.")
;;;; Customization
(defcustom bufler-workspace-tabs-tab-separator " | "
"String displayed between tabs.
Since there is no built-in separator between tabs, it can be
unclear where one tab ends and the next begins, depending on face
settings. Normally the tab-close button would indicate where a
tab ends, but our tabs are dynamic, rule-generated workspaces and
aren't closable manually, so we repurpose the
`tab-bar-close-button' as a separator.
This string can be anything, including an image using display
properties. See the default value of `tab-bar-close-button'."
:type 'string
:group 'bufler-workspace)
;;;; Commands
(define-minor-mode bufler-workspace-tabs-mode
"Use Bufler workspaces for `tab-bar-mode' and `tab-line-mode'."
:group 'bufler-workspace
:global t
(if bufler-workspace-tabs-mode
(progn
;; Save settings.
(cl-loop for (symbol . _value) in bufler-workspace-tabs-mode-saved-settings
do (setf (map-elt bufler-workspace-tabs-mode-saved-settings symbol)
(symbol-value symbol)))
(advice-add 'tab-bar-select-tab :override #'bufler-workspace-tabs--tab-bar-select-tab)
(advice-add 'tab-bar-switch-to-tab :override #'bufler-workspace-frame-set)
(setf tab-bar-tabs-function #'bufler-workspace-tabs
tab-line-tabs-function #'bufler-workspace-buffers)
(tab-bar-mode 1)
(global-tab-line-mode 1)
;; NOTE: `tab-bar-mode' adds text properties to `tab-bar-close-button'
;; when it is activated, so we must set it after the mode is activated.
(setf tab-bar-separator bufler-workspace-tabs-tab-separator
tab-bar-close-button-show nil))
(advice-remove 'tab-bar-select-tab #'bufler-workspace-tabs--tab-bar-select-tab)
(advice-remove 'tab-bar-switch-to-tab #'bufler-workspace-frame-set)
(setf tab-bar-tabs-function #'tab-bar-tabs
tab-line-tabs-function #'tab-line-tabs-window-buffers)
;; Restore settings.
(cl-loop for (symbol . value) in bufler-workspace-tabs-mode-saved-settings
do (set symbol value)
do (setf (map-elt bufler-workspace-tabs-mode-saved-settings symbol) nil))
(tab-bar-mode -1)
(global-tab-line-mode -1))
(force-mode-line-update 'all))
(defalias 'bufler-tabs-mode #'bufler-workspace-tabs-mode)
(defun bufler-workspace-tabs--tab-bar-select-tab (&optional arg)
"Set the frame's workspace to the selected tab's workspace.
ARG is the position of the tab in the tab bar."
;; Modeled on/copied from `tab-bar-select-tab'.
(interactive "P")
(unless (integerp arg)
(let ((key (event-basic-type last-command-event)))
(setq arg (if (and (characterp key) (>= key ?1) (<= key ?9))
(- key ?0)
1))))
(let* ((tabs (funcall tab-bar-tabs-function))
(from-index (tab-bar--current-tab-index tabs))
(to-index (1- (max 1 (min arg (length tabs))))))
(unless (eq from-index to-index)
(let* ((_from-tab (tab-bar--tab))
(to-tab (nth to-index tabs))
(workspace-path (alist-get 'path to-tab)))
(bufler-workspace-frame-set workspace-path)
(force-mode-line-update 'all)))))
;;;; Functions
(defun bufler-workspace-tabs (&optional frame)
"Return a list of workspace tabs from FRAME's perspective.
FRAME defaults to the selected frame. Works as
`tab-bar-tabs-function'."
;; This is ridiculously complicated. It seems to all stem from,
;; again, that group paths can start with nil, but we need to ignore
;; initial nils when displaying paths, but we need to keep the
;; initial nil in the actual path. And then we need to store paths
;; as lists, not ever single elements, but putting a list in an
;; alist by consing the key onto the beginning causes its value to
;; be just the car of the value list, not a list itself (at least,
;; when retrieved with `alist-get'), which is very confusing, so we
;; use a plist at one point to avoid that. Anyway, this feels like
;; a terrible mess, so in the future we should probably use structs
;; for groups, which would probably make this much easier. I think
;; I've spent more time messing with this function than I have on
;; the actual grouping logic, which may say more about me than the
;; code.
(with-selected-frame (or frame (selected-frame))
(cl-labels ((tab-type
(path) (if (equal path (frame-parameter nil 'bufler-workspace-path))
'current-tab
'tab))
(path-first ;; CAR, or CADR if CAR is nil.
(path) (cl-typecase path
(string (list path))
(list (if (car path)
(list (car path))
(list (cadr path))))))
(workspace-to-tab
(workspace &optional type) (-let* (((&plist :name :path) workspace))
(list (or type (tab-type path))
(cons 'name (car name))
(cons 'path path))))
(path-top-level
(path) (pcase-exhaustive path
(`(,(and first (guard (not first)))
,(and second (guard second)) . ,_rest)
;; If I use _ in the variable names, it complains that they are not
;; unused. The test in (guard) doesn't count as using them, so it
;; complains either way. So use `ignore'. I hope it compiles out.
(ignore first second)
(cl-subseq path 0 2))
;; The path should always be a list!
(`(,first . ,_rest)
(list first))))
(path-to-workspace
;; This gets too complicated. We need to preserve the real path, but
;; if the first element is nil, we need to ignore that and display
;; the string after the nil. We sort-of cheat here by using
;; `path-first' in this function.
(path) (list :name (path-first path)
:path path)))
;; We bind all these lists to make understanding and debugging easier. And because
;; Edebug seems somewhat broken in Emacs 28 in that breakpoints don't seem to work
;; at all, so stepping through to the relevant point is practically impossible.
(let* ((bufler-vc-refresh nil)
(buffer-paths (bufler-group-tree-paths (bufler-buffers)))
(group-paths (mapcar #'butlast buffer-paths))
(top-level-paths (mapcar #'path-top-level group-paths))
(top-level-workspaces (mapcar #'path-to-workspace top-level-paths))
(unique-top-level-workspaces (seq-uniq top-level-workspaces #'equal))
(tabs (mapcar #'workspace-to-tab unique-top-level-workspaces)))
;; Add the current workspace if it's not listed (i.e. when the
;; current workspace is not a top-level workspace).
(unless (cl-loop with current-path = (frame-parameter nil 'bufler-workspace-path)
for tab in tabs
for tab-path = (alist-get 'path tab)
thereis (equal tab-path current-path))
(push (list 'current-tab
(cons 'name (bufler-format-path (frame-parameter nil 'bufler-workspace-path)))
(cons 'path (frame-parameter nil 'bufler-workspace-path)))
tabs))
tabs))))
;;;; Footer
(provide 'bufler-workspace-tabs)
;;; bufler-workspace-tabs.el ends here