Skip to content

Commit

Permalink
feat(core): add +define-dedicated-workspace!
Browse files Browse the repository at this point in the history
  • Loading branch information
abougouffa committed Jun 14, 2023
1 parent a5ce718 commit cae91b2
Show file tree
Hide file tree
Showing 2 changed files with 54 additions and 0 deletions.
8 changes: 8 additions & 0 deletions core/me-loaddefs.el
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,14 @@ prefix or universal argument, it waits for a moment (defined by
Return the region or the thing at point.")
(autoload '+webjump "../elisp/+emacs" "\
Like `webjump', with initial query filled from `+region-org-thing-at-point'." t)
(autoload '+define-dedicated-workspace! "../elisp/+emacs" "\
Define +NAME command to run BODY in a dedicated workspace.
If not specified, BODY defaults to `(NAME)'.
You can pass an exit hook or exit function on which, the created workspace will
be deleted.
(fn NAME [[:exit-hook HOOK] [:exit-func FUNC]] FORMS...)" nil t)
(register-definition-prefixes "../elisp/+emacs" '("+dir-locals--autoreload-" "+screenshot-" "+webjump-read-string-"))


Expand Down
46 changes: 46 additions & 0 deletions elisp/+emacs.el
Original file line number Diff line number Diff line change
Expand Up @@ -137,4 +137,50 @@ prefix or universal argument, it waits for a moment (defined by
(cl-letf (((symbol-function 'webjump-read-string) #'+webjump-read-string-with-initial-query))
(webjump))))

;;;###autoload
(defmacro +define-dedicated-workspace! (name &rest body)
"Define +NAME command to run BODY in a dedicated workspace.
If not specified, BODY defaults to `(NAME)'.
You can pass an exit hook or exit function on which, the created workspace will
be deleted.
\(fn NAME [[:exit-hook HOOK] [:exit-func FUNC]] FORMS...)"
(let* ((name (+unquote name))
(fn-name (intern (format "+%s" name)))
(fn-doc (format "Launch %s in a dedicated workspace." name))
(tab-name (intern (format "+%s-tab-name" name)))
(exit-fn-name (intern (format "+%s--close-workspace" name)))
exit-func exit-hook sexp fn-body)
(while (keywordp (car body))
(pcase (pop body)
(:exit-func (setq exit-func (+unquote (pop body))))
(:exit-hook (setq exit-hook (+unquote (pop body))))))
(setq sexp (if (null body) `((,name)) body))
(when (or exit-func exit-hook)
(setq
fn-body
`((defun ,exit-fn-name ()
(if (fboundp 'tabspaces-mode)
;; When `tabspaces' is available, use it.
(when-let ((tab-num (seq-position (tabspaces--list-tabspaces) ,tab-name #'string=)))
(tabspaces-close-workspace (1+ tab-num)))
;; Or default to the built-in `tab-bar'.
(when-let ((tab-num (seq-position (tab-bar-tabs) ,tab-name (lambda (tab name) (string= name (alist-get 'name tab))))))
(tab-close (1+ tab-num)))))))
(when exit-func (add-to-list 'fn-body `(advice-add ',exit-func :after #',exit-fn-name) t))
(when exit-hook (add-to-list 'fn-body `(add-hook ',exit-hook #',exit-fn-name) t)))
`(progn
(defvar ,tab-name ,(format "*%s*" name))
(defun ,fn-name ()
,fn-doc
(interactive)
(when ,tab-name
(if (fboundp 'tabspaces-mode)
(tabspaces-switch-or-create-workspace ,tab-name)
(tab-new)
(tab-rename +mu4e-tab-name)))
,@sexp)
,(macroexp-progn fn-body))))

;;; +emacs.el ends here

0 comments on commit cae91b2

Please sign in to comment.