From 76a07d54c66a1b99d084d6c9f40b979c7bd54484 Mon Sep 17 00:00:00 2001
From: frese <frese>
Date: Mon, 9 Feb 2004 17:24:52 +0000
Subject: [PATCH] - added (partial) support for motif hints (_MOTIF_WM_HINTS)

---
 src/motif.scm    | 63 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/packages.scm | 15 +++++++++++-
 2 files changed, 77 insertions(+), 1 deletion(-)
 create mode 100644 src/motif.scm

diff --git a/src/motif.scm b/src/motif.scm
new file mode 100644
index 0000000..2bb2b78
--- /dev/null
+++ b/src/motif.scm
@@ -0,0 +1,63 @@
+;; the _MOTIF_WM_HINTS property
+
+(define-record-type motif-wm-hints :motif-wm-hints
+  (make-motif-wm-hints functions decorations input-mode status)
+  motif-wm-hints?
+  (functions motif-wm-hints:functions)
+  (decorations motif-wm-hints:decorations)
+  (input-mode motif-wm-hints:input-mode)
+  (status motif-wm-hints:status))
+
+(define _MOTIF_WM_HINTS #f)
+
+(define-enumerated-type motif-decoration :motif-decoration
+  motif-decoration? motif-decoration-items motif-decoration-name
+  motif-decoration-index
+  (all border resize-horizontal title menu minimize maximize))
+
+(define motif-decoration-codes
+  (list (cons 1 (motif-decoration all))
+	(cons 2 (motif-decoration border))
+	(cons 4 (motif-decoration resize-horizontal))
+	(cons 8 (motif-decoration title))
+	(cons 16 (motif-decoration menu))
+	(cons 32 (motif-decoration minimize))
+	(cons 64 (motif-decoration maximize))))
+
+(define-enum-set-type motif-decorations :motif-decorations
+  motif-decorations? make-motif-decorations
+  motif-decoration motif-decoration? motif-decoration-items
+  motif-decoration-index)
+
+(define (int->decorations i)
+  (make-motif-decorations
+   (map cdr (filter (lambda (code.v)
+		      (> (bitwise-and (car code.v) i) 0))
+		    motif-decoration-codes))))
+
+(define flag:functions   1)
+(define flag:decorations 2)
+(define flag:input-mode  4)
+(define flag:status      8)
+
+(define (property->motif-wm-hints p)
+  (and (or (eq? (property:format p) (property-format short))
+	   (eq? (property:format p) (property-format long)))
+       (>= (length (property:data p)) 5)
+       (let* ((data (property:data p))
+	      (flags (first data)))
+	 ;; TODO: functions, input-mode, status
+	 (make-motif-wm-hints
+	  #f
+	  (and (> (bitwise-and flags flag:decorations) 0)
+	       (int->decorations (third data)))
+	  #f
+	  #f))))
+
+(define (get-motif-wm-hints dpy window)
+  (if (not _MOTIF_WM_HINTS)
+      (set! _MOTIF_WM_HINTS (intern-atom dpy "_MOTIF_WM_HINTS" #f)))
+  (let ((p (get-full-window-property dpy window _MOTIF_WM_HINTS
+				     #f _MOTIF_WM_HINTS)))
+    (and p
+	 (property->motif-wm-hints p))))
diff --git a/src/packages.scm b/src/packages.scm
index 8c68e9b..6ed2b78 100644
--- a/src/packages.scm
+++ b/src/packages.scm
@@ -87,6 +87,18 @@
         thread-fluids)
   (files file-name-completion))
 
+;; *** motif hints ***************************************************
+
+(define-structure motif
+  (export motif-wm-hints? motif-wm-hints:functions motif-wm-hints:decorations
+	  motif-wm-hints:input-mode motif-wm-hints:status
+	  ((motif-decorations motif-decoration) :syntax)
+	  get-motif-wm-hints)
+  (open scheme-with-scsh srfi-1
+	define-record-types finite-types enum-sets
+	xlib)
+  (files motif))
+
 ;; *** key-grab ******************************************************
 
 (define-structure key-grab
@@ -133,7 +145,8 @@
 	threads rendezvous-channels rendezvous
 	xlib
 	manager key-grab
-	utils dragging titlebar)
+	utils dragging titlebar
+	motif enum-sets)
   (files move-wm
 	 move-wm-resizer
 	 move-wm-icon))