Source

xwem / lisp / xwem-netwm.el

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
;;; xwem-netwm.el --- NETWM stuff.

;; Copyright (C) 2004,2005 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;;         Steve Youngs  <steve@youngs.au.com>
;; Created: Sat May 15 19:44:58 MSD 2004
;; Keywords: xwem
;; X-CVS: $Id$

;; This file is part of XWEM.

;; XWEM 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 2, or (at your option)
;; any later version.

;; XWEM 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 XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Support for NETWM hints.  See specification at:
;; http://www.freedesktop.org/standards/wm-spec/index.html.

;;; Code:

(require 'xlib-xlib)
(require 'xlib-xinerama)

(require 'xwem-load)
(require 'xwem-manage)
(require 'xwem-version)

(defgroup xwem-fullscreen nil
  "Group to customize fullscreen managing model."
  :prefix "xwem-fullscreen-"
  :group 'xwem-modes)

(defcustom xwem-fullscreen-switch-any-other nil
  "*Non-nil mean switch to any other client, if no other fullscreen client available."
  :type 'boolean
  :group 'xwem-fullscreen)

(defcustom xwem-fullscreen-iconify-when-inactive t
  "*Non-nil mean iconify fullscreen clients, when they gets inactive/deselected."
  :type 'boolean
  :group 'xwem-fullscreen)

(defcustom xwem-fullscreen-ai-rank '(1000 . 0)
  "*Always on top rank pair for active and inactive states."
  :type '(cons :tag "Rank pair"
               (number :tag "Active rank")
               (number :tag "Inactive rank"))
  :group 'xwem-fullscreen)

;;; Internal variables

;;; Constants
(defconst _NET_WM_NAME "_NET_WM_NAME")
(defconst _NET_WM_VISIBLE_NAME "_NET_WM_VISIBLE_NAME")
(defconst _NET_WM_ICON_NAME "_NET_WM_ICON_NAME")
(defconst _NET_WM_VISIBLE_ICON_NAME "_NET_WM_VISIBLE_ICON_NAME")
(defconst _NET_WM_DESKTOP "_NET_WM_DESKTOP")
(defconst _NET_WM_WINDOW_TYPE "_NET_WM_WINDOW_TYPE")
(defconst _NET_WM_WINDOW_TYPE_DESKTOP "_NET_WM_WINDOW_TYPE_DESKTOP")
(defconst _NET_WM_WINDOW_TYPE_DOCK "_NET_WM_WINDOW_TYPE_DOCK")
(defconst _NET_WM_WINDOW_TYPE_TOOLBAR "_NET_WM_WINDOW_TYPE_TOOLBAR")
(defconst _NET_WM_WINDOW_TYPE_MENU "_NET_WM_WINDOW_TYPE_MENU")
(defconst _NET_WM_WINDOW_TYPE_UTILITY "_NET_WM_WINDOW_TYPE_UTILITY")
(defconst _NET_WM_WINDOW_TYPE_SPLASH "_NET_WM_WINDOW_TYPE_SPLASH")
(defconst _NET_WM_WINDOW_TYPE_DIALOG "_NET_WM_WINDOW_TYPE_DIALOG")
(defconst _NET_WM_WINDOW_TYPE_NORMAL "_NET_WM_WINDOW_TYPE_NORMAL")
(defconst _NET_WM_STATE "_NET_WM_STATE")
(defconst _NET_WM_STATE_MODAL "_NET_WM_STATE_MODAL")
(defconst _NET_WM_STATE_STICKY "_NET_WM_STATE_STICKY")
(defconst _NET_WM_STATE_MAXIMIZED_VERT "_NET_WM_STATE_MAXIMIZED_VERT")
(defconst _NET_WM_STATE_MAXIMIZED_HORZ "_NET_WM_STATE_MAXIMIZED_HORZ")
(defconst _NET_WM_STATE_SHADED "_NET_WM_STATE_SHADED")
(defconst _NET_WM_STATE_SKIP_TASKBAR "_NET_WM_STATE_SKIP_TASKBAR")
(defconst _NET_WM_STATE_SKIP_PAGER "_NET_WM_STATE_SKIP_PAGER")
(defconst _NET_WM_STATE_HIDDEN "_NET_WM_STATE_HIDDEN")
(defconst _NET_WM_STATE_FULLSCREEN "_NET_WM_STATE_FULLSCREEN")
(defconst _NET_WM_STATE_ABOVE "_NET_WM_STATE_ABOVE")
(defconst _NET_WM_STATE_BELOW "_NET_WM_STATE_BELOW")
(defconst _NET_WM_ALLOWED_ACTIONS "_NET_WM_ALLOWED_ACTIONS")
(defconst _NET_WM_ACTION_MOVE "_NET_WM_ACTION_MOVE")
(defconst _NET_WM_ACTION_RESIZE "_NET_WM_ACTION_RESIZE")
(defconst _NET_WM_ACTION_MINIMIZE "_NET_WM_ACTION_MINIMIZE")
(defconst _NET_WM_ACTION_SHADE "_NET_WM_ACTION_SHADE")
(defconst _NET_WM_ACTION_STICK "_NET_WM_ACTION_STICK")
(defconst _NET_WM_ACTION_MAXIMIZE_HORZ "_NET_WM_ACTION_MAXIMIZE_HORZ")
(defconst _NET_WM_ACTION_MAXIMIZE_VERT "_NET_WM_ACTION_MAXIMIZE_VERT")
(defconst _NET_WM_ACTION_FULLSCREEN "_NET_WM_ACTION_FULLSCREEN")
(defconst _NET_WM_ACTION_CHANGE_DESKTOP "_NET_WM_ACTION_CHANGE_DESKTOP")
(defconst _NET_WM_ACTION_CLOSE "_NET_WM_ACTION_CLOSE")
(defconst _NET_WM_STRUT "_NET_WM_STRUT")
(defconst _NET_WM_ICON_GEOMETRY "_NET_WM_ICON_GEOMETRY")
(defconst _NET_WM_ICON "_NET_WM_ICON")
(defconst _NET_WM_PID "_NET_WM_PID")
(defconst _NET_WM_HANDLED_ICONS "_NET_WM_HANDLED_ICONS")
(defconst _NET_WM_STRUT "_NET_WM_STRUT")

(defconst _NET_SUPPORTED "_NET_SUPPORTED")
(defconst _NET_SUPPORTING_WM_CHECK "_NET_SUPPORTING_WM_CHECK")
(defconst _NET_CURRENT_DESKTOP "_NET_CURRENT_DESKTOP")
(defconst _NET_SHOWING_DESKTOP "_NET_SHOWING_DESKTOP")
(defconst _NET_NUMBER_OF_DESKTOPS "_NET_NUMBER_OF_DESKTOPS")
(defconst _NET_DESKTOP_GEOMETRY "_NET_DESKTOP_GEOMETRY")
(defconst _NET_ACTIVE_WINDOW "_NET_ACTIVE_WINDOW")
(defconst _NET_DESKTOP_NAMES "_NET_DESKTOP_NAMES")
(defconst _NET_CLIENT_LIST "_NET_CLIENT_LIST")
(defconst _NET_CLIENT_LIST_STACKING "_NET_CLIENT_LIST_STACKING")

(defconst UTF8_STRING "UTF8_STRING")

(defconst xwem-nwm-atom-names
 (list UTF8_STRING
       _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_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_NORMAL _NET_WM_STATE
       _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_ALLOWED_ACTIONS _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_STRUT
       _NET_WM_ICON_GEOMETRY _NET_WM_ICON _NET_WM_PID _NET_WM_HANDLED_ICONS
       _NET_WM_STRUT

       _NET_CURRENT_DESKTOP
       _NET_SHOWING_DESKTOP
       _NET_SUPPORTING_WM_CHECK
       _NET_NUMBER_OF_DESKTOPS
       _NET_DESKTOP_GEOMETRY
       _NET_ACTIVE_WINDOW))

(defconst xwem-nwm-supported
  (list _NET_WM_NAME _NET_CURRENT_DESKTOP
        _NET_NUMBER_OF_DESKTOPS
        _NET_DESKTOP_NAMES _NET_SHOWING_DESKTOP
        _NET_WM_STATE _NET_WM_STATE_FULLSCREEN
        _NET_CLIENT_LIST _NET_CLIENT_LIST_STACKING
        _NET_ACTIVE_WINDOW
        )
  )

(defun xwem-nwm-init ()
  "Initialize netwm stuff."
  (xwem-message 'init "Initializing NET_WM support ...")

  (mapc #'(lambda (name)
            (XInternAtom (xwem-dpy) name))
        xwem-nwm-atom-names)

  ;; Add client message handler on root window
  (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-nwm-root-evhandler 100
                              (list X-ClientMessage X-MapRequest))
  (X-Dpy-EventHandler-add (xwem-dpy) 'xwem-nwm-root-clnmsg 100
                          (list X-ClientMessage))
;  ;; Update root event mask
;  (setq xwem-root-ev-mask (Xmask-or xwem-root-ev-mask XM-
;  (XSelectInput (xwem-dpy)

  ;; Add hooks
  (add-hook 'xwem-frame-select-hook 'xwem-nwm-on-frame-select)
  (add-hook 'xwem-frame-creation-hook 'xwem-nwm-set-number-of-desktops)
  (add-hook 'xwem-frame-destroy-hook 'xwem-nwm-set-number-of-desktops)

  (add-hook 'xwem-cl-create-hook 'xwem-nwm-set-client-list)
  (add-hook 'xwem-cl-destroy-hook 'xwem-nwm-set-client-list)
  (add-hook 'xwem-client-select-hook 'xwem-nwm-set-active-window)

  ;; Set some properties
  (xwem-nwm-set-supported)
  (xwem-nwm-set-supporting-wm-check)

  (xwem-nwm-set-number-of-desktops)
  (xwem-nwm-set-current-desk)
  (xwem-nwm-set-desk-geometry)

  (xwem-nwm-set-client-list)

  (xwem-message 'init "Initializing NET_WM support ... done"))

(defun xwem-nwm-on-frame-select ()
  "Called when frame switching occurs, i.e. member of `xwem-frame-select-hook'."
  (xwem-nwm-set-current-desk (xwem-frame-selected)))

(defun xwem-nwm-root-evhandler (xdpy xwin xev)
  "Handle netwm's event"
  (X-Event-CASE xev
    (:X-ClientMessage
     (xwem-nwm-root-clnmsg xdpy xwin xev))
    (:X-MapRequest
     (xwem-nwm-root-mapreq xdpy xwin xev))))

(defun xwem-nwm-root-clnmsg (xdpy xwin xev)
  "Dispatch ClientMessage event on root window."
  (cond ((string= (X-Atom-name (X-Event-xclient-atom xev))
                  _NET_CURRENT_DESKTOP)
         (let ((num (truncate (caar (X-Event-xclient-msg xev)))))
           (xwem-frame-switch-nth num)))

        ((string= (X-Atom-name (X-Event-xclient-atom xev)) _NET_WM_STATE)
         (xwem-debug 'xwem-misc "_NET_WM_STATE: -> %S"
                     '(X-Event-xclient-msg xev))
         
         (let ((vop (caar (X-Event-xclient-msg xev)))
               (stype (caadr (X-Event-xclient-msg xev)))
               (cl (xwem-xwin-cl xwin)))
           ;; XXX Can handle only FULLSCREEN state
           (when (= stype (X-Atom-id (XInternAtom
                                      (xwem-dpy) _NET_WM_STATE_FULLSCREEN)))
             (cond ((= vop 0)
                    (xwem-toggle-fullscreen cl 'off))
                   ((= vop 1)
                    (xwem-toggle-fullscreen cl 'on))))))
        ))

(defun xwem-nwm-root-mapreq (xdpy xwin xev)
  "Dispatch map request of XWIN to set _NET_WM_STATE property."
  (XChangeProperty xdpy xwin
                   (XInternAtom xdpy _NET_WM_STATE)
                   XA-atom X-format-32 X-PropModeReplace
                   nil)
  )

(defun xwem-nwm-set-state (xwin &optional state)
  "Set XWIN's _NET_WM_STATE property to STATE.
If STATE is nil, then remove property."
  (XChangeProperty (xwem-dpy) xwin
                   (XInternAtom (xwem-dpy) _NET_WM_STATE)
                   XA-atom X-format-32 X-PropModeReplace
                   (if state
                       (list (XInternAtom (xwem-dpy) state))
                     nil)))

(defun xwem-nwm-apply-state (xwin state)
  (XSendEvent (xwem-dpy) (xwem-rootwin) nil XM-SubstructureRedirect
              (X-Create-message
               (list [1 X-ClientMessage]
                     [1 32]            ; format
                     [2 5555]           ; seq XXX
                     [4 (X-Win-id xwin)]
                     [4 (X-Atom-id (XInternAtom (xwem-dpy) _NET_WM_STATE))]
                     [4 1]
                     [4 (X-Atom-id (XInternAtom (xwem-dpy) state))]
                     [4 0]
                     [8 nil]))))
  
(defun xwem-nwm-set-supported (&rest notused)
  "Set _NET_SUPPORTED root window property."
  (XChangeProperty (xwem-dpy) (xwem-rootwin)
                   (XInternAtom (xwem-dpy) _NET_SUPPORTED)
                   XA-atom X-format-32 X-PropModeReplace
                   (mapcar #'(lambda (name)
                               (XInternAtom (xwem-dpy) name))
                           xwem-nwm-supported)))

(defun xwem-nwm-set-number-of-desktops (&rest notused)
  "Set _NET_NUMBER_OF_DESKTOPS."
  (XChangeProperty (xwem-dpy) (xwem-rootwin)
                   (XInternAtom (xwem-dpy) _NET_NUMBER_OF_DESKTOPS)
                   XA-cardinal X-format-32 X-PropModeReplace
                   (list (length (xwem-frames-list 'desktop)))))

(defun xwem-nwm-set-desk-geometry (&optional frame &rest notused)
  "Set _NET_DESKTOP_GEOMETRY."
  (unless frame
    (setq frame (xwem-frame-selected)))
  (when (xwem-frame-p frame)
    (XChangeProperty (xwem-dpy) (xwem-rootwin)
                     (XInternAtom (xwem-dpy) _NET_DESKTOP_GEOMETRY)
                     XA-cardinal X-format-32 X-PropModeReplace
                     (list (xwem-frame-width frame)
                           (xwem-frame-height frame)))))

(defun xwem-nwm-set-current-desk (&optional frame &rest notused)
  "Set _NET_CURRENT_DESKTOP."
  (unless frame
    (setq frame (xwem-frame-selected)))

  (when (xwem-frame-p frame)
    (XChangeProperty (xwem-dpy) (xwem-rootwin)
                     (XInternAtom (xwem-dpy) _NET_CURRENT_DESKTOP)
                     XA-cardinal X-format-32 X-PropModeReplace
                     (list (xwem-frame-num frame)))))

(defun xwem-nwm-set-showing-desk (&optional frame what &rest notused)
  "Set _NET_SHOWING_DESKTOP."
  (unless frame
    (setq frame (xwem-frame-selected)))

  (when (xwem-frame-p frame)
    (XChangeProperty (xwem-dpy) (xwem-rootwin)
                     (XInternAtom (xwem-dpy) _NET_CURRENT_DESKTOP)
                     XA-cardinal X-format-32 X-PropModeReplace
                     (list what))))

(defun xwem-nwm-set-active-window ()
  "Set _NET_ACTIVE_WINDOW."
  (XChangeProperty (xwem-dpy) (xwem-rootwin)
                   (XInternAtom (xwem-dpy) _NET_ACTIVE_WINDOW)
                   XA-window X-format-32 X-PropModeReplace
                   (list (and (xwem-cl-p (xwem-cl-selected))
                              (X-Win-id (xwem-cl-xwin (xwem-cl-selected)))))))

(defun xwem-nwm-set-wm-window-type (thing)
  "Set _NET_WM_WINDOW_TYPE."
  (let (xwin type)
    (setq type
          (cond ((and (X-Win-p thing)
                      (xwem-tray-find-dapp thing))
                 (setq xwin thing)
                 _NET_WM_WINDOW_TYPE_DOCK)

                ((xwem-frame-p thing)
                 (setq xwin (xwem-frame-xwin thing))
                 _NET_WM_WINDOW_TYPE_DESKTOP)

                ((xwem-cl-p thing)
                 (setq xwin (xwem-cl-xwin thing))
                 _NET_WM_WINDOW_TYPE_NORMAL)

                ((X-Win-p thing)
                 (setq xwin thing)
                 _NET_WM_WINDOW_TYPE_DIALOG)))

    (XChangeProperty (xwem-dpy) xwin
                     (XInternAtom (xwem-dpy) _NET_WM_WINDOW_TYPE)
                     XA-atom X-format-32 X-PropModeReplace
                     (list (XInternAtom (xwem-dpy) type)))
    ))

(defun xwem-nwm-set-supporting-wm-check (&rest unused)
  "Set _NET_SUPPORTING_WM_CHECK."
  (XChangeProperty (xwem-dpy) (xwem-rootwin)
                   (XInternAtom (xwem-dpy) _NET_SUPPORTING_WM_CHECK)
                   XA-window X-format-32 X-PropModeReplace
                   (list (xwem-minib-xwin xwem-minibuffer)))

  (XChangeProperty (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
                   (XInternAtom (xwem-dpy) _NET_SUPPORTING_WM_CHECK)
                   XA-window X-format-32 X-PropModeReplace
                   (list (xwem-minib-xwin xwem-minibuffer)))

  (XChangeProperty (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
                   (XInternAtom (xwem-dpy) _NET_WM_NAME)
                   (XInternAtom (xwem-dpy) UTF8_STRING)
                   X-format-32 X-PropModeReplace
                   (list xwem-version)))

(defun xwem-nwm-set-client-list (&rest notused)
  "Set _NET_CLIENT_LIST and _NET_CLIENT_LIST_STACKING."
  (XChangeProperty (xwem-dpy) (xwem-rootwin)
                   (XInternAtom (xwem-dpy) _NET_CLIENT_LIST)
                   XA-window X-format-32 X-PropModeReplace
                   (mapcar 'xwem-cl-xwin xwem-clients))

  ;; TODO: order
  (XChangeProperty (xwem-dpy) (xwem-rootwin)
                   (XInternAtom (xwem-dpy) _NET_CLIENT_LIST_STACKING)
                   XA-window X-format-32 X-PropModeReplace
                   (mapcar 'xwem-cl-xwin xwem-clients)))

;;;; ---- Fullscreen manage methods ----
;;

;;; Fullscreen major mode

;; Supported CL properties:

;;    `fs-real-size'           - Do not resize client, use its size.

;;    `fs-avoid-minib-overlap' - Resize client to fullscreen avoiding
;;                               xwem minibuffer overlaping.

(defvar xwem-fullscreen-mode-hook nil
  "*Hooks to call when client enters fullscreen mode.
Called with one argument - client.")

(defvar xwem-fullscreen-mode-map
  (let ((map (make-sparse-keymap 'XWEM-fullscreen-map)))
    (define-key map (kbd "C-S-<button1>") 'xwem-client-imove)
    (define-key map (kbd "C-S-<button3>") 'xwem-client-iresize)
    map)
  "Keymap for fullscreen clients.")

;; Properties
(define-xwem-client-property fs-real-size fullscreen
  "Non-nil to manage fullscreen clients in their real sizes.
I.e. no resize to fullfill screen."
  :type 'boolean
  :set 'xwem-fullscreen-set-fs-real-size)

(define-xwem-client-property fs-avoid-minib-overlap fullscreen
  "Non-nil to not overlap xwem minibuffer."
  :type 'boolean
  :set 'xwem-fullscreen-set-fs-avoid-minib-overlap)

(defun xwem-fullscreen-set-fs-real-size (cl prop val)
  "Set `fs-real-size' property."
  (xwem-cl-put-prop cl prop val)

  (if val
      (xwem-client-resize cl (X-Geom-width (xwem-cl-initial-xgeom cl))
                          (X-Geom-height (xwem-cl-initial-xgeom cl)))
    (xwem-refit cl)))

(defun xwem-fullscreen-set-fs-avoid-minib-overlap (cl prop val)
  "Set `fs-avoid-minib-overlap' property."
  (xwem-cl-put-prop cl prop val)
  
  (xwem-refit cl))

(defun xwem-netwm-fullscreen-p (cl)
  "Return non-nil if CL is very like to be managed at fullscreen mode."
  (let ((states (cddr (XGetWindowProperty (xwem-dpy) (xwem-cl-xwin cl)
                        (XInternAtom (xwem-dpy) _NET_WM_STATE)))))
    (member (X-Atom-id (XInternAtom (xwem-dpy) _NET_WM_STATE_FULLSCREEN))
            states)))

(defun xwem-cl-fullscreen-p (cl)
  "Return non-nil if CL is managed using fullscreen manage model."
  (eq (xwem-cl-manage-type cl) 'fullscreen))

;;;###autoload(autoload 'xwem-fullscreen-mode "xwem-netwm" nil t)
(define-xwem-command xwem-fullscreen-mode (cl)
  "Toggle fullscreen major mode for selected client CL.
It is an alias for `xwem-toggle-fullscreen' command."
  (xwem-interactive (list (xwem-cl-selected)))

  (xwem-toggle-fullscreen cl))

;;;###autoload
(defun xwem-manage-fullscreen (cl)
  "Manage method for fullscreen client CL."
  ;; Find out the place where to manage client
  (let ((tpnt (car (XTranslateCoordinates
                    (xwem-dpy) (xwem-cl-xwin cl)
                    (xwem-rootwin) 0 0)))
        (xin (X-XIneramaQueryScreens (xwem-dpy)))
        (rx 0) (ry 0))
    ;; Xinerama stuff
    (when (car xin)
      ;; XInerama enabled
      (while (setq xin (cdr xin))
        (when (and (>= (X-Point-x tpnt) (X-Rect-x (car xin)))
                   (<= (X-Point-x tpnt)
                       (+ (X-Rect-x (car xin)) (X-Rect-width (car xin))))
                   (>= (X-Point-y tpnt) (X-Rect-y (car xin)))
                   (<= (X-Point-y tpnt)
                       (+ (X-Rect-y (car xin)) (X-Rect-height (car xin)))))
          (setq rx (X-Rect-x (car xin))
                ry (X-Rect-y (car xin))
                xin nil))))

    (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) (xwem-rootwin) rx ry))

  ;; Set geometry to initial
  (setf (xwem-cl-new-xgeom cl)
        (copy-X-Geom (xwem-cl-initial-xgeom cl)))
  (setf (X-Geom-border-width (xwem-cl-new-xgeom cl)) nil)
  (xwem-refit cl)

  (xwem-use-local-map xwem-fullscreen-mode-map cl)
  (xwem-select-client cl)               ; XXX
  
  (run-hook-with-args 'xwem-fullscreen-mode-hook cl))

;;;###autoload(put 'manage 'fullscreen 'xwem-manage-fullscreen)

(defun xwem-fullscreen-refit-full (cl)
  "Refit CL to fullscreen."
  (let* ((tpnt (car (XTranslateCoordinates (xwem-dpy) (xwem-cl-xwin cl)
                                           (xwem-rootwin) 0 0)))
         (crect (make-X-Rect :x (X-Point-x tpnt) :y (X-Point-y tpnt)
                             :width (X-Geom-width (xwem-cl-xgeom cl))
                             :height (X-Geom-height (xwem-cl-xgeom cl))))
         (xin (X-XIneramaQueryScreens (xwem-dpy))))
    (if (car xin)
        (progn
          ;; XInerama enabled
          (while (and (setq xin (cdr xin))
                      (not (X-Rect-intersect-p (car xin) crect))))
          (setq xin (X-Rect-to-X-Geom (car xin))))
      
      ;; No XInerama, so use root geometry
      (setq xin (xwem-rootgeom)))

    ;; Update geometry to not overlap xwem minibuffer, if
    ;; 'no-minib-overlap CL property is set.
    (when (xwem-client-property cl 'fs-avoid-minib-overlap)
      (setf (X-Geom-height xin)
            (- (X-Geom-height xin)
               (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)))))

    (setf (X-Geom-border-width xin)
          (X-Geom-border-width (xwem-cl-xgeom cl)))

    ;; Update CL geometry
    (xwem-cl-correct-size-for-size cl xin)))

(defun xwem-fullscreen-refit-real (cl)
  "Refit to real CL's size."
  (xwem-cl-apply-new-xgeom cl))
  
(defun xwem-refit-fullscreen (cl)
  "Refit method for fullscreen client CL."
  (cond ((xwem-client-property cl 'fs-real-size)
         (xwem-fullscreen-refit-real cl))
        (t (xwem-fullscreen-refit-full cl)))

  (xwem-cl-apply-xgeom cl))

(define-xwem-deffered xwem-fullscreen-apply-state (cl)
  "Apply CL's state to life."
  (when (xwem-cl-p cl)
    (case (xwem-cl-state cl)
      (active
       (xwem-misc-set-xwin-always-on-top
        (xwem-cl-xwin cl) (car xwem-fullscreen-ai-rank))
       (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)))
        
      (inactive
       (xwem-misc-set-xwin-always-on-top
        (xwem-cl-xwin cl) (cdr xwem-fullscreen-ai-rank))
       (when (and xwem-fullscreen-iconify-when-inactive
                  ;; XXX skip dummy clients and special
                  (not (or (xwem-dummy-client-p (xwem-cl-selected))
                           (xwem-special-p (xwem-cl-selected)))))
         (xwem-iconify cl)))

      (iconified
       (xwem-misc-set-xwin-always-on-top
        (xwem-cl-xwin cl) (cdr xwem-fullscreen-ai-rank))
       (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl))))))
         
(defun xwem-activate-fullscreen (cl &optional type)
  "Activate method for fullscreen client CL."
  (xwem-fullscreen-apply-state cl))

(defun xwem-deactivate-fullscreen (cl &optional type)
  "Deactivate fullscreen client CL."
  (cond ((eq type 'deactivate)
         (xwem-fullscreen-apply-state cl))

        ((eq type 'deselect)
         (when (xwem-cl-active-p cl)
           (xwem-client-change-state cl 'inactive))
         (xwem-fullscreen-apply-state cl))))

(defun xwem-iconify-fullscreen (cl)
  "Iconify method for fullscreen client CL."
  (xwem-fullscreen-apply-state cl))

;;; Additional methods
(define-xwem-method other-client fullscreen (cl)
  "Return fullscreen client other then CL."
  (or (xwem-cl-other cl :clients (xwem-clients-list 'xwem-cl-fullscreen-p))
      (and xwem-fullscreen-switch-any-other
	   (xwem-cl-other cl))))

;;;; ---- Fullscreen Commands ----

;;;###autoload(autoload 'xwem-toggle-fullscreen "xwem-netwm" nil t)
(define-xwem-command xwem-toggle-fullscreen (cl &optional force)
  "Enable/disable fullscreen mode for CL.
Optional argument FORCE is one of:
  `on'  - Force fullscreen.
  `off' - Force non-fullscreen."
  (xwem-interactive (list (xwem-cl-selected)))

  (let ((xwin (xwem-cl-xwin cl)))
    (cond ((and (eq (xwem-cl-manage-type cl) 'fullscreen)
                (or (null force) (eq force 'off)))
           (xwem-nwm-set-state xwin nil)
           (let ((mspec (xwem-manda-find-match-1 cl xwem-manage-internal-list)))
             (if (and mspec (not (eq (car mspec) 'fullscreen)))
                 ;; If there some other than 'fullscreen manda entry - use it!
                 (xwem-client-change-manage-type cl mspec)
               ;; Otherwise try default 'generic manda
               (xwem-client-change-manage-type cl '(generic)))))

          ((and (not (eq (xwem-cl-manage-type cl) 'fullscreen))
                (or (null force) (eq force 'on)))
           (xwem-nwm-set-state xwin _NET_WM_STATE_FULLSCREEN)
           (xwem-client-change-manage-type cl '(fullscreen))))))

;;;###autoload(autoload 'xwem-switch-to-fullscreen-cl "xwem-netwm" nil t)
(define-xwem-command xwem-switch-to-fullscreen-cl ()
  "Switch to client that in fullscreen mode."
  (xwem-interactive)

  (let* ((fsclients (xwem-clients-list 'xwem-cl-fullscreen-p))
         (cl (and fsclients (xwem-read-client "Fullscreen CL: " fsclients))))

    (unless (xwem-cl-alive-p cl)
      (error 'xwem-error "No fullscreen clients"))

    (xwem-select-client cl)))


(provide 'xwem-netwm)
;;;; On-load actions

;; Fullscreen manage type 
(define-xwem-manage-model fullscreen
  "Managing model to show client at fullscreen size."
  :match-spec '(function xwem-netwm-fullscreen-p)
  :manage-properties '(omit-aspect-ratio t) ; disregard aspect ratio

  :manage-method 'xwem-manage-fullscreen
  :activate-method 'xwem-activate-fullscreen
  :deactivate-method 'xwem-deactivate-fullscreen
  :refit-method 'xwem-refit-fullscreen
  :iconify-method 'xwem-iconify-fullscreen)

(if xwem-started
    (xwem-nwm-init)
  (add-hook 'xwem-after-init-hook 'xwem-nwm-init))

;;; xwem-netwm.el ends here