emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/workroom e9637846b5 27/74: Rewrite workroom to fix some lo


From: ELPA Syncer
Subject: [nongnu] elpa/workroom e9637846b5 27/74: Rewrite workroom to fix some long-standing problems
Date: Sun, 27 Nov 2022 16:03:26 -0500 (EST)

branch: elpa/workroom
commit e9637846b5567db009987cedbecc982a7a711bd2
Author: Akib Azmain Turja <akib@disroot.org>
Commit: Akib Azmain Turja <akib@disroot.org>

    Rewrite workroom to fix some long-standing problems
---
 README.org  |   56 ++-
 workroom.el | 1310 ++++++++++++++++++++++++++++++++++++++---------------------
 2 files changed, 863 insertions(+), 503 deletions(-)

diff --git a/README.org b/README.org
index d41019e3c0..f4fd182d9e 100644
--- a/README.org
+++ b/README.org
@@ -10,14 +10,32 @@ Each workroom also has its own set of views.  Views are 
just named
 window configurations.  They allow you to switch to another window
 configuration without losing your well-planned window setup.
 
-You can also bookmark a workroom or all your workrooms to restore them
-at a later time, possibly in another Emacs session.
+You can also bookmark a workroom to restore them at a later time,
+possibly in another Emacs session.  You can also save your workrooms
+in your desktop.
+
+* Install
+
+** MELPA
+
+=M-x package-refresh-contents= and =M-x package-install RET workroom=.
+
+** Quelpa
+
+Do =M-x quelpa RET workroom=, Quelpa should get the recipe from MELPA
+and install it.
+
+** Straight.el
+
+Put this in ~(straight-use-package 'workroom)~ your init file,
+Straight.el should get the recipe from MELPA and install it.
+
+* Usage
 
 There is always a workroom named "master", which contains all live
 buffers.  Removing any buffer from this workroom kills that buffer.
-You can't kill, rename or bookmark this workroom, but you can
-customize the variable ~workroom-default-room-name~ to change its
-name.
+You can't kill this workroom, but you can customize the variable
+~workroom-default-room-name~ to change its name.
 
 All the useful commands can be called with following key sequences:
 
@@ -32,34 +50,10 @@ All the useful commands can be called with following key 
sequences:
 | ~C-x x c~ | ~workroom-clone~            |
 | ~C-x x C~ | ~workroom-clone-view~       |
 | ~C-x x m~ | ~workroom-bookmark~         |
-| ~C-x x M~ | ~workroom-bookmark-all~     |
 | ~C-x x b~ | ~workroom-switch-to-buffer~ |
 | ~C-x x a~ | ~workroom-add-buffer~       |
-| ~C-x x k~ | ~workroom-remove-buffer~    |
-| ~C-x x K~ | ~workroom-kill-buffer~      |
+| ~C-x x k~ | ~workroom-kill-buffer~      |
+| ~C-x x K~ | ~workroom-remove-buffer~    |
 
 Here the prefix key sequence is ~C-x x~, but you can customize
 ~workroom-command-map-prefix~ to change it.
-
-Adding and removing buffers to/from workrooms can become a burden.
-You can automate this process by setting ~buffers~ slot of ~workroom~
-to a function without arguments returning a list of live buffers.
-That list of buffer will be used as the list of buffers of that
-workroom.  The default workroom is an example of this type of
-workroom, which uses ~buffer-list~ for the list of buffers.
-
-* Install
-
-** MELPA
-
-=M-x package-refresh-contents= and =M-x package-install RET workroom=.
-
-** Quelpa
-
-Do =M-x quelpa RET workroom=, Quelpa should get the recipe from MELPA
-and install it.
-
-** Straight.el
-
-Put this in ~(straight-use-package 'workroom)~ your init file,
-Straight.el should get the recipe from MELPA and install it.
diff --git a/workroom.el b/workroom.el
index 6d755d2ee0..aa4a7f577d 100644
--- a/workroom.el
+++ b/workroom.el
@@ -35,14 +35,14 @@
 ;; window configurations.  They allow you to switch to another window
 ;; configuration without losing your well-planned window setup.
 
-;; You can also bookmark a workroom or all your workrooms to restore
-;; them at a later time, possibly in another Emacs session.
+;; You can also bookmark a workroom to restore them at a later time,
+;; possibly in another Emacs session.  You can also save your
+;; workrooms in your desktop.
 
 ;; There is always a workroom named "master", which contains all live
 ;; buffers.  Removing any buffer from this workroom kills that buffer.
-;; You can't kill, rename or bookmark this workroom, but you can
-;; customize the variable `workroom-default-room-name' to change its
-;; name.
+;; You can't kill this workroom, but you can customize the variable
+;; `workroom-default-room-name' to change its name.
 
 ;; All the useful commands can be called with following key sequences:
 
@@ -57,27 +57,22 @@
 ;;   C-x x c    `workroom-clone'
 ;;   C-x x C    `workroom-clone-view'
 ;;   C-x x m    `workroom-bookmark'
-;;   C-x x M    `workroom-bookmark-all'
 ;;   C-x x b    `workroom-switch-to-buffer'
 ;;   C-x x a    `workroom-add-buffer'
-;;   C-x x k    `workroom-remove-buffer'
-;;   C-x x K    `workroom-kill-buffer'
+;;   C-x x k    `workroom-kill-buffer'
+;;   C-x x K    `workroom-remove-buffer'
 
 ;; Here the prefix key sequence is "C-x x", but you can customize
 ;; `workroom-command-map-prefix' to change it.
 
-;; Adding and removing buffers to/from workrooms can become a burden.
-;; You can automate this process by setting `buffers' slot of
-;; `workroom' to a function without arguments returning a list of live
-;; buffers.  That list of buffer will be used as the list of buffers
-;; of that workroom.  The default workroom is an example of this type
-;; of workroom, which uses `buffer-list' for the list of buffers.
-
 ;;; Code:
 
 (require 'cl-lib)
 (require 'bookmark)
 
+
+;;;; User Options.
+
 (defgroup workroom nil
   "Named rooms for work without irrelevant distracting buffers."
   :group 'convenience
@@ -95,7 +90,8 @@ Workroom-Mode must be reenabled for changes to take effect."
 
 This workroom contains all live buffers of the current Emacs session.
 
-Workroom-Mode must be reenabled for changes to take effect."
+Workroom-Mode must be reenabled for changes to take effect, or the
+name can be manually changed with `workroom-rename'."
   :type 'string)
 
 (defcustom workroom-default-view-name "main"
@@ -131,21 +127,19 @@ value can't restored."
                             (function :tag "Decoder function"))))
 
 (defcustom workroom-mode-lighter
-  '(" WR["
-    (:eval (propertize (workroom-name (workroom-current-room)) 'face
-                       (if (member (current-buffer)
-                                   (workroom-buffer-list
-                                    (workroom-current-room)))
-                           'compilation-info
-                         'warning)))
-    "]["
-    (:eval (propertize (workroom-view-name (workroom-current-view))
-                       'face (if (member (current-buffer)
-                                         (workroom-buffer-list
-                                          (workroom-current-room)))
-                                 'compilation-info
-                               'warning)))
-    "]")
+  '(:eval
+    (let ((face (if (member (current-buffer)
+                            (workroom-buffer-list
+                             (workroom-current-room)))
+                    'compilation-info
+                  'warning)))
+      `(" WR["
+        (:propertize ,(workroom-name (workroom-current-room))
+                     face ,face)
+        "]["
+        (:propertize ,(workroom-view-name (workroom-current-view))
+                     face ,face)
+        "]")))
   "Format of Workroom mode lighter.
 
 The value is a mode line terminal like `mode-line-format'."
@@ -171,34 +165,68 @@ The value is a mode line terminal like 
`mode-line-format'."
   "Normal hook run after renaming a view."
   :type 'hook)
 
-(defcustom workroom-buffer-list-change-hook nil
-  "Normal hook run after changing the buffer list of a workroom."
-  :type 'hook)
+(defvar workroom-command-map
+  (let ((keymap (make-sparse-keymap)))
+    ;; NOTE: Be sure to keep commentary and README up to date.
+    (define-key keymap "s" #'workroom-switch)
+    (define-key keymap "S" #'workroom-switch-view)
+    (define-key keymap "d" #'workroom-kill)
+    (define-key keymap "D" #'workroom-kill-view)
+    (define-key keymap "r" #'workroom-rename)
+    (define-key keymap "R" #'workroom-rename-view)
+    (define-key keymap "c" #'workroom-clone)
+    (define-key keymap "C" #'workroom-clone-view)
+    (define-key keymap "m" #'workroom-bookmark)
+    (define-key keymap "b" #'workroom-switch-to-buffer)
+    (define-key keymap "a" #'workroom-add-buffer)
+    (define-key keymap "k" #'workroom-kill-buffer)
+    (define-key keymap "K" #'workroom-remove-buffer)
+    keymap)
+  "Keymap containing all useful commands of Workroom.")
+
+(defvar workroom-mode-map (make-sparse-keymap)
+  "Keymap for Workroom-Mode.")
 
-(cl-defstruct workroom
+(define-key workroom-mode-map workroom-command-map-prefix
+            workroom-command-map)
+
+
+;;;; Workroom and View Manipulation.
+
+(cl-defstruct (workroom--room
+               (:constructor workroom--make-room)
+               (:copier workroom--copy-room))
   "Structure for workroom."
-  (name nil :documentation "Name of the workroom." :type string)
-  (views nil :documentation "Views of the workroom." :type list)
-  (buffers nil :documentation "Buffers of the workroom.")
-  (selected-view nil :documentation "The last selected view.")
+  (name nil :documentation "Name of the workroom.")
+  (buffer-manager
+   nil
+   :documentation "The function handling the buffer list.")
+  (buffer-manager-data
+   nil
+   :documentation "The data stored by the buffer manager function.")
+  (view-list nil :documentation "List of views of the workroom.")
   (default-p
    nil
    :documentation "Whether the workroom is the default one.")
-  (previous-view-list
-   nil
-   :documentation "List of previously selected views.")
   (view-history
    nil
    :documentation "`completing-read' history of view names."))
 
-(cl-defstruct workroom-view
+(cl-defstruct (workroom--view
+               (:constructor workroom--make-view)
+               (:copier workroom--copy-view))
   "Structure for view of workroom."
-  (name nil :documentation "Name of the view." :type string)
+  (name nil :documentation "Name of the view.")
   (window-config
    nil
-   :documentation "Window configuration of the view."))
+   :documentation "Window configuration of the view.")
+  (window-config-writable
+   nil
+   :documentation "Writable window configuration of the view.")
+  (frame nil :documentation "The frame showing the view, or nil."))
 
-(defalias 'workroomp #'workroom-p)
+(defvar workroom--initializing nil
+  "Non-nil mean Workroom-Mode is initializing.")
 
 (defvar workroom--rooms nil
   "List of currently live workrooms.")
@@ -207,35 +235,149 @@ The value is a mode line terminal like 
`mode-line-format'."
   "`completing-read' history list of workroom names.")
 
 (defvar workroom--view-history nil
-  "`completing-read' history list of workroom view names.")
+  "`completing-read' history list of workroom view names.
+
+This is let-bound before using, the history is saved into the
+workroom's view-history slot.  Use `workroom-view-history' to access
+that.")
 
 (defvar workroom-mode)
 
-(defvar workroom-mode-map (make-sparse-keymap)
-  "Keymap for Workroom-Mode.")
+(defun workroomp (object)
+  "Return non-nil if OBJECT is a workroom object."
+  (workroom--room-p object))
 
-(defvar workroom-command-map
-  (let ((keymap (make-sparse-keymap)))
-    ;; NOTE: Be sure to keep commentary and README up to date.
-    (define-key keymap "s" #'workroom-switch-room)
-    (define-key keymap "S" #'workroom-switch-view)
-    (define-key keymap "d" #'workroom-kill)
-    (define-key keymap "D" #'workroom-kill-view)
-    (define-key keymap "r" #'workroom-rename)
-    (define-key keymap "R" #'workroom-rename-view)
-    (define-key keymap "c" #'workroom-clone)
-    (define-key keymap "C" #'workroom-clone-view)
-    (define-key keymap "m" #'workroom-bookmark)
-    (define-key keymap "M" #'workroom-bookmark-all)
-    (define-key keymap "b" #'workroom-switch-to-buffer)
-    (define-key keymap "a" #'workroom-add-buffer)
-    (define-key keymap "k" #'workroom-remove-buffer)
-    (define-key keymap "K" #'workroom-kill-buffer)
-    keymap)
-  "Keymap containing all useful commands of Workroom.")
+(defun workroom-name (room)
+  "Return the name of workroom ROOM."
+  (workroom--room-name room))
 
-(define-key workroom-mode-map workroom-command-map-prefix
-            workroom-command-map)
+(defun workroom-live-p (room)
+  "Return t if ROOM is a live workroom."
+  (not (not (workroom-name room))))
+
+(defun workroom-buffer-manager-function (room)
+  "Return the function to manage the member buffers of workroom ROOM.
+
+The buffer manager is a function taking two or more arguments.  The
+function shouldn't be an uninterned symbol or lambda/closure.  The
+first argument is ROOM, the workroom.  The second one is ACTION, it
+specify what to do.  ACTION can any of:
+
+`:initialize'
+  Do initialization for workroom ROOM.  No extra arguments.
+
+`:list-buffers'
+  List of member buffers of workroom ROOM.  No extra arguments.
+
+`:add-buffer'
+  Add BUFFER as a member of workroom ROOM.  BUFFER is the third
+  argument and is a buffer.
+
+`:remove-buffer'
+  Remove BUFFER from the member list of workroom ROOM.  BUFFER is the
+  third argument and is a buffer.
+
+`:clone'
+  Clone buffer list from workroom SOURCE to workroom ROOM.  SOURCE is
+  the third argument is a workroom.  `:initialize' is not called on
+  ROOM, the function must do the initialization itself if required.
+
+`:encode'
+  Encode the buffer manager data and return it.  No extra arguments.
+  DATA is the writable encoded buffer manager data.  DATA is passed as
+  the third argument of ACTION `:load' to load the data.
+
+`:load'
+  Load the data previously encoded with `:encode'.  The third argument
+  is the encoded data DATA that ACTION `:encode' returned.  The fourth
+  argument is the list of buffers to add to it, BUFFERS.  BUFFERS
+  contains some or all of the buffers, that were member of the
+  workroom ACTION `:encode' was called with, just after the call.
+  `:initialize' is not called on ROOM, the function must do the
+  initialization itself if required.
+
+To set it, use (`setf' (`workroom-buffer-manager-function' ROOM)
+FUNCTION), where FUNCTION is the buffer manager function."
+  (workroom--room-buffer-manager room))
+
+(gv-define-setter workroom-buffer-manager-function (function room)
+  `(let ((wr ,room))
+     (when (workroom-default-p wr)
+       (error "Cannot change buffer manager of the default workroom"))
+     (setf (workroom--room-buffer-manager wr) ,function)))
+
+(defun workroom-buffer-manager-data (room)
+  "Return the data stored by the buffer manager of workroom ROOM.
+
+This is reserved for the buffer manager of ROOM, this should be used
+by only the buffer manager and associated stuffs.
+
+To set it, use (`setf' (`workroom-buffer-manager-data' ROOM) DATA),
+where DATA is the data to store.  The data can be modified with side
+effect, it is not unaltered."
+  (workroom--room-buffer-manager-data room))
+
+(gv-define-setter workroom-buffer-manager-data (function room)
+  `(setf (workroom--room-buffer-manager-data ,room) ,function))
+
+(defun workroom-view-list (room)
+  "Return the views of workroom ROOM."
+  (workroom--room-view-list room))
+
+(defun workroom-default-p (room)
+  "Return non-nil if workroom ROOM is the default workroom."
+  (workroom--room-default-p room))
+
+(defun workroom-view-history (room)
+  "Completing read history of view of workroom ROOM."
+  (workroom--room-view-history room))
+
+(defun workroom-view-p (object)
+  "Return non-nil if OBJECT is a view object."
+  (workroom--view-p object))
+
+(defun workroom-view-name (view)
+  "Return the name of view VIEW."
+  (workroom--view-name view))
+
+(defun workroom-view-live-p (room)
+  "Return t if ROOM is a live view."
+  (not (not (workroom-view-name room))))
+
+(defun workroom-view-window-configuration (view &optional writable)
+  "Return the window configuration of view VIEW.
+
+If WRITABLE is non-nil, return a window configuration that can be
+written to a string (or file) and read back.
+
+This is expensive, because it can recalculate the window configuration
+and returns a copy of it."
+  (when (workroom--view-frame view)
+    (setf (workroom--view-window-config (workroom-current-view))
+          (workroom--frame-window-config
+           (workroom--view-frame view)))
+    (setf (workroom--view-window-config-writable
+           (workroom-current-view))
+          (workroom--frame-window-config
+           (workroom--view-frame view) 'writable)))
+  (copy-tree (if writable
+                 (workroom--view-window-config-writable view)
+               (workroom--view-window-config view))))
+
+(defun workroom-view-frame (view)
+  "Return the frame showing the view VIEW, or nil if none."
+  (let ((frame (workroom--view-frame view)))
+    (when frame
+      (if (frame-live-p frame)
+          frame
+        (setf (workroom--view-frame view) nil)
+        nil))))
+
+(defun workroom-list ()
+  "Return the list of workrooms.
+
+A copy is returned, so it can be modified with side-effects."
+  (copy-sequence workroom--rooms))
 
 (defun workroom-get (name)
   "Return the workroom named NAME.
@@ -253,25 +395,48 @@ If no such workroom exists, create a new one named NAME 
and return
 that."
   (let ((room (workroom-get name)))
     (unless room
-      (setq room (make-workroom
+      (setq room (workroom--make-room
                   :name name
-                  :buffers (list (get-buffer-create "*scratch*"))))
+                  :buffer-manager #'workroom-default-buffer-manager))
+      (workroom-default-buffer-manager room :initialize)
       (push room workroom--rooms))
     room))
 
 (defun workroom-get-default ()
   "Return the default workroom."
-  (catch 'found
+  (cl-block nil
     (dolist (room workroom--rooms nil)
       (when (workroom-default-p room)
-        (throw 'found room)))))
+        (cl-return room)))))
+
+(defun workroom-generate-new-room-name (name)
+  "Return a string that isn't the name of any workroom based on NAME.
+
+If there is no live workroom named NAME, then return NAME.  Otherwise
+modify NAME by appending `<NUMBER>', incrementing NUMBER (starting at
+2) until an unused name is found, and then return that name."
+  (if (not (workroom-get name))
+      name
+    (cl-block nil
+      (let ((n 2))
+        (while t
+          (let ((str (format "%s<%i>" name n)))
+            (when (not (workroom-get str))
+              (cl-return str))
+            (cl-incf n)))))))
+
+(defun workroom-generate-new-room (name)
+  "Create and return a workroom with a name based on NAME.
+
+Choose the workroom's name using `workroom-generate-new-room-name'."
+  (workroom-get-create (workroom-generate-new-room-name name)))
 
 (defun workroom-view-get (room name)
   "Return the view of ROOM named NAME.
 
 If no such view exists, return nil."
   (catch 'found
-    (dolist (view (workroom-views room) nil)
+    (dolist (view (workroom-view-list room) nil)
       (when (string= name (workroom-view-name view))
         (throw 'found view)))))
 
@@ -281,16 +446,38 @@ If no such view exists, return nil."
 If no such view exists, create a new one named NAME and return that."
   (let ((view (workroom-view-get room name)))
     (unless view
-      (setq view (make-workroom-view :name name))
-      (push view (workroom-views room)))
+      (setq view (workroom--make-view :name name))
+      (setf (workroom--room-view-list room)
+            (nconc (workroom--room-view-list room) `(,view))))
     view))
 
+(defun workroom-generate-new-view-name (room name)
+  "Return a string that isn't the name of any view of ROOM.
+
+If there is no live view named NAME in ROOM, then return NAME.
+Otherwise modify NAME by appending `<NUMBER>', incrementing NUMBER
+\(starting at 2) until an unused name is found, and then return that
+name."
+  (if (not (workroom-view-get room name))
+      name
+    (cl-block nil
+      (let ((n 2))
+        (while t
+          (let ((str (format "%s<%i>" name n)))
+            (when (not (workroom-view-get room str))
+              (cl-return str))
+            (cl-incf n)))))))
+
+(defun workroom-generate-new-view (room name)
+  "Create and return a view of ROOM with a name based on NAME.
+
+Choose the view's name using `workroom-generate-new-view-name'."
+  (workroom-view-get-create
+   room (workroom-generate-new-view-name room name)))
+
 (defun workroom-buffer-list (room)
   "Return the buffer list of workroom ROOM."
-  (let ((buffers (workroom-buffers room)))
-    (if (functionp buffers)
-        (funcall buffers)
-      buffers)))
+  (funcall (workroom--room-buffer-manager room) room :list-buffers))
 
 (defun workroom-current-room (&optional frame)
   "Return the current workroom of FRAME."
@@ -344,9 +531,10 @@ REQUIRE-MATCH and PREDICATE is same as in 
`completing-read'."
     (prog1
         (completing-read
          (concat prompt (when def (format " (default %s)" def)) ": ")
-         (mapcar #'workroom-view-name (workroom-views room))
+         (mapcar #'workroom-view-name (workroom-view-list room))
          predicate require-match nil 'workroom--room-history def)
-      (setf (workroom-view-history room) workroom--view-history))))
+      (setf (workroom--room-view-history room)
+            workroom--view-history))))
 
 (defun workroom--read-view-to-switch ( room prompt &optional def
                                        require-match predicate)
@@ -398,12 +586,14 @@ be a string.  DEF, REQUIRE-MATCH and PREDICATE is same as 
in
   "Read buffer function restricted to buffers of the current workroom.
 
 PROMPT, DEF, REQUIRE-MATCH and PREDICATE is same as in `read-buffer'."
-  (workroom--read-member-buffer (workroom-current-room) prompt def
-                                require-match predicate))
+  (workroom--read-member-buffer
+   (workroom-current-room) prompt def require-match predicate))
+
+(defun workroom--frame-window-config (&optional frame writable)
+  "Return a object describing the window configuration in FRAME.
 
-(defun workroom--save-window-config ()
-  "Return a object describing the current window configuration."
-  (window-state-get (frame-root-window)))
+If WRITABLE, return a writable object."
+  (window-state-get (frame-root-window frame) writable))
 
 (defun workroom--load-window-config (state)
   "Load window configuration STATE."
@@ -489,140 +679,10 @@ PROMPT, DEF, REQUIRE-MATCH and PREDICATE is same as in 
`read-buffer'."
         ;; buffers) before loading it.
         (window-state-put (cons (car state) (sanitize (cdr state)))
                           (frame-root-window) 'safe))
-    (delete-other-windows)
-    (set-window-dedicated-p (selected-window) nil)
-    (switch-to-buffer "*scratch*")))
-
-(defun workroom--encode-buffer-bookmark (buffer)
-  "Encode BUFFER using `bookmark-make-record'."
-  (with-current-buffer buffer
-    (ignore-errors
-      (bookmark-make-record))))
-
-(defun workroom--decode-buffer-bookmark (object)
-  "Decode OBJECT using `bookmark-jump'."
-  (save-window-excursion
-    ;; Make sure `display-buffer' only changes the window
-    ;; configuration of the selected frame, so that
-    ;; `save-window-excursion' can revert it.
-    (let* ((buffers nil)
-           (display-buffer-overriding-action
-            `(,(lambda (buffer _)
-                 (push buffer buffers)
-                 (set-window-buffer (frame-first-window) buffer))
-              . nil)))
-      (bookmark-jump object)
-      (car buffers))))
-
-(defun workroom--encode (room)
-  "Encode workroom ROOM to a printable object."
-  `(;; Format.
-    0
-    ;; Workroom name.
-    ,(workroom-name room)
-    ;; Views (window configurations).
-    ,(mapcar
-      (lambda (view)
-        (cons (workroom-view-name view)
-              (save-window-excursion
-                (workroom--load-window-config
-                 (workroom-view-window-config view))
-                (window-state-get (frame-root-window) 'writable))))
-      (workroom-views room))
-    ;; Buffers.
-    ,(cl-remove-if
-      #'null
-      (mapcar
-       (lambda (buffer)
-         (catch 'done
-           (dolist (entry workroom-buffer-handler-alist nil)
-             (when-let
-                 ((object (funcall (plist-get (cdr entry) :encoder)
-                                   buffer)))
-               (throw 'done (cons (car entry) object))))))
-       (workroom-buffer-list room)))
-    ;; The function returning the list of buffer, if any.
-    ,(when (functionp (workroom-buffers room))
-       (workroom-buffers room))))
-
-(defun workroom--decode (object)
-  "Decode OBJECT to a workroom."
-  (pcase (car object)
-    (0
-     (let ((buffers
-            ;; Restore buffers.
-            (mapcar
-             (lambda (entry)
-               (funcall
-                (plist-get
-                 (alist-get (car entry) workroom-buffer-handler-alist)
-                 :decoder)
-                (cdr entry)))
-             (nth 2 (cdr object)))))
-       (make-workroom
-        :name (nth 0 (cdr object))
-        :views (mapcar (lambda (view-obj)
-                         (make-workroom-view
-                          :name (car view-obj)
-                          :window-config (cdr view-obj)))
-                       (nth 1 (cdr object)))
-        :buffers (if (nth 3 (cdr object))
-                     (nth 3 (cdr object))
-                   buffers))))
-    (_
-     (error "Unknown format of encoding"))))
-
-(defun workroom--restore-rooms (data)
-  "Restore workrooms in DATA."
-  (pcase (car data)
-    ('workroom
-     ;; Restore a single workroom.
-     (let ((room (workroom--decode (cdr data))))
-       (when-let ((existing (workroom-get (workroom-name room))))
-         (unless (y-or-n-p
-                  (format-message
-                   "Workroom `%s' already exists, overwrite? "
-                   (workroom-name room)))
-           (user-error "Workroom `%s' exists" (workroom-name room)))
-         (workroom-kill existing))
-       (push room workroom--rooms)))
-    ('workroom-set
-     ;; Restore all workrooms.
-     (let ((rooms nil)
-           (rooms-to-kill nil))
-       (dolist (object (cdr data))
-         (let ((room (workroom--decode object)))
-           (when-let ((existing (workroom-get (workroom-name room))))
-             (unless (y-or-n-p
-                      (format-message
-                       "Workroom `%s' already exists, overwrite? "
-                       (workroom-name room)))
-               (user-error "Workroom `%s' exists"
-                           (workroom-name room)))
-             (push existing rooms-to-kill))
-           (push room rooms)))
-       (mapc #'workroom-kill rooms-to-kill)
-       (setq workroom--rooms (nconc rooms workroom--rooms))))))
-
-(defun workroom--read-bookmark (prompt)
-  "Prompt with PROMPT, read a bookmark name, don't require match."
-  (bookmark-maybe-load-default-file)
-  (completing-read
-   prompt (lambda (string predicate action)
-            (if (eq action 'metadata)
-                '(metadata (category . bookmark))
-              (complete-with-action action bookmark-alist string
-                                    predicate)))
-   nil nil nil 'bookmark-history))
-
-(defun workroom--remove-buffer-refs ()
-  "Remove references of current buffer from all workrooms."
-  (dolist (room workroom--rooms)
-    ;; When buffers is a list, its our responsibility to keep it
-    ;; clean, and when its is function, its their responsibility to
-    ;; not return killed buffers.
-    (unless (functionp (workroom-buffers room))
-      (workroom-remove-buffer (current-buffer) room))))
+    (unless workroom--initializing
+      (delete-other-windows)
+      (set-window-dedicated-p (selected-window) nil)
+      (switch-to-buffer "*scratch*"))))
 
 (defun workroom--barf-unless-enabled ()
   "Signal `user-error' unless Workroom-Mode is enabled."
@@ -636,27 +696,7 @@ PROMPT, DEF, REQUIRE-MATCH and PREDICATE is same as in 
`read-buffer'."
      (workroom--barf-unless-enabled)
      ,@body))
 
-;;;###autoload
-(defun workroom-bookmark-jump (bookmark)
-  "Handle BOOKMARK."
-  (workroom--barf-unless-enabled)
-  (let ((data (alist-get 'data (bookmark-get-bookmark-record
-                                bookmark))))
-    (workroom--restore-rooms data)))
-
-(defun workroom--init-frame (frame)
-  "Initialize frame FRAME."
-  (when (and (not (frame-parameter frame 'parent-frame))
-             (eq (frame-parameter frame 'minibuffer) t))
-    (with-selected-frame frame
-      (workroom-switch
-       (workroom-get-default) workroom-default-view-name
-       ;; TODO: Do we really need `no-record'?
-       ;; (workroom-current-room) should be nil, so nothing should be
-       ;; in the history even if we don't pass this argument.
-       'no-record))))
-
-(defun workroom-switch (room view &optional no-record)
+(defun workroom-switch-view (room view &optional no-record)
   "Switch to view VIEW in workroom ROOM.
 
 If called interactively, prompt for view to switch.  If prefix
@@ -673,20 +713,16 @@ When the optional argument NO-RECORD is non-nil, don't 
record the
 switch."
   (interactive
    (workroom--require-mode-enable
-     (let ((room
-            (if current-prefix-arg
-                (workroom--read-to-switch
-                 "Switch to workroom"
-                 (cond
-                  ((and (eq (car (workroom-previous-room-list))
-                            (workroom-current-room))
-                        (> (length (workroom-previous-room-list)) 1))
-                   (workroom-name
-                    (cadr (workroom-previous-room-list))))
-                  ((car (workroom-previous-room-list))
-                   (workroom-name
-                    (car (workroom-previous-room-list))))))
-              (workroom-current-room))))
+     (let ((room (if current-prefix-arg
+                     (workroom--read-to-switch
+                      "Switch to workroom"
+                      (let ((def (cl-find-if-not
+                                  (apply-partially
+                                   #'eq (workroom-current-room))
+                                  (workroom-previous-room-list))))
+                        (when def
+                          (workroom-name def))))
+                   (workroom-current-room))))
        (when (stringp room)
          (setq room (if (string-empty-p room)
                         (workroom-get-default)
@@ -694,28 +730,55 @@ switch."
        (let ((view
               (workroom--read-view-to-switch
                room "Switch to view"
-               (cond
-                ((and
-                  (eq (car (workroom-previous-view-list room))
-                      (workroom-current-view))
-                  (> (length (workroom-previous-view-list room)) 1))
-                 (workroom-view-name
-                  (cadr (workroom-previous-view-list room))))
-                ((car (workroom-previous-view-list room))
-                 (workroom-view-name
-                  (car (workroom-previous-view-list room))))))))
-         (when (and (stringp view) (string-empty-p view))
+               (let ((def
+                      (cl-find-if
+                       (lambda (view)
+                         (and (not (eq view (workroom-current-view)))
+                              (null (workroom-view-frame view))))
+                       (workroom-view-list room))))
+                 (when def
+                   (workroom-view-name def))))))
+         (when (string-empty-p view)
            (setq view workroom-default-view-name))
          (list room view)))))
   (workroom--barf-unless-enabled)
-  (setq room (if (stringp room)
-                 (workroom-get-create room)
-               (or room (workroom-current-room))))
-  (setq view (if (stringp view)
-                 (workroom-view-get-create room view)
-               (or view (workroom-selected-view room)
-                   (workroom-view-get-create
-                    room workroom-default-view-name))))
+  (setq room
+        (if (stringp room)
+            (if (string-empty-p room)
+                (error
+                 "Empty string for workroom name is not allowed")
+              (workroom-get-create room))
+          (or room (workroom-current-room))))
+  (setq view
+        (if (stringp view)
+            (if (string-empty-p view)
+                (error "Empty string for view name is not allowed")
+              (workroom-view-get-create room view))
+          (or view
+              (cl-find-if
+               (lambda (view) (null (workroom-view-frame view)))
+               (workroom-view-list room))
+              (cl-find-if
+               (lambda (view)
+                 (or (null (workroom-view-frame view))
+                     (eq (workroom-view-frame view)
+                         (selected-frame))))
+               (workroom-view-list room))
+              (let ((v (workroom-view-get-create
+                        room workroom-default-view-name)))
+                (if (and (workroom-view-frame v)
+                         (not (eq (workroom-view-frame v)
+                                  (selected-frame))))
+                    (workroom-generate-new-view
+                     room workroom-default-view-name)
+                  v)))))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (unless (workroom-view-p view)
+    (signal 'wrong-type-argument `(workroom-view-p . ,view)))
+  (when (and (not (eq view (workroom-current-view)))
+             (workroom-view-frame view))
+    (error "Cannot switch to a view already in use in another frame"))
   (unless (eq room (workroom-current-room))
     (when (and (not no-record) (workroom-current-room))
       (push (workroom-current-room)
@@ -723,19 +786,20 @@ switch."
     (set-frame-parameter nil 'workroom-current-room room))
   (unless (eq view (workroom-current-view))
     (when (workroom-current-view)
-      (setf (workroom-view-window-config (workroom-current-view))
-            (workroom--save-window-config))
-      (unless no-record
-        (push (workroom-current-view)
-              (workroom-previous-view-list room))))
-    (setf (workroom-selected-view room) view)
+      (setf (workroom--view-window-config (workroom-current-view))
+            (workroom--frame-window-config))
+      (setf (workroom--view-window-config-writable
+             (workroom-current-view))
+            (workroom--frame-window-config nil 'writable))
+      (setf (workroom--view-frame (workroom-current-view)) nil)
+      (setf (workroom--room-view-list room)
+            (cons view (delq view (workroom--room-view-list room)))))
     (set-frame-parameter nil 'workroom-current-view view)
-    (workroom--load-window-config (workroom-view-window-config view))
+    (setf (workroom--view-frame view) (selected-frame))
+    (workroom--load-window-config (workroom--view-window-config view))
     (run-hooks 'workroom-switch-hook)))
 
-(defalias 'workroom-switch-view #'workroom-switch)
-
-(defun workroom-switch-room (room)
+(defun workroom-switch (room)
   "Switch to workroom ROOM.
 
 ROOM is should be workroom object, or a name of a workroom object."
@@ -750,7 +814,7 @@ ROOM is should be workroom object, or a name of a workroom 
object."
            (workroom-name (cadr (workroom-previous-room-list))))
           ((car (workroom-previous-room-list))
            (workroom-name (car (workroom-previous-room-list)))))))))
-  (workroom-switch room nil))
+  (workroom-switch-view room nil))
 
 (defun workroom-kill (room)
   "Kill workroom ROOM.
@@ -759,26 +823,34 @@ ROOM is should be workroom object, or a name of a 
workroom object."
   (interactive
    (workroom--require-mode-enable
      (list
-      (workroom-get
-       (workroom--read
-        "Kill workroom" (workroom-name (workroom-current-room))
-        t (lambda (cand)
-            (not
-             (workroom-default-p
-              (workroom-get (if (consp cand) (car cand) cand))))))))))
+      (workroom--read
+       "Kill workroom" (workroom-name (workroom-current-room))
+       t (lambda (cand)
+           (not
+            (workroom-default-p
+             (workroom-get (if (consp cand) (car cand) cand)))))))))
   (workroom--barf-unless-enabled)
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (unless (workroomp room)
+    (signal 'wrong-type-argument `(workroomp . ,room)))
   (when (workroom-default-p room)
     (error "Cannot kill default workroom"))
   (when (eq room (workroom-current-room))
-    (workroom-switch (workroom-get-default)
-                     (workroom-view-get-create
-                      (workroom-get-default)
-                      workroom-default-view-name)))
+    (workroom-switch-view (workroom-get-default)
+                          (workroom-view-get-create
+                           (workroom-get-default)
+                           workroom-default-view-name)))
+  (setf (workroom--room-name room) nil)
   (setq workroom--rooms (delete room workroom--rooms))
   (dolist (frame (frame-list))
-    (setf (frame-parameter frame 'workroom-previous-room-list)
-          (delete room (frame-parameter
-                        frame 'workroom-previous-room-list))))
+    (set-frame-parameter
+     frame 'workroom-previous-room-list
+     (delete room
+             (frame-parameter frame 'workroom-previous-room-list))))
   (run-hooks 'workroom-kill-room-hook))
 
 (defun workroom-kill-view (room view)
@@ -795,31 +867,37 @@ should be in the workroom ROOM."
                        (workroom-name (workroom-current-room)) t))
                    (workroom-current-room))))
        (list room
-             (workroom-view-get-create
+             (workroom-view-get
               room
               (workroom--read-view
                room "Kill view"
                (when (eq room (workroom-current-room))
                  (workroom-view-name (workroom-current-view)))))))))
   (workroom--barf-unless-enabled)
-  (when (stringp room)
-    (setq room (workroom-get room)))
-  (when (stringp view)
-    (setq view (workroom-view-get room view)))
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (setq view (if (stringp view)
+                 (or (workroom-view-get room view)
+                     (signal 'wrong-type-argument
+                             `(workroom-view-p . ,room)))
+               view))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (unless (workroom-view-p view)
+    (signal 'wrong-type-argument `(workroom-view-p . ,view)))
   (when (and room view)
     (when (eq view (workroom-current-view))
-      (workroom-switch
-       room
-       (let ((views (workroom-views room))
-             (vi nil))
-         (while (and (not vi) views)
-           (let ((v (pop views)))
-             (unless (eq v view)
-               (setq vi (car views)))))
-         (or vi (workroom-view-get-create
+      (workroom-switch-view
+       room (or (cl-find-if-not (apply-partially #'eq view)
+                                (workroom-view-list room))
+                (workroom-view-get-create
                  room workroom-default-view-name))))
-      (pop (workroom-previous-view-list room)))
-    (setf (workroom-views room) (delete view (workroom-views room)))
+    (setf (workroom--view-name view) nil)
+    (setf (workroom--room-view-list room)
+          (delete view (workroom--room-view-list room)))
     (run-hooks 'workroom-kill-view-hook)))
 
 (defun workroom-rename (room new-name)
@@ -831,17 +909,18 @@ ROOM is should be workroom object, or a name of a 
workroom object."
      (let ((room
             (workroom--read
              "Rename workroom" (workroom-name (workroom-current-room))
-             t (lambda (cand)
-                 (not (workroom-default-p
-                       (workroom-get (if (consp cand)
-                                         (car cand)
-                                       cand))))))))
+             t)))
        (list room (read-string (format-message
                                 "Rename workroom `%s' to: " room))))))
   (workroom--barf-unless-enabled)
-  (when (stringp room)
-    (setq room (workroom-get room)))
-  (setf (workroom-name room) new-name)
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (setf (workroom--room-name room) new-name)
   (run-hooks 'workroom-rename-room-hook))
 
 (defun workroom-rename-view (room view new-name)
@@ -867,11 +946,21 @@ ROOM is should be workroom object, or a name of a 
workroom object."
                            "Rename view `%s' of workroom `%s' to: "
                            view (workroom-name room)))))))
   (workroom--barf-unless-enabled)
-  (when (stringp room)
-    (setq room (workroom-get room)))
-  (when (stringp view)
-    (setq view (workroom-view-get room view)))
-  (setf (workroom-view-name view) new-name)
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (setq view (if (stringp view)
+                 (or (workroom-view-get room view)
+                     (signal 'wrong-type-argument
+                             `(workroom-view-live-p . ,room)))
+               view))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (unless (workroom-view-live-p view)
+    (signal 'wrong-type-argument `(workroom-view-live-p . ,view)))
+  (setf (workroom--view-name view) new-name)
   (run-hooks 'workroom-rename-view-hook))
 
 (defun workroom-clone (room name)
@@ -879,21 +968,24 @@ ROOM is should be workroom object, or a name of a 
workroom object."
   (interactive
    (workroom--require-mode-enable
      (let ((room (workroom--read
-                  "Clone workroom" (workroom-name
-                                    (workroom-current-room))
-                  t (lambda (cand)
-                      (not (functionp (workroom-buffers
-                                       (workroom-get (if (consp cand)
-                                                         (car cand)
-                                                       cand)))))))))
+                  "Clone workroom"
+                  (workroom-name (workroom-current-room)) t)))
        (list room (read-string "Name of cloned workroom: ")))))
   (workroom--barf-unless-enabled)
-  (when (stringp room)
-    (setq room (workroom-get room)))
-  (let ((clone (make-workroom :name name
-                              :views (mapcar #'copy-sequence
-                                             (workroom-views room))
-                              :buffers (workroom-buffers room))))
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (let ((clone
+         (workroom--make-room
+          :name name
+          :view-list (mapcar #'workroom--copy-view
+                             (workroom-view-list room))
+          :buffer-manager (workroom--room-buffer-manager room))))
+    (funcall (workroom--room-buffer-manager room) clone :clone room)
     (push clone workroom--rooms)
     clone))
 
@@ -917,78 +1009,39 @@ ROOM is should be workroom object, or a name of a 
workroom object."
                    t)))
        (list room view (read-string "Name of cloned view: ")))))
   (workroom--barf-unless-enabled)
-  (when (stringp room)
-    (setq room (workroom-get room)))
-  (when (stringp view)
-    (setq view (workroom-view-get room view)))
-  (let ((clone (make-workroom-view
-                :name name
-                :window-config (workroom-view-window-config view))))
-    (push clone (workroom-views room))
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (setq view (if (stringp view)
+                 (or (workroom-view-get room view)
+                     (signal 'wrong-type-argument
+                             `(workroom-view-live-p . ,room)))
+               view))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (unless (workroom-view-live-p view)
+    (signal 'wrong-type-argument `(workroom-view-live-p . ,view)))
+  (let ((clone
+         (workroom--make-view
+          :name name
+          :window-config (workroom-view-window-configuration view))))
+    (setf (workroom--room-view-list room)
+          (nconc (workroom--room-view-list room) `(,clone)))
     clone))
 
-(defun workroom-bookmark (room name no-overwrite)
-  "Save workroom ROOM to a bookmark named NAME.
-
-If NO-OVERWRITE is nil or prefix arg is given, don't overwrite any
-previous bookmark with the same name.
-
-The default workroom cannot be saved."
-  (interactive
-   (list (workroom--read
-          "Workroom" nil t
-          (lambda (cand)
-            (not (equal (workroom-name (workroom-get-default))
-                        (if (consp cand) (car cand) cand)))))
-         (workroom--read-bookmark "Save to bookmark: ")
-         current-prefix-arg))
-  (when (stringp room)
-    (setq room (workroom-get room)))
-  (dolist (frame (frame-list))
-    (when (frame-parameter frame 'workroom-current-room)
-      (with-selected-frame frame
-        (setf (workroom-view-window-config (workroom-current-view))
-              (workroom--save-window-config)))))
-  (bookmark-store
-   name `((data . (workroom . ,(workroom--encode room)))
-          (handler . workroom-bookmark-jump))
-   no-overwrite))
-
-(defun workroom-bookmark-all (name no-overwrite)
-  "Save all workrooms except the default one to a bookmark named NAME.
-
-If NO-OVERWRITE is nil or prefix arg is given, don't overwrite any
-previous bookmark with the same name."
-  (interactive (list (workroom--read-bookmark "Save to bookmark: ")
-                     current-prefix-arg))
-  (dolist (frame (frame-list))
-    (when (frame-parameter frame 'workroom-current-room)
-      (with-selected-frame frame
-        (setf (workroom-view-window-config (workroom-current-view))
-              (workroom--save-window-config)))))
-  (bookmark-store name
-                  `((data . (workroom-set
-                             ,@(mapcar #'workroom--encode
-                                       (remove
-                                        (workroom-get-default)
-                                        workroom--rooms))))
-                    (handler . workroom-bookmark-jump))
-                  no-overwrite))
-
 (defun workroom-add-buffer (buffer &optional room)
   "Add BUFFER to workroom ROOM.
 
-ROOM should be a `workroom'.  When ROOM is a `workroom' object, add
-BUFFER to it.  If ROOM is nil, add BUFFER to the room of the selected
-frame.
+ROOM should be a workroom object or a string.  When ROOM is a string,
+the workroom object with that string as the name is used.  When ROOM
+is a workroom object, add BUFFER to it.  If ROOM is nil, add BUFFER to
+the room of the selected frame.
 
 If ROOM is the default workroom, do nothing."
   (interactive
    (workroom--require-mode-enable
-     (when (functionp (workroom-buffers
-                       (workroom-current-room)))
-       (user-error
-        "Cannot add buffer to workroom with dynamic buffer list"))
      (list (get-buffer-create
             (workroom--read-non-member-buffer
              (workroom-current-room) "Add buffer: "
@@ -997,13 +1050,15 @@ If ROOM is the default workroom, do nothing."
                                  (workroom-current-room))))
                (current-buffer))))
            nil)))
-  (unless room
-    (setq room (workroom-current-room)))
-  (if (functionp (workroom-buffers room))
-      (error "Cannot add buffer to workroom with dynamic buffer list")
-    (unless (member buffer (workroom-buffers room))
-      (push buffer (workroom-buffers room))
-      (run-hooks 'workroom-buffer-list-change-hook))))
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               (or room (workroom-current-room))))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (funcall (workroom--room-buffer-manager room)
+           room :add-buffer buffer))
 
 (defun workroom-remove-buffer (buffer &optional room)
   "Remove BUFFER from workroom ROOM.
@@ -1015,13 +1070,6 @@ selected frame.
 If ROOM is the default workroom, kill buffer."
   (interactive
    (workroom--require-mode-enable
-     (when (and (functionp (workroom-buffers
-                            (workroom-current-room)))
-                (not (workroom-default-p
-                      (workroom-current-room))))
-       (user-error
-        "Cannot remove buffer from non-default workroom with dynamic \
-buffer list"))
      (list (get-buffer
             (workroom--read-member-buffer
              (workroom-current-room)
@@ -1032,18 +1080,15 @@ buffer list"))
                (current-buffer))
              t))
            nil)))
-  (unless room
-    (setq room (workroom-current-room)))
-  (if (not (functionp (workroom-buffers room)))
-      (when (member buffer (workroom-buffers room))
-        (setf (workroom-buffers room)
-              (delete buffer (workroom-buffers room)))
-        (run-hooks 'workroom-buffer-list-change-hook))
-    (unless (workroom-default-p room)
-      (error
-       "Cannot remove buffer from non-default workroom with dynamic \
-buffer list"))
-    (kill-buffer buffer)))
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               (or room (workroom-current-room))))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (funcall (workroom--room-buffer-manager room)
+           room :remove-buffer buffer))
 
 (defmacro workroom-define-replacement (fn)
   "Define `workroom-FN' as replacement for FN.
@@ -1066,6 +1111,101 @@ restrict." fn)
 (workroom-define-replacement switch-to-buffer)
 (workroom-define-replacement kill-buffer)
 
+(defun workroom-default-buffer-manager (room action &rest args)
+  "The default buffer manager of workrooms.
+
+Set as the `workroom-buffer-manager-function' of ROOM, which see.  The
+value of ACTION and ARGS are also described there."
+  (setf (workroom-buffer-manager-data room)
+        (cl-delete-if-not #'buffer-live-p
+                          (workroom-buffer-manager-data room)))
+  (pcase action
+    (:initialize
+     (cl-destructuring-bind () args
+       (setf (workroom-buffer-manager-data room)
+             `(,(get-scratch-buffer-create)))))
+    (:list-buffers
+     (cl-destructuring-bind () args
+       (workroom-buffer-manager-data room)))
+    (:add-buffer
+     (cl-destructuring-bind (buffer) args
+       (push buffer (workroom-buffer-manager-data room))))
+    (:remove-buffer
+     (cl-destructuring-bind (buffer) args
+       (setf (workroom-buffer-manager-data room)
+             (delq buffer (workroom-buffer-manager-data room)))))
+    (:clone
+     (cl-destructuring-bind (source) args
+       (setf (workroom-buffer-manager-data room)
+             (copy-sequence (workroom-buffer-manager-data source)))))
+    (:encode
+     (cl-destructuring-bind () args
+       ;; Nothing, we'll get the buffer list through the fourth
+       ;; argument of `:load'.
+       ))
+    (:load
+     (cl-destructuring-bind (_data buffers) args
+       (setf (workroom-buffer-manager-data room)
+             (copy-sequence buffers))))))
+
+(defun workroom-default-room-buffer-manager (room action &rest args)
+  "The buffer manager of the default workroom.
+
+Set as the `workroom-buffer-manager-function' of ROOM, which see.  The
+value of ACTION and ARGS are also described there."
+  (pcase action
+    (:initialize
+     (cl-destructuring-bind () args
+       ;; Nothing.
+       ))
+    (:list-buffers
+     (cl-destructuring-bind () args
+       (buffer-list)))
+    (:add-buffer
+     (cl-destructuring-bind (_buffer) args
+       ;; Nothing, all live buffer are members.
+       ))
+    (:remove-buffer
+     (cl-destructuring-bind (buffer) args
+       ;; All live buffer are members, so the buffer must die to
+       ;; leave us.
+       (kill-buffer buffer)))
+    (:clone
+     (cl-destructuring-bind (_source) args
+       ;; There can't be two default workrooms, so this function can't
+       ;; manage two workrooms.  We'll hand over responsibilities to
+       ;; the default buffer manager.
+       (setf (workroom-buffer-manager-function room)
+             #'workroom-default-buffer-manager)
+       (workroom-default-buffer-manager room :clone (buffer-list))))
+    (:encode
+     (cl-destructuring-bind () args
+       ;; Nothing, the default workroom can't be encoding (but can
+       ;; indeed be saved, see the action `:load').
+       ))
+    (:load
+     (cl-destructuring-bind (data buffers) args
+       ;; There can't be two default workrooms, so this function can't
+       ;; manage two workrooms.  We'll hand over responsibilities to
+       ;; the default buffer manager.
+       (setf (workroom-buffer-manager-function room)
+             #'workroom-default-buffer-manager)
+       (workroom-default-buffer-manager room :load data buffers)))))
+
+(defun workroom--frame-manage-p (frame)
+  "Return non-nil if workroom should manage FRAME."
+  (and (not (frame-parameter frame 'parent-frame))
+       (eq (frame-parameter frame 'minibuffer) t)))
+
+(defun workroom--init-frame (frame)
+  "Initialize frame FRAME."
+  (when (workroom--frame-manage-p frame)
+    (let ((default (workroom-get-default)))
+      (with-selected-frame frame
+        (workroom-switch-view
+         default (workroom-generate-new-view
+                  default workroom-default-view-name))))))
+
 ;;;###autoload
 (define-minor-mode workroom-mode
   "Toggle workroom mode."
@@ -1077,64 +1217,290 @@ restrict." fn)
               workroom-command-map)
   (if workroom-mode
       (progn
-        (let ((default-room (workroom-get-default)))
+        (workroom-mode -1)
+        (setq workroom-mode t)
+        (let ((workroom--initializing t)
+              (default-room (workroom-get-default)))
           (unless default-room
-            (setq default-room
-                  (make-workroom
-                   :name workroom-default-room-name
-                   :views (list
-                           (make-workroom-view
-                            :name workroom-default-view-name
-                            :window-config
-                            (workroom--save-window-config)))
-                   :buffers #'buffer-list
-                   :default-p t))
+            (setq
+             default-room
+             (workroom--make-room
+              :name workroom-default-room-name
+              :buffer-manager #'workroom-default-room-buffer-manager
+              :default-p t))
+            (workroom-default-room-buffer-manager
+             default-room :initialize)
             (push default-room workroom--rooms))
           (unless (equal (workroom-name default-room)
                          workroom-default-room-name)
-            (setf (workroom-name default-room)
-                  workroom-default-room-name)))
-        (mapc #'workroom--init-frame (frame-list))
-        (add-hook 'after-make-frame-functions #'workroom--init-frame)
-        (add-hook 'kill-buffer-hook #'workroom--remove-buffer-refs))
+            (setf (workroom--room-name default-room)
+                  workroom-default-room-name))
+          (mapc #'workroom--init-frame (frame-list))
+          (add-hook 'after-make-frame-functions
+                    #'workroom--init-frame)))
     (dolist (frame (frame-list))
       (when (frame-parameter frame 'workroom-current-room)
-        (with-selected-frame frame
-          (setf (workroom-view-window-config (workroom-current-view))
-                (workroom--save-window-config))
-          (set-frame-parameter nil 'workroom-current-room nil)
-          (set-frame-parameter nil 'workroom-current-view nil)
-          (set-frame-parameter nil 'workroom-previous-room-list
-                               nil))))
-    (remove-hook 'after-make-frame-functions #'workroom--init-frame)
-    (remove-hook 'kill-buffer-hook #'workroom--remove-buffer-refs)))
+        (set-frame-parameter frame 'workroom-current-room nil)
+        (set-frame-parameter frame 'workroom-current-view nil)
+        (set-frame-parameter frame 'workroom-previous-room-list nil)))
+    (setq workroom--rooms nil)
+    (remove-hook 'after-make-frame-functions #'workroom--init-frame)))
+
+
+;;;; Workroom Encoding/Decoding.
+
+(defun workroom--encode-view-1 (view)
+  "Encode view VIEW to a writable object."
+  `( :name ,(workroom-view-name view)
+     :window-config ,(workroom-view-window-configuration
+                      view 'writable)))
+
+(defun workroom--decode-view-1 (object)
+  "Decode encoded view OBJECT to a view."
+  (workroom--make-view
+   :name (plist-get object :name)
+   :window-config (plist-get object :window-config)
+   :window-config-writable (plist-get object :window-config)))
+
+(defun workroom--encode-room-1 (room)
+  "Encode workroom ROOM to a writable object.
+
+The buffers are not encoded, they must be encoded separately."
+  `( :name ,(workroom-name room)
+     :view-list ,(mapcar #'workroom--encode-view-1
+                         (workroom-view-list room))
+     :buffer-manager ,(workroom-buffer-manager-function room)
+     :buffer-manager-data ,(funcall
+                            (workroom-buffer-manager-function room)
+                            room :encode)))
+
+(defun workroom--decode-room-1 (object buffers)
+  "Decode encoded workroom OBJECT to a workroom.
+
+BUFFERS should be a list of the buffer that were the member of ROOM
+when ROOM was encoded."
+  (let ((room (workroom--make-room
+               :name (workroom-generate-new-room-name
+                      (plist-get object :name))
+               :view-list (mapcar #'workroom--decode-view-1
+                                  (plist-get object :view-list))
+               :buffer-manager (plist-get object :buffer-manager))))
+    (funcall (plist-get object :buffer-manager) room :load
+             (plist-get object :buffer-manager-data) buffers)
+    room))
+
+
+;;;; Buffer Encoding/Decoding.
+
+(defun workroom--encode-buffers (buffers)
+  "Encode the buffers in the list BUFFERS to writable objects."
+  (let* ((objects '(nil))
+         (tail objects))
+    (dolist (buffer buffers)
+      (cl-block nil
+        (dolist (entry workroom-buffer-handler-alist nil)
+          (when-let ((object (funcall (plist-get (cdr entry) :encoder)
+                                      buffer)))
+            (setf (cdr tail)
+                  `(( :name ,(buffer-name buffer)
+                      :encoding ,(car entry)
+                      :object ,object)))
+            (setq tail (cdr tail))
+            (cl-return)))))
+    (cdr objects)))
+
+(defun workroom--decode-buffers (objects)
+  "Restore the buffers encoded in OBJECTS."
+  (let* ((buffers '(nil))
+         (tail buffers))
+    (dolist (object objects)
+      (let ((decoder
+             (plist-get (alist-get (plist-get object :encoding)
+                                   workroom-buffer-handler-alist)
+                        :decoder)))
+        (setf (cdr tail)
+              `((,(plist-get object :name)
+                 . ,(when decoder
+                      (funcall decoder (plist-get object :object))))))
+        (setq tail (cdr tail))))
+    (cdr buffers)))
+
+(defun workroom--encode-buffer-bookmark (buffer)
+  "Encode BUFFER using `bookmark-make-record'."
+  (with-current-buffer buffer
+    (ignore-errors
+      (bookmark-make-record))))
+
+(defun workroom--decode-buffer-bookmark (object)
+  "Decode OBJECT using `bookmark-jump'."
+  (let* ((buffer nil))
+    (bookmark-jump object (lambda (buf) (setq buffer buf)))
+    buffer))
+
+
+;;;; Bookmark Integration.
+
+(defun workroom--read-bookmark (prompt)
+  "Prompt with PROMPT, read a bookmark name, don't require match."
+  (bookmark-maybe-load-default-file)
+  (completing-read
+   prompt (lambda (string predicate action)
+            (if (eq action 'metadata)
+                '(metadata (category . bookmark))
+              (complete-with-action action bookmark-alist string
+                                    predicate)))
+   nil nil nil 'bookmark-history))
+
+;;;###autoload
+(defun workroom-bookmark-jump-to-room (bookmark)
+  "Jump to the workroom in bookmark BOOKMARK."
+  (workroom--barf-unless-enabled)
+  (let ((data (cdr (alist-get 'data (bookmark-get-bookmark-record
+                                     bookmark)))))
+    (pcase (plist-get data :version)
+      (1
+       (let* ((buffers (mapcar #'cdr
+                               (cl-delete-if
+                                #'null
+                                (workroom--decode-buffers
+                                 (plist-get data :buffers)))))
+              (room (workroom--decode-room-1
+                     (plist-get data :room) buffers)))
+         (push room workroom--rooms)
+         (workroom-switch room)))
+      (version
+       (error "Unsuppported bookmark version %i" version))))
+  (set-buffer (window-buffer)))
+
+(defun workroom-bookmark (room name no-overwrite)
+  "Save workroom ROOM to a bookmark named NAME.
+
+If NO-OVERWRITE is nil or prefix argument is given, don't overwrite
+any previous bookmark with the same name."
+  (interactive
+   (list (workroom--read
+          "Workroom" nil t
+          (lambda (cand)
+            (not (equal (workroom-name (workroom-get-default))
+                        (if (consp cand) (car cand) cand)))))
+         (workroom--read-bookmark "Save to bookmark: ")
+         current-prefix-arg))
+  (workroom--barf-unless-enabled)
+  (setq room (if (stringp room)
+                 (or (workroom-get room)
+                     (signal 'wrong-type-argument
+                             `(workroom-live-p . ,room)))
+               room))
+  (unless (workroom-live-p room)
+    (signal 'wrong-type-argument `(workroom-live-p . ,room)))
+  (bookmark-store
+   name `((data . (workroom
+                   :version 1
+                   :room ,(workroom--encode-room-1 room)
+                   :buffers ,(workroom--encode-buffers
+                              (workroom-buffer-list room))))
+          (handler . workroom-bookmark-jump-to-room))
+   no-overwrite))
+
+
+;;;; Desktop Integration.
+
+(defun workroom--desktop-restore (object)
+  "Restore all workrooms from OBJECT recorded in desktop file."
+  (pcase (plist-get object :version)
+    (1
+     ;; Restore default workroom name and views.
+     (let ((def-room (workroom-get-default))
+           (room-name-alist nil))
+       (let ((room (plist-get object :default-room)))
+         (workroom-rename def-room (plist-get room :name))
+         (dolist (view (workroom--room-view-list def-room))
+           (setf (workroom--view-name view) nil))
+         (setf (workroom--room-view-list def-room)
+               (mapcar #'workroom--decode-view-1
+                       (plist-get room :view-list)))
+         (setf (workroom--room-view-history def-room) nil)
+         ;; We use room-name-alist to map names to rooms, because the
+         ;; room names in OBJECT may not be used as the names of the
+         ;; newly create rooms (maybe because they are is use, for
+         ;; example).
+         (push (cons (plist-get room :name) def-room)
+               room-name-alist))
+       ;; Restore other workrooms.
+       (dolist (wr (plist-get object :other-rooms))
+         (let* ((buffers (cl-delete-if #'null
+                                       (mapcar
+                                        #'get-buffer
+                                        (plist-get wr :buffers))))
+                (room (workroom--decode-room-1
+                       (plist-get wr :room) buffers)))
+           (push room workroom--rooms)
+           (push (cons (plist-get (plist-get wr :room) :name) room)
+                 room-name-alist)))
+       ;; Switch to views.
+       (let ((active-views (plist-get object :active-views)))
+         (let ((selected-frame (selected-frame)))
+           (dolist (frame (frame-list))
+             (when (workroom--frame-manage-p frame)
+               (select-frame frame 'norecord)
+               (set-frame-parameter frame 'workroom-current-room nil)
+               (set-frame-parameter frame 'workroom-current-view nil)
+               (set-frame-parameter frame 'workroom-previous-room-list
+                                    nil)
+               (let* ((view (pop active-views))
+                      (room (cdr (assoc-string
+                                  (car view) room-name-alist))))
+                 (if view
+                     (workroom-switch-view
+                      room
+                      (workroom-view-get room (cdr view)))
+                   (workroom-switch-view
+                    def-room
+                    (workroom-generate-new-view
+                     def-room workroom-default-view-name))))))
+           (select-frame selected-frame 'norecord)))))
+    (version
+     (error "Unsuppported workroom with version %i in desktop file"
+            version))))
 
 (defun workroom--desktop-inject-restore-code ()
   "Inject workroom restore code in desktop file."
-  ;; Save window configuration on all frames.
-  (dolist (frame (frame-list))
-    (when (frame-parameter frame 'workroom-current-room)
-      (with-selected-frame frame
-        (setf (workroom-view-window-config (workroom-current-view))
-              (workroom--save-window-config)))))
   ;; Inject restoring code.
-  (let ((time (format-time-string "%s%N")))
-    (insert (format "
+  (when workroom-mode
+    (let ((time (format-time-string "%s%N")))
+      (insert
+       (format
+        "
 ;; Workroom section:
 (defun workroom--desktop-restore-%s ()
   \"Restore workrooms.\"
   (remove-hook 'desktop-after-read-hook
                #'workroom--desktop-restore-%s)
   (when (bound-and-true-p workroom-mode)
-    (workroom--restore-rooms '%S)))
+    (workroom--desktop-restore '%S)))
 (add-hook 'desktop-after-read-hook #'workroom--desktop-restore-%s)
 "
-                    time time
-                    `(workroom-set
-                      . ,(mapcar #'workroom--encode
-                                 (remove (workroom-get-default)
-                                         workroom--rooms)))
-                    time))))
+        time time
+        `( :version 1
+           :default-room ,(workroom--encode-room-1
+                           (workroom-get-default))
+           :other-rooms
+           ,(mapcar
+             (lambda (room)
+               `( :room ,(workroom--encode-room-1 room)
+                  :buffers ,(mapcar #'buffer-name
+                                    (workroom-buffer-list room))))
+             (cl-remove-if #'workroom-default-p
+                           workroom--rooms))
+           :active-views
+           ,(mapcar
+             (lambda (frame)
+               (with-selected-frame frame
+                 (cons (workroom-name (workroom-current-room))
+                       (workroom-view-name (workroom-current-view)))))
+             (cl-remove-if-not #'workroom--frame-manage-p
+                               (frame-list))))
+        time)))))
 
 ;;;###autoload
 (define-minor-mode workroom-desktop-save-mode



reply via email to

[Prev in Thread] Current Thread [Next in Thread]