fine-tune mode lighter

Co-authored-by: msin32 <103911574+msin32@users.noreply.github.com>

.github/workflows/melpazoid.yml

@@ -7,10 +7,11 @@ jobs:
   build:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
       - name: Set up Python 3.10
-        uses: actions/setup-python@v1
+        uses: actions/setup-python@v4
-        with: { python-version: 3.10.12 }
+        with:
+          python-version: '3.10'
       - name: Install
         run: |
           python -m pip install --upgrade pip

emacs-everywhere.el

@@ -53,21 +53,24 @@
 
 (defvar emacs-everywhere--display-server
   (cond
-   ((eq system-type 'darwin) 'quartz)
+   ((eq system-type 'darwin) '(quartz . nil))
-   ((memq system-type '(ms-dos windows-nt cygwin)) 'windows)
+   ((memq system-type '(ms-dos windows-nt cygwin)) '(windows . nil))
    ((eq system-type 'gnu/linux)
-    (if (getenv "WAYLAND_DISPLAY") 'wayland 'x11))
+    (cons
-   (t 'unknown))
+     (if (getenv "WAYLAND_DISPLAY") 'wayland 'x11)
+     (intern (or (getenv "XDG_CURRENT_DESKTOP") "unknown"))))
+   (t '(unknown . nil)))
   "The detected display server.")
 
 (defcustom emacs-everywhere-paste-command
-  (pcase emacs-everywhere--display-server
+  (pcase (car emacs-everywhere--display-server)
     ('quartz (list "osascript" "-e" "tell application \"System Events\" to keystroke \"v\" using command down"))
-    ('x11 (list "xdotool" "key" "--clearmodifiers" "Shift+Insert"))
     ('windows
      (list "powershell" "-NoProfile" "-Command"
            "& {(New-Object -ComObject wscript.shell).SendKeys(\"^v\")}"))
-    ((or 'wayland 'unknown)
+    ('x11 (list "xdotool" "key" "--clearmodifiers" "Shift+Insert"))
+    ('wayland (list "ydotool" "key" "42:1" "110:1" "42:0" "110:0"))
+    ('unknown
      (list "notify-send"
            "No paste command defined for emacs-everywhere"
            "-a" "Emacs" "-i" "emacs")))
@@ -79,9 +82,9 @@ To not run any command, set to nil."
   :group 'emacs-everywhere)
 
 (defcustom emacs-everywhere-copy-command
-  (pcase emacs-everywhere--display-server
+  (pcase (car emacs-everywhere--display-server)
     ('x11 (list "xclip" "-selection" "clipboard" "%f"))
-    ((and 'wayland (guard (executable-find "wl-copy")))
+    ('wayland
      (list "sh" "-c" "wl-copy < %f"))
     ('windows
      (list "Powershell" "-NoProfile" "-Command" "& { Get-Content %f | clip }")))
@@ -100,10 +103,11 @@ it worked can be a good idea."
 
 (defcustom emacs-everywhere-window-focus-command
   (pcase emacs-everywhere--display-server
-    ('quartz (list "osascript" "-e" "tell application \"%w\" to activate"))
+    (`(quartz . ,_) (list "osascript" "-e" "tell application \"%w\" to activate"))
-    ('x11 (list "xdotool" "windowactivate" "--sync" "%w"))
+    (`(windows . ,_) (list "powershell" "-NoProfile" "-command"
-    ('windows (list "powershell" "-NoProfile" "-command"
+                           "& {Add-Type 'using System; using System.Runtime.InteropServices; public class Tricks { [DllImport(\"user32.dll\")] public static extern bool SetForegroundWindow(IntPtr hWnd); }'; [tricks]::SetForegroundWindow(%w) }"))
-                    "& {Add-Type 'using System; using System.Runtime.InteropServices; public class Tricks { [DllImport(\"user32.dll\")] public static extern bool SetForegroundWindow(IntPtr hWnd); }'; [tricks]::SetForegroundWindow(%w) }")))
+    (`(x11 . ,_) (list "xdotool" "windowactivate" "--sync" "%w"))
+    (`(wayland . KDE) (list "kdotool" "windowactivate" "%w"))) ; No --sync
   "Command to refocus the active window when emacs-everywhere was triggered.
 This is given as a list in the form (CMD ARGS...).
 In the arguments, \"%w\" is treated as a placeholder for the window ID,
@@ -324,7 +328,7 @@ buffers.")
 (define-minor-mode emacs-everywhere-mode
   "Tweak the current buffer to add some emacs-everywhere considerations."
   :init-value nil
-  :lighter "EE"
+  :lighter " EE"
   :keymap `((,(kbd "C-c C-c") . emacs-everywhere--finish-or-ctrl-c-ctrl-c)
             (,(kbd "C-x 5 0") . emacs-everywhere-finish)
             (,(kbd "C-c C-k") . emacs-everywhere-abort))
@@ -451,6 +455,27 @@ Please go to 'System Preferences > Security & Privacy > Privacy > Accessibility'
 
 (defun emacs-everywhere--app-info-linux ()
   "Return information on the active window, on linux."
+  (pcase-let ((`(,window-id ,app-name ,window-title ,window-geometry))
+              (pcase emacs-everywhere--display-server
+                (`(x11 . ,_) (emacs-everywhere--app-info-linux-x11))
+                (`(wayland . KDE) (emacs-everywhere--app-info-linux-kde))
+                (_ (user-error "Unable to fetch app info with display server %S" emacs-everywhere--display-server))))
+    (make-emacs-everywhere-app
+     :id (string-to-number window-id)
+     :class app-name
+     :title window-title
+     :geometry (list
+                (if (= (nth 0 window-geometry) (nth 2 window-geometry))
+                    (nth 0 window-geometry)
+                  (- (nth 0 window-geometry) (nth 2 window-geometry)))
+                (if (= (nth 1 window-geometry) (nth 3 window-geometry))
+                    (nth 1 window-geometry)
+                  (- (nth 1 window-geometry) (nth 3 window-geometry)))
+                (nth 4 window-geometry)
+                (nth 5 window-geometry)))))
+
+(defun emacs-everywhere--app-info-linux-x11 ()
+  "Return information on the current active window, on a Linux X11 sessions."
   (let ((window-id (emacs-everywhere--call "xdotool" "getactivewindow")))
     (let ((app-name
            (car (split-string-and-unquote
@@ -474,19 +499,28 @@ Please go to 'System Preferences > Security & Privacy > Privacy > Accessibility'
                            (cadr (assoc "Relative upper-left Y" info))
                            (cadr (assoc "Width" info))
                            (cadr (assoc "Height" info)))))))
-      (make-emacs-everywhere-app
+      (list window-id app-name window-title window-geometry))))
-       :id (string-to-number window-id)
+
-       :class app-name
+(defun emacs-everywhere--app-info-linux-kde ()
-       :title window-title
+  "Return information on the current active window, on a Linux KDE sessions."
-       :geometry (list
+  (let ((window-id (emacs-everywhere--call "kdotool" "getactivewindow")))
-                  (if (= (nth 0 window-geometry) (nth 2 window-geometry))
+    (let ((app-name
-                      (nth 0 window-geometry)
+           (car (last (split-string (emacs-everywhere--call "kdotool" "getwindowclassname" window-id) "\\."))))
-                    (- (nth 0 window-geometry) (nth 2 window-geometry)))
+          (window-title
-                  (if (= (nth 1 window-geometry) (nth 3 window-geometry))
+           (emacs-everywhere--call "kdotool" "getwindowname" window-id))
-                      (nth 1 window-geometry)
+          (window-geometry
-                    (- (nth 1 window-geometry) (nth 3 window-geometry)))
+           (let ((geom (mapcar
-                  (nth 4 window-geometry)
+                        (lambda (line) (split-string line "[:,x] ?"))
-                  (nth 5 window-geometry))))))
+                        (split-string (string-trim-left
+                                       (emacs-everywhere--call "kdotool" "getwindowgeometry" window-id) "[^P]+")
+                                      "\n" nil " +"))))
+             (mapcar #'string-to-number
+                     (list (cadr (assoc "Position" geom))
+                           (caddr (assoc "Position" geom))
+                           "0" "0"
+                           (cadr (assoc "Geometry" geom))
+                           (caddr (assoc "Geometry" geom)))))))
+      (list window-id app-name window-title window-geometry))))
 
 (defvar emacs-everywhere--dir (file-name-directory load-file-name))
 
@@ -688,6 +722,33 @@ Should end in a newline to avoid interfering with the buffer content."
       (require 'ox-md)
       (org-export-to-buffer (if (featurep 'ox-gfm) 'gfm 'md) (current-buffer)))))
 
+(defun emacs-everywhere--required-executables ()
+  "Return a list of cons cells, each giving a required executable and its purpose."
+  (let* ((var-cmds
+          (list (cons "paste" emacs-everywhere-paste-command)
+                (cons "copy" emacs-everywhere-copy-command)
+                (cons "focus window" emacs-everywhere-window-focus-command)
+                (list "pandoc conversion" "pandoc")))
+         (de-cmds
+          (pcase emacs-everywhere--display-server
+            (`(x11 . ,_)
+             (list (list "app info" "xdotool")
+                   (list "app info" "xprop")
+                   (list "app info" "xwininfo")))
+            (`(wayland . KDE)
+             (list (list "app info" "kdotool")))))
+         (feat-cmds
+          (append var-cmds de-cmds))
+         executable-list)
+      (dolist (feat-cmd (delq nil feat-cmds))
+        (when (cdr feat-cmd)
+          (when (and (equal (cadr feat-cmd) "sh")
+                     (equal (caddr feat-cmd) "-c"))
+            (setcdr feat-cmd (split-string (cadddr feat-cmd))))
+          (push (cons (cadr feat-cmd) (car feat-cmd))
+                executable-list)))
+      executable-list))
+
 (defun emacs-everywhere-check-health ()
   "Check whether emacs-everywhere has everything it needs."
   (interactive)
@@ -696,34 +757,24 @@ Should end in a newline to avoid interfering with the buffer content."
   (read-only-mode 1)
   (with-silent-modifications
     (erase-buffer)
-    (let ((feat-cmds
+    (let ((required-cmds
-           (list (cons "paste" emacs-everywhere-paste-command)
+           (emacs-everywhere--required-executables)))
-                 (cons "copy" emacs-everywhere-copy-command)
-                 (cons "focus window" emacs-everywhere-window-focus-command)
-                 (list "pandoc conversion" "pandoc")
-                 (and (memq emacs-everywhere--display-server '(x11 wayland))
-                      (list "app info" "xdotool"))
-                 (and (memq emacs-everywhere--display-server '(x11 wayland))
-                      (list "app info" "xprop"))
-                 (and (memq emacs-everywhere--display-server '(x11 wayland))
-                      (list "app info" "xwininfo")))))
       (insert (propertize "Emacs Everywhere system health check\n" 'face 'outline-1)
               "operating system: " (propertize (symbol-name system-type) 'face 'font-lock-type-face)
-              ", display server: " (propertize (symbol-name emacs-everywhere--display-server) 'face 'font-lock-type-face)
+              ", display server: " (propertize (symbol-name (car emacs-everywhere--display-server)) 'face 'font-lock-type-face)
+              (and (cdr emacs-everywhere--display-server)
+                   (concat "/" (propertize (symbol-name (cdr emacs-everywhere--display-server)) 'face 'font-lock-type-face)))
               "\n")
-      (dolist (feat-cmd (delq nil feat-cmds))
+      (dolist (req-cmd required-cmds)
-        (if (not (cdr feat-cmd))
+        (if (not (cdr req-cmd))
             (insert
-             (propertize (format "• %s (unavailible)\n" (car feat-cmd)) 'face 'font-lock-comment-face))
+             (propertize (format "• %s (unavailible)\n" (cdr req-cmd)) 'face 'font-lock-comment-face))
-          (when (and (equal (cadr feat-cmd) "sh")
-                     (equal (caddr feat-cmd) "-c"))
-            (setcdr feat-cmd (split-string (cadddr feat-cmd))))
           (insert
-           (propertize (format "• %s " (car feat-cmd))
+           (propertize (format "• %s " (cdr req-cmd))
                        'face `(:inherit outline-4 :height ,(face-attribute 'default :height)))
            "requires "
-           (propertize (cadr feat-cmd) 'face 'font-lock-constant-face)
+           (propertize (car req-cmd) 'face 'font-lock-constant-face)
-           (if (executable-find (cadr feat-cmd))
+           (if (executable-find (car req-cmd))
                (propertize " ✓ installed" 'face 'success)
              (propertize " ✗ missing" 'face 'error))
            "\n"))))))