[STUMP] netwm support: Unicode window titles

[Magnus Henoch]

Three years ago I started hacking netwm support for Stumpwm.  (netwm
is also known as EMWH and wm-spec, and can be found at
<URL:http://standards.freedesktop.org/wm-spec/wm-spec-latest.html>)
My primary goal was (and is) support for third-party docks and
pagers.

I'm now trying to resurrect my patches and fit them onto today's
Stumpwm, piece by piece.  The attached patch sets some properties
indicating protocol support, and tries to use Unicode window titles
(property _NET_WM_NAME) when available.  _NET_WM_NAME uses UTF-8, as
opposed to WM_NAME.  You can see that Stumpwm can't see Unicode titles
by googling for "eĉ" and looking at the window name of your browser -
it just says NIL.

More patches will come; I'd just like get comments on what I've done
so far...

Magnus

cvs diff: Diffing .
Index: core.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/core.lisp,v
retrieving revision 1.123
diff -u -r1.123 core.lisp
--- core.lisp   26 Feb 2007 23:38:26 -0000      1.123
+++ core.lisp   20 Apr 2007 18:50:24 -0000
@@ -46,14 +46,16 @@
           for j from dst-start
           as c = (char-code (char src i))
           if (<= min c max) do (setf (aref dst j) c)
-          else do (return i)
+          ;; replace unknown characters with question marks
+          else do (setf (aref dst j) (char-code #\?))
           finally (return i))
        (loop for i from src-start to src-end
           for j from dst-start
           as c = (elt src i)
           as n = (if (characterp c) (char-code c) c)
           if (and (integerp n) (<= min n max)) do (setf (aref dst j) n)
-          else do (return i)
+          ;; ditto
+          else do (setf (aref dst j) (char-code #\?))
           finally (return i)))))
 
 (defun screen-x (screen)
@@ -260,7 +262,16 @@
 ;;     (xlib:clear-area (window-parent window)))))
 
 (defun xwin-name (win)
-  (xlib:wm-name win))
+  (or
+   (let ((net-wm-name (xlib:get-property win :_NET_WM_NAME)))
+     (when net-wm-name
+       #+sbcl (sb-ext:octets-to-string
+              (coerce net-wm-name '(vector (unsigned-byte 8)))
+              :external-format :utf-8)
+       ;; TODO: handle UTF-8 from _NET_WM_NAME
+       #-sbcl
+       (concatenate 'string (mapcar #'code-char net-wm-name))))
+   (xlib:wm-name win)))
 
 ;; FIXME: should we raise the winodw or its parent?
 (defun raise-window (win)
@@ -290,7 +301,7 @@
   (ecase type
     (:normal *normal-border-width*)
     (:maxsize *maxsize-border-width*)
-    (:transient *transient-border-width*)))
+    ((:transient :dialog) *transient-border-width*)))
 
 (defun xwin-class (win)
   (multiple-value-bind (res class) (xlib:get-wm-class win)
@@ -368,17 +379,42 @@
     (xwin-hide (window-xwin window) (window-parent window))))
 
 (defun xwin-type (win)
-  "Return one of :maxsize, :transient, or :normal."
-  (or (and (xlib:get-property win :WM_TRANSIENT_FOR)
-          :transient)
-      (and (let ((hints (xlib:wm-normal-hints win)))
+  "Return one of :desktop, :dock, :toolbar, :utility, :splash,
+:dialog, :transient, :maxsize and :normal.  Right now
+only :dialog and :normal (and :maxsize and :transient) are
+actually returned; see +WINDOW-TYPES+."
+  (or (and (let ((hints (xlib:wm-normal-hints win)))
             (and hints (or (xlib:wm-size-hints-max-width hints)
                            (xlib:wm-size-hints-max-height hints)
                            (xlib:wm-size-hints-min-aspect hints)
                            (xlib:wm-size-hints-max-aspect hints))))
           :maxsize)
+      (let ((net-wm-window-type (xlib:get-property win :_NET_WM_WINDOW_TYPE)))
+       (when net-wm-window-type
+         (dolist (type-atom net-wm-window-type)
+           (when (assoc (xlib:atom-name *display* type-atom) +window-types+)
+             (return (cdr (assoc (xlib:atom-name *display* type-atom) 
+window-types+)))))))
+      (and (xlib:get-property win :WM_TRANSIENT_FOR)
+          :transient)
       :normal))
 
+(defun xwin-strut (screen win)
+  "Return the area that the window wants to reserve along the edges of the 
screen.
+Values are left, right, top, bottom, left_start_y, left_end_y,
+right_start_y, right_end_y, top_start_x, top_end_x, bottom_start_x
+and bottom_end_x."
+  (let ((net-wm-strut-partial (xlib:get-property win :_NET_WM_STRUT_PARTIAL)))
+    (if (= (length net-wm-strut-partial) 12)
+       (apply 'values net-wm-strut-partial)
+      (let ((net-wm-strut (xlib:get-property win :_NET_WM_STRUT)))
+       (if (= (length net-wm-strut) 4)
+           (apply 'values (concatenate 'list net-wm-strut
+                                       (list 0 (screen-height screen)
+                                             0 (screen-height screen)
+                                             0 (screen-width screen)
+                                             0 (screen-width screen))))
+         (values 0 0 0 0 0 0 0 0 0 0 0 0))))))
+
 ;; Stolen from Eclipse
 (defun xwin-send-configuration-notify (xwin x y w h bw)
   "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
@@ -416,7 +452,7 @@
       (ecase (window-type win)
         (:normal *normal-gravity*)
         (:maxsize *maxsize-gravity*)
-        (:transient *transient-gravity*))))
+        ((:transient :dialog) *transient-gravity*))))
 
 (defun geometry-hints (win)
   "Return hints for max width and height and increment hints. These
@@ -445,7 +481,7 @@
     ;; determine what the width and height should be
     (cond
       ;; Adjust the defaults if the window is a transient_for window.
-      ((eq (window-type win) :transient)
+      ((member (window-type win) '(:transient :dialog))
        (setf center t
             width (min (window-width win) width)
             height (min (window-height win) height)))
@@ -1595,8 +1631,47 @@
                                     :subwindow-mode :include-inferiors
                                     :foreground  (xlib:alloc-color 
(xlib:screen-default-colormap screen-number) +default-foreground-color+)
                                     :background (xlib:alloc-color 
(xlib:screen-default-colormap screen-number) +default-background-color+)))
+    (net-set-properties screen-number focus-window)
     screen))
 
