;; 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))))