mirror of
https://github.com/emacs-exwm/exwm.git
synced 2024-11-27 06:48:00 +01:00
Add system tray support
* exwm-systemtray.el: New module adds a simple system tray (using the X11 System Tray protocol). * exwm-workspace.el (exwm-workspace-switch-hook, exwm-workspace-switch): New hook run after switching workspace.
This commit is contained in:
parent
3f7722079c
commit
bfd43feb49
2 changed files with 377 additions and 4 deletions
372
exwm-systemtray.el
Normal file
372
exwm-systemtray.el
Normal file
|
@ -0,0 +1,372 @@
|
|||
;;; exwm-systemtray.el --- System Tray Module for -*- lexical-binding: t -*-
|
||||
;;; EXWM
|
||||
|
||||
;; Copyright (C) 2016 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Chris Feng <chris.w.feng@gmail.com>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This module adds system tray support for EXWM.
|
||||
|
||||
;; To use this module, load and enable it as follows:
|
||||
;; (require 'exwm-systemtray)
|
||||
;; (exwm-systemtray-enable)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'xcb-xembed)
|
||||
(require 'xcb-systemtray)
|
||||
(require 'exwm-core)
|
||||
(require 'exwm-workspace)
|
||||
|
||||
(defclass exwm-systemtray--icon ()
|
||||
((width :initarg :width)
|
||||
(height :initarg :height)
|
||||
(visible :initarg :visible))
|
||||
:documentation "Attributes of a system tray icon.")
|
||||
|
||||
;; GTK icons require at least 16 pixels to show normally.
|
||||
(defconst exwm-systemtray--icon-min-size 16 "Minimum icon size.")
|
||||
|
||||
(defvar exwm-systemtray-height (max exwm-systemtray--icon-min-size
|
||||
(line-pixel-height))
|
||||
"System tray height.
|
||||
|
||||
You shall use the default value if using auto-hide minibuffer.")
|
||||
|
||||
(defvar exwm-systemtray-icon-gap 2 "Gap between icons.")
|
||||
|
||||
(defvar exwm-systemtray--connection nil "The X connection.")
|
||||
(defvar exwm-systemtray--list nil "The icon list.")
|
||||
(defvar exwm-systemtray--selection-owner-window nil
|
||||
"The selection owner window.")
|
||||
(defvar exwm-systemtray--embedder nil "The embedder window.")
|
||||
|
||||
(defun exwm-systemtray--embed (icon)
|
||||
"Embed an icon."
|
||||
(exwm--log "(System Tray) Try to embed #x%x" icon)
|
||||
(let ((info (xcb:+request-unchecked+reply exwm-systemtray--connection
|
||||
(make-instance 'xcb:xembed:get-_XEMBED_INFO
|
||||
:window icon)))
|
||||
width* height* visible)
|
||||
(when info
|
||||
(exwm--log "(System Tray) Embed #x%x" icon)
|
||||
(with-slots (width height)
|
||||
(xcb:+request-unchecked+reply exwm-systemtray--connection
|
||||
(make-instance 'xcb:GetGeometry :drawable icon))
|
||||
(setq height* exwm-systemtray-height
|
||||
width* (round (* width (/ (float height*) height))))
|
||||
(when (< width* exwm-systemtray--icon-min-size)
|
||||
(setq width* exwm-systemtray--icon-min-size
|
||||
height* (round (* height (/ (float width*) width)))))
|
||||
(exwm--log "(System Tray) Resize from %dx%d to %dx%d"
|
||||
width height width* height*))
|
||||
;; Reparent to the embedder.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ReparentWindow
|
||||
:window icon
|
||||
:parent exwm-systemtray--embedder
|
||||
:x 0
|
||||
;; Vertically centered.
|
||||
:y (/ (- exwm-systemtray-height height*) 2)))
|
||||
;; Resize the icon.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ConfigureWindow
|
||||
:window icon
|
||||
:value-mask (logior xcb:ConfigWindow:Width
|
||||
xcb:ConfigWindow:Height
|
||||
xcb:ConfigWindow:BorderWidth)
|
||||
:width width*
|
||||
:height height*
|
||||
:border-width 0))
|
||||
;; Set event mask.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ChangeWindowAttributes
|
||||
:window icon
|
||||
:value-mask xcb:CW:EventMask
|
||||
:event-mask (logior xcb:EventMask:ResizeRedirect
|
||||
xcb:EventMask:PropertyChange)))
|
||||
(when (setq visible
|
||||
(/= 0 (logand (slot-value info 'flags) xcb:xembed:MAPPED)))
|
||||
(exwm--log "(System Tray) Map the window")
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:MapWindow :window icon)))
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:xembed:SendEvent
|
||||
:destination icon
|
||||
:event
|
||||
(xcb:marshal
|
||||
(make-instance 'xcb:xembed:EMBEDDED-NOTIFY
|
||||
:window icon
|
||||
:time xcb:Time:CurrentTime
|
||||
:embedder exwm-systemtray--embedder
|
||||
:version 0)
|
||||
exwm-systemtray--connection)))
|
||||
(push `(,icon . ,(make-instance 'exwm-systemtray--icon
|
||||
:width width*
|
||||
:height height*
|
||||
:visible visible))
|
||||
exwm-systemtray--list)
|
||||
(exwm-systemtray--refresh))))
|
||||
|
||||
(defun exwm-systemtray--unembed (icon)
|
||||
"Unembed an icon."
|
||||
(exwm--log "(System Tray) Unembed #x%x" icon)
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:UnmapWindow :window icon))
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ReparentWindow
|
||||
:window icon
|
||||
:parent exwm--root
|
||||
:x 0 :y 0))
|
||||
(setq exwm-systemtray--list
|
||||
(assq-delete-all icon exwm-systemtray--list))
|
||||
(exwm-systemtray--refresh))
|
||||
|
||||
(defun exwm-systemtray--refresh ()
|
||||
"Refresh the system tray."
|
||||
;; Make sure to redraw the embedder.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:UnmapWindow :window exwm-systemtray--embedder))
|
||||
(let ((x exwm-systemtray-icon-gap)
|
||||
map)
|
||||
(dolist (pair exwm-systemtray--list)
|
||||
(when (slot-value (cdr pair) 'visible)
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ConfigureWindow
|
||||
:window (car pair)
|
||||
:value-mask xcb:ConfigWindow:X
|
||||
:x x))
|
||||
(setq x (+ x (slot-value (cdr pair) 'width)
|
||||
exwm-systemtray-icon-gap))
|
||||
(setq map t)))
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ConfigureWindow
|
||||
:window exwm-systemtray--embedder
|
||||
:value-mask (logior xcb:ConfigWindow:X
|
||||
xcb:ConfigWindow:Width)
|
||||
:x (- (frame-pixel-width exwm-workspace--current) x)
|
||||
:width x))
|
||||
(when map
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:MapWindow :window exwm-systemtray--embedder))))
|
||||
(xcb:flush exwm-systemtray--connection))
|
||||
|
||||
(defun exwm-systemtray--on-DestroyNotify (data _synthetic)
|
||||
"Unembed icons on DestroyNotify."
|
||||
(let ((obj (make-instance 'xcb:DestroyNotify)))
|
||||
(xcb:unmarshal obj data)
|
||||
(with-slots (window) obj
|
||||
(when (alist-get window exwm-systemtray--list)
|
||||
(exwm-systemtray--unembed window)))))
|
||||
|
||||
(defun exwm-systemtray--on-ReparentNotify (data _synthetic)
|
||||
"Unembed icons on ReparentNotify."
|
||||
(let ((obj (make-instance 'xcb:ReparentNotify)))
|
||||
(xcb:unmarshal obj data)
|
||||
(with-slots (window parent) obj
|
||||
(when (and (/= parent exwm-systemtray--embedder)
|
||||
(alist-get window exwm-systemtray--list))
|
||||
(exwm-systemtray--unembed window)))))
|
||||
|
||||
(defun exwm-systemtray--on-ResizeRequest (data _synthetic)
|
||||
"Resize the tray icon on ResizeRequest."
|
||||
(let ((obj (make-instance 'xcb:ResizeRequest))
|
||||
attr)
|
||||
(xcb:unmarshal obj data)
|
||||
(with-slots (window width height) obj
|
||||
(when (setq attr (alist-get window exwm-systemtray--list))
|
||||
(with-slots ((width* width)
|
||||
(height* height))
|
||||
attr
|
||||
(setq height* exwm-systemtray-height
|
||||
width* (round (* width (/ (float height*) height))))
|
||||
(when (< width* exwm-systemtray--icon-min-size)
|
||||
(setq width* exwm-systemtray--icon-min-size
|
||||
height* (round (* height (/ (float width*) width)))))
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ConfigureWindow
|
||||
:window window
|
||||
:value-mask (logior xcb:ConfigWindow:Y
|
||||
xcb:ConfigWindow:Width
|
||||
xcb:ConfigWindow:Height)
|
||||
;; Vertically centered.
|
||||
:y (/ (- exwm-systemtray-height height*) 2)
|
||||
:width width*
|
||||
:height height*)))
|
||||
(exwm-systemtray--refresh)))))
|
||||
|
||||
(defun exwm-systemtray--on-PropertyNotify (data _synthetic)
|
||||
"Map/Unmap the tray icon on PropertyNotify."
|
||||
(let ((obj (make-instance 'xcb:PropertyNotify))
|
||||
attr info visible)
|
||||
(xcb:unmarshal obj data)
|
||||
(with-slots (window atom state) obj
|
||||
(when (and (eq state xcb:Property:NewValue)
|
||||
(eq atom xcb:Atom:_XEMBED_INFO)
|
||||
(setq attr (alist-get window exwm-systemtray--list)))
|
||||
(setq info (xcb:+request-unchecked+reply exwm-systemtray--connection
|
||||
(make-instance 'xcb:xembed:get-_XEMBED_INFO
|
||||
:window window)))
|
||||
(when info
|
||||
(setq visible (/= 0 (logand (slot-value info 'flags)
|
||||
xcb:xembed:MAPPED)))
|
||||
(exwm--log "(System Tray) #x%x visible? %s" window visible)
|
||||
(if visible
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:MapWindow :window window))
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:UnmapWindow :window window)))
|
||||
(setf (slot-value attr 'visible) visible)
|
||||
(exwm-systemtray--refresh))))))
|
||||
|
||||
(defun exwm-systemtray--on-ClientMessage (data _synthetic)
|
||||
"Handle client messages."
|
||||
(let ((obj (make-instance 'xcb:ClientMessage))
|
||||
opcode data32)
|
||||
(xcb:unmarshal obj data)
|
||||
(with-slots (window type data) obj
|
||||
(when (eq type xcb:Atom:_NET_SYSTEM_TRAY_OPCODE)
|
||||
(setq data32 (slot-value data 'data32)
|
||||
opcode (elt data32 1))
|
||||
(cond ((= opcode xcb:systemtray:opcode:REQUEST-DOCK)
|
||||
(exwm-systemtray--embed (elt data32 2)))
|
||||
((= opcode xcb:systemtray:opcode:BEGIN-MESSAGE)
|
||||
;; FIXME
|
||||
)
|
||||
((= opcode xcb:systemtray:opcode:CANCEL-MESSAGE)
|
||||
;; FIXME
|
||||
)
|
||||
(t
|
||||
(exwm--log "(System Tray) Unknown opcode message: %s" obj)))))))
|
||||
|
||||
(defun exwm-systemtray--on-exwm-workspace-switch ()
|
||||
"Reparent the system tray in `exwm-workspace-switch-hook'."
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ReparentWindow
|
||||
:window exwm-systemtray--embedder
|
||||
:parent (string-to-number
|
||||
(frame-parameter exwm-workspace--current
|
||||
'window-id))
|
||||
:x 0
|
||||
:y (- (frame-pixel-height exwm-workspace--current)
|
||||
exwm-systemtray-height)))
|
||||
(exwm-systemtray--refresh))
|
||||
|
||||
(defvar xcb:Atom:_NET_SYSTEM_TRAY_S0)
|
||||
|
||||
(defun exwm-systemtray--init ()
|
||||
"Initialize system tray module."
|
||||
(cl-assert (not exwm-systemtray--connection))
|
||||
(cl-assert (not exwm-systemtray--list))
|
||||
(cl-assert (not exwm-systemtray--selection-owner-window))
|
||||
(cl-assert (not exwm-systemtray--embedder))
|
||||
;; Create a new connection.
|
||||
(setq exwm-systemtray--connection (xcb:connect-to-socket))
|
||||
(set-process-query-on-exit-flag (slot-value exwm-systemtray--connection
|
||||
'process)
|
||||
nil)
|
||||
;; Initialize XELB modules.
|
||||
(xcb:xembed:init exwm-systemtray--connection)
|
||||
(xcb:systemtray:init exwm-systemtray--connection)
|
||||
;; Acquire the manager selection _NET_SYSTEM_TRAY_S0.
|
||||
(with-slots (owner)
|
||||
(xcb:+request-unchecked+reply exwm-systemtray--connection
|
||||
(make-instance 'xcb:GetSelectionOwner
|
||||
:selection xcb:Atom:_NET_SYSTEM_TRAY_S0))
|
||||
(when (/= owner xcb:Window:None)
|
||||
(error "[EXWM] Other system tray detected")))
|
||||
(let ((id (xcb:generate-id exwm-systemtray--connection)))
|
||||
(setq exwm-systemtray--selection-owner-window id)
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:CreateWindow
|
||||
:depth 0 :wid id :parent exwm--root
|
||||
:x 0 :y 0 :width 1 :height 1
|
||||
:border-width 0 :class xcb:WindowClass:InputOnly
|
||||
:visual 0 :value-mask xcb:CW:OverrideRedirect
|
||||
:override-redirect 1))
|
||||
;; Get the selection ownership.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:SetSelectionOwner
|
||||
:owner id
|
||||
:selection xcb:Atom:_NET_SYSTEM_TRAY_S0
|
||||
:time xcb:Time:CurrentTime))
|
||||
;; Set _NET_WM_NAME.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
|
||||
:window id :data "EXWM system tray selection owner"))
|
||||
;; Set the _NET_SYSTEM_TRAY_ORIENTATION property.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:xembed:set-_NET_SYSTEM_TRAY_ORIENTATION
|
||||
:window id
|
||||
:data xcb:systemtray:ORIENTATION:HORZ)))
|
||||
;; Create the embedder.
|
||||
(let ((id (xcb:generate-id exwm-systemtray--connection))
|
||||
parent y)
|
||||
(setq exwm-systemtray--embedder id)
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:CreateWindow
|
||||
:depth 0 :wid id :parent exwm--root
|
||||
:x 0 :y 0 :width 1 :height exwm-systemtray-height
|
||||
:border-width 0 :class xcb:WindowClass:CopyFromParent
|
||||
:visual 0 :value-mask xcb:CW:EventMask
|
||||
:event-mask xcb:EventMask:SubstructureNotify))
|
||||
(if exwm-workspace-minibuffer-position
|
||||
(setq parent (frame-parameter exwm-workspace--minibuffer
|
||||
'exwm-container)
|
||||
;; Vertically centered.
|
||||
y (/ (- (line-pixel-height) exwm-systemtray-height) 2))
|
||||
(setq parent (string-to-number (frame-parameter exwm-workspace--current
|
||||
'window-id))
|
||||
;; Bottom aligned.
|
||||
y (- (frame-pixel-height exwm-workspace--current)
|
||||
exwm-systemtray-height)))
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ReparentWindow
|
||||
:window id :parent parent :x 0 :y y))
|
||||
;; Set _NET_WM_NAME.
|
||||
(xcb:+request exwm-systemtray--connection
|
||||
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
|
||||
:window id :data "EXWM system tray embedder")))
|
||||
(xcb:flush exwm-systemtray--connection)
|
||||
;; Attach event listeners.
|
||||
(xcb:+event exwm-systemtray--connection 'xcb:DestroyNotify
|
||||
#'exwm-systemtray--on-DestroyNotify)
|
||||
(xcb:+event exwm-systemtray--connection 'xcb:ReparentNotify
|
||||
#'exwm-systemtray--on-ReparentNotify)
|
||||
(xcb:+event exwm-systemtray--connection 'xcb:ResizeRequest
|
||||
#'exwm-systemtray--on-ResizeRequest)
|
||||
(xcb:+event exwm-systemtray--connection 'xcb:PropertyNotify
|
||||
#'exwm-systemtray--on-PropertyNotify)
|
||||
(xcb:+event exwm-systemtray--connection 'xcb:ClientMessage
|
||||
#'exwm-systemtray--on-ClientMessage)
|
||||
;; Add hook to reparent the embedder.
|
||||
(unless exwm-workspace-minibuffer-position
|
||||
(add-hook 'exwm-workspace-switch-hook
|
||||
#'exwm-systemtray--on-exwm-workspace-switch)))
|
||||
|
||||
(defun exwm-systemtray-enable ()
|
||||
"Enable system tray support for EXWM."
|
||||
(add-hook 'exwm-init-hook #'exwm-systemtray--init))
|
||||
|
||||
|
||||
|
||||
(provide 'exwm-systemtray)
|
||||
|
||||
;; exwm-systemtray.el ends here
|
|
@ -23,9 +23,6 @@
|
|||
|
||||
;; This module adds workspace support for EXWM.
|
||||
|
||||
;; Todo:
|
||||
;; + Add system tray support.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'exwm-core)
|
||||
|
@ -141,6 +138,9 @@ workspace frame."
|
|||
:stack-mode xcb:StackMode:Above))
|
||||
(set-frame-width exwm-workspace--minibuffer width nil t)))
|
||||
|
||||
(defvar exwm-workspace-switch-hook nil
|
||||
"Normal hook run after switching workspace.")
|
||||
|
||||
;;;###autoload
|
||||
(defun exwm-workspace-switch (index &optional force)
|
||||
"Switch to workspace INDEX. Query for INDEX if it's not specified.
|
||||
|
@ -203,7 +203,8 @@ The optional FORCE option is for internal use only."
|
|||
(xcb:+request exwm--connection
|
||||
(make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP
|
||||
:window exwm--root :data index))
|
||||
(xcb:flush exwm--connection)))))
|
||||
(xcb:flush exwm--connection))
|
||||
(run-hooks 'exwm-workspace-switch-hook))))
|
||||
|
||||
;;;###autoload
|
||||
(defun exwm-workspace-move-window (index &optional id)
|
||||
|
|
Loading…
Reference in a new issue