+(defun net-set-properties (screen-number focus-window)
+  "Set NETWM properties on the root window of the specified screen.
+FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
+  (let ((root (xlib:screen-root screen-number)))
+    ;; NETWM stuff
+    ;; _NET_SUPPORTED:
+    (xlib:change-property root :_NET_SUPPORTED
+                         (append +net-supported-atoms+ +window-types-atoms+)
+                         :atom 32)
+
+    ;; _NET_SUPPORTING_WM_CHECK:
+    (xlib:change-property root :_NET_SUPPORTING_WM_CHECK
+                         (list focus-window) :window 32
+                         :transform #'xlib:drawable-id)
+    (xlib:change-property focus-window :_NET_SUPPORTING_WM_CHECK
+                         (list focus-window) :window 32
+                         :transform #'xlib:drawable-id)
+    (xlib:change-property focus-window :_NET_WM_NAME
+                         (list (map 'vector #'char-code "stumpwm"))
+                         :string 8)
+    
+    ;; _NET_CLIENT_LIST: TODO
+
+    ;; _NET_NUMBER_OF_DESKTOPS:
+    (xlib:change-property root :_NET_NUMBER_OF_DESKTOPS (list 1) :cardinal 32)
+
+    ;; _NET_DESKTOP_GEOMETRY:
+    (xlib:change-property root :_NET_DESKTOP_GEOMETRY
+                         (list (xlib:screen-width screen-number)
+                               (xlib:screen-height screen-number))
+                         :cardinal 32)
+    
+    ;; _NET_DESKTOP_VIEWPORT:
+    (xlib:change-property root :_NET_DESKTOP_VIEWPORT
+                         (list 0 0) :cardinal 32)
+    ;; _NET_CURRENT_DESKTOP:
+    (xlib:change-property root :_NET_CURRENT_DESKTOP
+                         (list 0) :cardinal 32)))
 
 ;;; keyboard helper functions
 
Index: primitives.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/primitives.lisp,v
retrieving revision 1.66
diff -u -r1.66 primitives.lisp
--- primitives.lisp     26 Feb 2007 23:38:26 -0000      1.66
+++ primitives.lisp     20 Apr 2007 18:50:25 -0000
@@ -125,6 +125,36 @@
 (defvar +wm-protocols+ nil
   "the WM_PROTOCOLS atom")
 
+(defparameter +net-supported+
+  (list
+   :_NET_SUPPORTING_WM_CHECK
+   :_NET_NUMBER_OF_DESKTOPS
+   :_NET_DESKTOP_GEOMETRY
+   :_NET_DESKTOP_VIEWPORT
+   :_NET_CURRENT_DESKTOP
+   :_NET_WM_WINDOW_TYPE)
+  "Supported NETWM properties.
+Window types are in +WINDOW-TYPES+.")
+
+(defvar +net-supported-atoms+ nil
+  "The atoms of +NET-SUPPORTED+.")
+
+(defparameter +window-types+
+  (list
+;;;   (cons :_NET_WM_WINDOW_TYPE_DESKTOP :desktop)
+;;;   (cons :_NET_WM_WINDOW_TYPE_DOCK :dock)
+;;;   (cons :_NET_WM_WINDOW_TYPE_TOOLBAR :toolbar)
+;;;   (cons :_NET_WM_WINDOW_TYPE_MENU :menu)
+;;;   (cons :_NET_WM_WINDOW_TYPE_UTILITY :utility)
+;;;   (cons :_NET_WM_WINDOW_TYPE_SPLASH :splash)
+   (cons :_NET_WM_WINDOW_TYPE_DIALOG :dialog)
+   (cons :_NET_WM_WINDOW_TYPE_NORMAL :normal))
+  "Alist mapping NETWM window types to keywords.
+Include only those we are ready to support.")
+
+(defvar +window-types-atoms+ nil
+  "The atoms of +WINDOW-TYPES+.")
+
 ;; Window states
 (defconstant +withdrawn-state+ 0)
 (defconstant +normal-state+ 1)
Index: stumpwm.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/stumpwm.lisp,v
retrieving revision 1.58
diff -u -r1.58 stumpwm.lisp
--- stumpwm.lisp        26 Feb 2007 23:38:26 -0000      1.58
+++ stumpwm.lisp        20 Apr 2007 18:50:25 -0000
@@ -54,6 +54,8 @@
 ;;     +rp-command+ (xlib:intern-atom *display* "RP_COMMAND")
 ;;     +rp-command-request+ (xlib:intern-atom *display* "RP_COMMAND_REQUEST")
 ;;     +rp-command-result+ (xlib:intern-atom *display* "RP_COMMAND_RESULT")
+       +net-supported-atoms+ (mapcar (lambda (a) (xlib:intern-atom *display* 
a)) +net-supported+)
+       +window-types-atoms+ (mapcar (lambda (a) (xlib:intern-atom *display* 
(car a))) +window-types+)
        )
 )
 
@@ -138,6 +140,8 @@
         (progn
           ;; we need to do this first because init-screen grabs keys
           (update-modifier-map)
+          ;; Initialize the necessary atoms
+          (init-atoms)
           ;; Initialize all the screens
           (handler-case
               (progn (setf *screen-list* (loop for i in (xlib:display-roots 
*display*)
@@ -146,8 +150,6 @@
                      (xlib:display-finish-output *display*))
             (xlib:access-error ()
               (return-from stumpwm (write-line "Another window manager is 
running."))))
-          ;; Initialize the necessary atoms
-          (init-atoms)
           (mapc 'process-existing-windows *screen-list*)
           ;; We need to setup each screen with its current window. Go
           ;; through them in reverse so the first screen's frame ends up