branch: externals/xelb
commit c99266a3318c077ef4ef9ca6d26582be0af90b16
Merge: 4621160 ad845df
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
Merge xelb-util into this repo
---
util/xcb-cursor.el | 433 ++++++++++++++++++++++
util/xcb-ewmh.el | 757 +++++++++++++++++++++++++++++++++++++
util/xcb-icccm.el | 542 +++++++++++++++++++++++++++
util/xcb-keysyms.el | 326 ++++++++++++++++
util/xcb-xim.el | 1026 +++++++++++++++++++++++++++++++++++++++++++++++++++
util/xcb-xlib.el | 113 ++++++
6 files changed, 3197 insertions(+), 0 deletions(-)
diff --git a/util/xcb-cursor.el b/util/xcb-cursor.el
new file mode 100644
index 0000000..5579fff
--- /dev/null
+++ b/util/xcb-cursor.el
@@ -0,0 +1,433 @@
+;;; xcb-cursor.el --- Port of Xcursor -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <chris.w.f...@gmail.com>
+;; Keywords: unix
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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.
+
+;; This file 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 this file. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library is a port of Xcursor in Xlib, and roughly corresponds to the
+;; xcb/util-cursor project.
+
+;; Usage tips:
+;; + Do not forget to call `xcb:cursor:init' for _every_ connection using this
+;; library.
+;; + The only useful method in this library is `xcb:cursor:load-cursor', which
+;; loads a cursor by its name (e.g. "left_ptr"), in the following order:
+;; 1. themed cursor
+;; 2. inherited themed cursor
+;; 3. standard X cursor
+
+;; Todo:
+;; + Add legacy support for RENDER.
+;; + Cursor should be set per screen (only the first is used right now).
+;; + Move codes corresponding to xcb/util-renderutil or xcb/util-image
+;; elsewhere.
+
+;; References:
+;; + Xcursor(3).
+;; + xcb/util-cursor (git://anongit.freedesktop.org/xcb/util-cursor)
+;; + xcb/util-renderutil (git://anongit.freedesktop.org/xcb/util-renderutil)
+;; + xcb/util-image (git://anongit.freedesktop.org/xcb/util-image)
+
+;;; Code:
+
+(require 'xcb-xproto)
+(require 'xcb-render)
+
+;; FIXME: check if resource manager really works
+(cl-defmethod xcb:cursor:init ((obj xcb:connection))
+ "Initialize Xcursor for connection OBJ."
+ ;; Initialize resource manager
+ (let* ((root (slot-value (car (slot-value (xcb:get-setup obj) 'roots))
+ 'root))
+ (rm (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:GetProperty
+ :delete 0 :window root
+ :property xcb:Atom:RESOURCE_MANAGER
+ :type xcb:Atom:STRING
+ :long-offset 0
+ :long-length 16384))) ;FIXME: xcb/util-cursor
+ (rm (split-string
+ (decode-coding-string
+ (apply 'unibyte-string (append (slot-value rm 'value) nil))
+ 'iso-latin-1)
+ "\n"))
+ theme size dpi)
+ (dolist (i rm)
+ (pcase (replace-regexp-in-string "^\\(\\S-+\\)" "\\1" i)
+ ("Xcursor.theme"
+ (setq theme
+ (replace-regexp-in-string "^[^:]+:\\s-*\\(.+$\\)" "\\1" i)))
+ ("Xcursor.size"
+ (setq size
+ (string-to-int (replace-regexp-in-string "^[^:]+:\\s-*\\(.+$\\)"
+ "\\1" i))))
+ ("Xft.dpi"
+ (setq dpi
+ (string-to-int (replace-regexp-in-string "^[^:]+:\\s-*\\(.+$\\)"
+ "\\1" i))))))
+ ;; Get cursor size from XCURSOR_SIZE environment variable
+ (let ((default-size (getenv "XCURSOR_SIZE")))
+ (when default-size
+ (setq default-size (string-to-int default-size)))
+ (setq size (or default-size size)))
+ ;; Alternatives
+ (when (and (not size) dpi)
+ (setq size (/ (* dpi 16) 72))) ;FIXME: xcb/util-cursor
+ (unless size
+ (setq size
+ ;; FIXME: xcb/util-cursor
+ (/ (min (x-display-pixel-width) (x-display-pixel-height)) 48)))
+ ;; Save default values
+ (let ((plist (plist-get (slot-value obj 'extra-plist) 'cursor)))
+ (setq plist (plist-put plist 'theme theme)
+ plist (plist-put plist 'size size))
+ (setf (slot-value obj 'extra-plist)
+ (plist-put (slot-value obj 'extra-plist) 'cursor plist))))
+ ;; Initialize render extension
+ (if (= 0 (slot-value (xcb:get-extension-data exwm--connection 'xcb:render)
+ 'present))
+ (error "[XELB:CURSOR] Render extension is not supported by this server")
+ (with-slots (minor-version)
+ (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:render:QueryVersion
+ :client-major-version 0 :client-minor-version 8))
+ (if (> 8 minor-version)
+ (error "[XELB:CURSOR] Render version 0.8 is not supported")
+ (let* ((formats
+ (slot-value (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:render:QueryPictFormats))
+ 'formats))
+ (format (catch 'break
+ (dolist (i formats)
+ (with-slots (type depth direct) i
+ (with-slots (red-shift red-mask
+ green-shift green-mask
+ blue-shift blue-mask
+ alpha-shift alpha-mask)
+ direct
+ ;; FIXME: xcb/util-renderutil
+ (when (and (= type xcb:render:PictType:Direct)
+ (= depth 32)
+ (= red-shift 16) (= red-mask #xFF)
+ (= green-shift 8) (= green-mask #xFF)
+ (= blue-shift 0) (= blue-mask #xFF)
+ (= alpha-shift 24)
+ (= alpha-mask #xFF))
+ (throw 'break i)))))))
+ (plist (plist-get (slot-value obj 'extra-plist) 'cursor)))
+ (setf (slot-value obj 'extra-plist)
+ (plist-put (slot-value obj 'extra-plist) 'cursor
+ (plist-put plist 'pict-format format))))))))
+
+(defsubst xcb:cursor:-get-path ()
+ "Return a list of cursor paths."
+ (let ((path (getenv "XCURSOR_PATH")))
+ (if path
+ (split-string path ":" t)
+ '("~/.icons"
+ "/usr/share/icons"
+ "/usr/share/pixmaps"
+ "/usr/X11R6/lib/X11/icons"))))
+
+(defun xcb:cursor:-get-theme-inherits (file)
+ "Return the inherited themes in a index.theme file FILE."
+ (let ((lines (with-temp-buffer
+ (insert-file-contents file)
+ (split-string (buffer-string) "\n" t))))
+ (catch 'break
+ (dolist (line lines)
+ (when (string-match "^Inherits\\s-*=\\s-*" line)
+ (throw 'break
+ (split-string (replace-regexp-in-string "^[^=]+=\\(.*\\)$"
+ "\\1" line)
+ "[;, \t\n]+" t)))))))
+
+(defun xcb:cursor:-find-file (theme name &optional skip)
+ "Return the file for cursor named NAME in theme THEME, or nil if not found."
+ (catch 'return
+ ;; Skip searched themes
+ (when (memq theme skip)
+ (throw 'return nil))
+ ;; Give up when supplied "core" theme and a valid cursor name
+ (when (and (string= "core" theme) (xcb:cursor:-shape->id name))
+ (throw 'return nil))
+ (let ((path (xcb:cursor:-get-path))
+ file)
+ ;; 1. try THEME/cursors/NAME in each cursor path
+ (dolist (i path)
+ (setq file (concat i "/" theme "/cursors/" name))
+ (when (file-readable-p file)
+ (throw 'return file)))
+ ;; 2. try "Inherits=" key in "index.theme"
+ (dolist (i path)
+ (setq file (concat i "/" theme "/index.theme"))
+ (when (file-readable-p file)
+ (cl-pushnew theme skip)
+ ;; try all inherited themes
+ (dolist (j (xcb:cursor:-get-theme-inherits file))
+ (setq file (xcb:cursor:-find-file j name skip))
+ (when file
+ (throw 'return file))
+ (cl-pushnew j skip)))))
+ nil))
+
+(defconst xcb:cursor:-file-magic-lsb "Xcur"
+ "The magic number for little-endian Xcursor file.")
+(defconst xcb:cursor:-file-magic-msb "rucX"
+ "The magic number for big-endian Xcursor file.")
+
+(defclass xcb:cursor:-file-header (xcb:-struct)
+ ((magic :type xcb:CARD32)
+ (header :type xcb:CARD32)
+ (version :type xcb:CARD32)
+ (ntoc :type xcb:CARD32)) ;redundant, required for calculating TOC bytes
+ :documentation "Xcursor file header.")
+
+(defclass xcb:cursor:-file-header-toc (xcb:-struct)
+ ((ntoc :type xcb:CARD32) ;redundant slot
+ (toc :type xcb:-ignore)
+ (toc~ :initform '(name toc type xcb:cursor:-file-toc
+ size (xcb:-fieldref 'ntoc))
+ :type xcb:-list))
+ :documentation "The TOC field in Xcursor file header.")
+
+(defclass xcb:cursor:-file-toc (xcb:-struct)
+ ((type :type xcb:CARD32)
+ (subtype :type xcb:CARD32)
+ (position :type xcb:CARD32))
+ :documentation "Xcursor file TOC entry.")
+
+(defclass xcb:cursor:-file-chunk-header (xcb:-struct)
+ ((header :type xcb:CARD32)
+ (type :type xcb:CARD32)
+ (subtype :type xcb:CARD32)
+ (version :type xcb:CARD32)
+ (width :type xcb:CARD32) ;redundant, required for calculating image bytes
+ (height :type xcb:CARD32)) ;redundant, required for calculating image bytes
+ :documentation "Xcursor file chunk header.")
+
+(defconst xcb:cursor:-file-chunk-image-header 36
+ "Header value of image-type chunk in Xcursor file.")
+(defconst xcb:cursor:-file-chunk-image-type #xFFFD0002
+ "Type of image-type chunk in Xcursor file.")
+(defconst xcb:cursor:-file-chunk-image-version 1
+ "Version of image-type chunk in Xcursor file.")
+
+(defclass xcb:cursor:-file-chunk-image (xcb:-struct)
+ ((width :type xcb:CARD32) ;<= #x7FFF, redundant
+ (height :type xcb:CARD32) ;<= #x7FFF, redundant
+ (xhot :type xcb:CARD32) ;<= width
+ (yhot :type xcb:CARD32) ;<= height
+ (delay :type xcb:CARD32) ;in ms
+ (pixels :type xcb:-ignore)
+ (pixels~ :initform '(name pixels type xcb:CARD32
+ size (* (xcb:-fieldref 'width)
+ (xcb:-fieldref 'height)))
+ :type xcb:-list))
+ :documentation "Image-type chunk in Xcursor file.")
+
+(cl-defmethod xcb:cursor:-parse-file ((obj xcb:connection) path)
+ "Parse an Xcursor file named PATH."
+ (catch 'return
+ (let ((data (let ((coding-system-for-read 'binary))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents path) (buffer-string))))
+ xcb:lsb ;override global byte order
+ best-size chunks
+ magic file-header file-header-toc chunk-header chunk)
+ ;; Determine byte order
+ (setq magic (substring data 0 4))
+ (if (string= xcb:cursor:-file-magic-lsb magic)
+ (setq xcb:lsb t) ;LSB first
+ (if (string= xcb:cursor:-file-magic-msb magic)
+ (setq xcb:lsb nil) ;MSB first
+ (throw 'return nil)))
+ (setq file-header (make-instance 'xcb:cursor:-file-header))
+ ;;
+ (xcb:unmarshal file-header (substring data 0 16))
+ ;; FIXME: checks
+ (setq file-header-toc (make-instance 'xcb:cursor:-file-header-toc))
+ (xcb:unmarshal file-header-toc
+ (substring data 12 (+ 16 (* 12 (slot-value file-header
+ 'ntoc)))))
+ (with-slots (toc) file-header-toc
+ (let ((target (plist-get
+ (plist-get (slot-value obj 'extra-plist) 'cursor)
+ 'size)))
+ (catch 'break
+ (dolist (i toc)
+ (with-slots (type subtype) i
+ (when (= type xcb:cursor:-file-chunk-image-type)
+ (when (= target subtype)
+ (setq best-size target)
+ (throw 'break nil))
+ (when (or (not best-size)
+ (> (abs (- target best-size))
+ (abs (- target subtype))))
+ (setq best-size subtype)))))))
+ ;; Collect chunks fitting this size
+ (setq chunk-header (make-instance 'xcb:cursor:-file-chunk-header))
+ (dolist (i toc)
+ (with-slots (type subtype position) i
+ (when (and (= type xcb:cursor:-file-chunk-image-type)
+ (= subtype best-size))
+ (xcb:unmarshal chunk-header (substring data position
+ (+ position 24)))
+ ;; Validate the header of this chunk
+ (with-slots (header type subtype version) chunk-header
+ (when (or (/= header xcb:cursor:-file-chunk-image-header)
+ (/= type xcb:cursor:-file-chunk-image-type)
+ (/= subtype best-size)
+ (/= version xcb:cursor:-file-chunk-image-version))
+ (throw 'return nil)))
+ ;; Parse this chunk
+ (setq chunk (make-instance 'xcb:cursor:-file-chunk-image))
+ (xcb:unmarshal chunk (substring data (+ position 16)
+ (+ position 36
+ (* 4
+ (slot-value chunk-header
+ 'width)
+ (slot-value chunk-header
+ 'height)))))
+ (setq chunks (nconc chunks (list chunk))))))
+ (list xcb:lsb chunks)))))
+
+(cl-defmethod xcb:cursor:-load-cursor ((obj xcb:connection) file)
+ "Load a cursor file FILE."
+ (let* ((images (xcb:cursor:-parse-file obj file))
+ (lsb (car images))
+ (images (cadr images))
+ (root (slot-value (car (slot-value (xcb:get-setup obj) 'roots))
+ 'root))
+ (picture (xcb:generate-id obj))
+ (pict-format (slot-value
+ (plist-get
+ (plist-get (slot-value obj 'extra-plist) 'cursor)
+ 'pict-format)
+ 'id))
+ pixmap gc cursors cursor last-width last-height)
+ (dolist (image images)
+ (with-slots (width height xhot yhot delay pixels) image
+ (when (or (not pixmap) (/= last-width width) (/= last-height height))
+ (if pixmap
+ (progn (xcb:+request obj (make-instance 'xcb:FreePixmap
+ :pixmap pixmap))
+ (xcb:+request obj (make-instance 'xcb:FreeGC :gc gc)))
+ (setq pixmap (xcb:generate-id obj)
+ gc (xcb:generate-id obj)))
+ (xcb:+request obj (make-instance 'xcb:CreatePixmap
+ :depth 32 :pid pixmap :drawable root
+ :width width :height height))
+ (xcb:+request obj (make-instance 'xcb:CreateGC
+ :cid gc :drawable pixmap
+ :value-mask 0))
+ (setq last-width width
+ last-height height))
+ (xcb:+request obj (make-instance 'xcb:PutImage
+ :format xcb:ImageFormat:ZPixmap
+ :drawable pixmap
+ :gc gc
+ :width width
+ :height height
+ :dst-x 0
+ :dst-y 0
+ :left-pad 0
+ :depth 32
+ :data (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (mapconcat
+ (if lsb 'xcb:-pack-u4-lsb
+ 'xcb:-pack-u4)
+ pixels []))))
+ (xcb:+request obj (make-instance 'xcb:render:CreatePicture
+ :pid picture
+ :drawable pixmap
+ :format pict-format
+ :value-mask 0))
+ (setq cursor (xcb:generate-id obj)
+ cursors (nconc cursors
+ (list (make-instance 'xcb:render:ANIMCURSORELT
+ :cursor cursor
+ :delay delay))))
+ (xcb:+request obj (make-instance 'xcb:render:CreateCursor
+ :cid cursor
+ :source picture
+ :x xhot :y yhot))
+ (xcb:+request obj (make-instance 'xcb:render:FreePicture
+ :picture picture))))
+ (xcb:+request obj (make-instance 'xcb:FreePixmap :pixmap pixmap))
+ (xcb:+request obj (make-instance 'xcb:FreeGC :gc gc))
+ (xcb:flush obj)
+ (if (= 1 (length cursors))
+ ;; Non-animated cursor
+ (slot-value (car cursors) 'cursor)
+ ;; Animated cursor
+ (setq cursor (xcb:generate-id obj))
+ (xcb:+request obj (make-instance 'xcb:render:CreateAnimCursor
+ :cid cursor
+ :cursors (vconcat cursors)))
+ (dolist (i cursors)
+ (xcb:+request obj (make-instance 'xcb:FreeCursor
+ :cursor (slot-value i 'cursor))))
+ (xcb:flush obj)
+ cursor)))
+
+(defsubst xcb:cursor:-shape->id (name)
+ "Return the standard Xcursor font for cursor named NAME."
+ ;; Standard X cursor fonts are defined in Emacs
+ (intern-soft (concat "x-pointer-" (replace-regexp-in-string "_" "-" name))))
+
+(cl-defmethod xcb:cursor:load-cursor ((obj xcb:connection) name)
+ "Return a cursor whose name is NAME."
+ (let* ((theme (or (plist-get
+ (plist-get (slot-value obj 'extra-plist) 'cursor) 'theme)
+ "default"))
+ (file (xcb:cursor:-find-file theme name)))
+ (if file
+ (xcb:cursor:-load-cursor obj file)
+ ;; Fallback to standard X cursors
+ (let ((pointer (xcb:cursor:-shape->id name))
+ (cursor xcb:Cursor:None)
+ font)
+ (when (boundp pointer)
+ (setq pointer (symbol-value pointer)
+ font (xcb:generate-id obj)
+ cursor (xcb:generate-id obj))
+ (xcb:+request obj
+ (make-instance 'xcb:OpenFont
+ :fid font :name-len (length "cursor")
+ :name "cursor"))
+ (xcb:+request obj
+ (make-instance 'xcb:CreateGlyphCursor
+ :cid cursor :source-font font :mask-font font
+ :source-char pointer :mask-char (1+ pointer)
+ :fore-red 0 :fore-green 0 :fore-blue 0
+ :back-red #xFFFF :back-green #xFFFF
+ :back-blue #xFFFF))
+ (xcb:flush obj))
+ cursor))))
+
+
+
+(provide 'xcb-cursor)
+
+;;; xcb-cursor.el ends here
diff --git a/util/xcb-ewmh.el b/util/xcb-ewmh.el
new file mode 100644
index 0000000..f5f00ff
--- /dev/null
+++ b/util/xcb-ewmh.el
@@ -0,0 +1,757 @@
+;;; xcb-ewmh.el --- Extended Window Manager Hints -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <chris.w.f...@gmail.com>
+;; Keywords: unix
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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.
+
+;; This file 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 this file. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implement EWMH the same way as xcb/util-wm.
+
+;; Usage tips:
+;; + Do not forget to call `xcb:ewmh:init' for _every_ connection using
+;; this library.
+;; + Use `xcb:ewmh:SendEvent' instead of `xcb:SendEvent' to send client
+;; messages defined in this library.
+;; + Initialize this library auto loads and initializes 'xcb-icccm'.
+
+;; Todo:
+;; + Interned atoms are actually connection-dependent. Currently they are
+;; simply saved as global variables.
+;; + Is UTF-8 string NULL-terminated?
+;; + _NET_WM_CM_Sn (should implement "manager selection" in ICCCM first)
+
+;; References:
+;; + EWMH (http://standards.freedesktop.org/wm-spec/wm-spec-latest.html)
+;; + xcb/util-wm (git://anongit.freedesktop.org/xcb/util-wm)
+
+;;; Code:
+
+(require 'xcb-xproto)
+(require 'xcb-icccm)
+
+;;;; EWMH Atoms
+
+(defconst xcb:ewmh:-atoms ;_NET_WM_CM_Sn are left out
+ '(;; Root Window Properties (and Related Messages)
+ _NET_SUPPORTED
+ _NET_CLIENT_LIST
+ _NET_CLIENT_LIST_STACKING
+ _NET_NUMBER_OF_DESKTOPS
+ _NET_DESKTOP_GEOMETRY
+ _NET_DESKTOP_VIEWPORT
+ _NET_CURRENT_DESKTOP
+ _NET_DESKTOP_NAMES
+ _NET_ACTIVE_WINDOW
+ _NET_WORKAREA
+ _NET_SUPPORTING_WM_CHECK
+ _NET_VIRTUAL_ROOTS
+ _NET_DESKTOP_LAYOUT
+ _NET_SHOWING_DESKTOP
+ ;; Other Root Window Messages
+ _NET_CLOSE_WINDOW
+ _NET_MOVERESIZE_WINDOW
+ _NET_WM_MOVERESIZE
+ _NET_RESTACK_WINDOW
+ _NET_REQUEST_FRAME_EXTENTS
+ ;; Application Window Properties
+ _NET_WM_NAME
+ _NET_WM_VISIBLE_NAME
+ _NET_WM_ICON_NAME
+ _NET_WM_VISIBLE_ICON_NAME
+ _NET_WM_DESKTOP
+ _NET_WM_WINDOW_TYPE
+ _NET_WM_STATE
+ _NET_WM_ALLOWED_ACTIONS
+ _NET_WM_STRUT
+ _NET_WM_STRUT_PARTIAL
+ _NET_WM_ICON_GEOMETRY
+ _NET_WM_ICON
+ _NET_WM_PID
+ _NET_WM_HANDLED_ICONS
+ _NET_WM_USER_TIME
+ _NET_WM_USER_TIME_WINDOW
+ _NET_FRAME_EXTENTS
+ _NET_WM_OPAQUE_REGION
+ _NET_WM_BYPASS_COMPOSITOR
+ ;; Window Manager Protocols
+ _NET_WM_PING
+ _NET_WM_SYNC_REQUEST
+ _NET_WM_SYNC_REQUEST_COUNTER
+ _NET_WM_FULLSCREEN_MONITORS
+ ;; Other Properties
+ _NET_WM_FULL_PLACEMENT
+ ;; _NET_WM_WINDOW_TYPE hint
+ _NET_WM_WINDOW_TYPE_DESKTOP
+ _NET_WM_WINDOW_TYPE_DOCK
+ _NET_WM_WINDOW_TYPE_TOOLBAR
+ _NET_WM_WINDOW_TYPE_MENU
+ _NET_WM_WINDOW_TYPE_UTILITY
+ _NET_WM_WINDOW_TYPE_SPLASH
+ _NET_WM_WINDOW_TYPE_DIALOG
+ _NET_WM_WINDOW_TYPE_DROPDOWN_MENU
+ _NET_WM_WINDOW_TYPE_POPUP_MENU
+ _NET_WM_WINDOW_TYPE_TOOLTIP
+ _NET_WM_WINDOW_TYPE_NOTIFICATION
+ _NET_WM_WINDOW_TYPE_COMBO
+ _NET_WM_WINDOW_TYPE_DND
+ _NET_WM_WINDOW_TYPE_NORMAL
+ ;; _NET_WM_STATE hint
+ _NET_WM_STATE_MODAL
+ _NET_WM_STATE_STICKY
+ _NET_WM_STATE_MAXIMIZED_VERT
+ _NET_WM_STATE_MAXIMIZED_HORZ
+ _NET_WM_STATE_SHADED
+ _NET_WM_STATE_SKIP_TASKBAR
+ _NET_WM_STATE_SKIP_PAGER
+ _NET_WM_STATE_HIDDEN
+ _NET_WM_STATE_FULLSCREEN
+ _NET_WM_STATE_ABOVE
+ _NET_WM_STATE_BELOW
+ _NET_WM_STATE_DEMANDS_ATTENTION
+ _NET_WM_STATE_FOCUSED
+ ;; _NET_WM_ACTION hint
+ _NET_WM_ACTION_MOVE
+ _NET_WM_ACTION_RESIZE
+ _NET_WM_ACTION_MINIMIZE
+ _NET_WM_ACTION_SHADE
+ _NET_WM_ACTION_STICK
+ _NET_WM_ACTION_MAXIMIZE_HORZ
+ _NET_WM_ACTION_MAXIMIZE_VERT
+ _NET_WM_ACTION_FULLSCREEN
+ _NET_WM_ACTION_CHANGE_DESKTOP
+ _NET_WM_ACTION_CLOSE
+ _NET_WM_ACTION_ABOVE
+ _NET_WM_ACTION_BELOW)
+ "EWMH atoms.")
+
+(cl-defmethod xcb:ewmh:init ((obj xcb:connection))
+ "Initialize EWMH module.
+
+This method must be called before using any other method in this module.
+
+This method also initializes ICCCM module automatically."
+ (xcb:icccm:init obj) ;required
+ (let ((atoms xcb:ewmh:-atoms))
+ (dotimes (i (x-display-screens))
+ (push (intern (format "_NET_WM_CM_S%d" i)) atoms))
+ (xcb:icccm:intern-atoms obj atoms)))
+
+;;;; Client message
+
+(defclass xcb:ewmh:SendEvent (xcb:SendEvent)
+ ((propagate :initform 0)
+ (event-mask :initform (logior xcb:EventMask:SubstructureNotify
+ xcb:EventMask:SubstructureRedirect)))
+ :documentation "A fork of `xcb:SendEvent' to send EWMH client message.
+
+Note that this only applies to \"sending a message to the root window\" in
+EWMH")
+
+(defclass xcb:ewmh:--ClientMessage ()
+ ((data :type xcb:-ignore)) ;shadowed slot
+ :documentation "To shadow the data slot in `xcb:SendEvent'.")
+;;
+(defclass xcb:ewmh:-ClientMessage (xcb:ewmh:--ClientMessage xcb:ClientMessage)
+ ((format :initform 32)))
+
+;;;; Abstract classes for getting/changing (UTF-8) string properties
+
+(defclass xcb:ewmh:-GetProperty-utf8 (xcb:icccm:-GetProperty-text)
+ ((type :initform xcb:Atom:UTF8_STRING))
+ :documentation "Get an EWMH UTF-8 text property (request part).")
+(defclass xcb:ewmh:-GetProperty-utf8~reply (xcb:icccm:-GetProperty-text~reply)
+ nil
+ :documentation "Get an EWMH UTF-8 text property (reply part).")
+(defclass xcb:ewmh:-ChangeProperty-utf8 (xcb:icccm:-ChangeProperty-text)
+ ((type :initform xcb:Atom:UTF8_STRING))
+ :documentation "Change an EWMH UTF-8 text property.")
+
+;;;; Root Window Properties (and Related Messages)
+
+;; _NET_SUPPORTED
+(defclass xcb:ewmh:get-_NET_SUPPORTED (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_SUPPORTED)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:ewmh:get-_NET_SUPPORTED~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_SUPPORTED (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_SUPPORTED)
+ (type :initform xcb:Atom:ATOM)))
+
+;; _NET_CLIENT_LIST
+(defclass xcb:ewmh:get-_NET_CLIENT_LIST (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_CLIENT_LIST)
+ (type :initform xcb:Atom:WINDOW)))
+(defclass xcb:ewmh:get-_NET_CLIENT_LIST~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_CLIENT_LIST (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_CLIENT_LIST)
+ (type :initform xcb:Atom:WINDOW)))
+
+;; _NET_CLIENT_LIST_STACKING
+(defclass xcb:ewmh:get-_NET_CLIENT_LIST_STACKING (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_CLIENT_LIST_STACKING)
+ (type :initform xcb:Atom:WINDOW)))
+(defclass xcb:ewmh:get-_NET_CLIENT_LIST_STACKING~reply
+ (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_CLIENT_LIST_STACKING (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_CLIENT_LIST_STACKING)
+ (type :initform xcb:Atom:WINDOW)))
+
+;; _NET_NUMBER_OF_DESKTOPS
+(defclass xcb:ewmh:get-_NET_NUMBER_OF_DESKTOPS (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_NUMBER_OF_DESKTOPS)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_NUMBER_OF_DESKTOPS~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_NUMBER_OF_DESKTOPS
+ (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_NUMBER_OF_DESKTOPS)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_DESKTOP_GEOMETRY
+(defclass xcb:ewmh:-_NET_DESKTOP_GEOMETRY ()
+ ((width :initarg :width :type xcb:-ignore)
+ (height :initarg :height :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_DESKTOP_GEOMETRY (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_DESKTOP_GEOMETRY)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 2)))
+(defclass xcb:ewmh:get-_NET_DESKTOP_GEOMETRY~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_DESKTOP_GEOMETRY)
+ nil)
+(defclass xcb:ewmh:set-_NET_DESKTOP_GEOMETRY
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_DESKTOP_GEOMETRY)
+ ((property :initform xcb:Atom:_NET_DESKTOP_GEOMETRY)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:_NET_DESKTOP_GEOMETRY
+ (xcb:ewmh:-ClientMessage xcb:ewmh:-_NET_DESKTOP_GEOMETRY)
+ ((type :initform xcb:Atom:_NET_DESKTOP_GEOMETRY)))
+
+;; _NET_DESKTOP_VIEWPORT
+(defclass xcb:ewmh:get-_NET_DESKTOP_VIEWPORT (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_DESKTOP_VIEWPORT)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_DESKTOP_VIEWPORT~reply
+ (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_DESKTOP_VIEWPORT (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_DESKTOP_VIEWPORT)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:_NET_DESKTOP_VIEWPORT (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_DESKTOP_VIEWPORT)
+ (new-vx :initarg :new-vx :type xcb:CARD32)
+ (new-vy :initarg :new-vy :type xcb:CARD32)))
+
+;; _NET_CURRENT_DESKTOP
+(defclass xcb:ewmh:get-_NET_CURRENT_DESKTOP (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_CURRENT_DESKTOP)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_CURRENT_DESKTOP~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_CURRENT_DESKTOP (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_CURRENT_DESKTOP)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:_NET_CURRENT_DESKTOP (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_CURRENT_DESKTOP)
+ (new-index :initarg :new-index :type xcb:CARD32)
+ (timestamp :initarg :timestamp :type xcb:CARD32)))
+
+;; _NET_DESKTOP_NAMES
+(defclass xcb:ewmh:get-_NET_DESKTOP_NAMES (xcb:ewmh:-GetProperty-utf8)
+ ((property :initform xcb:Atom:_NET_DESKTOP_NAMES)))
+(defclass xcb:ewmh:get-_NET_DESKTOP_NAMES~reply
+ (xcb:ewmh:-GetProperty-utf8~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_DESKTOP_NAMES (xcb:ewmh:-ChangeProperty-utf8)
+ ((property :initform xcb:Atom:_NET_DESKTOP_NAMES)))
+
+;; _NET_ACTIVE_WINDOW
+(defclass xcb:ewmh:get-_NET_ACTIVE_WINDOW (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_ACTIVE_WINDOW)
+ (type :initform xcb:Atom:WINDOW)))
+(defclass xcb:ewmh:get-_NET_ACTIVE_WINDOW~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_ACTIVE_WINDOW (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_ACTIVE_WINDOW)
+ (type :initform xcb:Atom:WINDOW)))
+(defclass xcb:ewmh:_NET_ACTIVE_WINDOW (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_ACTIVE_WINDOW)
+ (source-indication :initarg :source-indication :type xcb:CARD32)
+ (timestamp :initarg :timestamp :type xcb:CARD32)
+ (current-active-window :initarg :current-active-window :type xcb:WINDOW)))
+
+;; _NET_WORKAREA
+(defclass xcb:ewmh:get-_NET_WORKAREA (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_WORKAREA)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WORKAREA~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WORKAREA (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_WORKAREA)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_SUPPORTING_WM_CHECK
+(defclass xcb:ewmh:get-_NET_SUPPORTING_WM_CHECK (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_SUPPORTING_WM_CHECK)
+ (type :initform xcb:Atom:WINDOW)))
+(defclass xcb:ewmh:get-_NET_SUPPORTING_WM_CHECK~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_SUPPORTING_WM_CHECK
+ (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_SUPPORTING_WM_CHECK)
+ (type :initform xcb:Atom:WINDOW)))
+
+;; _NET_VIRTUAL_ROOTS
+(defclass xcb:ewmh:get-_NET_VIRTUAL_ROOTS (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_VIRTUAL_ROOTS)
+ (type :initform xcb:Atom:WINDOW)))
+(defclass xcb:ewmh:get-_NET_VIRTUAL_ROOTS~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_VIRTUAL_ROOTS (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_VIRTUAL_ROOTS)
+ (type :initform xcb:Atom:WINDOW)))
+
+;; _NET_DESKTOP_LAYOUT
+;; Orientations
+(defconst xcb:ewmh:_NET_WM_ORIENTATION_HORZ 0)
+(defconst xcb:ewmh:_NET_WM_ORIENTATION_VERT 1)
+;; Starting corners
+(defconst xcb:ewmh:_NET_WM_TOPLEFT 0)
+(defconst xcb:ewmh:_NET_WM_TOPRIGHT 1)
+(defconst xcb:ewmh:_NET_WM_BOTTOMRIGHT 2)
+(defconst xcb:ewmh:_NET_WM_BOTTOMLEFT 3)
+;;
+(defclass xcb:ewmh:-_NET_DESKTOP_LAYOUT ()
+ ((orientation :initarg :orientation :type xcb:-ignore)
+ (columns :initarg :columns :type xcb:-ignore)
+ (rows :initarg :rows :type xcb:-ignore)
+ (starting-corner :initarg :starting-corner :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_DESKTOP_LAYOUT (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_DESKTOP_LAYOUT)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 4)))
+(defclass xcb:ewmh:get-_NET_DESKTOP_LAYOUT~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_DESKTOP_LAYOUT)
+ nil)
+(defclass xcb:ewmh:set-_NET_DESKTOP_LAYOUT
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_DESKTOP_LAYOUT)
+ ((property :initform xcb:Atom:_NET_DESKTOP_LAYOUT)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_SHOWING_DESKTOP
+(defclass xcb:ewmh:get-_NET_SHOWING_DESKTOP (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_SHOWING_DESKTOP)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_SHOWING_DESKTOP~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_SHOWING_DESKTOP (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_SHOWING_DESKTOP)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:_NET_SHOWING_DESKTOP (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_SHOWING_DESKTOP)
+ (show :initarg :show :type xcb:CARD32)))
+
+;;;; Other Root Window Messages
+
+;; _NET_CLOSE_WINDOW
+(defclass xcb:ewmh:_NET_CLOSE_WINDOW (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_CLOSE_WINDOW)
+ (timestamp :initarg :timestamp :type xcb:CARD32)
+ (source-indication :initarg :source-indication :type xcb:CARD32)))
+
+;; _NET_MOVERESIZE_WINDOW
+(defclass xcb:ewmh:_NET_MOVERESIZE_WINDOW (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_MOVERESIZE_WINDOW)
+ (gravity-and-flags :initarg :gravity-and-flags :type xcb:CARD32)
+ (x :initarg :x :type xcb:CARD32)
+ (y :initarg :y :type xcb:CARD32)
+ (width :initarg :width :type xcb:CARD32)
+ (height :initarg :height :type xcb:CARD32)))
+
+;; _NET_WM_MOVERESIZE
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT 0)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP 1)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT 2)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT 3)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT 4)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM 5)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT 6)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT 7)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_MOVE 8)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_KEYBOARD 9)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_MOVE_KEYBOARD 10)
+(defconst xcb:ewmh:_NET_WM_MOVERESIZE_CANCEL 11)
+;;
+(defclass xcb:ewmh:_NET_WM_MOVERESIZE (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_WM_MOVERESIZE)
+ (x-root :initarg :x-root :type xcb:CARD32)
+ (y-root :initarg :y-root :type xcb:CARD32)
+ (direction :initarg :direction :type xcb:CARD32)
+ (button :initarg :button :type xcb:CARD32)
+ (source-indication :initarg :source-indication :type xcb:CARD32)))
+
+;; _NET_RESTACK_WINDOW
+(defclass xcb:ewmh:_NET_RESTACK_WINDOW (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_RESTACK_WINDOW)
+ (source-indication :initarg :source-indication :type xcb:CARD32)
+ (sibling :initarg :sibling :type xcb:WINDOW)
+ (detail :initarg :detail :type xcb:CARD32)))
+
+;; _NET_REQUEST_FRAME_EXTENTS
+(defclass xcb:ewmh:_NET_REQUEST_FRAME_EXTENTS (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_REQUEST_FRAME_EXTENTS)))
+
+;;;; Application Window Properties
+
+;; _NET_WM_NAME
+(defclass xcb:ewmh:get-_NET_WM_NAME (xcb:ewmh:-GetProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_NAME)))
+(defclass xcb:ewmh:get-_NET_WM_NAME~reply (xcb:ewmh:-GetProperty-utf8~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_NAME (xcb:ewmh:-ChangeProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_NAME)))
+
+;; _NET_WM_VISIBLE_NAME
+(defclass xcb:ewmh:get-_NET_WM_VISIBLE_NAME (xcb:ewmh:-GetProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_VISIBLE_NAME)))
+(defclass xcb:ewmh:get-_NET_WM_VISIBLE_NAME~reply
+ (xcb:ewmh:-GetProperty-utf8~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_VISIBLE_NAME (xcb:ewmh:-ChangeProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_VISIBLE_NAME)))
+
+;; _NET_WM_ICON_NAME
+(defclass xcb:ewmh:get-_NET_WM_ICON_NAME (xcb:ewmh:-GetProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_ICON_NAME)))
+(defclass xcb:ewmh:get-_NET_WM_ICON_NAME~reply
+ (xcb:ewmh:-GetProperty-utf8~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_ICON_NAME (xcb:ewmh:-ChangeProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_ICON_NAME)))
+
+;; _NET_WM_VISIBLE_ICON_NAME
+(defclass xcb:ewmh:get-_NET_WM_VISIBLE_ICON_NAME (xcb:ewmh:-GetProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_VISIBLE_ICON_NAME)))
+(defclass xcb:ewmh:get-_NET_WM_VISIBLE_ICON_NAME~reply
+ (xcb:ewmh:-GetProperty-utf8~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_VISIBLE_ICON_NAME
+ (xcb:ewmh:-ChangeProperty-utf8)
+ ((property :initform xcb:Atom:_NET_WM_VISIBLE_ICON_NAME)))
+
+;; _NET_WM_DESKTOP
+(defclass xcb:ewmh:get-_NET_WM_DESKTOP (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_DESKTOP)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WM_DESKTOP~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_DESKTOP (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_DESKTOP)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:_NET_WM_DESKTOP (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_WM_DESKTOP)
+ (new-desktop :initarg :new-desktop :type xcb:CARD32)
+ (source-indication :initarg :source-indication :type xcb:CARD32)))
+
+;; _NET_WM_WINDOW_TYPE
+(defclass xcb:ewmh:get-_NET_WM_WINDOW_TYPE (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_WM_WINDOW_TYPE)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:ewmh:get-_NET_WM_WINDOW_TYPE~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_WINDOW_TYPE (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_WM_WINDOW_TYPE)
+ (type :initform xcb:Atom:ATOM)))
+
+;; _NET_WM_STATE
+(defconst xcb:ewmh:_NET_WM_STATE_REMOVE 0)
+(defconst xcb:ewmh:_NET_WM_STATE_ADD 1)
+(defconst xcb:ewmh:_NET_WM_STATE_TOGGLE 2)
+;;
+(defclass xcb:ewmh:get-_NET_WM_STATE (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_WM_STATE)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:ewmh:get-_NET_WM_STATE~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_STATE (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_WM_STATE)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:ewmh:_NET_WM_STATE (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:_NET_WM_STATE)
+ (action :initarg :action :type xcb:CARD32)
+ (first-property :initarg :first-property :type xcb:CARD32)
+ (second-property :initarg :second-property :type xcb:CARD32)
+ (source-indication :initarg :source-indication :type xcb:CARD32)))
+
+;; _NET_WM_ALLOWED_ACTIONS
+(defclass xcb:ewmh:get-_NET_WM_ALLOWED_ACTIONS (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_WM_ALLOWED_ACTIONS)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:ewmh:get-_NET_WM_ALLOWED_ACTIONS~reply
+ (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_ALLOWED_ACTIONS (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_WM_ALLOWED_ACTIONS)
+ (type :initform xcb:Atom:ATOM)))
+
+;; _NET_WM_STRUT
+(defclass xcb:ewmh:-_NET_WM_STRUT ()
+ ((left :initarg :left :type xcb:-ignore)
+ (right :initarg :right :type xcb:-ignore)
+ (top :initarg :top :type xcb:-ignore)
+ (bottom :initarg :bottom :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_WM_STRUT (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_WM_STRUT)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 4)))
+(defclass xcb:ewmh:get-_NET_WM_STRUT~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_WM_STRUT)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_STRUT
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_WM_STRUT)
+ ((property :initform xcb:Atom:_NET_WM_STRUT)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_STRUT_PARTIAL
+(defclass xcb:ewmh:-_NET_WM_STRUT_PARTIAL ()
+ ((left :initarg :left :type xcb:-ignore)
+ (right :initarg :right :type xcb:-ignore)
+ (top :initarg :top :type xcb:-ignore)
+ (bottom :initarg bottom :type xcb:-ignore)
+ (left-start-y :initarg :left-start-y :type xcb:-ignore)
+ (left-end-y :initarg :left-end-y :type xcb:-ignore)
+ (right-start-y :initarg :right-start-y :type xcb:-ignore)
+ (right-end-y :initarg :right-end-y :type xcb:-ignore)
+ (top-start-x :initarg :top-start-x :type xcb:-ignore)
+ (top-end-x :initarg :top-end-x :type xcb:-ignore)
+ (bottom-start-x :initarg :bottom-start-x:type xcb:-ignore)
+ (bottom-end-x :initarg :bottom-end-x :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_WM_STRUT_PARTIAL (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_WM_STRUT_PARTIAL)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 12)))
+(defclass xcb:ewmh:get-_NET_WM_STRUT_PARTIAL~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_WM_STRUT_PARTIAL)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_STRUT_PARTIAL
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_WM_STRUT_PARTIAL)
+ ((property :initform xcb:Atom:_NET_WM_STRUT_PARTIAL)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_ICON_GEOMETRY
+(defclass xcb:ewmh:-_NET_WM_ICON_GEOMETRY ()
+ ((x :initarg :x :type xcb:-ignore)
+ (y :initarg :y :type xcb:-ignore)
+ (width :initarg :width :type xcb:-ignore)
+ (height :initarg :height :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_WM_ICON_GEOMETRY (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_WM_ICON_GEOMETRY)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 4)))
+(defclass xcb:ewmh:get-_NET_WM_ICON_GEOMETRY~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_WM_ICON_GEOMETRY)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_ICON_GEOMETRY
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_WM_ICON_GEOMETRY)
+ ((property :initform xcb:Atom:_NET_WM_ICON_GEOMETRY)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_ICON
+(defclass xcb:ewmh:-get-_NET_WM_ICON (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_WM_ICON)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:-get-_NET_WM_ICON~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:-set-_NET_WM_ICON (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_WM_ICON)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_PID
+(defclass xcb:ewmh:get-_NET_WM_PID (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_PID)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WM_PID~reply (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_PID (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_PID)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_HANDLED_ICONS
+(defclass xcb:ewmh:get-_NET_WM_HANDLED_ICONS (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_HANDLED_ICONS)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WM_HANDLED_ICONS~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_HANDLED_ICONS (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_HANDLED_ICONS)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_USER_TIME
+(defclass xcb:ewmh:get-_NET_WM_USER_TIME (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_USER_TIME)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WM_USER_TIME~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_USER_TIME (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_USER_TIME)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_USER_TIME_WINDOW
+(defclass xcb:ewmh:get-_NET_WM_USER_TIME_WINDOW (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_USER_TIME_WINDOW)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WM_USER_TIME_WINDOW~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_USER_TIME_WINDOW
+ (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_USER_TIME_WINDOW)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_FRAME_EXTENTS
+(defclass xcb:ewmh:-_NET_FRAME_EXTENTS ()
+ ((left :initarg :left :type xcb:-ignore)
+ (right :initarg :right :type xcb:-ignore)
+ (top :initarg :top :type xcb:-ignore)
+ (bottom :initarg :bottom :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_FRAME_EXTENTS (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_FRAME_EXTENTS)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 4)))
+(defclass xcb:ewmh:get-_NET_FRAME_EXTENTS~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_FRAME_EXTENTS)
+ nil)
+(defclass xcb:ewmh:set-_NET_FRAME_EXTENTS
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_FRAME_EXTENTS)
+ ((property :initform xcb:Atom:_NET_FRAME_EXTENTS)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_OPAQUE_REGION
+(defclass xcb:ewmh:get-_NET_WM_OPAQUE_REGION (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:_NET_WM_OPAQUE_REGION)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:ewmh:get-_NET_WM_OPAQUE_REGION~reply
+ (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_OPAQUE_REGION (xcb:icccm:-ChangeProperty)
+ ((property :initform xcb:Atom:_NET_WM_OPAQUE_REGION)
+ (type :initform xcb:Atom:ATOM)))
+
+;; _NET_WM_BYPASS_COMPOSITOR
+(defclass xcb:ewmh:get-_NET_WM_BYPASS_COMPOSITOR
+ (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_BYPASS_COMPOSITOR)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:get-_NET_WM_BYPASS_COMPOSITOR~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_BYPASS_COMPOSITOR
+ (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:_NET_WM_BYPASS_COMPOSITOR)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;;;; Window Manager Protocols
+
+;; _NET_WM_PING
+(defclass xcb:ewmh:_NET_WM_PING (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:WM_PROTOCOLS)
+ (protocol :initform xcb:Atom:_NET_WM_PING :type xcb:CARD32)
+ (timestamp :initarg :timestamp :type xcb:CARD32)
+ (client-window :initarg :client-window :type xcb:WINDOW)))
+
+;; _NET_WM_SYNC_REQUEST
+(defclass xcb:ewmh:_NET_WM_SYNC_REQUEST (xcb:ewmh:-ClientMessage)
+ ((type :initform xcb:Atom:WM_PROTOCOLS)
+ (protocol :initform xcb:Atom:_NET_WM_SYNC_REQUEST :type xcb:CARD32)
+ (timestamp :initarg :timestamp :type xcb:CARD32)
+ (low :initarg :low :type xcb:CARD32)
+ (high :initarg :high :type xcb:CARD32)))
+
+;; _NET_WM_SYNC_REQUEST_COUNTER
+(defclass xcb:ewmh:-_NET_WM_SYNC_REQUEST_COUNTER ()
+ ((low :initarg :low :type xcb:-ignore)
+ (high :initarg :hight :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_WM_SYNC_REQUEST_COUNTER
+ (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_WM_SYNC_REQUEST_COUNTER)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 2)))
+(defclass xcb:ewmh:get-_NET_WM_SYNC_REQUEST_COUNTER~reply
+ (xcb:icccm:-GetProperty-explicit~reply
+ xcb:ewmh:-_NET_WM_SYNC_REQUEST_COUNTER)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_SYNC_REQUEST_COUNTER
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_WM_SYNC_REQUEST_COUNTER)
+ ((property :initform xcb:Atom:_NET_WM_SYNC_REQUEST_COUNTER)
+ (type :initform xcb:Atom:CARDINAL)))
+
+;; _NET_WM_FULLSCREEN_MONITORS
+(defclass xcb:ewmh:-_NET_WM_FULLSCREEN_MONITORS ()
+ ((top :initarg :top :type xcb:-ignore)
+ (bottom :initarg :bottom :type xcb:-ignore)
+ (left :initarg :left :type xcb:-ignore)
+ (right :initarg :right :type xcb:-ignore)))
+;;
+(defclass xcb:ewmh:get-_NET_WM_FULLSCREEN_MONITORS
+ (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:_NET_WM_FULLSCREEN_MONITORS)
+ (type :initform xcb:Atom:CARDINAL)
+ (long-length :initform 4)))
+(defclass xcb:ewmh:get-_NET_WM_FULLSCREEN_MONITORS~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:ewmh:-_NET_WM_FULLSCREEN_MONITORS)
+ nil)
+(defclass xcb:ewmh:set-_NET_WM_FULLSCREEN_MONITORS
+ (xcb:icccm:-ChangeProperty-explicit xcb:ewmh:-_NET_WM_FULLSCREEN_MONITORS)
+ ((property :initform xcb:Atom:_NET_WM_FULLSCREEN_MONITORS)
+ (type :initform xcb:Atom:CARDINAL)))
+(defclass xcb:ewmh:_NET_WM_FULLSCREEN_MONITORS
+ (xcb:ewmh:-ClientMessage xcb:ewmh:-_NET_WM_FULLSCREEN_MONITORS)
+ ((type :initform xcb:Atom:_NET_WM_FULLSCREEN_MONITORS)))
+
+;;;; Other Properties
+
+;;;; Misc.
+
+(defconst xcb:ewmh:source-indication:none 0)
+(defconst xcb:ewmh:source-indication:normal 1)
+(defconst xcb:ewmh:source-indication:other 2)
+
+
+
+(provide 'xcb-ewmh)
+
+;;; xcb-ewmh.el ends here
diff --git a/util/xcb-icccm.el b/util/xcb-icccm.el
new file mode 100644
index 0000000..0e96849
--- /dev/null
+++ b/util/xcb-icccm.el
@@ -0,0 +1,542 @@
+;;; xcb-icccm.el --- Inter-Client Communication -*- lexical-binding: t -*-
+;;; Conventions Manual
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <chris.w.f...@gmail.com>
+;; Keywords: unix
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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.
+
+;; This file 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 this file. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implement ICCCM the same way as xcb/util-wm.
+
+;; Usage tips:
+;; + Do not forget to call `xcb:icccm:init' for _every_ connection using
+;; this library.
+;; + Use `xcb:icccm:SendEvent' instead of `xcb:SendEvent' to send client
+;; messages defined in this library.
+
+;; Todo:
+;; + Interned atoms are actually connection-dependent. Currently they are
+;; simply saved as global variables.
+
+;; References:
+;; + ICCCM (http://www.x.org/releases/X11R7.7/doc/xorg-docs/icccm/icccm.txt)
+;; + xcb/util-wm (git://anongit.freedesktop.org/xcb/util-wm)
+
+;;; Code:
+
+(require 'xcb-xproto)
+
+;;;; ICCCM atoms
+
+(defconst xcb:icccm:-atoms
+ '(UTF8_STRING COMPOUND_TEXT TEXT C_STRING
+ WM_PROTOCOLS WM_TAKE_FOCUS WM_DELETE_WINDOW WM_STATE)
+ "Atoms involved in ICCCM.")
+
+(cl-defmethod xcb:icccm:init ((obj xcb:connection))
+ "Initialize ICCCM module.
+
+This method must be called before using any other method in this module."
+ (xcb:icccm:intern-atoms obj xcb:icccm:-atoms))
+
+(cl-defmethod xcb:icccm:intern-atoms ((obj xcb:connection) atoms)
+ "Intern the X atoms listed in the list AOTMS.
+
+The value of these atoms will be available in `xcb:Atom' namespace."
+ (dolist (atom atoms)
+ (let ((name (symbol-name atom))
+ reply)
+ (unless (boundp atom)
+ (setq reply (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:InternAtom
+ :only-if-exists 0
+ :name-len (length name)
+ :name name)))
+ (eval `(defvar ,(intern (concat "xcb:Atom:" name)) ;add prefix
+ (slot-value ,reply 'atom)))))))
+
+;;;; Client message
+
+(defclass xcb:icccm:SendEvent (xcb:SendEvent)
+ ((propagate :initform 0)
+ (event-mask :initform xcb:EventMask:NoEvent))
+ :documentation "A fork of `xcb:SendEvent' to send ICCCM client messages.")
+
+(defclass xcb:icccm:--ClientMessage ()
+ ((data :type xcb:-ignore)) ;shadowed slot
+ :documentation "To shadow the data slot in `xcb:SendEvent'.")
+;;
+(defclass xcb:icccm:-ClientMessage
+ (xcb:icccm:--ClientMessage xcb:ClientMessage)
+ ((format :initform 32)
+ (type :initform xcb:Atom:WM_PROTOCOLS)
+ (protocol :type xcb:ATOM) ;new slot
+ (time :initarg :time :type xcb:TIMESTAMP) ;new slot
+ (pad~0 :initform 12 :type xcb:-pad)) ;new slot
+ :documentation "An ICCCM client message with data slot replaced by
+protocol and time.")
+
+(defclass xcb:icccm:WM_DELETE_WINDOW (xcb:icccm:-ClientMessage)
+ ((protocol :initform xcb:Atom:WM_DELETE_WINDOW)
+ (time :initform xcb:Time:CurrentTime))
+ :documentation "Delete a window using the WM_DELETE_WINDOW client message.")
+
+(defclass xcb:icccm:WM_TAKE_FOCUS (xcb:icccm:-ClientMessage)
+ ((protocol :initform xcb:Atom:WM_TAKE_FOCUS))
+ :documentation "Set a focus using the WM_TAKE_FOCUS client message.
+
+A valid timestamp (rather than `xcb:Time:CurrentTime') must be supplied.")
+
+;;;; Abstract classes for getting/changing (plain) list properties
+
+(defclass xcb:icccm:-GetProperty (xcb:GetProperty)
+ ((delete :initform 0)
+ (long-offset :initform 0)
+ (long-length :initform 1000000000)) ;as long as possible
+ :documentation "Get an ICCCM property (request part).")
+
+(defclass xcb:icccm:-GetProperty~reply (xcb:GetProperty~reply)
+ nil
+ :documentation "Get an ICCCM property (reply part).")
+;;
+(cl-defmethod xcb:unmarshal ((obj xcb:icccm:-GetProperty~reply) byte-array)
+ "Fill in the fields in the reply of ICCCM GetProperty request OBJ
+according to BYTE-ARRAY.
+
+This method automatically format the value as 8, 16 or 32 bits array."
+ (let ((retval (cl-call-next-method obj byte-array))
+ tmp)
+ (with-slots (~lsb length format bytes-after value-len value) obj
+ (if (or (= 0 value-len) (= 0 length))
+ (setf value nil) ;no available value
+ (setq tmp (substring value
+ 0 ;long-offset
+ (- (length value) bytes-after))
+ value nil)
+ (pcase format
+ (8
+ (cl-assert (= value-len (length tmp)))
+ (setf value tmp))
+ (16
+ (cl-assert (= (* 2 value-len) (length tmp)))
+ (if ~lsb
+ (dotimes (i value-len)
+ (setf value (vconcat value
+ (vector (xcb:-unpack-u2-lsb tmp 0))))
+ (setq tmp (substring tmp 2)))
+ (dotimes (i value-len)
+ (setf value (vconcat value
+ (vector (xcb:-unpack-u2 tmp 0))))
+ (setq tmp (substring tmp 2)))))
+ (32
+ (cl-assert (= (* 4 value-len) (length tmp)))
+ (if ~lsb
+ (dotimes (i value-len)
+ (setf value (vconcat value
+ (vector (xcb:-unpack-u4-lsb tmp 0))))
+ (setq tmp (substring tmp 4)))
+ (dotimes (i value-len)
+ (setf value (vconcat value (vector (xcb:-unpack-u4 tmp 0))))
+ (setq tmp (substring tmp 4)))))
+ (_ (cl-assert nil)))))
+ retval))
+
+(defclass xcb:icccm:-ChangeProperty (xcb:ChangeProperty)
+ ((mode :initform xcb:PropMode:Replace)
+ (format :initform 32)
+ (data :initform nil))
+ :documentation "Change an ICCCM property.")
+;;
+(cl-defmethod xcb:marshal ((obj xcb:icccm:-ChangeProperty))
+ "Return the byte-array representation of an ICCCM ChangeProperty request.
+
+This method automatically sets the data length."
+ (with-slots (~lsb format data-len data) obj
+ (setf data-len (length data))
+ (setf data
+ (pcase format
+ (8 data)
+ (16 (mapconcat (lambda (i) (if ~lsb (xcb:-pack-u2-lsb i)
+ (xcb:-pack-u2 i)))
+ data []))
+ (32 (mapconcat (lambda (i) (if ~lsb (xcb:-pack-u4-lsb i)
+ (xcb:-pack-u4 i)))
+ data []))
+ (_ (cl-assert nil)))))
+ (cl-call-next-method obj))
+
+;;;; Abstract classes for getting/changing text properties
+
+(defclass xcb:icccm:-GetProperty-text (xcb:icccm:-GetProperty)
+ ((type :initform xcb:GetPropertyType:Any))
+ :documentation "Get an ICCCM text property (request part).")
+
+(defclass xcb:icccm:-GetProperty-text~reply (xcb:icccm:-GetProperty~reply)
+ nil
+ :documentation "Get an ICCCM text property (reply part).")
+;;
+(cl-defmethod xcb:unmarshal ((obj xcb:icccm:-GetProperty-text~reply)
+ byte-array)
+ "Fill in the fields in the reply of ICCCM GetProperty (text) request OBJ
+according to BYTE-ARRAY.
+
+This method automatically decodes the value (as string)."
+ (let* ((retval (cl-call-next-method obj byte-array)))
+ (with-slots (format type value) obj
+ (when (symbolp type) (setq type (symbol-value type)))
+ (when (and value (= format 8))
+ (setf value
+ (decode-coding-string
+ (apply 'unibyte-string (append value nil))
+ (cond ((eq type xcb:Atom:UTF8_STRING) 'utf-8)
+ ((eq type xcb:Atom:STRING) 'iso-latin-1)
+ ((eq type xcb:Atom:COMPOUND_TEXT)
+ 'compound-text-with-extensions)
+ ((or (eq type xcb:Atom:TEXT) (eq type xcb:Atom:C_STRING))
+ 'no-conversion)
+ (t (error "[XELB:ICCCM] Unsupported encoding: %d"
+ type)))))))
+ retval))
+
+(defclass xcb:icccm:-ChangeProperty-text (xcb:icccm:-ChangeProperty)
+ ((type :initform xcb:Atom:STRING) ;may be changed
+ (format :initform 8))
+ :documentation "Change an ICCCM text property.")
+;;
+(cl-defmethod xcb:marshal ((obj xcb:icccm:-ChangeProperty-text))
+ "Return the byte-array representation of an ICCCM ChangeProperty (text)
+request OBJ.
+
+This method automatically encodes the data (which is a string)."
+ (with-slots (type data) obj
+ (when (symbolp type) (setq type (symbol-value type)))
+ (setf data
+ (vconcat
+ (encode-coding-string
+ data
+ (cond ((eq type xcb:Atom:UTF8_STRING) 'utf-8)
+ ((eq type xcb:Atom:STRING) 'iso-latin-1)
+ ((eq type xcb:Atom:COMPOUND_TEXT)
+ 'compound-text-with-extensions)
+ ((or (eq type xcb:Atom:TEXT) (eq type xcb:Atom:C_STRING))
+ 'no-conversion)
+ (t (error "[XELB:ICCCM] Unsupported encoding: %d" type)))))))
+ (cl-call-next-method obj))
+
+;;;; Abstract classes for getting/changing single field properties
+
+(defclass xcb:icccm:-GetProperty-single (xcb:icccm:-GetProperty)
+ nil
+ :documentation "Get an ICCCM single-valued property (request part).")
+
+(defclass xcb:icccm:-GetProperty-single~reply (xcb:icccm:-GetProperty~reply)
+ nil
+ :documentation "Get a single-valued ICCCM property (reply part).")
+;;
+(cl-defmethod xcb:unmarshal ((obj xcb:icccm:-GetProperty-single~reply)
+ byte-array)
+ "Fill in the fields in the reply of an ICCCM GetProperty (single-valued)
+request OBJ according to BYTE-ARRAY."
+ (let ((retval (cl-call-next-method obj byte-array)))
+ (with-slots (value) obj
+ (when value
+ (cl-assert (= 1 (length value)))
+ (setf value (elt value 0))))
+ retval))
+
+(defclass xcb:icccm:-ChangeProperty-single (xcb:icccm:-ChangeProperty)
+ nil
+ :documentation "Change a single-valued ICCCM property.")
+;;
+(cl-defmethod xcb:marshal ((obj xcb:icccm:-ChangeProperty-single))
+ "Return the byte-array representation of a single-valued ICCCM ChangeProperty
+request OBJ."
+ (with-slots (data) obj
+ (setf data `[,data]))
+ (cl-call-next-method obj))
+
+;;;; Abstract classes for getting/changing property with explicit fields
+
+(defclass xcb:icccm:-GetProperty-explicit (xcb:icccm:-GetProperty)
+ nil
+ :documentation "Get an ICCCM property whose fields are explicitly listed out
+(request part).")
+
+(defclass xcb:icccm:-GetProperty-explicit~reply (xcb:icccm:-GetProperty~reply)
+ nil
+ :documentation "Get an ICCCM property whose fields are explicitly listed out
+(reply part).")
+;;
+(cl-defmethod xcb:unmarshal ((obj xcb:icccm:-GetProperty-explicit~reply)
+ byte-array)
+ "Fill in the reply of an ICCCM GetProperty request whose fields are
+explicitly listed out."
+ (let* ((retval (cl-call-next-method obj byte-array))
+ (slots-orig (eieio-class-slots xcb:icccm:-GetProperty~reply))
+ (slots (eieio-class-slots (eieio-object-class obj)))
+ (slots (nthcdr (length slots-orig) slots))
+ (value (slot-value obj 'value)))
+ (unless value (setq value (make-vector (length slots) nil))) ;fallback
+ ;; Set explicit fields from value field
+ (dotimes (i (length value))
+ (setf (slot-value obj (cl--slot-descriptor-name (elt slots i)))
+ (elt value i)))
+ retval))
+
+(defclass xcb:icccm:-ChangeProperty-explicit (xcb:icccm:-ChangeProperty)
+ ((format :initform 32))
+ :documentation "Change an ICCCM property whose fields are explicitly listed
+out.")
+;;
+(cl-defmethod xcb:marshal ((obj xcb:icccm:-ChangeProperty-explicit))
+ "Return the byte-array representation of an ICCCM ChangeProperty request
+whose fields are explicitly listed out."
+ (let* ((slots-orig (eieio-class-slots xcb:icccm:-ChangeProperty))
+ (slots (eieio-class-slots (eieio-object-class obj)))
+ (slots (nthcdr (length slots-orig) slots)))
+ ;; Set data field from explicit fields
+ (setf (slot-value obj 'data)
+ (mapconcat (lambda (slot)
+ (list (slot-value obj (cl--slot-descriptor-name slot))))
+ slots []))
+ (cl-call-next-method obj)))
+
+;;;; Client Properties
+
+;; WM_NAME
+(defclass xcb:icccm:get-WM_NAME (xcb:icccm:-GetProperty-text)
+ ((property :initform xcb:Atom:WM_NAME)))
+(defclass xcb:icccm:get-WM_NAME~reply (xcb:icccm:-GetProperty-text~reply)
+ nil)
+(defclass xcb:icccm:set-WM_NAME (xcb:icccm:-ChangeProperty-text)
+ ((property :initform xcb:Atom:WM_NAME)))
+
+;; WM_ICON_NAME
+(defclass xcb:icccm:get-WM_ICON_NAME (xcb:icccm:-GetProperty-text)
+ ((property :initform xcb:Atom:WM_ICON_NAME)))
+(defclass xcb:icccm:get-WM_ICON_NAME~reply (xcb:icccm:-GetProperty-text~reply)
+ nil)
+(defclass xcb:icccm:set-WM_ICON_NAME (xcb:icccm:-ChangeProperty-text)
+ ((property :initform xcb:Atom:WM_ICON_NAME)))
+
+;; WM_SIZE_HINTS
+(defconst xcb:icccm:WM_SIZE_HINTS:USPosition 1)
+(defconst xcb:icccm:WM_SIZE_HINTS:USSize 2)
+(defconst xcb:icccm:WM_SIZE_HINTS:PPosition 4)
+(defconst xcb:icccm:WM_SIZE_HINTS:PSize 8)
+(defconst xcb:icccm:WM_SIZE_HINTS:PMinSize 16)
+(defconst xcb:icccm:WM_SIZE_HINTS:PMaxSize 32)
+(defconst xcb:icccm:WM_SIZE_HINTS:PResizeInc 64)
+(defconst xcb:icccm:WM_SIZE_HINTS:PAspect 128)
+(defconst xcb:icccm:WM_SIZE_HINTS:PBaseSize 256)
+(defconst xcb:icccm:WM_SIZE_HINTS:PWinGravity 512)
+;;
+(defclass xcb:icccm:-WM_SIZE_HINTS ()
+ ((flags :initarg :flags :initform 0 :type xcb:-ignore)
+ (x :initarg :x :initform 0 :type xcb:-ignore)
+ (y :initarg :y :initform 0 :type xcb:-ignore)
+ (width :initarg :width :initform 0 :type xcb:-ignore)
+ (height :initarg :height :initform 0 :type xcb:-ignore)
+ (min-width :initarg :min-width :initform 0 :type xcb:-ignore)
+ (min-height :initarg :min-height :initform 0 :type xcb:-ignore)
+ (max-width :initarg :max-width :initform 0 :type xcb:-ignore)
+ (max-height :initarg :max-height :initform 0 :type xcb:-ignore)
+ (width-inc :initarg :width-inc :initform 0 :type xcb:-ignore)
+ (height-inc :initarg :height-inc :initform 0 :type xcb:-ignore)
+ (min-aspect-num :initarg :min-aspect-num :initform 0 :type xcb:-ignore)
+ (min-aspect-den :initarg :min-aspect-den :initform 0 :type xcb:-ignore)
+ (max-aspect-num :initarg :max-aspect-num :initform 0 :type xcb:-ignore)
+ (max-aspect-den :initarg :max-aspect-den :initform 0 :type xcb:-ignore)
+ (base-width :initarg :base-width :initform 0 :type xcb:-ignore)
+ (base-height :initarg :base-height :initform 0 :type xcb:-ignore)
+ (win-gravity :initarg :win-gravity :initform 0 :type xcb:-ignore)))
+;;
+(defclass xcb:icccm:get-WM_SIZE_HINTS (xcb:icccm:-GetProperty-explicit)
+ ((type :initform xcb:Atom:WM_SIZE_HINTS)
+ (long-length :initform 18))) ;fixed
+(defclass xcb:icccm:get-WM_SIZE_HINTS~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:icccm:-WM_SIZE_HINTS)
+ nil)
+(defclass xcb:icccm:set-WM_SIZE_HINTS
+ (xcb:icccm:-ChangeProperty-explicit xcb:icccm:-WM_SIZE_HINTS)
+ ((type :initform xcb:Atom:WM_SIZE_HINTS)))
+
+;; WM_NORMAL_HINTS
+(defclass xcb:icccm:get-WM_NORMAL_HINTS (xcb:icccm:get-WM_SIZE_HINTS)
+ ((property :initform xcb:Atom:WM_NORMAL_HINTS)))
+(defclass xcb:icccm:get-WM_NORMAL_HINTS~reply
+ (xcb:icccm:get-WM_SIZE_HINTS~reply)
+ nil)
+(defclass xcb:icccm:set-WM_NORMAL_HINTS (xcb:icccm:set-WM_SIZE_HINTS)
+ ((property :initform xcb:Atom:WM_NORMAL_HINTS)))
+
+;; WM_HINTS
+(defconst xcb:icccm:WM_HINTS:InputHint 1)
+(defconst xcb:icccm:WM_HINTS:StateHint 2)
+(defconst xcb:icccm:WM_HINTS:IconPixmapHint 4)
+(defconst xcb:icccm:WM_HINTS:IconWindowHint 8)
+(defconst xcb:icccm:WM_HINTS:IconPositionHint 16)
+(defconst xcb:icccm:WM_HINTS:IconMaskHint 32)
+(defconst xcb:icccm:WM_HINTS:WindowGroupHint 64)
+(defconst xcb:icccm:WM_HINTS:MessageHint 128)
+(defconst xcb:icccm:WM_HINTS:UrgencyHint 256)
+;;
+(defclass xcb:icccm:-WM_HINTS ()
+ ((flags :initarg :flags :initform 0 :type xcb:-ignore)
+ (input :initarg :input :initform 0 :type xcb:-ignore)
+ (initial-state :initarg :initial-state :initform 0 :type xcb:-ignore)
+ (icon-pixmap :initarg :icon-pixmap :initform 0 :type xcb:-ignore)
+ (icon-window :initarg :icon-window :initform 0 :type xcb:-ignore)
+ (icon-x :initarg :icon-x :initform 0 :type xcb:-ignore)
+ (icon-y :initarg :icon-y :initform 0 :type xcb:-ignore)
+ (icon-mask :initarg :icon-mask :initform 0 :type xcb:-ignore)
+ (window-group :initarg :window-group :initform 0 :type xcb:-ignore)))
+;;
+(defclass xcb:icccm:get-WM_HINTS (xcb:icccm:-GetProperty-explicit)
+ ;; (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:WM_HINTS)
+ (type :initform xcb:Atom:WM_HINTS)
+ (long-length :initform 9))) ;fixed
+(defclass xcb:icccm:get-WM_HINTS~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:icccm:-WM_HINTS)
+ nil)
+(defclass xcb:icccm:set-WM_HINTS
+ (xcb:icccm:-ChangeProperty-explicit xcb:icccm:-WM_HINTS)
+ ((property :initform xcb:Atom:WM_HINTS)
+ (type :initform xcb:Atom:WM_HINTS)))
+
+;; WM_CLASS
+(defclass xcb:icccm:get-WM_CLASS (xcb:icccm:-GetProperty-text)
+ ((property :initform xcb:Atom:WM_CLASS)
+ (type :initform xcb:Atom:STRING)))
+(defclass xcb:icccm:get-WM_CLASS~reply (xcb:icccm:-GetProperty-text~reply)
+ ((instance-name :type xcb:-ignore)
+ (class-name :type xcb:-ignore)))
+;;
+(cl-defmethod xcb:unmarshal ((obj xcb:icccm:get-WM_CLASS~reply) byte-array)
+ ;; Split value into instance & class names
+ (let* ((retval (cl-call-next-method obj byte-array))
+ (tmp (slot-value obj 'value))
+ (tmp (if tmp (split-string tmp "\0" t) '(nil nil))))
+ (with-slots (instance-name class-name) obj
+ (setf instance-name (car tmp)
+ class-name (cadr tmp)))
+ retval))
+;;
+(defclass xcb:icccm:set-WM_CLASS (xcb:icccm:-ChangeProperty-text)
+ ((property :initform xcb:Atom:WM_CLASS)
+ (type :initform xcb:Atom:STRING)
+ (instance-name :initarg :instance-name :type xcb:-ignore)
+ (class-name :initarg :class-name :type xcb:-ignore)))
+;;
+(cl-defmethod xcb:marshal ((obj xcb:icccm:set-WM_CLASS))
+ (with-slots (data instance-name class-name) obj
+ (setf data (concat instance-name "\0" class-name "\0")))
+ (cl-call-next-method obj))
+
+;; WM_TRANSIENT_FOR
+(defclass xcb:icccm:get-WM_TRANSIENT_FOR (xcb:icccm:-GetProperty-single)
+ ((property :initform xcb:Atom:WM_TRANSIENT_FOR)
+ (type :initform xcb:Atom:WINDOW)
+ (long-length :initform 1)))
+(defclass xcb:icccm:get-WM_TRANSIENT_FOR~reply
+ (xcb:icccm:-GetProperty-single~reply)
+ nil)
+(defclass xcb:icccm:set-WM_TRANSIENT_FOR (xcb:icccm:-ChangeProperty-single)
+ ((property :initform xcb:Atom:WM_TRANSIENT_FOR)))
+
+;; WM_PROTOCOLS
+(defclass xcb:icccm:get-WM_PROTOCOLS (xcb:icccm:-GetProperty)
+ ((property :initform xcb:Atom:WM_PROTOCOLS)
+ (type :initform xcb:Atom:ATOM)))
+(defclass xcb:icccm:get-WM_PROTOCOLS~reply (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:icccm:set-WM_PROTOCOLS (xcb:icccm:-ChangeProperty)
+ ((type :initform xcb:Atom:ATOM)
+ (format :initform 32)))
+
+;; WM_COLORMAP_WINDOWS
+(defclass xcb:icccm:get-WM_COLORMAP_WINDOWS (xcb:icccm:-GetProperty)
+ ((type :initform xcb:Atom:WINDOW)))
+(defclass xcb:icccm:get-WM_COLORMAP_WINDOWS~reply
+ (xcb:icccm:-GetProperty~reply)
+ nil)
+(defclass xcb:icccm:set-WM_COLORMAP_WINDOWS (xcb:icccm:-ChangeProperty)
+ ((type :initform xcb:Atom:WINDOW)
+ (format :initform 32)))
+
+;; WM_CLIENT_MACHINE
+(defclass xcb:icccm:get-WM_CLIENT_MACHINE (xcb:icccm:-GetProperty-text)
+ ((property :initform xcb:Atom:WM_CLIENT_MACHINE)))
+(defclass xcb:icccm:get-WM_CLIENT_MACHINE~reply
+ (xcb:icccm:-GetProperty-text~reply)
+ nil)
+(defclass xcb:icccm:set-WM_CLIENT_MACHINE (xcb:icccm:-ChangeProperty-text)
+ ((property :initform xcb:Atom:WM_CLIENT_MACHINE)))
+
+;;;; Window Manager Properties
+
+;; WM_STATE
+(defconst xcb:icccm:WM_STATE:WithdrawnState 0)
+(defconst xcb:icccm:WM_STATE:NormalState 1)
+(defconst xcb:icccm:WM_STATE:IconicState 3)
+;;
+(defclass xcb:icccm:-WM_STATE ()
+ ((state :initarg :state :type xcb:-ignore)
+ (icon :initarg :icon :type xcb:-ignore)))
+;;
+(defclass xcb:icccm:get-WM_STATE (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:WM_STATE)
+ (type :initform xcb:Atom:WM_STATE)
+ (long-length :initform 2)))
+(defclass xcb:icccm:get-WM_STATE~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:icccm:-WM_STATE)
+ nil)
+(defclass xcb:icccm:set-WM_STATE
+ (xcb:icccm:-ChangeProperty-explicit xcb:icccm:-WM_STATE)
+ ((property :initform xcb:Atom:WM_STATE)
+ (type :initform xcb:Atom:WM_STATE)))
+
+;; WM_ICON_SIZE
+(defclass xcb:icccm:-WM_ICON_SIZE ()
+ ((min-width :initarg :min-width :type xcb:-ignore)
+ (min-height :initarg :min-height :type xcb:-ignore)
+ (max-width :initarg :max-width :type xcb:-ignore)
+ (max-height :initarg :max-height :type xcb:-ignore)
+ (width-inc :initarg :width-inc :type xcb:-ignore)
+ (height-inc :initarg :height-inc :type xcb:-ignore)))
+;;
+(defclass xcb:icccm:get-WM_ICON_SIZE (xcb:icccm:-GetProperty-explicit)
+ ((property :initform xcb:Atom:WM_ICON_SIZE)
+ (type :initform xcb:Atom:WM_ICON_SIZE)
+ (long-length :initform 6)))
+(defclass xcb:icccm:get-WM_ICON_SIZE~reply
+ (xcb:icccm:-GetProperty-explicit~reply xcb:icccm:-WM_ICON_SIZE)
+ nil)
+(defclass xcb:icccm:set-WM_ICON_SIZE
+ (xcb:icccm:-ChangeProperty-explicit xcb:icccm:-WM_ICON_SIZE)
+ ((property :initform xcb:Atom:WM_ICON_SIZE)
+ (type :initform xcb:Atom:WM_ICON_SIZE)))
+
+
+
+(provide 'xcb-icccm)
+
+;;; xcb-icccm.el ends here
diff --git a/util/xcb-keysyms.el b/util/xcb-keysyms.el
new file mode 100644
index 0000000..7f9e5e5
--- /dev/null
+++ b/util/xcb-keysyms.el
@@ -0,0 +1,326 @@
+;;; xcb-keysyms.el --- Conversion between -*- lexical-binding: t -*-
+;;; X keysyms, X keycodes and Emacs key event.
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <chris.w.f...@gmail.com>
+;; Keywords: unix
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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.
+
+;; This file 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 this file. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library mainly deals with the conversion between X keycodes, X keysyms
+;; and Emacs key events, roughly corresponding to the xcb/util-keysyms project.
+
+;; Usage tips:
+;; + Do not forget to call `xcb:keysyms:init' for _every_ connection using
+;; this library.
+;; + xcb:keysyms:*-mask correctly relate Emacs modifier keys to X ones,
+;; thus shall be used in preference to 'xcb:ModMask:*' or
+;; 'xcb:KeyButMask:Mod*'.
+
+;; Todo:
+;; + Is xcb:ModMask:Control/xcb:ModMask:Shift always equivalent to
+;; control/shift in Emacs?
+
+;; References:
+;; + X protocol (http://www.x.org/releases/X11R7.7/doc/xproto/x11protocol.txt)
+;; + xcb/util-keysyms (git://anongit.freedesktop.org/xcb/util-keysyms)
+
+;;; Code:
+
+(require 'xcb)
+
+(defvar xcb:keysyms:meta-mask nil "META key mask.")
+(defvar xcb:keysyms:control-mask xcb:ModMask:Control "CONTROL key mask.")
+(defvar xcb:keysyms:shift-mask xcb:ModMask:Shift "SHIFT key mask.")
+(defvar xcb:keysyms:hyper-mask nil "HYPER key mask.")
+(defvar xcb:keysyms:super-mask nil "SUPER key mask.")
+(defvar xcb:keysyms:alt-mask nil "ALT key mask.")
+(defvar xcb:keysyms:lock-mask xcb:ModMask:Lock "LOCK key mask.")
+(defvar xcb:keysyms:num-lock-mask nil "NUM LOCK key mask.")
+(defvar xcb:keysyms:mode-switch-mask nil "MODE SWITCH key mask.")
+
+(cl-defmethod xcb:keysyms:init ((obj xcb:connection))
+ "Initialize keysyms module.
+
+This method must be called before using any other method in this module."
+ (with-slots (min-keycode max-keycode) (xcb:get-setup obj)
+ (xcb:keysyms:update-keyboard-mapping obj
+ min-keycode
+ (1+ (- max-keycode min-keycode)))
+ (unless xcb:keysyms:meta-mask ;avoid duplicated initialization
+ (xcb:keysyms:update-modifier-mapping obj))))
+
+(cl-defmethod xcb:keysyms:update-keyboard-mapping ((obj xcb:connection)
+ first-keycode count)
+ "Update keyboard mapping (from FIRST-KEYCODE to FIRST-KEYCODE + COUNT - 1)."
+ (let* ((reply (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:GetKeyboardMapping
+ :first-keycode first-keycode :count count)))
+ (keysyms-per-keycode (slot-value reply 'keysyms-per-keycode))
+ (keysyms (slot-value reply 'keysyms))
+ (result (plist-get (slot-value obj 'extra-plist) 'keysyms))
+ keycode index row-index keysym)
+ (dotimes (i count)
+ (setq keycode (+ i first-keycode)
+ index (* i keysyms-per-keycode)
+ row-index 0)
+ (setq keysym (nth (+ index row-index) keysyms))
+ (setq result (assq-delete-all keycode result))
+ (while (and (/= keysym 0) (< row-index keysyms-per-keycode))
+ (setq result (append result `((,keycode . ,keysym)))
+ row-index (1+ row-index)
+ keysym (nth (+ index row-index) keysyms))))
+ (setf (slot-value obj 'extra-plist)
+ (plist-put (slot-value obj 'extra-plist) 'keysyms result))))
+
+(cl-defmethod xcb:keysyms:update-modifier-mapping ((obj xcb:connection))
+ "Differentiate xcb:ModMask:1 ~ xcb:ModMask:5."
+ ;; Determine MODE SWITCH and NUM LOCK
+ (let* ((reply (xcb:+request-unchecked+reply obj
+ (make-instance 'xcb:GetModifierMapping)))
+ (keycodes-per-modifier (slot-value reply 'keycodes-per-modifier))
+ (keycodes (slot-value reply 'keycodes))
+ (mode-masks (list xcb:ModMask:Shift xcb:ModMask:Lock
+ xcb:ModMask:Control xcb:ModMask:1 xcb:ModMask:2
+ xcb:ModMask:3 xcb:ModMask:4 xcb:ModMask:5))
+ events keycode keysym)
+ (setq xcb:keysyms:mode-switch-mask nil
+ xcb:keysyms:num-lock-mask nil)
+ (cl-assert (= (length keycodes) (* 8 keycodes-per-modifier)))
+ (dotimes (i 8)
+ (setq events nil)
+ (dotimes (j keycodes-per-modifier)
+ (when (and (/= (setq keycode (pop keycodes)) 0)
+ (setq keysym (xcb:keysyms:keycode->keysym obj keycode 0)))
+ (setq events
+ (nconc events
+ (list (xcb:keysyms:keysym->event keysym nil t))))))
+ (cond ((memq 'mode-switch* events)
+ (setq xcb:keysyms:mode-switch-mask (elt mode-masks i)))
+ ((memq 'kp-numlock events)
+ (setq xcb:keysyms:num-lock-mask (elt mode-masks i))))))
+ ;; Determine remaining keys
+ (let* ((frame (unless (frame-parameter nil 'window-id)
+ (catch 'break
+ (dolist (i (frame-list))
+ (when (frame-parameter i 'window-id)
+ (throw 'break i))))))
+ (id (string-to-int (frame-parameter frame 'window-id)))
+ (root
+ (slot-value (car (slot-value (xcb:get-setup obj) 'roots)) 'root))
+ (keycode (xcb:keysyms:keysym->keycode obj ?a))
+ (fake-event (make-instance 'xcb:SendEvent
+ :propagate 0 :destination id
+ :event-mask xcb:EventMask:NoEvent
+ :event nil))
+ (key-press (make-instance 'xcb:KeyPress
+ :detail keycode :time xcb:Time:CurrentTime
+ :root root :event id :child 0
+ :root-x 0 :root-y 0 :event-x 0 :event-y 0
+ :state nil :same-screen 1))
+ event)
+ (dolist (i (list xcb:ModMask:1 xcb:ModMask:2 xcb:ModMask:3
+ xcb:ModMask:4 xcb:ModMask:5))
+ (unless (or (equal i xcb:keysyms:mode-switch-mask) ;already determined
+ (equal i xcb:keysyms:num-lock-mask))
+ (setf (slot-value key-press 'state) i
+ (slot-value fake-event 'event) (xcb:marshal key-press obj))
+ (run-with-idle-timer 0 nil (lambda ()
+ (xcb:+request obj fake-event)
+ (xcb:flush obj)))
+ (catch 'break
+ (with-timeout (1) ;FIXME
+ (while t
+ (setq event (read-event))
+ (when (and (integerp event) (= ?a (event-basic-type event)))
+ (pcase event
+ (?\M-a (setq xcb:keysyms:meta-mask i))
+ (?\A-a (setq xcb:keysyms:alt-mask i))
+ (?\s-a (setq xcb:keysyms:super-mask i))
+ (?\H-a (setq xcb:keysyms:hyper-mask i)))
+ (throw 'break nil)))))))))
+
+(cl-defmethod xcb:keysyms:keycode->keysym ((obj xcb:connection)
+ keycode modifiers)
+ "Get the keysym from KeyPress event
+
+SHIFT LOCK is ignored."
+ (let* ((keysyms (plist-get (slot-value obj 'extra-plist) 'keysyms))
+ (group (delq nil (mapcar (lambda (i)
+ (when (= keycode (car i)) (cdr i)))
+ keysyms)))
+ (group (pcase (length group)
+ (1 (append group '(0) group '(0)))
+ (2 (append group group))
+ (3 (append group '(0)))
+ (_
+ (list (elt group 0) (elt group 1)
+ (elt group 2) (elt group 3)))))
+ (group (if (and xcb:keysyms:mode-switch-mask ;not initialized
+ (/= 0
+ (logand modifiers xcb:keysyms:mode-switch-mask)))
+ (cddr group) (list (elt group 0) (elt group 1))))
+ (mask (logior (if (= 0 (logand modifiers xcb:keysyms:shift-mask)) 0 1)
+ (if (= 0 (logand modifiers xcb:keysyms:lock-mask))
+ 0 2))))
+ (if (and xcb:keysyms:num-lock-mask ;not initialized
+ (/= 0 (logand modifiers xcb:keysyms:num-lock-mask))
+ (<= #xff80 (elt group 1)) (>= #xffbe (elt group 1))) ;keypad
+ (if (= mask 1) (elt group 0) (elt group 1))
+ (pcase mask
+ (0 (elt group 0)) ;SHIFT off, CAPS LOCK off
+ (1 (elt group 1)) ;SHIFT on, CAPS LOCK off
+ (2 (upcase (elt group 0))) ;SHIFT off, CAPS LOCK on
+ (3 (upcase (elt group 1))))))) ;SHIFT on, CAPS LOCK on
+
+(cl-defmethod xcb:keysyms:keysym->keycode ((obj xcb:connection) keysym)
+ "Convert X keysym to (first match) keycode"
+ (car (rassoc keysym (plist-get (slot-value obj 'extra-plist) 'keysyms))))
+
+;; This list is largely base on 'lispy_function_keys' in 'keyboard.c'.
+;; Emacs has a built-in variable `x-keysym-table' providing Latin-1 and legacy
+;; keysyms, which seems not very useful here.
+;; FIXME: shall we also include 'iso_lispy_function_keys' there?
+(defconst xcb:keysyms:-function-keys
+ `( ;#xff00 - #xff0f
+ ,@(make-list 8 nil) backspace tab linefeed clear nil return nil nil
+ ;#xff10 - #xff1f
+ nil nil nil pause nil nil nil nil nil nil nil escape nil nil nil nil
+ ;#xff20 - #xff2f
+ nil kanji muhenkan henkan romaji hiragana katakana hiragana-katakana
+ zenkaku hankaku zenkaku-hankaku touroku massyo kana-lock kana-shift
+ eisu-shift
+ ;#xff30 - #xff3f
+ eisu-toggle ,@(make-list 15 nil)
+ ;#xff40 - #xff4f
+ ,@(make-list 16 nil)
+ ;#xff50 - #xff5f
+ home left up right down prior next end begin ,@(make-list 7 nil)
+ ;#xff60 - #xff6f
+ select print execute insert nil undo redo menu find cancel help break
+ nil nil nil nil
+ ;#xff70 - #xff7f
+ ;; nil nil nil nil backtab ,@(make-list 10 nil) kp-numlock
+ nil nil nil nil backtab ,@(make-list 9 nil) mode-switch* kp-numlock
+ ;#xff80 - #xff8f
+ kp-space ,@(make-list 8 nil) kp-tab nil nil nil kp-enter nil nil
+ ;#xff90 - #xff9f
+ nil kp-f1 kp-f2 kp-f3 kp-f4 kp-home kp-left kp-up kp-right kp-down
+ kp-prior kp-next kp-end kp-begin kp-insert kp-delete
+ ;#xffa0 - #xffaf
+ ,@(make-list 10 nil)
+ kp-multiply kp-add kp-separator kp-subtract kp-decimal kp-divide
+ ;#xffb0 - #xffbf
+ kp-0 kp-1 kp-2 kp-3 kp-4 kp-5 kp-6 kp-7 kp-8 kp-9 nil nil nil kp-equal
+ f1 f2
+ ;#xffc0 - #xffcf
+ f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18
+ ;#xffd0 - #xffdf
+ f19 f20 f21 f22 f23 f24 f25 f26 f27 f28 f29 f30 f31 f32 f33 f34
+ ;#xffe0 - #xffef
+ ;; f35 ,@(make-list 15 nil)
+ f35 lshift* rshift* lcontrol* rcontrol* caps-lock* shift-lock*
+ lmeta* rmeta* lalt* ralt* lsuper* rsuper* lhyper* rhyper*
+ ;#xff00 - #xffff
+ ,@(make-list 15 nil) delete)
+ "Emacs event representations of X function keys (keysym #xff00 to #xffff)")
+
+(defun xcb:keysyms:event->keysym (event)
+ "Translate Emacs key event to X Keysym.
+
+This function returns nil when it fails to convert an event."
+ (let ((modifiers (event-modifiers event))
+ (event (event-basic-type event))
+ keysym)
+ (if (not (integerp event))
+ (setq keysym
+ (pcase event
+ (`mouse-1 xcb:ButtonIndex:1)
+ (`mouse-2 xcb:ButtonIndex:2)
+ (`mouse-3 xcb:ButtonIndex:3)
+ (`mouse-4 xcb:ButtonIndex:4)
+ (`mouse-5 xcb:ButtonIndex:5)
+ ;; Function keys
+ (_ (cl-position event xcb:keysyms:-function-keys))))
+ (if (and (<= #x20 event) (>= #xff event)) ;Latin-1
+ (setq keysym event)
+ (when (and (<= #x100 event) (>= #x10ffff event)) ;Unicode
+ (setq keysym (+ #x1000000 event)))))
+ (when keysym
+ (when (and (not (integerp event)) (< 5 keysym))
+ (setq keysym (logior keysym #xff00)))
+ `(,keysym
+ ;; state for KeyPress event
+ ,(apply 'logior
+ (mapcar (lambda (i)
+ (pcase i
+ (`meta xcb:keysyms:meta-mask)
+ (`control xcb:keysyms:control-mask)
+ (`shift xcb:keysyms:shift-mask)
+ (`hyper xcb:keysyms:hyper-mask)
+ (`super xcb:keysyms:super-mask)
+ (`alt xcb:keysyms:alt-mask)
+ (`down 0)
+ ;; FIXME: more?
+ (_ 0)))
+ modifiers))))))
+
+(defun xcb:keysyms:keysym->event (keysym &optional mask allow-modifiers)
+ "Translate X Keysym into Emacs key event."
+ (let ((event (cond ((and (<= #x20 keysym) (>= #xff keysym))
+ keysym)
+ ((and (<= #xff00 keysym) (>= #xffff keysym))
+ (elt xcb:keysyms:-function-keys (logand keysym #xff)))
+ ((and (<= #x1000100 keysym) (>= #x110ffff keysym))
+ (- keysym #x1000000))
+ ((and (<= 1 keysym) (>= 5 keysym)) ;ButtonPress assuemd
+ (intern-soft (format "down-mouse-%d" keysym))))))
+ (when (and (not allow-modifiers)
+ (memq event
+ '(lshift* rshift* lcontrol* rcontrol*
+ caps-lock* shift-lock* lmeta* rmeta* lalt* ralt*
+ lsuper* rsuper* lhyper* rhyper*
+ mode-switch* kp-numlock)))
+ (setq event nil))
+ (when event
+ (if (not mask)
+ event
+ (setq event (list event))
+ (when (/= 0 (logand mask xcb:keysyms:meta-mask))
+ (push 'meta event))
+ (when (/= 0 (logand mask xcb:keysyms:control-mask))
+ (push 'control event))
+ (when (and (/= 0 (logand mask xcb:keysyms:shift-mask))
+ ;; Emacs only set shift bit for letters
+ (integerp (car (last event)))
+ (<= ?A (car (last event))) (>= ?Z (car (last event))))
+ (push 'shift event))
+ (when (and xcb:keysyms:hyper-mask
+ (/= 0 (logand mask xcb:keysyms:hyper-mask)))
+ (push 'hyper event))
+ (when (/= 0 (logand mask xcb:keysyms:super-mask))
+ (push 'super event))
+ (when (and xcb:keysyms:alt-mask
+ (/= 0 (logand mask xcb:keysyms:alt-mask)))
+ (push 'alt event))
+ (event-convert-list event)))))
+
+(provide 'xcb-keysyms)
+
+;;; xcb-keysyms.el ends here
diff --git a/util/xcb-xim.el b/util/xcb-xim.el
new file mode 100644
index 0000000..2678990
--- /dev/null
+++ b/util/xcb-xim.el
@@ -0,0 +1,1026 @@
+;;; xcb-xim.el --- XIM Protocol -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <chris.w.f...@gmail.com>
+;; Keywords: unix
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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.
+
+;; This file 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 this file. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements the X Input Method Protocol.
+
+;; Please note that the byte order of an XIM packet can be different from that
+;; of X packets. Moreover, if you are writing an XIM server, the byte order is
+;; actually specified by the client. Therefore we provide a different global
+;; variable `xim:lsb' to indicate the byte order of classes in this library.
+;; You should let-bind it whenever creating new objects.
+
+;; Todo:
+;; + Add extension support.
+
+;; References:
+;; + XIM (http://www.x.org/releases/X11R7.7/doc/libX11/XIM/xim.txt)
+
+;;; Code:
+
+(require 'xcb-types)
+(require 'xcb-xlib)
+
+;;;; Protocol number
+
+(defconst xim:opcode:connect 1)
+(defconst xim:opcode:connect-reply 2)
+(defconst xim:opcode:disconnect 3)
+(defconst xim:opcode:disconnect-reply 4)
+
+(defconst xim:opcode:auth-required 10)
+(defconst xim:opcode:auth-reply 11)
+(defconst xim:opcode:auth-next 12)
+(defconst xim:opcode:auth-setup 13)
+(defconst xim:opcode:auth-ng 14)
+
+(defconst xim:opcode:error 20)
+
+(defconst xim:opcode:open 30)
+(defconst xim:opcode:open-reply 31)
+(defconst xim:opcode:close 32)
+(defconst xim:opcode:close-reply 33)
+(defconst xim:opcode:register-triggerkeys 34)
+(defconst xim:opcode:trigger-notify 35)
+(defconst xim:opcode:trigger-notify-reply 36)
+(defconst xim:opcode:set-event-mask 37)
+(defconst xim:opcode:encoding-negotiation 38)
+(defconst xim:opcode:encoding-negotiation-reply 39)
+(defconst xim:opcode:query-extension 40)
+(defconst xim:opcode:query-extension-reply 41)
+(defconst xim:opcode:set-im-values 42)
+(defconst xim:opcode:set-im-values-reply 43)
+(defconst xim:opcode:get-im-values 44)
+(defconst xim:opcode:get-im-values-reply 45)
+
+(defconst xim:opcode:create-ic 50)
+(defconst xim:opcode:create-ic-reply 51)
+(defconst xim:opcode:destroy-ic 52)
+(defconst xim:opcode:destroy-ic-reply 53)
+(defconst xim:opcode:set-ic-values 54)
+(defconst xim:opcode:set-ic-values-reply 55)
+(defconst xim:opcode:get-ic-values 56)
+(defconst xim:opcode:get-ic-values-reply 57)
+(defconst xim:opcode:set-ic-focus 58)
+(defconst xim:opcode:unset-ic-focus 59)
+(defconst xim:opcode:forward-event 60)
+(defconst xim:opcode:sync 61)
+(defconst xim:opcode:sync-reply 62)
+(defconst xim:opcode:commit 63)
+(defconst xim:opcode:reset-ic 64)
+(defconst xim:opcode:reset-ic-reply 65)
+
+(defconst xim:opcode:geometry 70)
+(defconst xim:opcode:str-conversion 71)
+(defconst xim:opcode:str-conversion-reply 72)
+(defconst xim:opcode:preedit-start 73)
+(defconst xim:opcode:preedit-start-reply 74)
+(defconst xim:opcode:preedit-draw 75)
+(defconst xim:opcode:preedit-caret 76)
+(defconst xim:opcode:preedit-caret-reply 77)
+(defconst xim:opcode:preedit-done 78)
+(defconst xim:opcode:status-start 79)
+(defconst xim:opcode:status-draw 80)
+(defconst xim:opcode:status-done 81)
+(defconst xim:opcode:preeditstate 82)
+
+;;;; Basic requests packet format
+
+(defvar xim:lsb xcb:lsb "t for LSB first, nil otherwise.
+
+Consider let-bind it rather than change its global value.")
+
+(defclass xim:-struct (xcb:-struct)
+ ((~lsb :initform (symbol-value 'xim:lsb))
+ (~auto-padding :initform nil)) ;disable auto padding
+ :documentation "Struct type for XIM.")
+
+(defclass xim:-request (xim:-struct)
+ ((~major-opcode :type xcb:CARD8)
+ (~minor-opcode :initform 0 :type xcb:CARD8)
+ (~length :initform 0 :type xcb:CARD16))
+ :documentation "XIM request type.")
+
+(cl-defmethod xcb:marshal ((obj xim:-request))
+ "Return the byte-array representation of XIM request OBJ."
+ (let ((result (cl-call-next-method obj)))
+ (vconcat (substring result 0 2)
+ (funcall (if (slot-value obj '~lsb)
+ 'xcb:-pack-u2-lsb
+ 'xcb:-pack-u2)
+ (1- (/ (length result) 4)))
+ (substring result 4))))
+
+;;;; Data types
+
+(xcb:deftypealias 'xim:BITMASK16 'xcb:CARD16)
+
+(xcb:deftypealias 'xim:BITMASK32 'xcb:CARD32)
+
+(defsubst xim:PADDING (N)
+ (% (- 4 (% N 4)) 4))
+
+(xcb:deftypealias 'xim:LPCE 'xcb:char)
+
+(defclass xim:STRING (xim:-struct)
+ ((length :initarg :length :type xcb:-u2)
+ (string :initarg :string :type xcb:-ignore)
+ (string~ :initform '(name string type xim:LPCE
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+(defclass xim:STR (xim:-struct)
+ ((length :initarg :length :type xcb:-u1)
+ (name :initarg :name :type xcb:-ignore)
+ (name~ :initform '(name name type xcb:char size (xcb:-fieldref 'length))
+ :type xcb:-list)))
+
+(defclass xim:XIMATTR (xim:-struct)
+ ((id :initarg :id :type xcb:CARD16)
+ (type :initarg :type :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (attribute :initarg :attribute :type xcb:-ignore)
+ (attribute~ :initform '(name attribute type xcb:char
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+(defclass xim:XICATTR (xim:XIMATTR)
+ nil)
+
+(defconst xim:ATTRIBUTE-VALUE-TYPE:separator-of-nestedlist 0)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:byte-data 1)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:word-data 2)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:long-data 3)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:char-data 4)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:window 5)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:xim-styles 10)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:x-rectangle 11)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:x-point 12)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:x-font-set 13)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:xim-hot-key-triggers 15)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:xim-string-conversion 17)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:xim-preedit-state 18)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:xim-reset-state 19)
+(defconst xim:ATTRIBUTE-VALUE-TYPE:xim-nested-list #x7FFF)
+
+(defclass xim:XIMStyles (xim:-struct)
+ ((number :initarg :number :type xcb:-u2)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (styles :initarg :styles :type xcb:-ignore)
+ (styles~ :initform '(name styles type xcb:CARD32
+ size (/ (xcb:-fieldref 'number) 4))
+ :type xcb:-list)))
+
+;; Auto set the number slot
+(cl-defmethod xcb:marshal ((obj xim:XIMStyles))
+ (setf (slot-value obj 'number) (* 4 (length (slot-value obj 'styles))))
+ (cl-call-next-method obj))
+
+(defclass xim:XFontSet (xim:-struct)
+ ((length :initarg :length :type xcb:-u2)
+ (base-font-name :initarg :base-font-name :type xcb:-ignore)
+ (base-font-name~ :initform '(name base-font-name type xim:LPCE
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+(defclass xim:XIMHotKeyTriggers (xim:-struct)
+ ((number :type xcb:-u4)
+ (triggers :type xcb:-ignore)
+ (triggers~ :initform '(name triggers type xim:XIMTRIGGERKEY
+ size (xcb:-fieldref 'number))
+ :type xcb:-list)
+ (states :type xcb:-ignore)
+ (states~ :initform '(name states type xim:XIMHOTKEYSTATE
+ size (xcb:-fieldref 'number))
+ :type xcb:-list)))
+
+(defclass xim:XIMTRIGGERKEY (xim:-struct)
+ ((keysym :initarg :keysym :type xcb:CARD32)
+ (modifier :initarg :modifier :type xcb:CARD32)
+ (modifier-mask :initarg :modifier-mask :type xcb:CARD32)))
+
+(defclass xim:ENCODINGINFO (xim:-struct)
+ ((length :initarg :length :type xcb:-u2)
+ (encoding-info :initarg :encoding-info :type xcb:-ignore)
+ (encoding-info~ :initform '(name encoding-info type xcb:char
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+(defclass xim:EXT (xim:-struct)
+ ((major-opcode :initarg :major-opcode :type xcb:CARD8)
+ (minor-opcode :initarg :minor-opcode :type xcb:CARD8)
+ (length :initarg :length :type xcb:-u2)
+ (name :initarg :name :type xcb:-ignore)
+ (name~ :initform '(name name type xcb:char size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(defclass xim:XIMATTRIBUTE (xim:-struct)
+ ((id :initarg :id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (value :initarg :value :type xcb:-ignore)
+ (value~ :initform '(name value type xcb:void size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(cl-defmethod xcb:marshal ((obj xim:XIMATTRIBUTE))
+ (let ((value (slot-value obj 'value)))
+ (when (eieio-object-p value)
+ (setq value (xcb:marshal value))
+ (setf (slot-value obj 'length) (length value)
+ (slot-value obj 'value) value))
+ (cl-call-next-method obj)))
+
+(defclass xim:XICATTRIBUTE (xim:XIMATTRIBUTE)
+ nil)
+
+(defclass xim:XIMSTRCONVTEXT (xim:-struct)
+ ((feedback :initarg :feedback :type xcb:CARD16)
+ (string-length :initarg :string-length :type xcb:-u2)
+ (string :initarg :string :type xcb:-ignore)
+ (string~ :initform '(name string type xcb:char
+ size (xcb:-fieldref 'string-length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (xcb:-fieldref 'string-length))
+ :type xcb:-pad)
+ (feedbacks-length :initarg :feedbacks-length :type xcb:-u2)
+ (pad~1 :initform 2 :type xcb:-pad)
+ (feedbacks :initarg :feedbacks :type xcb:-ignore)
+ (feedbacks~ :initform '(name feedbacks type xcb:void
+ size (xcb:-fieldref 'feedbacks-length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:XIMSTRCONVTEXT))
+ (let ((feedbacks (mapconcat 'xcb:marshal (slot-value obj 'feedbacks) [])))
+ (setf (slot-value obj 'feedbacks-length) (length feedbacks)
+ (slot-value obj 'feedbacks) feedbacks)
+ (cl-call-next-method obj)))
+
+(cl-defmethod xcb:unmarshal ((obj xim:XIMSTRCONVTEXT) byte-array)
+ (let ((retval (cl-call-next-method obj byte-array))
+ (data (slot-value obj 'feedbacks))
+ feedback feedbacks)
+ (while (< 0 (length data))
+ (setq feedback (make-instance 'xim:XIMSTRCONVFEEDBACK)
+ data (substring data (xcb:unmarshal feedback data))
+ feedbacks (nconc feedbacks (list feedback))))
+ (setf (slot-value obj 'feedbacks) feedbacks)
+ retval))
+
+(defconst xim:string-conversion:left-edge #x0000001)
+(defconst xim:string-conversion:right-edge #x0000002)
+(defconst xim:string-conversion:top-edge #x0000004)
+(defconst xim:string-conversion:bottom-edge #x0000008)
+(defconst xim:string-conversion:convealed #x0000010)
+(defconst xim:string-conversion:wrapped #x0000020)
+
+(xcb:deftypealias 'xim:XIMFEEDBACK 'xcb:CARD32)
+
+;; FIXME: different from Xlib:XIM*
+(defconst xim:reverse #x000001)
+(defconst xim:underline #x000002)
+(defconst xim:highlight #x000004)
+(defconst xim:primary #x000008)
+(defconst xim:secondary #x000010)
+(defconst xim:tertiary #x000020)
+(defconst xim:visible-to-forward #x000040)
+(defconst xim:visible-to-backward #x000080)
+(defconst xim:visible-center #x000100)
+
+(xcb:deftypealias 'xim:XIMHOTKEYSTATE 'xcb:CARD32)
+
+(defconst xim:hot-key-state:on #x0000001)
+(defconst xim:hot-key-state:off #x0000002)
+
+(xcb:deftypealias 'xim:XIMPREEDITSTATE 'xcb:CARD32)
+
+(defconst xim:preedit:enable #x0000001)
+(defconst xim:preedit:disable #x0000002)
+
+(xcb:deftypealias 'xim:XIMRESETSTATE 'xcb:CARD32)
+
+(defconst xim:initial-state #x0000001)
+(defconst xim:preserve-state #x0000002)
+
+;;;; Error notification
+
+(defclass xim:error (xim:-request)
+ ((~major-opcode :initform xim:opcode:error)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (flag :initarg :flag :type xim:BITMASK16)
+ (error-code :initarg :error-code :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (type :initarg :type :type xcb:CARD16)
+ (detail :initarg :detail :type xcb:-ignore)
+ (detail~ :initform '(name detail type xcb:char
+ size (xcb:-fieldref 'length)) :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(defconst xim:error-flag:invalid-both 0)
+(defconst xim:error-flag:invalid-im-id 1)
+(defconst xim:error-flag:invalid-ic-id 2)
+
+(defconst xim:error-code:bad-alloc 1)
+(defconst xim:error-code:bad-style 2)
+(defconst xim:error-code:bad-client-window 3)
+(defconst xim:error-code:bad-focus-window 4)
+(defconst xim:error-code:bad-area 5)
+(defconst xim:error-code:bad-spot-location 6)
+(defconst xim:error-code:bad-colormap 7)
+(defconst xim:error-code:bad-atom 8)
+(defconst xim:error-code:bad-pixel 9)
+(defconst xim:error-code:bad-pixmap 10)
+(defconst xim:error-code:bad-name 11)
+(defconst xim:error-code:bad-cursor 12)
+(defconst xim:error-code:bad-protocol 13)
+(defconst xim:error-code:bad-foreground 14)
+(defconst xim:error-code:bad-background 15)
+(defconst xim:error-code:locale-not-supported 16)
+(defconst xim:error-code:bad-something 999)
+
+;;;; Connection establishment
+
+(defclass xim:connect (xim:-request)
+ ((~major-opcode :initform xim:opcode:connect)
+ (byte-order :initarg :byte-order :type xcb:-u1)
+ (pad~0 :initform 1 :type xcb:-pad)
+ (major-version :initarg :major-version :type xcb:CARD16)
+ (minor-version :initarg :minor-version :type xcb:CARD16)
+ (number :initarg :number :type xcb:CARD16)
+ (auth-names :initarg :auth-names :type xcb:-ignore)
+ (auth-names~ :initform '(name auth-names type xim:STRING
+ size (xcb:-fieldref 'number))
+ :type xcb:-list)))
+
+(defconst xim:connect-byte-order:msb-first #x42)
+(defconst xim:connect-byte-order:lsb-first #x6c)
+
+(defclass xim:auth-required (xim:-request)
+ ((~major-opcode :initform xim:opcode:auth-required)
+ (index :initarg :index :type xcb:CARD8)
+ (pad~0 :initform 3 :type xcb:-pad)
+ (length :initarg :length :type xcb:-u2)
+ (pad~1 :initform 2 :type xcb:-pad)
+ (data :initarg :data :type xcb:-ignore)
+ (data~ :initform '(name data type xcb:void size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~1 :initform '(xim:PADDING (slot-value length)) :type xcb:-pad)))
+
+(defclass xim:auth-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:auth-reply)
+ (length :initarg :length :type xcb:-u2)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (data :initarg :data :type xcb:-ignore)
+ (data~ :initform '(name data type xcb:void size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~1 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(defclass xim:auth-next (xim:-request)
+ ((~major-opcode :initform xim:opcode:auth-next)
+ (length :initarg :length :type xcb:-u2)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (data :initarg :data :type xcb:-ignore)
+ (data~ :initform '(name data type xcb:void size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~1 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(defclass xim:auth-setup (xim:-request)
+ ((~major-opcode :initform xim:opcode:auth-setup)
+ (number :initarg :number :type xcb:CARD16)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (names :initarg :names :type xcb:-ignore)
+ (names~ :initform '(name names type xim:STRING
+ size (xcb:-fieldref 'number))
+ :type xcb:-list)))
+
+(defclass xim:auth-ng (xim:-request)
+ ((~major-opcode :initform xim:opcode:auth-ng)))
+
+(defclass xim:connect-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:connect-reply)
+ ;; Default to version 1.0
+ (major-version :initarg :major-version :initform 1 :type xcb:CARD16)
+ (minor-version :initarg :minor-version :initform 0 :type xcb:CARD16)))
+
+(defclass xim:disconnect (xim:-request)
+ ((~major-opcode :initform xim:opcode:disconnect)))
+
+(defclass xim:disconnect-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:disconnect-reply)))
+
+(defclass xim:open (xim:-request)
+ ((~major-opcode :initform xim:opcode:open)
+ (locale-name :initarg :locale-name :type xim:STR)
+ (pad~0 :initform '(xim:PADDING (1+ (slot-value (xcb:-fieldref 'locale-name)
+ 'length)))
+ :type xcb:-pad)))
+
+(defclass xim:open-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:open-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (im-attrs-length :initarg :im-attrs-length :type xcb:-u2)
+ (im-attrs :initarg :im-attrs :type xcb:-ignore)
+ (im-attrs~ :initform '(name im-attrs type xcb:void
+ size (xcb:-fieldref 'im-attrs-length))
+ :type xcb:-list)
+ (ic-attrs-length :initarg :ic-attrs-length :type xcb:-u2)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (ic-attrs :initarg :ic-attrs :type xcb:-ignore)
+ (ic-attrs~ :initform '(name ic-attrs type xcb:void
+ size (xcb:-fieldref 'ic-attrs-length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:open-reply))
+ (let ((im-attrs (mapconcat 'xcb:marshal (slot-value obj 'im-attrs) []))
+ (ic-attrs (mapconcat 'xcb:marshal (slot-value obj 'ic-attrs) [])))
+ (setf (slot-value obj 'im-attrs-length) (length im-attrs)
+ (slot-value obj 'im-attrs) im-attrs
+ (slot-value obj 'ic-attrs-length) (length ic-attrs)
+ (slot-value obj 'ic-attrs) ic-attrs)
+ (cl-call-next-method obj)))
+
+(cl-defmethod xcb:unmarshal ((obj xim:open-reply) byte-array)
+ (let ((retval (cl-call-next-method obj byte-array))
+ (im-data (slot-value obj 'im-attrs))
+ (ic-data (slot-value obj 'ic-attrs))
+ im-attr im-attrs ic-attr ic-attrs)
+ (while (< 0 (length im-data))
+ (setq im-attr (make-instance 'xim:XIMATTR)
+ im-data (substring im-data (xcb:unmarshal im-attr im-data))
+ im-attrs (nconc im-attrs (list im-attr))))
+ (while (< 0 (length ic-data))
+ (setq ic-attr (make-instance 'xim:XICATTR)
+ ic-data (substring ic-data (xcb:unmarshal ic-attr ic-data))
+ ic-attrs (nconc ic-attrs (list ic-attr))))
+ (setf (slot-value obj 'im-attrs) im-attrs
+ (slot-value obj 'ic-attrs) ic-attrs)
+ retval))
+
+(defclass xim:close (xim:-request)
+ ((~major-opcode :initform xim:opcode:close)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (pad~0 :initform 2 :type xcb:-pad)))
+
+(defclass xim:close-reply (xim:close)
+ ((~major-opcode :initform xim:opcode:close-reply)))
+
+;;;; Event flow control
+
+(defclass xim:set-event-mask (xim:-request)
+ ((~major-opcode :initform xim:opcode:set-event-mask)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (forward-event-mask :initarg :forward-event-mask :type xcb:-u4)
+ (synchronous-event-mask :initarg :synchronous-event-mask :type xcb:-u4)))
+
+(defclass xim:register-triggerkeys (xim:-request)
+ ((~major-opcode :initform xim:opcode:register-triggerkeys)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (on-keys-length :initarg :on-keys-length :type xcb:-u4)
+ (on-keys :initarg :on-keys :type xcb:-ignore)
+ (on-keys~ :initform '(name on-keys type xim:XIMTRIGGERKEY
+ size (/ (xcb:-fieldref 'on-keys-length) 12))
+ :type xcb:-list)
+ (off-keys-length :initarg :off-keys-length :type xcb:-u4)
+ (off-keys :initarg :off-keys :type xcb:-ignore)
+ (off-keys~ :initform '(name off-keys type xim:XIMTRIGGERKEY
+ size (/ (xcb:-fieldref 'off-keys-length) 12))
+ :type xcb:-list)))
+
+(defclass xim:trigger-nofity (xim:-request)
+ ((~major-opcode :initform xim:opcode:trigger-notify)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (flag :initarg :flag :type xcb:CARD32)
+ (index :initarg :index :type xcb:CARD32)
+ (client-select-event-mask :initarg :client-select-event-mask
+ :type xcb:-u4)))
+
+(defconst xim:trigger-nofity-flag:on-keys 0)
+(defconst xim:trigger-nofity-flag:off-keys 1)
+
+(defclass xim:trigger-nofity-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:trigger-notify-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Encoding negotiation
+
+(defclass xim:encoding-negotiation (xim:-request)
+ ((~major-opcode :initform xim:opcode:encoding-negotiation)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (names-length :initarg :names-length :type xcb:-u2)
+ (names :initarg :names :type xcb:-ignore)
+ (names~ :initform '(name names type xcb:void
+ size (xcb:-fieldref 'names-length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (xcb:-fieldref 'names-length))
+ :type xcb:-pad)
+ (encodings-length :initarg :encoding-length :type xcb:-u2)
+ (pad~1 :initform 2 :type xcb:-pad)
+ (encodings :initarg :encodings :type xcb:-ignore)
+ (encodings~ :initform '(name encodings type xcb:void
+ size (xcb:-fieldref 'encodings-length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:encoding-negotiation))
+ (let ((names (mapconcat 'xcb:marshal (slot-value obj 'names) []))
+ (encodings (mapconcat 'xcb:marshal (slot-value obj 'encodings) [])))
+ (setf (slot-value obj 'names-length) (length names)
+ (slot-value obj 'names) names
+ (slot-value obj 'encodings-length) (length encodings)
+ (slot-value obj 'encodings) encodings)
+ (cl-call-next-method obj)))
+
+(cl-defmethod xcb:unmarshal ((obj xim:encoding-negotiation) byte-array)
+ (let ((retval (cl-call-next-method obj byte-array))
+ (names-data (slot-value obj 'names))
+ (encodings-data (slot-value obj 'encodings))
+ name names encoding encodings)
+ (while (< 0 (length names-data))
+ (setq name (make-instance 'xim:STR)
+ names-data (substring names-data (xcb:unmarshal name names-data))
+ names (nconc names (list name))))
+ (while (< 0 (length encodings-data))
+ (setq encoding (make-instance 'xim:ENCODINGINFO)
+ encodings-data
+ (substring encodings-data (xcb:unmarshal encoding encodings-data))
+ encodings (nconc encodings (list encoding))))
+ (setf (slot-value obj 'names) names
+ (slot-value obj 'encodings) encodings)
+ retval))
+
+(defclass xim:encoding-negotiation-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:encoding-negotiation-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (category :initarg :category :type xcb:CARD16)
+ (index :initarg :index :type xcb:INT16)
+ (pad~0 :initform 2 :type xcb:-pad)))
+
+(defconst xim:encoding-negotiation-reply-category:name 0)
+(defconst xim:encoding-negotiation-reply-category:data 1)
+
+;;;; Query the supported extension protocol list
+
+(defclass xim:query-extension (xim:-request)
+ ((~major-opcode :initform xim:opcode:query-extension)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (extensions :initarg :extensions :type xcb:-ignore)
+ (extensions~ :initform '(name extensions type xcb:void
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(cl-defmethod xcb:marshal ((obj xim:query-extension))
+ (let ((extensions (mapconcat 'xcb:marshal (slot-value obj 'extensions) [])))
+ (setf (slot-value obj 'length) (length extensions)
+ (slot-value obj 'extensions) extensions)
+ (cl-call-next-method obj)))
+
+(cl-defmethod xcb:unmarshal ((obj xim:query-extension) byte-array)
+ (let ((retval (cl-call-next-method obj byte-array))
+ (data (slot-value obj 'extensions))
+ extension extensions)
+ (while (< 0 (length data))
+ (setq extension (make-instance 'xim:STR)
+ data (substring data (xcb:unmarshal extension data))
+ extensions (nconc extensions (list extension))))
+ (setf (slot-value obj 'extensions) extensions)
+ retval))
+
+(defclass xim:query-extension-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:query-extension-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (extensions :initarg :extensions :type xcb:-ignore)
+ (extensions~ :initform '(name extensions type xcb:void
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:query-extension-reply))
+ (let ((extensions (mapconcat 'xcb:marshal (slot-value obj 'extensions) [])))
+ (setf (slot-value obj 'length) (length extensions)
+ (slot-value obj 'extensions) extensions)
+ (cl-call-next-method obj)))
+
+(cl-defmethod xcb:unmarshal ((obj xim:query-extension-reply) byte-array)
+ (let ((retval (cl-call-next-method obj byte-array))
+ (data (slot-value obj 'extensions))
+ extension extensions)
+ (while (< 0 (length data))
+ (setq extension (make-instance 'xim:EXT)
+ data (substring data (xcb:unmarshal extension data))
+ extensions (nconc extensions (list extension))))
+ (setf (slot-value obj 'extensions) extensions)
+ retval))
+
+;;;; Setting IM values
+
+(defclass xim:set-im-values (xim:-request)
+ ((~major-opcode :initform xim:opcode:set-im-values)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (im-attributes :initarg :im-attributes :type xcb:-ignore)
+ (im-attributes~ :initform '(name im-attributes type xcb:void
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:set-im-values))
+ (let ((im-attributes (mapconcat 'xcb:marshal
+ (slot-value obj 'im-attributes) [])))
+ (setf (slot-value obj 'length) (length im-attributes)
+ (slot-value obj 'im-attributes) im-attributes)
+ (cl-call-next-method obj)))
+
+(defclass xim:set-im-values-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:set-im-values-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (pad~0 :initform 2 :type xcb:-pad)))
+
+;;;; Getting IM values
+
+(defclass xim:get-im-values (xim:-request)
+ ((~major-opcode :initform xim:opcode:get-im-values)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (im-attributes-id :initarg :im-attributes-id :type xcb:-ignore)
+ (im-attributes-id~ :initform '(name im-attributes-id type xcb:CARD16
+ size (/ (xcb:-fieldref 'length) 2))
+ :type xcb:-list)))
+
+(defclass xim:get-im-values-reply (xim:set-im-values)
+ ((~major-opcode :initform xim:opcode:get-im-values-reply)))
+
+;;;; Creating an IC
+
+(defclass xim:create-ic (xim:-request)
+ ((~major-opcode :initform xim:opcode:create-ic)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (ic-attributes :initarg :ic-attributes :type xcb:-ignore)
+ (ic-attributes~ :initform '(name ic-attributes type xcb:void
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:create-ic))
+ (let ((ic-attributes (mapconcat 'xcb:marshal
+ (slot-value obj 'ic-attributes) [])))
+ (setf (slot-value obj 'length) (length ic-attributes)
+ (slot-value obj 'ic-attributes) ic-attributes)
+ (cl-call-next-method obj)))
+
+(cl-defmethod xcb:unmarshal ((obj xim:create-ic) byte-array)
+ (let ((retval (cl-call-next-method obj byte-array))
+ (data (slot-value obj 'ic-attributes))
+ ic-attribute ic-attributes)
+ (while (< 0 (length data))
+ (setq ic-attribute (make-instance 'xim:XICATTRIBUTE)
+ data (substring data (xcb:unmarshal ic-attribute data))
+ ic-attributes (nconc ic-attributes (list ic-attribute))))
+ (setf (slot-value obj 'ic-attributes) ic-attributes)
+ retval))
+
+(defclass xim:create-ic-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:create-ic-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Destroy the IC
+
+(defclass xim:destroy-ic (xim:-request)
+ ((~major-opcode :initform xim:opcode:destroy-ic)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+(defclass xim:destroy-ic-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:destroy-ic-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Setting IC values
+
+(defclass xim:set-ic-values (xim:-request)
+ ((~major-opcode :initform xim:opcode:set-ic-values)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (ic-attributes :initarg :ic-attributes :type xcb:-ignore)
+ (ic-attributes~ :initform '(name ic-attributes type xcb:void
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)))
+
+(cl-defmethod xcb:marshal ((obj xim:set-ic-values))
+ (let ((ic-attributes (mapconcat 'xcb:marshal
+ (slot-value obj 'ic-attributes) [])))
+ (setf (slot-value obj 'length) (length ic-attributes)
+ (slot-value obj 'ic-attributes) ic-attributes)
+ (cl-call-next-method obj)))
+
+(defclass xim:set-ic-values-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:set-ic-values-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Getting IC values
+
+(defclass xim:get-ic-values (xim:-request)
+ ((~major-opcode :initform xim:opcode:get-ic-values)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (ic-attributes-id :initarg :ic-attributes-id :type xcb:-ignore)
+ (ic-attributes-id~ :initform '(name ic-attributes-id type xcb:CARD16
+ size (/ (xcb:-fieldref 'length) 2))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+(defclass xim:get-ic-values-reply (xim:set-ic-values)
+ ((~major-opcode :initform xim:opcode:get-ic-values-reply)))
+
+;;;; Setting IC focus
+
+(defclass xim:set-ic-focus (xim:-request)
+ ((~major-opcode :initform xim:opcode:set-ic-focus)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Unsetting IC focus
+
+(defclass xim:unset-ic-focus (xim:-request)
+ ((~major-opcode :initform xim:opcode:unset-ic-focus)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Filtering events
+
+(defclass xim:forward-event (xim:-request)
+ ((~major-opcode :initform xim:opcode:forward-event)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (flag :initarg :flag :type xim:BITMASK16)
+ (serial-number :initarg :serial-number :type xcb:CARD16)
+ (event :initarg :event :type xcb:-ignore)
+ (event~ :initform '(name event type xcb:void size 32) :type xcb:-list)))
+
+(defconst xim:forward-event-flag:synchronous 1)
+(defconst xim:forward-event-flag:request-filtering 2)
+(defconst xim:forward-event-flag:request-lookupstring 4)
+
+;;;; Synchronizing with the IM server
+
+(defclass xim:sync (xim:-request)
+ ((~major-opcode :initform xim:opcode:sync)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+(defclass xim:sync-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:sync-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;;;; Sending a committed string
+
+(defclass xim:commit (xim:-request)
+ ((~major-opcode :initform xim:opcode:commit)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (flag :initarg :flag :type xim:BITMASK16)))
+
+(defconst xim:commit-flag:synchronous 1)
+;; FIXME: different from Xlib:XLookup*
+(defconst xim:commit-flag:x-lookup-chars 2)
+(defconst xim:commit-flag:x-lookup-key-sym 4)
+(defconst xim:commit-flag:x-lookup-both 6)
+
+(defclass xim:commit-x-lookup-key-sym (xim:commit)
+ ((flag :initform xim:commit-flag:x-lookup-key-sym)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (key-sym :initarg :key-sym :type xcb:KEYSYM)))
+
+(defclass xim:commit-x-lookup-chars (xim:commit)
+ ((flag :initform xim:commit-flag:x-lookup-chars)
+ (length :initarg :length :type xcb:-u2)
+ (string :initarg :string :type xcb:-ignore)
+ (string~ :initform '(name string type xcb:BYTE
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~1 :initform '(xim:PADDING (xcb:-fieldref 'length)) :type xcb:-pad)))
+
+(defclass xim:commit-x-lookup-both (xim:commit-x-lookup-key-sym
+ xim:commit-x-lookup-chars)
+ ((flag :initform xim:commit-flag:x-lookup-both)
+ (pad~1 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+;;;; Reset IC
+
+(defclass xim:reset-ic (xim:-request)
+ ((~major-opcode :initform xim:opcode:reset-ic)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+(defclass xim:reset-ic-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:reset-ic-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (length :initarg :length :type xcb:-u2)
+ (string :initarg :string :type xcb:-ignore)
+ (string~ :initform '(name string type xcb:BYTE
+ size (xcb:-fieldref 'length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'length)))
+ :type xcb:-pad)))
+
+;;;; Callbacks
+
+;; Negotiating geometry
+(defclass xim:geometry (xim:-request)
+ ((~major-opcode :initform xim:opcode:geometry)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;; Converting a string
+(defclass xim:str-conversion (xim:-request)
+ ((~major-opcode :initform xim:opcode:str-conversion)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (position :initarg :position :type xcb:CARD16)
+ (pad~0 :initform 2 :type xcb:-pad)
+ (direction :initarg :direction :type xcb:CARD32)
+ (factor :initarg :factor :type xcb:CARD16)
+ (operation :initarg :operation :type xcb:CARD16)
+ (length :initarg :length :type xcb:INT16)))
+
+(defconst xim:caret-direction:forward-char 0)
+(defconst xim:caret-direction:backward-char 1)
+(defconst xim:caret-direction:forward-word 2)
+(defconst xim:caret-direction:backward-word 3)
+(defconst xim:caret-direction:caret-up 4)
+(defconst xim:caret-direction:caret-down 5)
+(defconst xim:caret-direction:next-line 6)
+(defconst xim:caret-direction:previous-line 7)
+(defconst xim:caret-direction:line-start 8)
+(defconst xim:caret-direction:line-end 9)
+(defconst xim:caret-direction:absolute-position 10)
+(defconst xim:caret-direction:dont-change 11)
+
+(defconst xim:string-conversion-operation:substitution 1)
+(defconst xim:string-conversion-operation:retrieval 2)
+
+(defclass xim:str-conversion-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:str-conversion-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (feedback :initarg :feedback :type xcb:CARD32)
+ (text :initarg :text :type xim:XIMSTRCONVTEXT)))
+
+;; Preedit callbacks
+(defclass xim:preedit-start (xim:-request)
+ ((~major-opcode :initform xim:opcode:preedit-start)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+(defclass xim:preedit-start-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:preedit-start-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (return-value :initarg :return-value :type xcb:INT32)))
+
+(defclass xim:preedit-draw (xim:-request)
+ ((~major-opcode :initform xim:opcode:preedit-draw)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (caret :initarg :caret :type xcb:INT32)
+ (chg-first :initarg :chg-first :type xcb:INT32)
+ (chg-length :initarg :chg-length :type xcb:INT32)
+ (status :initarg :status :type xim:BITMASK32)
+ (string-length :initarg :string-length :type xcb:-u2)
+ (string :initarg :string :type xcb:-ignore)
+ (string~ :initform '(name string type xcb:char
+ size (xcb:-fieldref 'string-length))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'string-length)))
+ :type xcb:-pad)
+ (feedback-length :initarg :feedback-length :type xcb:-u2)
+ (pad~1 :initform 2 :type xcb:-pad)
+ (feedback :initarg :feedback :type xcb:-ignore)
+ (feedback~ :initform '(name feedback type xim:XIMFEEDBACK
+ size (/ (xcb:-fieldref 'feedback-length) 4))
+ :type xcb:-list)))
+
+(defconst xim:preedit-draw-status:no-string 1)
+(defconst xim:preedit-draw-status:no-feedback 2)
+
+(defclass xim:preedit-caret (xim:-request)
+ ((~major-opcode :initform xim:opcode:preedit-caret)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (position :initarg :position :type xcb:INT32)
+ (direction :initarg :direction :type xcb:CARD32)
+ (style :initarg :style :type xcb:CARD32)))
+
+(defconst xim:preedit-caret-style:invisible 0)
+(defconst xim:preedit-caret-style:primary 1)
+(defconst xim:preedit-caret-style:secondary 2)
+
+(defclass xim:preedit-caret-reply (xim:-request)
+ ((~major-opcode :initform xim:opcode:preedit-caret-reply)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (position :initarg :position :type xcb:CARD32)))
+
+(defclass xim:preedit-done (xim:-request)
+ ((~major-opcode :initform xim:opcode:preedit-done)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+;; Preedit state notify
+(defclass xim:preeditstate (xim:-request)
+ ((~major-opcode :initform xim:opcode:preeditstate)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (state :initarg :state :type xim:BITMASK32)))
+
+(defconst xim:preeditstate:unknown 0)
+(defconst xim:preeditstate:enable 1)
+(defconst xim:preeditstate:disable 2)
+
+;; Status callbacks
+(defclass xim:status-start (xim:-request)
+ ((~major-opcode :initform xim:opcode:status-start)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+(defclass xim:status-draw (xim:-request)
+ ((~major-opcode :initform xim:opcode:status-draw)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)
+ (type :initarg :type :type xcb:CARD32)))
+
+(defconst xim:status-draw-type:text 0)
+(defconst xim:status-draw-type:bitmap 1)
+
+(defclass xim:status-draw-text (xim:status-draw)
+ ((type :initarg :type :initform xim:status-draw-type:text)
+ (status :initarg :status :type xim:BITMASK32)
+ (string-length :initarg :string-length :type xcb:-u2)
+ (string :initarg :string :type xcb:-ignore)
+ (string~ :initform '(name string type xcb:char
+ size (xcb:-fieldref 'string-lessp))
+ :type xcb:-list)
+ (pad~0 :initform '(xim:PADDING (+ 2 (xcb:-fieldref 'string-length)))
+ :type xcb:-pad)
+ (feedback-length :initarg :feedback-length :type xcb:-u2)
+ (pad~1 :initform 2 :type xcb:-pad)
+ (feedback :initarg :feedback :type xcb:-ignore)
+ (feedback~ :initform '(name feedback type xim:XIMFEEDBACK
+ size (/ (xcb:-fieldref 'feedback-length) 4))
+ :type xcb:-list)))
+
+(defclass xim:status-draw-bitmap (xim:status-draw)
+ ((type :initarg :type :initform xim:status-draw-type:bitmap)
+ (pixmap-data :initarg :pixmap-data :type xcb:PIXMAP)))
+
+(defclass xim:status-done (xim:-request)
+ ((~major-opcode :initform xim:opcode:status-done)
+ (im-id :initarg :im-id :type xcb:CARD16)
+ (ic-id :initarg :ic-id :type xcb:CARD16)))
+
+
+
+(provide 'xcb-xim)
+
+;;; xcb-xim.el ends here
diff --git a/util/xcb-xlib.el b/util/xcb-xlib.el
new file mode 100644
index 0000000..f5e86d8
--- /dev/null
+++ b/util/xcb-xlib.el
@@ -0,0 +1,113 @@
+;;; xcb-xlib.el --- Port of Xlib -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <chris.w.f...@gmail.com>
+;; Keywords: unix
+
+;; This file is not part of GNU Emacs.
+
+;; This file 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.
+
+;; This file 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 this file. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file currently only contains constants from 'Xlib.h'
+
+;;; Code:
+
+(defconst xlib:XNRequiredCharSet "requiredCharSet")
+(defconst xlib:XNQueryOrientation "queryOrientation")
+(defconst xlib:XNBaseFontName "baseFontName")
+(defconst xlib:XNOMAutomatic "omAutomatic")
+(defconst xlib:XNMissingCharSet "missingCharSet")
+(defconst xlib:XNDefaultString "defaultString")
+(defconst xlib:XNOrientation "orientation")
+(defconst xlib:XNDirectionalDependentDrawing "directionalDependentDrawing")
+(defconst xlib:XNContextualDrawing "contextualDrawing")
+(defconst xlib:XNFontInfo "fontInfo")
+
+(defconst xlib:XNVaNestedList "XNVaNestedList")
+(defconst xlib:XNQueryInputStyle "queryInputStyle")
+(defconst xlib:XNClientWindow "clientWindow")
+(defconst xlib:XNInputStyle "inputStyle")
+(defconst xlib:XNFocusWindow "focusWindow")
+(defconst xlib:XNResourceName "resourceName")
+(defconst xlib:XNResourceClass "resourceClass")
+(defconst xlib:XNGeometryCallback "geometryCallback")
+(defconst xlib:XNDestroyCallback "destroyCallback")
+(defconst xlib:XNFilterEvents "filterEvents")
+(defconst xlib:XNPreeditStartCallback "preeditStartCallback")
+(defconst xlib:XNPreeditDoneCallback "preeditDoneCallback")
+(defconst xlib:XNPreeditDrawCallback "preeditDrawCallback")
+(defconst xlib:XNPreeditCaretCallback "preeditCaretCallback")
+(defconst xlib:XNPreeditStateNotifyCallback "preeditStateNotifyCallback")
+(defconst xlib:XNPreeditAttributes "preeditAttributes")
+(defconst xlib:XNStatusStartCallback "statusStartCallback")
+(defconst xlib:XNStatusDoneCallback "statusDoneCallback")
+(defconst xlib:XNStatusDrawCallback "statusDrawCallback")
+(defconst xlib:XNStatusAttributes "statusAttributes")
+(defconst xlib:XNArea "area")
+(defconst xlib:XNAreaNeeded "areaNeeded")
+(defconst xlib:XNSpotLocation "spotLocation")
+(defconst xlib:XNColormap "colorMap")
+(defconst xlib:XNStdColormap "stdColorMap")
+(defconst xlib:XNForeground "foreground")
+(defconst xlib:XNBackground "background")
+(defconst xlib:XNBackgroundPixmap "backgroundPixmap")
+(defconst xlib:XNFontSet "fontSet")
+(defconst xlib:XNLineSpace "lineSpace")
+(defconst xlib:XNCursor "cursor")
+(defconst xlib:XNQueryIMValuesList "queryIMValuesList")
+(defconst xlib:XNQueryICValuesList "queryICValuesList")
+(defconst xlib:XNVisiblePosition "visiblePosition")
+(defconst xlib:XNR6PreeditCallback "r6PreeditCallback")
+(defconst xlib:XNStringConversionCallback "stringConversionCallback")
+(defconst xlib:XNStringConversion "stringConversion")
+(defconst xlib:XNResetState "resetState")
+(defconst xlib:XNHotKey "hotKey")
+(defconst xlib:XNHotKeyState "hotKeyState")
+(defconst xlib:XNPreeditState "preeditState")
+(defconst xlib:XNSeparatorofNestedList "separatorofNestedList")
+
+(defconst xlib:XIMPreeditArea #x0001)
+(defconst xlib:XIMPreeditCallbacks #x0002)
+(defconst xlib:XIMPreeditPosition #x0004)
+(defconst xlib:XIMPreeditNothing #x0008)
+(defconst xlib:XIMPreeditNone #x0010)
+(defconst xlib:XIMStatusArea #x0100)
+(defconst xlib:XIMStatusCallbacks #x0200)
+(defconst xlib:XIMStatusNothing #x0400)
+(defconst xlib:XIMStatusNone #x0800)
+
+(defconst xlib:XIMReverse #x001)
+(defconst xlib:XIMUnderline #x002)
+(defconst xlib:XIMHighlight #x004)
+(defconst xlib:XIMPrimary #x010)
+(defconst xlib:XIMSecondary #x020)
+(defconst xlib:XIMTertiary #x040)
+(defconst xlib:XIMVisibleToForward #x080)
+(defconst xlib:XIMVisibleToBackword #x100)
+(defconst xlib:XIMVisibleToCenter #x200)
+
+(defconst xlib:XBufferOverflow -1)
+(defconst xlib:XLookupNone 1)
+(defconst xlib:XLookupChars 2)
+(defconst xlib:XLookupKeySym 3)
+(defconst xlib:XLookupBoth 4)
+
+
+
+(provide 'xcb-xlib)
+
+;;; xcb-xlib.el ends here
