perspective-exwm: add Published-At

Fix byte-compile warnings

.github/workflows/melpazoid.yml

@@ -0,0 +1,30 @@
+# melpazoid <https://github.com/riscy/melpazoid> build checks.
+
+# If your package is on GitHub, enable melpazoid's checks by copying this file
+# to .github/workflows/melpazoid.yml and modifying RECIPE and EXIST_OK below.
+
+name: melpazoid
+on: [push, pull_request]
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v2
+    - name: Set up Python 3.9
+      uses: actions/setup-python@v1
+      with: { python-version: 3.9 }
+    - name: Install
+      run: |
+        python -m pip install --upgrade pip
+        sudo apt-get install emacs && emacs --version
+        git clone https://github.com/riscy/melpazoid.git ~/melpazoid
+        pip install ~/melpazoid
+    - name: Run
+      env:
+        LOCAL_REPO: ${{ github.workspace }}
+        # RECIPE is your recipe as written for MELPA:
+        RECIPE: (perspective-exwm :repo "SqrtMinusOne/perspective-exwm" :fetcher github)
+        # set this to false (or remove it) if the package isn't on MELPA:
+        EXIST_OK: false
+      run: echo $GITHUB_REF && make -C ~/melpazoid

README.org

@@ -1,12 +1,14 @@
 #+TITLE: perspective-exwm
 
