-
Notifications
You must be signed in to change notification settings - Fork 16
/
tabspaces.el
789 lines (698 loc) · 32.7 KB
/
tabspaces.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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
;;; tabspaces.el --- Leverage tab-bar and project for buffer-isolated workspaces -*- lexical-binding: t -*-
;; Author: Colin McLear <[email protected]>
;; Maintainer: Colin McLear
;; Version: 1.5
;; Package-Requires: ((emacs "27.1") (project "0.8.1"))
;; Keywords: convenience, frames
;; Homepage: https://github.com/mclear-tools/tabspaces
;; Copyright (C) 2022 Colin McLear
;; This file is not part of GNU Emacs
;; 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 package provides several functions to facilitate a frame-based
;; tab workflow with one workspace per tab, integration with project.el (for
;; project-based workspaces) and buffer isolation per tab (i.e. a "tabspace"
;; workspace). The package assumes project.el and tab-bar.el are both present
;; (they are built-in to Emacs 27.1+).
;; This file is not part of GNU Emacs.
;;; Acknowledgements
;; Much of the package code is inspired by:
;; - https://github.com/kaz-yos/emacs
;; - https://github.com/wamei/elscreen-separate-buffer-list/issues/8
;; - https://www.rousette.org.uk/archives/using-the-tab-bar-in-emacs/
;; - https://github.com/minad/consult#multiple-sources
;; - https://github.com/florommel/bufferlo
;;; Code:
;;;; Requirements
(require 'tab-bar)
(require 'project)
(require 'vc)
(require 'seq)
(require 'cl-lib)
(require 'dired-x)
(declare-function magit-init "magit-status")
(declare-function magit-status-setup-buffer "magit-status")
;;;; Variables
(defgroup tabspaces nil
"Manage tab/workspace buffers."
:group 'convenience)
(defcustom tabspaces-default-tab "Default"
"Specify a default tab by name TAB."
:group 'tabspaces
:type 'string)
(defcustom tabspaces-remove-to-default t
"Add buffer to default tabspace when removed from current tabspace."
:group 'tabspaces
:type 'boolean)
(defcustom tabspaces-include-buffers '("*scratch*")
"Buffers that should always get included in a new tab or frame.
This is a list of regular expressions that match buffer names,
which overrides buffers excluded by `tabspaces-exclude-buffers'."
:group 'tabspaces
:type '(repeat string))
(defcustom tabspaces-exclude-buffers nil
"Buffers that should always get excluded in a new tab or frame.
This is a list of regular expressions that match buffer names,
which does not override buffers inside `tabspaces-include-buffers'."
:group 'tabspaces
:type '(repeat string))
(defcustom tabspaces-use-filtered-buffers-as-default nil
"When t, remap `switch-to-buffer' to `tabspaces-switch-to-buffer'."
:group 'tabspaces
:type 'boolean)
(defcustom tabspaces-keymap-prefix "C-c TAB"
"Key prefix for the tabspaces-prefix-map keymap."
:group 'tabspaces
:type 'string)
(defcustom tabspaces-initialize-project-with-todo t
"When Non-nil create a `tabspaces-todo-file-name' file in the project
when creating a workspace for it."
:group 'tabspaces
:type 'boolean)
(defcustom tabspaces-todo-file-name "project-todo.org"
"The name of the TODO file to create if non-existing for new workspaces."
:group 'tabspaces
:type 'string)
(defcustom tabspaces-project-switch-commands project-switch-commands
"Available commands when switch between projects.
Change this value if you wish to run a specific command, such as
`find-file' on project switch. Otherwise this will default to
the value of `project-switch-commands'."
:group 'tabspaces
:type 'sexp)
(defcustom tabspaces-fully-resolve-paths nil
"Resolve \".\", \"..\", etc. in project paths."
:group 'tabspaces
:type 'boolean)
;;;; Create Buffer Workspace
(defun tabspaces-reset-buffer-list ()
"Reset the current tab's `buffer-list'.
Only the current window buffers and buffers in
`tabspaces-include-buffers' are kept in the `buffer-list' and
`buried-buffer-list'."
(interactive)
;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Current-Buffer.html
;; The current-tab uses `buffer-list' and `buried-buffer-list'.
;; A hidden tab keeps these as `wc-bl' and `wc-bbl'.
(set-frame-parameter nil
'buffer-list
(let ((window-buffers (mapcar #'window-buffer (window-list))))
(seq-filter (lambda (buffer)
(or (member buffer window-buffers)
(and (member (buffer-name buffer)
tabspaces-include-buffers)
(not (member (buffer-name buffer)
tabspaces-exclude-buffers)))))
(frame-parameter nil 'buffer-list))))
(set-frame-parameter nil
'buried-buffer-list
(seq-filter (lambda (buffer)
(and (member (buffer-name buffer)
tabspaces-include-buffers)
(not (member (buffer-name buffer)
tabspaces-exclude-buffers))))
(frame-parameter nil 'buried-buffer-list))))
(defun tabspaces--tab-post-open-function (_tab)
"Reset buffer list on new tab creation."
(tabspaces-reset-buffer-list))
;;;; Filter Workspace Buffers
(defun tabspaces--local-buffer-p (buffer)
"Return whether BUFFER is in the list of local buffers."
(or (member (buffer-name buffer) tabspaces-include-buffers)
(memq buffer (frame-parameter nil 'buffer-list))))
(defun tabspaces--set-buffer-predicate (frame)
"Set the buffer predicate of FRAME to `tabspaces--local-buffer-p'."
(set-frame-parameter frame 'buffer-predicate #'tabspaces--local-buffer-p))
(defun tabspaces--reset-buffer-predicate (frame)
"Reset the buffer predicate of FRAME if it is `tabspaces--local-buffer-p'."
(when (eq (frame-parameter frame 'buffer-predicate) #'tabspaces--local-buffer-p)
(set-frame-parameter frame 'buffer-predicate nil)))
(defun tabspaces--buffer-list (&optional frame tabnum)
"Return a list of all live buffers associated with the current frame and tab.
A non-nil value of FRAME selects a specific frame instead of the
current one. If TABNUM is nil, the current tab is used. If it is
non-nil, then specify a tab index in the given frame."
(let ((list
(if tabnum
(let ((tab (nth tabnum (frame-parameter frame 'tabs))))
(if (eq 'current-tab (car tab))
(frame-parameter frame 'buffer-list)
(or
(cdr (assq 'wc-bl tab))
(mapcar 'get-buffer
(car (cdr (assq #'tabspaces--buffer-list (assq 'ws tab))))))))
(frame-parameter frame 'buffer-list))))
(seq-filter #'buffer-live-p list)))
;;;; Project Workspace Helper Functions
;;;###autoload
(defun tabspaces--current-tab-name ()
"Get name of current tab."
(cdr (assq 'name (tab-bar--current-tab))))
;;;###autoload
(defun tabspaces--list-tabspaces ()
"Return a list of `tab-bar' tabs/workspaces."
(mapcar (lambda (tab) (alist-get 'name tab)) (tab-bar-tabs)))
;;;###autoload
(defun tabspaces--project-name ()
"Get name for project from vc.
If not in a project return buffer filename, or `-' if not visiting a file."
(let ((buf (buffer-file-name)))
(cond ((and buf (vc-registered buf))
(file-name-nondirectory (directory-file-name (vc-root-dir))))
(t "-"))))
;;;###autoload
(defun tabspaces--name-tab-by-project-or-default ()
"Return project name if in a project, or default tab-bar name if not.
The default tab-bar name uses the buffer name along with a counter."
(let ((project-name (tabspaces--project-name))
(tab (tab-bar-tab-name-current)))
(cond ((string= tab project-name)
(tab-bar-switch-to-tab tab))
((string= "-" project-name)
(tab-bar-tab-name-current-with-count))
(t (tabspaces--project-name)))))
;;;###autoload
(defun tabspaces--add-to-default-tabspace (buffer)
"Add BUFFER to default tabspace buffer list."
(let ((tab-names (mapcar
(lambda (tab) (alist-get 'name tab))
(funcall tab-bar-tabs-function))))
(when (and tabspaces-remove-to-default
(member tabspaces-default-tab tab-names))
;; add buffer to default tabspace
(tab-bar-select-tab-by-name tabspaces-default-tab)
(display-buffer buffer)
(switch-to-buffer buffer t nil)
(if (one-window-p t)
(previous-buffer)
(delete-window))
(tab-bar-switch-to-recent-tab))))
;;;; Interactive Functions
;;;;; Open Project & File
(defun tabspaces-project-switch-project-open-file (dir)
"Switch to another project by running an Emacs command.
Open file using `project-find-file'. NOTE: this function does *not*
open or switch to a new workspace. Rather it switches to a new
project and opens a file via `completing-read'. If you prefer to
use the project.el command-menu, then use
`project-switch-project'
When called, this function will use the project corresponding
to the selected directory DIR."
(interactive (list (project-prompt-project-dir)))
(let ((project-switch-commands tabspaces-project-switch-commands))
(project-switch-project dir)))
;;;;; Buffer Functions
(defun tabspaces-remove-buffer (&optional buffer)
"Bury and remove BUFFER from current tabspace.
If BUFFER is nil, remove current buffer. If
`tabspaces-remove-to-default' is t then add the buffer to the
default tabspace after remove, unless we're already in the default tabspace, in which case remove from the default as well."
(let* ((buffer (get-buffer (or buffer (current-buffer))))
(buffer-list (frame-parameter nil 'buffer-list))
(in-default-tab (string= (tabspaces--current-tab-name)
tabspaces-default-tab)))
;; delete window of buffer
(cond
((eq buffer (window-buffer (selected-window)))
(if (one-window-p t)
(bury-buffer)
(delete-window)))
((get-buffer-window buffer)
(select-window (get-buffer-window buffer) t)
(if (one-window-p t)
(bury-buffer)
(delete-window)))
(t
(message (format "Buffer `%s' removed from `%s' tabspace."
buffer (tabspaces--current-tab-name)))))
(bury-buffer buffer)
;; Delete buffer from tabspace buffer list
(delete buffer buffer-list)
;; If specified AND we're not in default tab, add buffer to default tabspace
(when (and tabspaces-remove-to-default (not in-default-tab))
(tabspaces--add-to-default-tabspace buffer))))
(defun tabspaces-remove-current-buffer ()
"Bury and remove current buffer from current tabspace."
(interactive)
(tabspaces-remove-buffer))
(defun tabspaces-remove-selected-buffer (buffer)
"Remove selected BUFFER from the frame's buffer list.
If `tabspaces-remove-to-default' is t then add the buffer to the
default tabspace."
(interactive
(list
(let ((blst (mapcar (lambda (b) (buffer-name b))
(tabspaces--buffer-list))))
;; select buffer
(read-buffer (format "Remove buffer from `%s' tabspace: "
(tabspaces--current-tab-name))
nil t
(lambda (b) (member (car b) blst))))))
(tabspaces-remove-buffer buffer))
(defun tabspaces-switch-to-buffer (buffer &optional norecord force-same-window)
"Display the local buffer BUFFER in the selected window.
This is the frame/tab-local equivalent to `switch-to-buffer'.
The arguments NORECORD and FORCE-SAME-WINDOW are passed to `switch-to-buffer'."
(interactive
(list
(let ((blst (cl-remove (buffer-name) (mapcar #'buffer-name (tabspaces--buffer-list)))))
(read-buffer
"Switch to local buffer: " blst nil
(lambda (b) (member (if (stringp b) b (car b)) blst))))))
(switch-to-buffer buffer norecord force-same-window))
;; See https://emacs.stackexchange.com/a/53016/11934
(defun tabspaces--report-dupes (xs)
(let ((ys ()))
(while xs
(unless (member (car xs) ys) ; Don't check it if already known to be a dup.
(when (member (car xs) (cdr xs)) (push (car xs) ys)))
(setq xs (cdr xs)))
ys))
(defun tabspaces-switch-buffer-and-tab (buffer &optional norecord force-same-window)
"Switch to the tab of chosen buffer, or create buffer.
If buffer does not exist in buffer-list user can either create a
new tab with the new buffer or open a new buffer in the current
tab."
(interactive
(list
(let ((blst (cl-remove (buffer-name) (mapcar #'buffer-name (buffer-list)))))
(read-buffer
"Switch to tab for buffer: " blst nil
(lambda (b) (member (if (stringp b) b (car b)) blst))))))
;; Action on buffer
(let* ((tabcand nil)
(buflst nil)
;; Provide flat list of all buffers in all tabs (and print dupe buffers).
;; This is the list of all buffers to search through.
(bufflst (flatten-tree (dolist (tab (tabspaces--list-tabspaces) buflst)
(push (mapcar #'buffer-name (tabspaces--buffer-list nil (tab-bar--tab-index-by-name tab))) buflst))))
(dupe (member buffer (tabspaces--report-dupes bufflst))))
;; Run through conditions:
(cond
;; 1. Buffer exists and is not open in more than one tabspace.
((and (get-buffer buffer)
(not dupe))
(dolist (tab (tabspaces--list-tabspaces))
(when (member buffer (mapcar #'buffer-name (tabspaces--buffer-list nil (tab-bar--tab-index-by-name tab))))
(progn (tab-bar-switch-to-tab tab)
(tabspaces-switch-to-buffer buffer)))))
;; 2. Buffer exists and is open in more than one tabspace.
((and (get-buffer buffer)
dupe)
(dolist (tab (tabspaces--list-tabspaces) tabcand)
(when (member buffer (mapcar #'buffer-name (tabspaces--buffer-list nil (tab-bar--tab-index-by-name tab))))
(push tab tabcand)))
(progn
(tab-bar-switch-to-tab (completing-read "Select tab: " tabcand))
(tabspaces-switch-to-buffer buffer)))
;; 3. Buffer does not exist.
((yes-or-no-p "Buffer not found -- create a new workspace with buffer?")
(switch-to-buffer-other-tab buffer))
;; 4. Default -- create buffer in current tabspace.
(t
(switch-to-buffer buffer norecord force-same-window)))))
(defun tabspaces-clear-buffers (&optional frame)
"Clear the tabspace's buffer list, except for the current buffer.
If FRAME is nil, use the current frame."
(interactive)
(set-frame-parameter frame 'buffer-list
(list (if frame
(with-selected-frame frame
(current-buffer))
(current-buffer)))))
;;;;; Switch or Create Workspace
;; Some convenience functions for opening/closing workspaces and buffers.
;; Some of these are just wrappers around built-in functions.
;;;###autoload
(defun tabspaces-switch-or-create-workspace (&optional workspace)
"Switch to tab if it exists, otherwise create a new tabbed workspace."
(interactive
(let ((tabs (tabspaces--list-tabspaces)))
(cond ((eq tabs nil)
(tab-new)
(tab-rename (completing-read "Workspace name: " tabs)))
(t
(list
(completing-read "Select or create tab: " tabs nil nil))))))
(cond ((member workspace (tabspaces--list-tabspaces))
(tab-bar-switch-to-tab workspace))
(t
(tab-new)
(tab-rename workspace))))
;;;;; Close Workspace
(defalias 'tabspaces-close-workspace #'tab-bar-close-tab)
;;;;; Close Workspace & Kill Buffers
(defun tabspaces-kill-buffers-close-workspace ()
"Kill all buffers in the workspace and then close the workspace itself."
(interactive)
(let ((buf (tabspaces--buffer-list)))
(unwind-protect
(cl-loop for b in buf
do (kill-buffer b))
(tab-bar-close-tab))))
;;;;; Open or Create Project in Workspace
(defvar tabspaces-project-tab-map '()
"Alist mapping full project paths to their respective tab names.")
(defun tabspaces-rename-existing-tab (old-name new-name)
"Rename an existing tab from OLD-NAME to NEW-NAME."
(let ((tabs (tab-bar-tabs)))
(dolist (tab tabs)
(when (equal (alist-get 'name tab) old-name)
(tab-bar-rename-tab-by-name old-name new-name)))))
(defun tabspaces-generate-descriptive-tab-name (project-path existing-tab-names)
"Generate a unique tab name from the PROJECT-PATH checking against EXISTING-TAB-NAMES."
(let* ((parts (reverse (split-string (directory-file-name project-path) "/")))
(base-name (car parts))
(parent-dir (nth 1 parts))
(grandparent-dir (nth 2 parts))
(simple-tab-name base-name)
(complex-tab-name (if parent-dir
(format "%s (%s/%s)" base-name (or grandparent-dir "") parent-dir)
base-name)))
(if (member simple-tab-name existing-tab-names)
(let ((existing-path (rassoc simple-tab-name tabspaces-project-tab-map)))
(when existing-path
;; Generate a new complex name for the existing conflict
(let ((new-name-for-existing (tabspaces-generate-complex-name (car existing-path))))
;; Rename the existing tab
(tabspaces-rename-existing-tab simple-tab-name new-name-for-existing)
;; Update the map with the new name for the existing path
(setcdr existing-path new-name-for-existing)))
;; Use the complex name for the new tab to avoid future conflicts
complex-tab-name)
;; No conflict, add to map and use the simple name
(progn
(add-to-list 'tabspaces-project-tab-map (cons project-path simple-tab-name))
simple-tab-name))))
(defun tabspaces-generate-complex-name (project-path)
"Generate a complex name based on the grandparent and parent directory names."
(let* ((parts (reverse (split-string (directory-file-name project-path) "/")))
(base-name (car parts))
(parent-dir (nth 1 parts))
(grandparent-dir (nth 2 parts)))
(format "%s (%s/%s)" base-name (or grandparent-dir "") parent-dir)))
;; Function to generate a unique numbered tab name
(defun generate-unique-numbered-tab-name (base-name existing-names)
(let ((counter 2)
(new-name base-name))
(while (member new-name existing-names)
(setq new-name (format "%s<%d>" base-name counter)
counter (1+ counter)))
new-name))
;; Replace read-directory-name so that we can create new projects when necessary
(defun tabspaces--read-directory-name (prompt &optional dir default mustmatch)
"Read a directory name, and create it if it does not exist."
(let ((dir-name (read-directory-name prompt dir default mustmatch)))
(unless (file-directory-p dir-name)
(when (y-or-n-p (format "Directory %s does not exist. Create it?" dir-name))
(make-directory dir-name t)))
dir-name))
;; Replace project-prompt-project-dir for project creation
(defun tabspaces-prompt-project-dir ()
"Prompt the user for a directory that is one of the known project roots.
The project is chosen among projects known from the project list,
see `project-list-file'.
It's also possible to enter an arbitrary directory not in the list."
(project--ensure-read-project-list)
(let* ((dir-choice "... (choose a dir)")
(choices
;; XXX: Just using this for the category (for the substring
;; completion style).
(project--file-completion-table
(append project--list `(,dir-choice))))
(pr-dir ""))
(while (equal pr-dir "")
;; If the user simply pressed RET, do this again until they don't.
(setq pr-dir (completing-read "Select project: " choices nil t)))
(if (equal pr-dir dir-choice)
(tabspaces--read-directory-name "Select directory: " nil nil nil)
pr-dir)))
;;;###autoload
(defun tabspaces-open-or-create-project-and-workspace (&optional project prefix)
"Open or create a project and its workspace with a descriptive tab name.
With universal argument PREFIX, always create a new tab for the project."
(interactive
(list (tabspaces-prompt-project-dir) current-prefix-arg))
(let* ((project-switch-commands tabspaces-project-switch-commands)
(project (if tabspaces-fully-resolve-paths
(expand-file-name project) ; Resolve relative paths
project))
(existing-tab-names (tabspaces--list-tabspaces))
(original-tab-name (or (cdr (assoc project tabspaces-project-tab-map))
(tabspaces-generate-descriptive-tab-name project existing-tab-names)))
(tab-name original-tab-name)
(session (concat project "." (file-name-nondirectory (directory-file-name project)) "-tabspaces-session.el"))
(project-directory project) ; Use the full path as the project directory
(project-exists (member (list project) project--list))
(create-new-tab (or prefix (not (member tab-name existing-tab-names)))))
(message "Tabspaces: Project directory: %s" project-directory)
;; Now manage the workspace based on the project state:
(cond
;; If there is no tab nor project, create both
((not project-exists)
(message "Tabspaces - Creating new project and tab")
(tab-bar-new-tab)
(tab-bar-rename-tab tab-name)
(let ((default-directory project-directory))
(message "Tabspaces: default directory set to %s" default-directory)
(if (featurep 'magit)
(magit-init project-directory)
(call-interactively #'vc-create-repo))
(delete-other-windows)
(when (and tabspaces-initialize-project-with-todo
(not (file-exists-p (expand-file-name tabspaces-todo-file-name project-directory))))
(with-temp-buffer
(write-file (expand-file-name tabspaces-todo-file-name project-directory))))
(if (featurep 'magit)
(magit-status-setup-buffer project-directory)
(project-vc-dir))
(dired-jump-other-window))
;; Remember new project
(let ((pr (project--find-in-directory default-directory)))
(project-remember-project pr)))
;; If project and tab exist, but we want a new tab
((and project-exists
(member tab-name existing-tab-names)
create-new-tab)
(message "Tabspaces - Creating new tab for existing project and tab")
(let ((new-tab-name (generate-unique-numbered-tab-name tab-name existing-tab-names)))
(tab-bar-new-tab)
(tab-bar-rename-tab new-tab-name)
(setq tab-name new-tab-name))
(project-switch-project project))
;; If project and tab exist, switch to it
((and project-exists
(member tab-name existing-tab-names))
(message "Tabspaces - Switching to existing tab")
(tab-bar-switch-to-tab tab-name))
;; If project exists, but no corresponding tab, open a new tab
(project-exists
(message "Tabspaces - Creating new tab for existing project")
(tab-bar-new-tab)
(tab-bar-rename-tab tab-name)
(if (file-exists-p session)
(tabspaces-restore-session session)
(project-switch-project project)))
(t
(message "Tabspaces - No project found or created.")
nil))
(message "Tabspaces: Conditional execution completed")
;; Update tabspaces-project-tab-map (only for the main tab, not numbered duplicates)
(unless (string-match-p "<[0-9]+>$" tab-name)
(setq tabspaces-project-tab-map
(cons (cons project-directory tab-name)
(assq-delete-all project-directory tabspaces-project-tab-map))))))
;;;; Tabspace Sessions
(defconst tabspaces-session-header
";; -------------------------------------------------------------------------
;; Tabspaces Session File for Emacs
;; -------------------------------------------------------------------------
" "Header to place in Tabspaces session file.")
(defcustom tabspaces-session t
"Whether to save tabspaces across sessions."
:group 'tabspaces
:type 'boolean)
(defcustom tabspaces-session-auto-restore nil
"Whether to restore tabspaces on session startup."
:group 'tabspaces
:type 'boolean)
(defcustom tabspaces-session-file (concat user-emacs-directory "tabsession.el")
"File for saving tabspaces session."
:group 'tabspaces
:type 'string)
(defvar tabspaces--session-list nil
"Store `tabspaces' session tabs and buffers.")
;; Helper functions
(defun tabspaces--buffile (b)
"Get filename for buffers."
(cl-remove-if nil (buffer-file-name b)))
(defun tabspaces--store-buffers (bufs)
"Make list of filenames."
(flatten-tree (mapcar #'tabspaces--buffile bufs)))
;; Save global session
;;;###autoload
(defun tabspaces-save-session ()
"Save tabspace name and buffers."
(interactive)
;; Start from an empty list.
(setq tabspaces--session-list nil)
(let ((curr (tab-bar--current-tab-index)))
;; loop over tabs
(cl-loop for tab in (tabspaces--list-tabspaces)
do (progn
(tab-bar-select-tab-by-name tab)
(setq tabspaces--session-list
(append tabspaces--session-list
(list (cons (tabspaces--store-buffers (tabspaces--buffer-list)) tab))))))
;; As tab-bar-select-tab starts counting from 1, we need to add 1 to the index.
(tab-bar-select-tab (+ curr 1)))
;; Write to file
(with-temp-file tabspaces-session-file
(point-min)
(insert ";; -*- mode: emacs-lisp; lexical-binding:t; coding: utf-8-emacs; -*-\n"
tabspaces-session-header
";; Created " (current-time-string) "\n\n"
";; Tabs and buffers:\n")
(insert "(setq tabspaces--session-list '" (format "%S" tabspaces--session-list) ")")))
;; Save current project session
(defun tabspaces-save-current-project-session ()
"Save tabspace name and buffers for current tab & project."
(interactive)
(let ((tabspaces--session-list nil) ;; Start from an empty list.
(ctab (tabspaces--current-tab-name))
(current-session (with-current-buffer (buffer-name)
(concat (vc-root-dir) "." (tabspaces--current-tab-name) "-tabspaces-session.el"))))
;; Get buffers
(add-to-list 'tabspaces--session-list (cons (tabspaces--store-buffers (tabspaces--buffer-list)) ctab))
;; Write to file
(with-temp-file current-session
(point-min)
(insert ";; -*- mode: emacs-lisp; lexical-binding:t; coding: utf-8-emacs; -*-\n"
tabspaces-session-header
";; Created " (current-time-string) "\n\n"
";; Tab and buffers:\n")
(insert "(setq tabspaces--session-list '" (format "%S" tabspaces--session-list) ")"))))
;; Restore session
;;;###autoload
(defun tabspaces-restore-session (&optional session)
"Restore tabspaces session."
(interactive)
(load-file (or session
tabspaces-session-file))
;; Start looping through the session list, but ensure to start from a
;; temporary buffer "*tabspaces--placeholder*" in order not to pollute the
;; buffer list with the final buffer from the previous tab.
(cl-loop for elm in tabspaces--session-list do
(switch-to-buffer "*tabspaces--placeholder*")
(tabspaces-switch-or-create-workspace (cdr elm))
(mapc #'find-file (car elm)))
;; Once the session list is restored, remove the temporary buffer from the
;; buffer list.
(cl-loop for elm in tabspaces--session-list do
(tabspaces-switch-or-create-workspace (cdr elm))
(tabspaces-remove-selected-buffer "*tabspaces--placeholder*"))
;; Finally, kill the temporary buffer to clean up.
(kill-buffer "*tabspaces--placeholder*"))
;; Make sure session file exists
(defun tabspaces--create-session-file ()
"Create the tabspaces session file if it does not exist."
(unless (file-exists-p tabspaces-session-file)
(with-temp-buffer
(write-file tabspaces-session-file))
(message "Created tabspaces session file: %s" tabspaces-session-file)))
;; Restore session used for startup
(defun tabspaces--restore-session-on-startup ()
"Restore tabspaces session on startup.
Unlike the interactive restore, this function does more clean up to remove
unnecessary tab."
(message "Restoring tabspaces session on startup.")
(tabspaces--create-session-file)
(load-file tabspaces-session-file)
;; Start looping through the session list, but ensure to start from a
;; temporary buffer "*tabspaces--placeholder*" in order not to pollute the
;; buffer list with the final buffer from the previous tab.
(cl-loop for elm in tabspaces--session-list do
(switch-to-buffer "*tabspaces--placeholder*")
(tabspaces-switch-or-create-workspace (cdr elm))
(mapc #'find-file (car elm)))
;; Once the session list is restored, remove the temporary buffer from the
;; buffer list.
(cl-loop for elm in tabspaces--session-list do
(tabspaces-switch-or-create-workspace (cdr elm))
(tabspaces-remove-selected-buffer "*tabspaces--placeholder*"))
;; If the tab restore started from an empty tab (e.g. at startup), remove the
;; tab by name of "*tabspaces--placeholder*".
;; NOTE When restore is interactively called, it is possible that an unnamed
;; tab to be incorrectly closed as we call `switch-to-buffer', which would
;; make the tab name to be "*tabspaces--placeholder*". At the startup, this
;; shouldn't be an issue, but conduct a simple check before closing the tab.
(if (eq (tab-bar--tab-index-by-name "*tabspaces--placeholder*") 0)
;; tab-bar-close-tab counts from 1.
(tab-bar-close-tab 1))
;; Finally, kill the temporary buffer to clean up.
(kill-buffer "*tabspaces--placeholder*"))
;;;; Define Keymaps
(defvar tabspaces-command-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C") 'tabspaces-clear-buffers)
(define-key map (kbd "b") 'tabspaces-switch-to-buffer)
(define-key map (kbd "d") 'tabspaces-close-workspace)
(define-key map (kbd "k") 'tabspaces-kill-buffers-close-workspace)
(define-key map (kbd "o") 'tabspaces-open-or-create-project-and-workspace)
(define-key map (kbd "r") 'tabspaces-remove-current-buffer)
(define-key map (kbd "R") 'tabspaces-remove-selected-buffer)
(define-key map (kbd "s") 'tabspaces-switch-or-create-workspace)
(define-key map (kbd "t") 'tabspaces-switch-buffer-and-tab)
map)
"Keymap for tabspace/workspace commands after `tabspaces-keymap-prefix'.")
(fset 'tabspaces-command-map tabspaces-command-map)
(defvar tabspaces-mode-map
(let ((map (make-sparse-keymap)))
(when tabspaces-keymap-prefix
(define-key map (kbd tabspaces-keymap-prefix) 'tabspaces-command-map))
map)
"Keymap for Tabspaces mode.")
;;;; Define Minor Mode
;;;###autoload
(define-minor-mode tabspaces-mode
"Create a global minor mode for `tabspaces', or buffer-isolated workspaces.
This uses Emacs `tab-bar' and `project.el'."
:lighter ""
:keymap tabspaces-mode-map
:global t
(cond (tabspaces-mode
;; Set up tabspace isolated buffers
(dolist (frame (frame-list))
(tabspaces--set-buffer-predicate frame)
(add-hook 'after-make-frame-functions #'tabspaces--set-buffer-predicate)
(add-to-list 'tab-bar-tab-post-open-functions #'tabspaces--tab-post-open-function)
;; Option to always use filtered buffers when minor mode is enabled.
(when tabspaces-use-filtered-buffers-as-default
;; Remap switch-to-buffer
(define-key (current-global-map) [remap switch-to-buffer] #'tabspaces-switch-to-buffer)))
(when tabspaces-session
(add-hook 'kill-emacs-hook #'tabspaces-save-session))
(when tabspaces-session-auto-restore
(tabspaces--restore-session-on-startup)))
(t
;; Remove all modifications
(dolist (frame (frame-list))
(tabspaces--reset-buffer-predicate frame))
(when tabspaces-use-filtered-buffers-as-default
(define-key (current-global-map) [remap switch-to-buffer] nil))
(setq tab-bar-tab-post-open-functions (remove #'tabspaces--tab-post-open-function tab-bar-tab-post-open-functions))
(remove-hook 'after-make-frame-functions #'tabspaces--set-buffer-predicate)
(remove-hook 'kill-emacs-hook #'tabspaces-save-session)
(remove-hook 'emacs-startup-hook #'tabspaces-restore-session))))
;;; Provide
(provide 'tabspaces)
;;; tabspaces.el ends here