Allow multiple workspaces per buffer

- Rename `bufler-workspace-name` to `bufler-workspace-names` to show it
  can hold multiple values
- Add prefix to workspace names in the groups (as a defcustom)
- Make `bufler-workspace-buffer-name-workspace` add to list of
  buffer-local workspace value instead of replacing it
- Use another version of `seq-group-by` in `bufler-group-tree` that adds
  an element in multiple groups if the grouping function returns a list.
- Add utility functions to access/manage named workspaces
  + Add function to list all buffers in a named workspace
  + Add function to clean up a single named workspace

Co-authored-by: Adam Porter <[email protected]>

bufler-group-tree.el

@@ -42,14 +42,32 @@
 
 ;;;; Functions
 
+(defun bufler-group-tree-seq-group-by (function sequence)
+  "Specialization of `seq-group-by' that puts elements of SEQUENCES in each of
+the workspaces returned by FUNCTION."
+  (seq-reduce
+   (lambda (acc elt)
+     (let ((keys (funcall function elt))
+           (add-to-group (lambda (key)
+                           (let ((cell (assoc key acc)))
+                             (if cell
+                                 (setcdr cell (push elt (cdr cell)))
+                               (push (list key elt) acc))))))
+       (if (listp keys)
+           (mapc add-to-group keys)
+         (funcall add-to-group keys))
+       acc))
+   (seq-reverse sequence)
+   nil))
+
 (defun bufler-group-tree (fns sequence)
   "Return SEQUENCE grouped according to FNS."
   (declare (indent defun))
   ;; Modeled on grouping from `sbuffer'.
   (cl-typecase fns
     (function
      ;; "Regular" subgroups (naming things is hard).
-     (seq-group-by fns sequence))
+     (bufler-group-tree-seq-group-by fns sequence))
     (list (cl-typecase (car fns)
             (function
              ;; "Regular" subgroups (naming things is hard).
@@ -59,7 +77,7 @@
                              (cons (car it)
                                    (bufler-group-tree (cdr fns) (cdr it))))
                            groups))
-               (seq-group-by (car fns) sequence)))
+               (bufler-group-tree-seq-group-by (car fns) sequence)))
             (list
              ;; "Recursive sub-subgroups" (naming things is hard).
              ;; First, separate all the buffers that match the

bufler-workspace.el

@@ -55,6 +55,11 @@ with prefix arguments."
   "Functions called when the workspace is set."
   :type 'hook)
 
+(defcustom bufler-workspace-name-prefix
+  "Workspace: "
+  "Prefix of named workspaces"
+  :type 'string)
+
 (defcustom bufler-workspace-format-path-fn #'bufler-format-path
   "Function to format group paths for display in mode line and frame title.
 May be customized to, e.g. only return the last element of a path."
@@ -159,22 +164,68 @@ act as if SET-WORKSPACE-P is non-nil."
        (bufler-buffer-workspace-path selected-buffer)))
     (switch-to-buffer selected-buffer)))
 
+;;;###autoload
+(defun bufler-workspace-list-named-workspaces ()
+  "Return the list of current named workspaces."
+  (seq-uniq
+   (cl-loop for buffer in (buffer-list)
+            when (buffer-local-value 'bufler-workspace-names buffer)
+            append it)))
+
+;;;###autoload
+(defun bufler-workspace-list-buffers-in-named-workspace (&optional name)
+  "Return the list of buffers in named workspace NAME.
+
+If NAME is nil, list the buffers in current frame workspace."
+  ;; This might get fused with `bufler-workspace-buffers'
+  (let ((buffers))
+    (--tree-map-nodes
+     (bufferp it)
+     (push it buffers)
+     (bufler-buffers :path (list (concat bufler-workspace-name-prefix (or name (frame-parameter nil 'bufler-workspace-path))))))
+    (cl-sort buffers #'string< :key #'buffer-name)))
+
 ;;;###autoload
 (defun bufler-workspace-buffer-name-workspace (&optional name)
   "Set current buffer's workspace to NAME.
 If NAME is nil (interactively, with prefix), unset the buffer's
-workspace name.  This sets the buffer-local variable
-`bufler-workspace-name'.  Note that, in order for a buffer to
+workspace name.  This prepends to the buffer-local variable
+`bufler-workspace-names'.  Note that, in order for a buffer to
 appear in a named workspace, the buffer must be matched by an
 `auto-workspace' group before any other group."
   (interactive (list (unless current-prefix-arg
                        (completing-read "Named workspace: "
-                                        (seq-uniq
-                                         (cl-loop for buffer in (buffer-list)
-                                                  when (buffer-local-value 'bufler-workspace-name buffer)
-                                                  collect it))))))
+                                        (bufler-workspace-list-named-workspaces)))))
   (setf bufler-cache nil)
-  (setq-local bufler-workspace-name name))
+  (if (and name (not (string= "" name)))
+      (add-to-list (make-local-variable 'bufler-workspace-names) name)
+    (setq-local bufler-workspace-names nil)))
+
+;;;###autoload
+(defun bufler-workspace-buffer-remove-maybe-kill (name)
+  "Remove NAME from current buffer's workspace list.
+
+If NAME was the last named workspace for the buffer, or the buffer
+had no named workspace associated, then current buffer is killed."
+  (interactive (list
+                (completing-read "Unmark workspace: "
+                                 bufler-workspace-names)))
+  (if-let ((ws (remove name bufler-workspace-names)))
+      (setq-local bufler-workspace-names ws)
+    (kill-buffer (current-buffer))))
+
+;;;###autoload
+(defun bufler-workspace-kill-named-workspace (name)
+  "Remove all references to workspace NAME from buffers.
+
+Kill buffers that had NAME as their last named workspace."
+  ;; This might get fused with `bufler-workspace-buffers'
+  (interactive (list (completing-read "Named workspace: "
+                                      (bufler-workspace-list-named-workspaces))))
+  (cl-mapc
+   (lambda (buffer) (with-current-buffer buffer (bufler-workspace-buffer-remove-maybe-kill name)))
+   (bufler-workspace-list-buffers-in-named-workspace name)))
+
 
 ;;;###autoload
 (define-minor-mode bufler-workspace-mode
@@ -207,7 +258,7 @@ Works as `tab-line-tabs-function'."
 (defun bufler-workspace-set-frame-name (path)
   "Set current frame's name according to PATH."
   (set-frame-name (when path
-                    (format "Workspace: %s" (funcall bufler-workspace-format-path-fn path)))))
+                    (format "%s" (funcall bufler-workspace-format-path-fn path)))))
 
 (cl-defun bufler-workspace-read-item (tree &key (leaf-key #'identity))
   "Return a leaf read from TREE with completion.

bufler.el

@@ -96,8 +96,8 @@ Usually this will be something like \"/usr/share/emacs/VERSION\".")
 (defvar bufler-cache nil
   "Cache of computed buffer groups.")
 
-(defvar bufler-workspace-name nil
-  "The buffer's named workspace, if any.")
+(defvar bufler-workspace-names nil
+  "A list of named workspaces owning the buffer, if any.")
 
 (defvar bufler-cache-related-dirs (make-hash-table :test #'equal)
   "Cache of relations between directories.
@@ -465,7 +465,7 @@ NAME, okay, `checkdoc'?"
 
 (declare-function bufler-workspace-buffer-name-workspace "bufler-workspace")
 (bufler-define-buffer-command name-workspace
-  "Set buffer's workspace name.
+  "Adds to buffer's workspace names.
 With prefix, unset it."
   (lambda (buffer)
     (with-current-buffer buffer
@@ -474,7 +474,7 @@ With prefix, unset it."
                  (completing-read "Named workspace: "
                                   (seq-uniq
                                    (cl-loop for buffer in (buffer-list)
-                                            when (buffer-local-value 'bufler-workspace-name buffer)
+                                            when (buffer-local-value 'bufler-workspace-names buffer)
                                             collect it)))))))
 
 ;;;;; Group commands
@@ -1106,8 +1106,9 @@ NAME, okay, `checkdoc'?"
     (concat "Tramp: " host)))
 
 (bufler-defauto-group workspace
-  (when-let* ((name (buffer-local-value 'bufler-workspace-name buffer)))
-    name))
+  (when-let* ((names (buffer-local-value 'bufler-workspace-names buffer)))
+    (mapcar (lambda (name) (concat bufler-workspace-name-prefix name)) names)))
+
 
 ;;;;;; Group-defining macro