+[[https://melpa.org/#/perspective-exwm][file:https://melpa.org/packages/perspective-exwm-badge.svg]]
+
 A couple of tricks and fixes to make using [[https://github.com/ch11ng/exwm][EXWM]] and [[https://github.com/nex3/perspective-el][perspective.el]] a better experience.
 
 * Installation
-While this package isn't available anywhere but here, you can install it directly from the repo, e.g.:
+This package is available on MELPA. Install it however you usually install packages, I use [[https://github.com/jwiegley/use-package][use-package]] and [[https://github.com/raxod502/straight.el][straight.el]]:
 #+begin_src emacs-lisp
 (use-package perspective-exwm
-  :straight (:host github :repo "SqrtMinusOne/perspective-ewxm.el"))
+  :straight t)
 #+end_src
 Or clone the repository, add the package to the =load-path= and load it with =require=.
 
@@ -22,10 +24,10 @@ The package provides a minor mode, =perspective-exwm-mode=, which is meant to be
 * Usage and details
 - =perspective-exwm-mode=\\
   The mode does a couple of things:
-  - advises away a bug with half-killing the current perspective when closing a floating window. I haven't tested this as thoroughly, so run =M-x perspective-exwm-revive-perspectives= if the problem arises anyway.
+  - advises away a bug with half-killing the current perspective when closing a floating window. +I haven't tested this as thoroughly+ I haven't run into this issue for nearly a month, so it seems to be fixed. But there's =M-x perspective-exwm-revive-perspectives= if the problem arises anyway.
   - fixes a bug with running =persp-set-buffer= on an EXWM buffer that was moved between workspaces by advising =persp-buffer-in-other-p=.
-  - fixes a bug when occasionally =persp-set-buffer= copied all the perspective from another workspaces to the current one.
-  - adjusts the name of the inital perspective in the new workspace. It tries to get the name from the =perspective-exwm-override-initial-name= variable and fallbacks to =main-<index>=.
+  - fixes a bug with =persp-set-buffer= copying all the perspectives from other workspaces to the current one.
+  - adjusts the name of the initial perspective in the new workspace. It tries to get the name from the =perspective-exwm-override-initial-name= variable and fallbacks to =main-<index>=.
 
   For the last point, I have the following in my configuration:
   #+begin_src emacs-lisp
@@ -37,9 +39,9 @@ The package provides a minor mode, =perspective-exwm-mode=, which is meant to be
         (4 . "dev")))
   #+end_src
 
-  This also serves a purpose, because otherwise there are issues with multiple perspectives sharing the same scratch buffer.
+  Having distinct perspective names between frames also serves a purpose, because otherwise there are issues with multiple perspectives sharing the same scratch buffer.
 - =M-x perspective-exwm-cycle-exwm-buffers-forward=, =perspective-exwm-cycle-exwm-buffers-backward=\\
-  Cycles EXWM buffers in the current perspective.
+  Cycle EXWM buffers in the current perspective.
 
   [[./img/cycle-buffers.png]]
 
@@ -47,6 +49,9 @@ The package provides a minor mode, =perspective-exwm-mode=, which is meant to be
 
   Set =perspective-exwm-get-exwm-buffer-name= to customize the displayed name, by default it's =exwm-class-name=.
 
+- =M-x perspective-exwm-cycle-all-buffers-forward=, =perspective-exwm-cycle-exwm-all-backward=\\
+  The same as above, but not restricted to EXWM buffers.
+
 - =M-x perspective-exwm-switch-perspective=\\
   Select a perspective from the list of all perspectives on all workspaces.
 
@@ -75,3 +80,6 @@ The package provides a minor mode, =perspective-exwm-mode=, which is meant to be
 
   (add-hook 'exwm-manage-finish-hook #'my/exwm-configure-window)
   #+end_src
+
+* Known issues
+- =perspective-exwm-move-to-workspace= kills X windows in the perspective it tries to move. Have no idea how to fix this at the moment.

perspective-exwm.el

@@ -1,13 +1,14 @@
 ;;; perspective-exwm.el --- Better integration for perspective.el and EXWM -*- lexical-binding: t -*-
 
-;; Copyright (C) 2021 Korytov Pavel
+;; Copyright (C) 2021-2023 Korytov Pavel
 ;; Copyright (C) 2008-2020 Natalie Weizenbaum <nex342@gmail.com>
 
 ;; Author: Korytov Pavel <thexcloud@gmail.com>
 ;; Maintainer: Korytov Pavel <thexcloud@gmail.com>
-;; Version: 0.1.3
+;; Version: 0.2.0
 ;; Package-Requires: ((emacs "27.1") (burly "0.2-pre") (exwm "0.26") (perspective "2.17"))
 ;; Homepage: https://github.com/SqrtMinusOne/perspective-exwm.el
+;; Published-At: 2021-12-01
 
 ;; This file is NOT part of GNU Emacs.
 
@@ -26,7 +27,25 @@
 
 ;;; Commentary:
 
-;; TODO
+;; A couple of tricks and fixes to make using EXWM and perspective.el
+;; a better experience.
+;;
+;; Most importantly, this package provides `perspective-exwm-mode',
+;; which fixes certain annoying issues between the two packages.  Take
+;; a look at its docstring for more info.
+;;
+;; Other useful functions are:
+;; - `perspective-exwm-cycle-exwm-buffers-backward' and
+;;   `perspective-exwm-cycle-exwm-buffers-backward'
+;; - `perspective-exwm-cycle-all-buffers-backward' and
+;;   `perspective-exwm-cycle-all-buffers-forward'
+;; - `perspective-exwm-switch-perspective'
+;; - `perspective-exwm-copy-to-workspace' and
+;;   `perspective-exwm-move-to-workspace'
+;;
+;; Finally, take a look at the package README at
+;; <https://github.com/SqrtMinusOne/perspective-exwm.el> for more
+;; information.
 
 ;;; Code:
 (require 'burly)
@@ -46,8 +65,8 @@
   "A function to return the current EXWM window title."
   exwm-title)
 
-(defcustom perspective-exwm-get-exwm-buffer-name #'perspective-exwm--get-class
-  "A function to get the EXWM buffer title.
+(defcustom perspective-exwm-get-buffer-name #'perspective-exwm--get-class
+  "Retrieve buffer name for the cycle commands.
 
 Meant to be ran in the context of the target buffer, e.g. with
 `with-current-buffer'.
@@ -59,19 +78,120 @@ The two default options are:
   :type 'function
   :options '(perspective-exwm--get-class perspective-exwm--get-title))
 
+(defcustom perspective-exwm-cycle-max-message-length
+  (- (frame-width) 10)
+  "Maximum length of the message displayed by the cycle commands."
+  :group 'perspective-exwm
+  :type 'integer)
+
 (defcustom perspective-exwm-override-initial-name nil
   "Set initial perspective name for a particular EXWM workspace."
   :group 'perspective-exwm
   :type '(alist :key-type (integer :tag "EXWM workspace index")
                 :value-type (string :tag "Initial perspective name")))
 
-(defun perspective-exwm--cycle-exwm-buffers (dir)
-  "Cycle EXWM buffers in the current perspective.
+(defface perspective-exwm-cycle-current-face
+  '((t (:inherit warning)))
+  "Face for the current buffer in the buffer cycling message."
+  :group 'perspective-exwm)
+
+(defface perspective-exwm-cycle-skip-face
+  '((t (:inherit persp-selected-face)))
+  "Face for the buffer to skip in the buffer cycling message."
+  :group 'perspective-exwm)
+
+(defface perspective-exwm-current-workspace-face
+  '((t (:inherit warning)))
+  "Face for the current workspace number.
+
+Used in `perspective-exwm-switch-perspective'."
+  :group 'perspective-exwm)
+
+(defface perspective-exwm-selected-pespective-face
+  '((t (:inherit persp-selected-face)))
+  "Face for the selected perspective.
+
+Used in `perspective-exwm-switch-perspective'."
+  :group 'perspective-exwm)
+
+(defun perspective-exwm--cycle-get-message (all-buffers cycle-buffers)
+  "Return the display message for the buffer cycling commands.
+
+ALL-BUFFERS is the list of all buffers in the current perspective.
+CYCLE-BUFFERS are the buffers to cycle through."
+  ;; Iterate over all buffers
+  (cl-loop with seen-current = nil
+           for buf in all-buffers
+           for name = (with-current-buffer buf
+                        (or (funcall perspective-exwm-get-buffer-name)
+                            (buffer-name)))
+           for is-current = (eq (current-buffer) buf)
+           for is-skip = (not (member buf cycle-buffers))
+           if is-current do (setq seen-current t)
+           if is-current
+           collect (concat "[" (propertize name 'face 'perspective-exwm-cycle-current-face) "] ") into current-list
+           else if is-skip
+           collect (concat "[" (propertize name 'face 'perspective-exwm-cycle-skip-face) "] ") into skip-list
+           else if seen-current
+           collect (format " %s " name) into after-list
+           else
+           collect (format " %s " name) into before-list
+           ;; 4 list:
+           ;; - current-list - current buffers
+           ;; - skip-list - buffers displayed in other windows
+           ;; - before-list - buffers before current
+           ;; - after-list - buffers after current
+           ;; We want to display them in the following order:
+           ;; skip-list before-list current-list after-list
+           ;; And trim before-list and after-list to fit the message
+           ;; length; that means trimming the end of before-list and
+           ;; the beginning of after-list.
+           finally return
+           (let* ((skip-msg (mapconcat #'identity skip-list ""))
+                  (current-msg (mapconcat #'identity current-list ""))
+                  (len (+ (length skip-msg) (length current-msg) 8))
+                  (before-stack (reverse before-list))
+                  (after-stack after-list))
+             ;; Length of nil is 0 :'(
+             (cl-loop for before-elem-len = (if before-stack (length (car before-stack)) 10000)
+                      for after-elem-len = (if after-stack (length (car after-stack)) 10000)
+                      while (and (or before-stack after-stack)
+                                 (< (+ len (min before-elem-len after-elem-len)) perspective-exwm-cycle-max-message-length))
+                      for before = (when (and before-stack
+                                              (< (+ len before-elem-len) perspective-exwm-cycle-max-message-length))
+                                     (pop before-stack))
+                      if before collect before into before-msg-list
+                      if before do (setq len (+ len before-elem-len))
+                      for after = (when (and after-stack
+                                             (< (+ len after-elem-len) perspective-exwm-cycle-max-message-length))
+                                    (pop after-stack))
+                      if after concat after into after-msg
+                      if after do (setq len (+ len after-elem-len))
+                      finally return
+                      (concat
+                       skip-msg
+                       (when before-stack
+                         (format " (%s) "
+                                 (propertize (number-to-string (length before-stack))
+                                             'face 'perspective-exwm-cycle-skip-face)))
+                       (mapconcat #'identity (reverse before-msg-list) "")
+                       current-msg
+                       after-msg
+                       (when after-stack
+                         (format " (%s) "
+                                 (propertize (number-to-string (length after-stack))
+                                             'face 'perspective-exwm-cycle-skip-face))))))))
+
+(defun perspective-exwm--cycle-exwm-buffers (dir &optional all)
+  "Cycle buffers in the current perspective.
 
 DIR is either 'forward or 'backward.  A buffer is skipped if it is
 already displayed in some other window of the current
 perspective.  The buffer name comes from
-`perspective-exwm-get-exwm-buffer-name'.
+`perspective-exwm-get-buffer-name'.
+
+If ALL is nil, then cycle only EXWM buffers.  Otherwise, cycle
+all.
 
 The function prints out the state to the messages.  The current
 buffer after the switch is highlighted with `warning', skipped
@@ -82,7 +202,7 @@ buffer is highlighted with `persp-selected-face'"
           (cl-loop for buf in (persp-current-buffers)
                    for is-another = (and (get-buffer-window buf) (not (eq current buf)))
                    if (and (buffer-live-p buf)
-                           (eq 'exwm-mode (buffer-local-value 'major-mode buf))
+                           (or all (eq 'exwm-mode (buffer-local-value 'major-mode buf)))
                            (not (string-match-p ignore-rx (buffer-name buf))))
                    collect buf into all-buffers
                    and if (not is-another) collect buf into cycle-buffers
@@ -97,19 +217,8 @@ buffer is highlighted with `persp-selected-face'"
                           (length cycle-buffers)))
              (next-buffer (nth next-pos cycle-buffers)))
         (switch-to-buffer next-buffer)
-        (message
-         "%s"
-         (cl-loop for buf in all-buffers
-                  for name = (with-current-buffer buf (funcall perspective-exwm-get-exwm-buffer-name))
-                  for is-current = (eq (current-buffer) buf)
-                  for is-skip = (not (member buf cycle-buffers))
-                  if is-current
-                  concat (concat "[" (propertize name 'face 'warning) "] ") into res
-                  else if is-skip
-                  concat (concat "[" (propertize name 'face 'persp-selected-face) "] ") into res
-                  else
-                  concat (format " %s  " name) into res
-                  finally return res))))))
+        (let ((msg (perspective-exwm--cycle-get-message all-buffers cycle-buffers)))
+          (message msg))))))
 
 ;;;###autoload
 (defun perspective-exwm-cycle-exwm-buffers-forward ()
@@ -129,6 +238,18 @@ detail."
   (interactive)
   (perspective-exwm--cycle-exwm-buffers 'backward))
 
+;;;###autoload
+(defun perspective-exwm-cycle-all-buffers-forward ()
+  "Cycle all buffers in the current perspective forward."
+  (interactive)
+  (perspective-exwm--cycle-exwm-buffers 'forward t))
+
+;;;###autoload
+(defun perspective-exwm-cycle-all-buffers-backward ()
+  "Cycle all buffers in the current perspective backward."
+  (interactive)
+  (perspective-exwm--cycle-exwm-buffers 'backward t))
+
 ;;;###autoload
 (defun perspective-exwm-switch-perspective ()
   "Switch to a perspective on any workspace."
@@ -149,18 +270,20 @@ detail."
                                            (propertize
                                             (format "[%s]" workspace-name)
                                             'face
-                                            'warning)
+                                            'perspective-exwm-current-workspace-face)
                                          (format "[%s]" workspace-name))
                                        (if (string-equal persp-name current-persp-name)
                                            (propertize
                                             persp-name
                                             'face
-                                            'persp-selected-face)
+                                            'perspective-exwm-selected-pespective-face)
                                          persp-name))
                                (cons i persp-name))))))
          (choice (cdr (assoc (completing-read "Select a perspective: " choices) choices))))
-    (exwm-workspace-switch (car choice))
-    (persp-switch (cdr choice))))
+    (exwm--defer
+     0 (lambda ()
+         (exwm-workspace-switch (car choice))
+         (persp-switch (cdr choice))))))
 
 ;;;###autoload
 (defun perspective-exwm-copy-to-workspace (&optional move)
@@ -169,26 +292,24 @@ detail."
 If MOVE is t, move the perspective instead."
   (interactive)
   (when (and move (= 1 (hash-table-count (perspectives-hash))))
-    (error "Can't move the only workspace"))
+    (user-error "Can't move the only workspace"))
   (let* ((target-workspace (exwm-workspace--prompt-for-workspace))
-         (persp (persp-curr))
          (persp-name (persp-current-name))
-         (url (burly-windows-url)))
+         (url (burly-windows-url))
+         (buffers (persp-current-buffers)))
     (unless (= (cl-position target-workspace exwm-workspace--list)
                exwm-workspace-current-index)
+      (when (gethash persp-name (perspectives-hash target-workspace))
+        (user-error "Perspective with name \"%s\" already exists on the target workspace" persp-name))
       (with-selected-frame target-workspace
-        (when (gethash persp-name (perspectives-hash))
-          (error "Perspective with name \"%s\" already exists on the target workspace" persp-name))
-        (puthash persp-name (copy-tree (copy-perspective persp)) (perspectives-hash))
         (with-perspective persp-name
-          ;; (run-hooks 'persp-created-hook)
-          (persp-update-modestring)))
+          (mapc #'persp-add-buffer buffers)
+          (burly-open-url url))
+        (persp-switch persp-name)
+        (persp-update-modestring))
       (when move
         (persp-kill persp-name))
-      (exwm-workspace-switch target-workspace)
-      (persp-switch persp-name)
-      (burly-open-url url)
-      (persp-update-modestring))))
+      (exwm-workspace-switch target-workspace))))
 
 ;;;###autoload
 (defun perspective-exwm-move-to-workspace ()
@@ -207,6 +328,14 @@ frame."
   (unless (and (derived-mode-p 'exwm-mode) exwm--floating-frame)
     (apply fun args)))
 
+(defvar perspective-exwm--override-current-index nil
+  "The true index of the workspace under creation.
+
+Overrides the index in `perspective-exwm--init-frame-around'.")
+
+(defvar perspective-exwm--is-floating nil
+  "If true, the frame under creation is floating.")
+
 (defun perspective-exwm--init-frame-around (fun &rest args)
   "An advice around `persp-init-frame'.
 
@@ -221,20 +350,50 @@ length of that list if it's not yet there.  This approach seems
 to work best, e.g. when doing `exwm-workspace-switch-create' and
 creating multiple workspaces at once."
   (let* ((workspace-index
-          (or (cl-position (car args) exwm-workspace--list)
+          (or perspective-exwm--override-current-index
+              (cl-position (car args) exwm-workspace--list)
               (length exwm-workspace--list)))
          (persp-initial-frame-name
           (or
            (cdr (assoc workspace-index
                        perspective-exwm-override-initial-name))
-           (format "main-%s" (funcall exwm-workspace-index-map workspace-index)))))
+           (format "main-%s" (funcall exwm-workspace-index-map workspace-index))))
+         (persp-initial-frame-name
+          (if perspective-exwm--is-floating
+              (format "%s-floating" persp-initial-frame-name)
+            persp-initial-frame-name)))
+    (apply fun args)))
+
+(defun perspective-exwm--floating-set-floating-around (fun &rest args)
+  "An advice around `exwm-floating--set-floating'.
+
+FUN should be `exwm-floating--set-floating', ARGS are passed to
+FUN with `apply'.
+
+This function creates a floating window, so this advice indicates
+that with seting `perspective-exwm--is-floating'"
+  (let ((perspective-exwm--override-current-index exwm-workspace-current-index)
+        (perspective-exwm--is-floating t))
+    (apply fun args)))
+
+(defun perspective-exwm--workspace-add-around (fun &rest args)
+  "An advice around `exwm-workspace-add'.
+
+FUN should be `exwm-workspace-add', ARGS are passed to FUN with
+`apply'.
+
+This is necessary because `exwm-workspace-add' first calls
+`make-frame' and only then moves it to the right index,
+i.e. there is no way to determine the true index of workspace
+under creation `persp-init-frame'."
+  (let ((perspective-exwm--override-current-index (car args)))
     (apply fun args)))
 
 (defun perspective-exwm--after-exwm-init ()
   "Create perspectives in workspaces.
 
 `perspective-exwm-override-initial-name' determines initial names
-of perspectives..
+of perspectives.
 
 The function is meant to be run from `exwm-init-hook'."
   (cl-loop for workspace-index from 0 to (exwm-workspace--count)
@@ -329,8 +488,7 @@ e.g. like this:
     ((or \"Firefox\" \"Nightly\") (perspective-exwm-assign-window
                                :workspace-index 2
                                :persp-name \"browser\"))))"
-  (let ((buffer-name (buffer-name))
-        (buffer (current-buffer)))
+  (let ((buffer (current-buffer)))
     (when (and workspace-index (not (= workspace-index exwm-workspace-current-index)))
       (exwm-workspace-move-window workspace-index))
     (when persp-name
@@ -352,8 +510,8 @@ The mode does a couple of things:
    anyway.
  - fixes a bug with running `persp-set-buffer' on an EXWM buffer that
    was moved between workspaces by advising `persp-buffer-in-other-p'.
- - fixes a bug when occasionally `persp-set-buffer' copied all the
-   perspectives from another workspaces to the current one
+ - fixes a bug with `persp-set-buffer' copying all the
+   perspectives from other workspaces to the current one
  - adjusts the name of the inital perspective in the new workspace.
    It tries to get the name from the
    `perspective-exwm-override-initial-name' variable and falls back to
@@ -378,6 +536,10 @@ inital workspaces are created with the new perspective names."
                       :override #'perspective-exwm--persp-buffer-in-other-p)
           (advice-add #'persp-set-buffer
                       :override #'perspective-exwm--persp-set-buffer-override)
+          (advice-add #'exwm-workspace-add
+                      :around #'perspective-exwm--workspace-add-around)
+          (advice-add #'exwm-floating--set-floating
+                      :around #'perspective-exwm--floating-set-floating-around)
           (add-hook 'exwm-init-hook #'perspective-exwm--after-exwm-init))
       (advice-remove #'persp-delete-frame
                      #'perspective-exwm--delete-frame-around)
@@ -387,6 +549,10 @@ inital workspaces are created with the new perspective names."
                      #'perspective-exwm--persp-buffer-in-other-p)
       (advice-remove #'persp-set-buffer
                      #'perspective-exwm--persp-set-buffer-override)
+      (advice-remove #'exwm-workspace-add
+                     #'perspective-exwm--workspace-add-around)
+      (advice-remove #'exwm-floating--set-floating
+                     #'perspective-exwm--floating-set-floating-around)
       (remove-hook 'exwm-init-hook #'perspective-exwm--after-exwm-init))))
 
 (provide 'perspective-exwm)