branch: elpa/workroom
commit 1d4c134d608056c55c9d55e48711195c61977af4
Author: Akib Azmain Turja <a...@disroot.org>
Commit: Akib Azmain Turja <a...@disroot.org>
Add new command workroom-switch-room, some refactoring
---
README.org | 15 ++--
workroom.el | 281 +++++++++++++++++++++++++++++++++++++-----------------------
2 files changed, 181 insertions(+), 115 deletions(-)
diff --git a/README.org b/README.org
index 9f73cbd41d..d41019e3c0 100644
--- a/README.org
+++ b/README.org
@@ -23,13 +23,14 @@ All the useful commands can be called with following key
sequences:
| Key | Command |
|-----------+-----------------------------|
-| ~C-x x s~ | ~workroom-switch~ |
-| ~C-x x d~ | ~workroom-kill-view~ |
-| ~C-x x D~ | ~workroom-kill~ |
-| ~C-x x r~ | ~workroom-rename-view~ |
-| ~C-x x R~ | ~workroom-rename~ |
-| ~C-x x c~ | ~workroom-clone-view~ |
-| ~C-x x C~ | ~workroom-clone~ |
+| ~C-x x s~ | ~workroom-switch-room~ |
+| ~C-x x S~ | ~workroom-switch-view~ |
+| ~C-x x d~ | ~workroom-kill~ |
+| ~C-x x D~ | ~workroom-kill-view~ |
+| ~C-x x r~ | ~workroom-rename~ |
+| ~C-x x R~ | ~workroom-rename-view~ |
+| ~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~ |
diff --git a/workroom.el b/workroom.el
index 5f747d69f9..6d755d2ee0 100644
--- a/workroom.el
+++ b/workroom.el
@@ -48,13 +48,14 @@
;; Key Command
;; --------------------------------------
-;; C-x x s `workroom-switch'
-;; C-x x d `workroom-kill-view'
-;; C-x x D `workroom-kill'
-;; C-x x r `workroom-rename-view'
-;; C-x x R `workroom-rename'
-;; C-x x c `workroom-clone-view'
-;; C-x x C `workroom-clone'
+;; C-x x s `workroom-switch-room'
+;; C-x x S `workroom-switch-view'
+;; C-x x d `workroom-kill'
+;; C-x x D `workroom-kill-view'
+;; C-x x r `workroom-rename'
+;; C-x x R `workroom-rename-view'
+;; 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'
@@ -150,29 +151,36 @@ value can't restored."
The value is a mode line terminal like `mode-line-format'."
:type 'sexp)
-(defvar workroom-switch-hook nil
- "Normal hook run after switching room or view.")
+(defcustom workroom-switch-hook nil
+ "Normal hook run after switching room or view."
+ :type 'hook)
-(defvar workroom-kill-room-hook nil
- "Normal hook run after killing a room.")
+(defcustom workroom-kill-room-hook nil
+ "Normal hook run after killing a room."
+ :type 'hook)
-(defvar workroom-kill-view-hook nil
- "Normal hook run after killing a view.")
+(defcustom workroom-kill-view-hook nil
+ "Normal hook run after killing a view."
+ :type 'hook)
-(defvar workroom-rename-room-hook nil
- "Normal hook run after renaming a room.")
+(defcustom workroom-rename-room-hook nil
+ "Normal hook run after renaming a room."
+ :type 'hook)
-(defvar workroom-rename-view-hook nil
- "Normal hook run after renaming a view.")
+(defcustom workroom-rename-view-hook nil
+ "Normal hook run after renaming a view."
+ :type 'hook)
-(defvar workroom-buffer-list-change-hook nil
- "Normal hook run after changing the buffer list of a workroom.")
+(defcustom workroom-buffer-list-change-hook nil
+ "Normal hook run after changing the buffer list of a workroom."
+ :type 'hook)
(cl-defstruct workroom
"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.")
(default-p
nil
:documentation "Whether the workroom is the default one.")
@@ -192,9 +200,6 @@ The value is a mode line terminal like `mode-line-format'."
(defalias 'workroomp #'workroom-p)
-(defvar workroom--default-view-of-default-room "main"
- "Name of default view of default workroom.")
-
(defvar workroom--rooms nil
"List of currently live workrooms.")
@@ -212,13 +217,14 @@ The value is a mode line terminal like
`mode-line-format'."
(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 "d" #'workroom-kill-view)
- (define-key keymap "D" #'workroom-kill)
- (define-key keymap "r" #'workroom-rename-view)
- (define-key keymap "R" #'workroom-rename)
- (define-key keymap "c" #'workroom-clone-view)
- (define-key keymap "C" #'workroom-clone)
+ (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)
@@ -618,43 +624,53 @@ PROMPT, DEF, REQUIRE-MATCH and PREDICATE is same as in
`read-buffer'."
(unless (functionp (workroom-buffers room))
(workroom-remove-buffer (current-buffer) room))))
+(defun workroom--barf-unless-enabled ()
+ "Signal `user-error' unless Workroom-Mode is enabled."
+ (unless workroom-mode
+ (user-error "Workroom mode is not enabled")))
+
(defmacro workroom--require-mode-enable (&rest body)
"Execute BODY if Workroom-Mode is enabled, otherwise signal error."
(declare (indent 0))
- `(if (not workroom-mode)
- (user-error "Workroom mode is not enabled")
+ `(progn
+ (workroom--barf-unless-enabled)
,@body))
;;;###autoload
(defun workroom-bookmark-jump (bookmark)
"Handle BOOKMARK."
- (workroom--require-mode-enable
- (let ((data (alist-get 'data (bookmark-get-bookmark-record
- bookmark))))
- (workroom--restore-rooms data))))
+ (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-of-default-room)
- (set-frame-parameter nil 'workroom-previous-room-list
- (cdr
- (frame-parameter
- nil 'workroom-previous-room-list))))))
+ (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)
- "Switch to view VIEW of workroom ROOM.
+(defun workroom-switch (room view &optional no-record)
+ "Switch to view VIEW in workroom ROOM.
If called interactively, prompt for view to switch. If prefix
argument is given, ask for workroom to switch before.
-ROOM may be a `workroom' object or string. If ROOM is a `workroom'
-object, switch to that workroom. If ROOM is a string, create a
-workroom with that name if it doesn't exist, then switch to the
-workroom."
+ROOM is should be workroom object, or a name of a workroom object.
+VIEW is should be a view object, or a name of a view object. VIEW
+should be in the workroom ROOM.
+
+ROOM defaults to the current workroom, and VIEW defaults to the last
+selected view of ROOM.
+
+When the optional argument NO-RECORD is non-nil, don't record the
+switch."
(interactive
(workroom--require-mode-enable
(let ((room
@@ -664,17 +680,17 @@ workroom."
(cond
((and (eq (car (workroom-previous-room-list))
(workroom-current-room))
- (< 1 (length (workroom-previous-room-list))))
+ (> (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))))
- (when (and (stringp room) (string-empty-p room))
- (setq room workroom-default-room-name))
(when (stringp room)
- (setq room (workroom-get-create room)))
+ (setq room (if (string-empty-p room)
+ (workroom-get-default)
+ (workroom-get-create room))))
(let ((view
(workroom--read-view-to-switch
room "Switch to view"
@@ -682,89 +698,134 @@ workroom."
((and
(eq (car (workroom-previous-view-list room))
(workroom-current-view))
- (< 1 (length (workroom-previous-view-list room))))
- (workroom-name
+ (> (length (workroom-previous-view-list room)) 1))
+ (workroom-view-name
(cadr (workroom-previous-view-list room))))
((car (workroom-previous-view-list room))
- (workroom-name
+ (workroom-view-name
(car (workroom-previous-view-list room))))))))
(when (and (stringp view) (string-empty-p view))
(setq view workroom-default-view-name))
(list room view)))))
- (when (stringp room)
- (setq room (workroom-get-create room)))
- (when (stringp view)
- (setq view (workroom-view-get-create 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))))
(unless (eq room (workroom-current-room))
- (when (workroom-current-room)
- (set-frame-parameter
- nil 'workroom-previous-room-list
- (cons (workroom-current-room)
- (frame-parameter nil 'workroom-previous-room-list))))
+ (when (and (not no-record) (workroom-current-room))
+ (push (workroom-current-room)
+ (frame-parameter nil 'workroom-previous-room-list)))
(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)))
+ (workroom--save-window-config))
+ (unless no-record
+ (push (workroom-current-view)
+ (workroom-previous-view-list room))))
+ (setf (workroom-selected-view room) view)
(set-frame-parameter nil 'workroom-current-view view)
(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)
+ "Switch to workroom ROOM.
+
+ROOM is should be workroom object, or a name of a workroom object."
+ (interactive
+ (workroom--require-mode-enable
+ `(,(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-switch room nil))
+
(defun workroom-kill (room)
- "Kill workroom ROOM."
+ "Kill workroom ROOM.
+
+ROOM is should be workroom object, or a name of a workroom object."
(interactive
(workroom--require-mode-enable
(list
- (workroom--read
- "Kill workroom" (workroom-name (workroom-current-room))
- t (lambda (cand)
- (not
- (workroom-default-p
- (workroom-get (if (consp cand) (car cand) cand)))))))))
- (when (stringp room)
- (setq room (workroom-get room)))
- (when room
- (when (workroom-default-p room)
- (error "Cannot kill default workroom"))
- (when (eq room (workroom-current-room))
- (workroom-switch (workroom-get-default)
- workroom--default-view-of-default-room))
- (setq workroom--rooms (delete room workroom--rooms))
- (run-hooks 'workroom-kill-room-hook)))
+ (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--barf-unless-enabled)
+ (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)))
+ (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))))
+ (run-hooks 'workroom-kill-room-hook))
(defun workroom-kill-view (room view)
- "Kill view VIEW of workroom ROOM."
+ "Kill view VIEW of workroom ROOM.
+
+VIEW is should be a view object, or a name of a view object. VIEW
+should be in the workroom ROOM."
(interactive
(workroom--require-mode-enable
- (let ((room
- (if current-prefix-arg
- (workroom-get
- (workroom--read
- "Kill view of workroom"
- (workroom-name (workroom-current-room)) t))
- (workroom-current-room))))
- (when (eq (length (workroom-views room)) 1)
- (user-error "Cannot kill the last view of a workroom"))
+ (let ((room (if current-prefix-arg
+ (workroom-get
+ (workroom--read
+ "Kill view of workroom"
+ (workroom-name (workroom-current-room)) t))
+ (workroom-current-room))))
(list room
- (workroom--read-view
- room "Kill view"
- (when (eq room (workroom-current-room))
- (workroom-view-name (workroom-current-view))))))))
+ (workroom-view-get-create
+ 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)))
(when (and room view)
- (when (eq (length (workroom-views room)) 1)
- (error "Cannot kill the last view of a workroom"))
(when (eq view (workroom-current-view))
- (workroom-switch room (car (workroom-views room)))
+ (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
+ room workroom-default-view-name))))
(pop (workroom-previous-view-list room)))
(setf (workroom-views room) (delete view (workroom-views room)))
(run-hooks 'workroom-kill-view-hook)))
(defun workroom-rename (room new-name)
- "Rename workroom ROOM to NEW-NAME."
+ "Rename workroom ROOM to NEW-NAME.
+
+ROOM is should be workroom object, or a name of a workroom object."
(interactive
(workroom--require-mode-enable
(let ((room
@@ -777,6 +838,7 @@ workroom."
cand))))))))
(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)
@@ -804,6 +866,7 @@ workroom."
(read-string (format-message
"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)
@@ -824,6 +887,7 @@ workroom."
(car cand)
cand)))))))))
(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
@@ -852,6 +916,7 @@ workroom."
(workroom-view-name (workroom-current-view)))
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)
@@ -902,11 +967,11 @@ previous bookmark with the same name."
(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))))
+ `((data . (workroom-set
+ ,@(mapcar #'workroom--encode
+ (remove
+ (workroom-get-default)
+ workroom--rooms))))
(handler . workroom-bookmark-jump))
no-overwrite))
@@ -989,10 +1054,11 @@ workroom while selecting buffer by setting `read-buffer'
function to
`(defun ,(intern (format "workroom-%S" fn)) ()
,(format "Like `%S' but restricted to current workroom.
-When prefix arg is given, don't restrict." fn)
+When prefix arg is given or Workroom-Mode is disabled, don't
+restrict." fn)
(declare (interactive-only ,(format "Use `%S' instead." fn)))
(interactive)
- (if current-prefix-arg
+ (if (or current-prefix-arg (not workroom-mode))
(call-interactively #',fn)
(let ((read-buffer-function #'workroom-read-buffer-function))
(call-interactively #',fn)))))
@@ -1059,8 +1125,7 @@ When prefix arg is given, don't restrict." fn)
\"Restore workrooms.\"
(remove-hook 'desktop-after-read-hook
#'workroom--desktop-restore-%s)
- (when (require 'workroom nil t)
- (workroom-mode +1)
+ (when (bound-and-true-p workroom-mode)
(workroom--restore-rooms '%S)))
(add-hook 'desktop-after-read-hook #'workroom--desktop-restore-%s)
"
