diff options
Diffstat (limited to 'exwm-systemtray.el')
| -rw-r--r-- | exwm-systemtray.el | 372 |
1 files changed, 372 insertions, 0 deletions
diff --git a/exwm-systemtray.el b/exwm-systemtray.el new file mode 100644 index 000000000000..c892fcc1a76a --- /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.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 |