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

For the last point, it would be better to use `cl-defmethod` to override
the `seq-group-by` function only when grouping workspaces but currently
no version tried work. Last try :

```lisp
(cl-defmethod seq-group-by ((function (eql 'bufler-group-auto-workspace)) 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-groups (lambda (key)
                            (let ((cell (assoc key acc)))
                              (if cell
                                  (setcdr cell (push elt (cdr cell)))
                                (push (list key elt) acc))))))
       (mapc add-to-groups keys)
       acc))
   (seq-reverse sequence)
   nil))
```

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

Author: gagbo

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

@@ -159,22 +159,29 @@ 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-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
 (define-minor-mode bufler-workspace-mode

bufler.el

@@ -97,8 +97,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.
@@ -457,7 +457,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
@@ -466,7 +466,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
@@ -1070,8 +1070,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 "Workspace: " name)) names)))
+
 
 ;;;;;; Group-defining macro