branch: externals/exwm
commit bfd43feb494a8a7675f3a882ea5ebeaa91fb3f82
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
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.
---
exwm-systemtray.el | 372 ++++++++++++++++++++++++++++++++++++++++++++++++++++
exwm-workspace.el | 9 +-
2 files changed, 377 insertions(+), 4 deletions(-)
diff --git a/exwm-systemtray.el b/exwm-systemtray.el
new file mode 100644
index 0000000..c892fcc
--- /dev/null
+++ b/exwm-systemtray.el
@@ -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.f...@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
diff --git a/exwm-workspace.el b/exwm-workspace.el
index 99a7c7b..e9bab30 100644
--- a/exwm-workspace.el
+++ b/exwm-workspace.el
@@ -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)
