cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-netwm.el

   1 ;;; xwem-netwm.el --- NETWM stuff.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Sat May 15 19:44:58 MSD 2004
   8 ;; Keywords: xwem
   9 ;; X-CVS: $Id: xwem-netwm.el,v 1.6 2005-04-04 19:54:14 lg Exp $
  10
  11 ;; This file is part of XWEM.
  12
  13 ;; XWEM is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26 ;; 02111-1307, USA.
  27
  28 ;;; Synched up with: Not in FSF
  29
  30 ;;; Commentary:
  31
  32 ;; Support for NETWM hints.  See specification at:
  33 ;; http://www.freedesktop.org/standards/wm-spec/index.html.
  34
  35 ;;; Code:
  36 \f
  37 (require 'xlib-xlib)
  38 (require 'xlib-xinerama)
  39
  40 (require 'xwem-load)
  41 (require 'xwem-manage)
  42 (require 'xwem-version)
  43
  44 (defgroup xwem-fullscreen nil
  45   "Group to customize fullscreen managing model."
  46   :prefix "xwem-fullscreen-"
  47   :group 'xwem-modes)
  48
  49 (defcustom xwem-fullscreen-switch-any-other nil
  50   "*Non-nil mean switch to any other client, if no other fullscreen client available."
  51   :type 'boolean
  52   :group 'xwem-fullscreen)
  53
  54 (defcustom xwem-fullscreen-iconify-when-inactive t
  55   "*Non-nil mean iconify fullscreen clients, when they gets inactive/deselected."
  56   :type 'boolean
  57   :group 'xwem-fullscreen)
  58
  59 (defcustom xwem-fullscreen-ai-rank '(1000 . 0)
  60   "*Always on top rank pair for active and inactive states."
  61   :type '(cons :tag "Rank pair"
  62                (number :tag "Active rank")
  63                (number :tag "Inactive rank"))
  64   :group 'xwem-fullscreen)
  65
  66 ;;; Internal variables
  67
  68 ;;; Constants
  69 (defconst _NET_WM_NAME "_NET_WM_NAME")
  70 (defconst _NET_WM_VISIBLE_NAME "_NET_WM_VISIBLE_NAME")
  71 (defconst _NET_WM_ICON_NAME "_NET_WM_ICON_NAME")
  72 (defconst _NET_WM_VISIBLE_ICON_NAME "_NET_WM_VISIBLE_ICON_NAME")
  73 (defconst _NET_WM_DESKTOP "_NET_WM_DESKTOP")
  74 (defconst _NET_WM_WINDOW_TYPE "_NET_WM_WINDOW_TYPE")
  75 (defconst _NET_WM_WINDOW_TYPE_DESKTOP "_NET_WM_WINDOW_TYPE_DESKTOP")
  76 (defconst _NET_WM_WINDOW_TYPE_DOCK "_NET_WM_WINDOW_TYPE_DOCK")
  77 (defconst _NET_WM_WINDOW_TYPE_TOOLBAR "_NET_WM_WINDOW_TYPE_TOOLBAR")
  78 (defconst _NET_WM_WINDOW_TYPE_MENU "_NET_WM_WINDOW_TYPE_MENU")
  79 (defconst _NET_WM_WINDOW_TYPE_UTILITY "_NET_WM_WINDOW_TYPE_UTILITY")
  80 (defconst _NET_WM_WINDOW_TYPE_SPLASH "_NET_WM_WINDOW_TYPE_SPLASH")
  81 (defconst _NET_WM_WINDOW_TYPE_DIALOG "_NET_WM_WINDOW_TYPE_DIALOG")
  82 (defconst _NET_WM_WINDOW_TYPE_NORMAL "_NET_WM_WINDOW_TYPE_NORMAL")
  83 (defconst _NET_WM_STATE "_NET_WM_STATE")
  84 (defconst _NET_WM_STATE_MODAL "_NET_WM_STATE_MODAL")
  85 (defconst _NET_WM_STATE_STICKY "_NET_WM_STATE_STICKY")
  86 (defconst _NET_WM_STATE_MAXIMIZED_VERT "_NET_WM_STATE_MAXIMIZED_VERT")
  87 (defconst _NET_WM_STATE_MAXIMIZED_HORZ "_NET_WM_STATE_MAXIMIZED_HORZ")
  88 (defconst _NET_WM_STATE_SHADED "_NET_WM_STATE_SHADED")
  89 (defconst _NET_WM_STATE_SKIP_TASKBAR "_NET_WM_STATE_SKIP_TASKBAR")
  90 (defconst _NET_WM_STATE_SKIP_PAGER "_NET_WM_STATE_SKIP_PAGER")
  91 (defconst _NET_WM_STATE_HIDDEN "_NET_WM_STATE_HIDDEN")
  92 (defconst _NET_WM_STATE_FULLSCREEN "_NET_WM_STATE_FULLSCREEN")
  93 (defconst _NET_WM_STATE_ABOVE "_NET_WM_STATE_ABOVE")
  94 (defconst _NET_WM_STATE_BELOW "_NET_WM_STATE_BELOW")
  95 (defconst _NET_WM_ALLOWED_ACTIONS "_NET_WM_ALLOWED_ACTIONS")
  96 (defconst _NET_WM_ACTION_MOVE "_NET_WM_ACTION_MOVE")
  97 (defconst _NET_WM_ACTION_RESIZE "_NET_WM_ACTION_RESIZE")
  98 (defconst _NET_WM_ACTION_MINIMIZE "_NET_WM_ACTION_MINIMIZE")
  99 (defconst _NET_WM_ACTION_SHADE "_NET_WM_ACTION_SHADE")
 100 (defconst _NET_WM_ACTION_STICK "_NET_WM_ACTION_STICK")
 101 (defconst _NET_WM_ACTION_MAXIMIZE_HORZ "_NET_WM_ACTION_MAXIMIZE_HORZ")
 102 (defconst _NET_WM_ACTION_MAXIMIZE_VERT "_NET_WM_ACTION_MAXIMIZE_VERT")
 103 (defconst _NET_WM_ACTION_FULLSCREEN "_NET_WM_ACTION_FULLSCREEN")
 104 (defconst _NET_WM_ACTION_CHANGE_DESKTOP "_NET_WM_ACTION_CHANGE_DESKTOP")
 105 (defconst _NET_WM_ACTION_CLOSE "_NET_WM_ACTION_CLOSE")
 106 (defconst _NET_WM_STRUT "_NET_WM_STRUT")
 107 (defconst _NET_WM_ICON_GEOMETRY "_NET_WM_ICON_GEOMETRY")
 108 (defconst _NET_WM_ICON "_NET_WM_ICON")
 109 (defconst _NET_WM_PID "_NET_WM_PID")
 110 (defconst _NET_WM_HANDLED_ICONS "_NET_WM_HANDLED_ICONS")
 111 (defconst _NET_WM_STRUT "_NET_WM_STRUT")
 112
 113 (defconst _NET_SUPPORTED "_NET_SUPPORTED")
 114 (defconst _NET_SUPPORTING_WM_CHECK "_NET_SUPPORTING_WM_CHECK")
 115 (defconst _NET_CURRENT_DESKTOP "_NET_CURRENT_DESKTOP")
 116 (defconst _NET_SHOWING_DESKTOP "_NET_SHOWING_DESKTOP")
 117 (defconst _NET_NUMBER_OF_DESKTOPS "_NET_NUMBER_OF_DESKTOPS")
 118 (defconst _NET_DESKTOP_GEOMETRY "_NET_DESKTOP_GEOMETRY")
 119 (defconst _NET_ACTIVE_WINDOW "_NET_ACTIVE_WINDOW")
 120 (defconst _NET_DESKTOP_NAMES "_NET_DESKTOP_NAMES")
 121 (defconst _NET_CLIENT_LIST "_NET_CLIENT_LIST")
 122 (defconst _NET_CLIENT_LIST_STACKING "_NET_CLIENT_LIST_STACKING")
 123
 124 (defconst UTF8_STRING "UTF8_STRING")
 125
 126 (defconst xwem-nwm-atom-names
 127  (list UTF8_STRING
 128        _NET_WM_NAME _NET_WM_VISIBLE_NAME _NET_WM_ICON_NAME
 129        _NET_WM_VISIBLE_ICON_NAME _NET_WM_DESKTOP _NET_WM_WINDOW_TYPE
 130        _NET_WM_WINDOW_TYPE_DESKTOP _NET_WM_WINDOW_TYPE_DOCK
 131        _NET_WM_WINDOW_TYPE_TOOLBAR _NET_WM_WINDOW_TYPE_MENU
 132        _NET_WM_WINDOW_TYPE_UTILITY _NET_WM_WINDOW_TYPE_SPLASH
 133        _NET_WM_WINDOW_TYPE_DIALOG _NET_WM_WINDOW_TYPE_NORMAL _NET_WM_STATE
 134        _NET_WM_STATE_MODAL _NET_WM_STATE_STICKY _NET_WM_STATE_MAXIMIZED_VERT
 135        _NET_WM_STATE_MAXIMIZED_HORZ _NET_WM_STATE_SHADED
 136        _NET_WM_STATE_SKIP_TASKBAR _NET_WM_STATE_SKIP_PAGER
 137        _NET_WM_STATE_HIDDEN _NET_WM_STATE_FULLSCREEN _NET_WM_STATE_ABOVE
 138        _NET_WM_STATE_BELOW _NET_WM_ALLOWED_ACTIONS _NET_WM_ACTION_MOVE
 139        _NET_WM_ACTION_RESIZE _NET_WM_ACTION_MINIMIZE _NET_WM_ACTION_SHADE
 140        _NET_WM_ACTION_STICK _NET_WM_ACTION_MAXIMIZE_HORZ
 141        _NET_WM_ACTION_MAXIMIZE_VERT _NET_WM_ACTION_FULLSCREEN
 142        _NET_WM_ACTION_CHANGE_DESKTOP _NET_WM_ACTION_CLOSE _NET_WM_STRUT
 143        _NET_WM_ICON_GEOMETRY _NET_WM_ICON _NET_WM_PID _NET_WM_HANDLED_ICONS
 144        _NET_WM_STRUT
 145
 146        _NET_CURRENT_DESKTOP
 147        _NET_SHOWING_DESKTOP
 148        _NET_SUPPORTING_WM_CHECK
 149        _NET_NUMBER_OF_DESKTOPS
 150        _NET_DESKTOP_GEOMETRY
 151        _NET_ACTIVE_WINDOW))
 152
 153 (defconst xwem-nwm-supported
 154   (list _NET_WM_NAME _NET_CURRENT_DESKTOP
 155         _NET_NUMBER_OF_DESKTOPS
 156         _NET_DESKTOP_NAMES _NET_SHOWING_DESKTOP
 157         _NET_WM_STATE _NET_WM_STATE_FULLSCREEN
 158         _NET_CLIENT_LIST _NET_CLIENT_LIST_STACKING
 159         _NET_ACTIVE_WINDOW
 160         )
 161   )
 162
 163 (defun xwem-nwm-init ()
 164   "Initialize netwm stuff."
 165   (xwem-message 'init "Initializing NET_WM support ...")
 166
 167   (mapc #'(lambda (name)
 168             (XInternAtom (xwem-dpy) name))
 169         xwem-nwm-atom-names)
 170
 171   ;; Add client message handler on root window
 172   (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-nwm-root-evhandler 100
 173                               (list X-ClientMessage X-MapRequest))
 174   (X-Dpy-EventHandler-add (xwem-dpy) 'xwem-nwm-root-clnmsg 100
 175                           (list X-ClientMessage))
 176 ;  ;; Update root event mask
 177 ;  (setq xwem-root-ev-mask (Xmask-or xwem-root-ev-mask XM-
 178 ;  (XSelectInput (xwem-dpy)
 179
 180   ;; Add hooks
 181   (add-hook 'xwem-frame-select-hook 'xwem-nwm-on-frame-select)
 182   (add-hook 'xwem-frame-creation-hook 'xwem-nwm-set-number-of-desktops)
 183   (add-hook 'xwem-frame-destroy-hook 'xwem-nwm-set-number-of-desktops)
 184
 185   (add-hook 'xwem-cl-create-hook 'xwem-nwm-set-client-list)
 186   (add-hook 'xwem-cl-destroy-hook 'xwem-nwm-set-client-list)
 187   (add-hook 'xwem-client-select-hook 'xwem-nwm-set-active-window)
 188
 189   ;; Set some properties
 190   (xwem-nwm-set-supported)
 191   (xwem-nwm-set-supporting-wm-check)
 192
 193   (xwem-nwm-set-number-of-desktops)
 194   (xwem-nwm-set-current-desk)
 195   (xwem-nwm-set-desk-geometry)
 196
 197   (xwem-nwm-set-client-list)
 198
 199   (xwem-message 'init "Initializing NET_WM support ... done"))
 200
 201 (defun xwem-nwm-on-frame-select ()
 202   "Called when frame switching occurs, i.e. member of `xwem-frame-select-hook'."
 203   (xwem-nwm-set-current-desk (xwem-frame-selected)))
 204
 205 (defun xwem-nwm-root-evhandler (xdpy xwin xev)
 206   "Handle netwm's event"
 207   (X-Event-CASE xev
 208     (:X-ClientMessage
 209      (xwem-nwm-root-clnmsg xdpy xwin xev))
 210     (:X-MapRequest
 211      (xwem-nwm-root-mapreq xdpy xwin xev))))
 212
 213 (defun xwem-nwm-root-clnmsg (xdpy xwin xev)
 214   "Dispatch ClientMessage event on root window."
 215   (cond ((string= (X-Atom-name (X-Event-xclient-atom xev))
 216                   _NET_CURRENT_DESKTOP)
 217          (let ((num (truncate (caar (X-Event-xclient-msg xev)))))
 218            (xwem-frame-switch-nth num)))
 219
 220         ((string= (X-Atom-name (X-Event-xclient-atom xev)) _NET_WM_STATE)
 221          (xwem-debug 'xwem-misc "_NET_WM_STATE: -> %S"
 222                      '(X-Event-xclient-msg xev))
 223
 224          (let ((vop (caar (X-Event-xclient-msg xev)))
 225                (stype (caadr (X-Event-xclient-msg xev)))
 226                (cl (xwem-xwin-cl xwin)))
 227            ;; XXX Can handle only FULLSCREEN state
 228            (when (= stype (X-Atom-id (XInternAtom
 229                                       (xwem-dpy) _NET_WM_STATE_FULLSCREEN)))
 230              (cond ((= vop 0)
 231                     (xwem-toggle-fullscreen cl 'off))
 232                    ((= vop 1)
 233                     (xwem-toggle-fullscreen cl 'on))))))
 234         ))
 235
 236 (defun xwem-nwm-root-mapreq (xdpy xwin xev)
 237   "Dispatch map request of XWIN to set _NET_WM_STATE property."
 238   (XChangeProperty xdpy xwin
 239                    (XInternAtom xdpy _NET_WM_STATE)
 240                    XA-atom X-format-32 X-PropModeReplace
 241                    nil)
 242   )
 243
 244 (defun xwem-nwm-set-state (xwin &optional state)
 245   "Set XWIN's _NET_WM_STATE property to STATE.
 246 If STATE is nil, then remove property."
 247   (XChangeProperty (xwem-dpy) xwin
 248                    (XInternAtom (xwem-dpy) _NET_WM_STATE)
 249                    XA-atom X-format-32 X-PropModeReplace
 250                    (if state
 251                        (list (XInternAtom (xwem-dpy) state))
 252                      nil)))
 253
 254 (defun xwem-nwm-apply-state (xwin state)
 255   (XSendEvent (xwem-dpy) (xwem-rootwin) nil XM-SubstructureRedirect
 256               (X-Create-message
 257                (list [1 X-ClientMessage]
 258                      [1 32]            ; format
 259                      [2 5555]           ; seq XXX
 260                      [4 (X-Win-id xwin)]
 261                      [4 (X-Atom-id (XInternAtom (xwem-dpy) _NET_WM_STATE))]
 262                      [4 1]
 263                      [4 (X-Atom-id (XInternAtom (xwem-dpy) state))]
 264                      [4 0]
 265                      [8 nil]))))
 266
 267 (defun xwem-nwm-set-supported (&rest notused)
 268   "Set _NET_SUPPORTED root window property."
 269   (XChangeProperty (xwem-dpy) (xwem-rootwin)
 270                    (XInternAtom (xwem-dpy) _NET_SUPPORTED)
 271                    XA-atom X-format-32 X-PropModeReplace
 272                    (mapcar #'(lambda (name)
 273                                (XInternAtom (xwem-dpy) name))
 274                            xwem-nwm-supported)))
 275
 276 (defun xwem-nwm-set-number-of-desktops (&rest notused)
 277   "Set _NET_NUMBER_OF_DESKTOPS."
 278   (XChangeProperty (xwem-dpy) (xwem-rootwin)
 279                    (XInternAtom (xwem-dpy) _NET_NUMBER_OF_DESKTOPS)
 280                    XA-cardinal X-format-32 X-PropModeReplace
 281                    (list (length (xwem-frames-list 'desktop)))))
 282
 283 (defun xwem-nwm-set-desk-geometry (&optional frame &rest notused)
 284   "Set _NET_DESKTOP_GEOMETRY."
 285   (unless frame
 286     (setq frame (xwem-frame-selected)))
 287   (when (xwem-frame-p frame)
 288     (XChangeProperty (xwem-dpy) (xwem-rootwin)
 289                      (XInternAtom (xwem-dpy) _NET_DESKTOP_GEOMETRY)
 290                      XA-cardinal X-format-32 X-PropModeReplace
 291                      (list (xwem-frame-width frame)
 292                            (xwem-frame-height frame)))))
 293
 294 (defun xwem-nwm-set-current-desk (&optional frame &rest notused)
 295   "Set _NET_CURRENT_DESKTOP."
 296   (unless frame
 297     (setq frame (xwem-frame-selected)))
 298
 299   (when (xwem-frame-p frame)
 300     (XChangeProperty (xwem-dpy) (xwem-rootwin)
 301                      (XInternAtom (xwem-dpy) _NET_CURRENT_DESKTOP)
 302                      XA-cardinal X-format-32 X-PropModeReplace
 303                      (list (xwem-frame-num frame)))))
 304
 305 (defun xwem-nwm-set-showing-desk (&optional frame what &rest notused)
 306   "Set _NET_SHOWING_DESKTOP."
 307   (unless frame
 308     (setq frame (xwem-frame-selected)))
 309
 310   (when (xwem-frame-p frame)
 311     (XChangeProperty (xwem-dpy) (xwem-rootwin)
 312                      (XInternAtom (xwem-dpy) _NET_CURRENT_DESKTOP)
 313                      XA-cardinal X-format-32 X-PropModeReplace
 314                      (list what))))
 315
 316 (defun xwem-nwm-set-active-window ()
 317   "Set _NET_ACTIVE_WINDOW."
 318   (XChangeProperty (xwem-dpy) (xwem-rootwin)
 319                    (XInternAtom (xwem-dpy) _NET_ACTIVE_WINDOW)
 320                    XA-window X-format-32 X-PropModeReplace
 321                    (list (and (xwem-cl-p (xwem-cl-selected))
 322                               (X-Win-id (xwem-cl-xwin (xwem-cl-selected)))))))
 323
 324 (defun xwem-nwm-set-wm-window-type (thing)
 325   "Set _NET_WM_WINDOW_TYPE."
 326   (let (xwin type)
 327     (setq type
 328           (cond ((and (X-Win-p thing)
 329                       (xwem-tray-find-dapp thing))
 330                  (setq xwin thing)
 331                  _NET_WM_WINDOW_TYPE_DOCK)
 332
 333                 ((xwem-frame-p thing)
 334                  (setq xwin (xwem-frame-xwin thing))
 335                  _NET_WM_WINDOW_TYPE_DESKTOP)
 336
 337                 ((xwem-cl-p thing)
 338                  (setq xwin (xwem-cl-xwin thing))
 339                  _NET_WM_WINDOW_TYPE_NORMAL)
 340
 341                 ((X-Win-p thing)
 342                  (setq xwin thing)
 343                  _NET_WM_WINDOW_TYPE_DIALOG)))
 344
 345     (XChangeProperty (xwem-dpy) xwin
 346                      (XInternAtom (xwem-dpy) _NET_WM_WINDOW_TYPE)
 347                      XA-atom X-format-32 X-PropModeReplace
 348                      (list (XInternAtom (xwem-dpy) type)))
 349     ))
 350
 351 (defun xwem-nwm-set-supporting-wm-check (&rest unused)
 352   "Set _NET_SUPPORTING_WM_CHECK."
 353   (XChangeProperty (xwem-dpy) (xwem-rootwin)
 354                    (XInternAtom (xwem-dpy) _NET_SUPPORTING_WM_CHECK)
 355                    XA-window X-format-32 X-PropModeReplace
 356                    (list (xwem-minib-xwin xwem-minibuffer)))
 357
 358   (XChangeProperty (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
 359                    (XInternAtom (xwem-dpy) _NET_SUPPORTING_WM_CHECK)
 360                    XA-window X-format-32 X-PropModeReplace
 361                    (list (xwem-minib-xwin xwem-minibuffer)))
 362
 363   (XChangeProperty (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
 364                    (XInternAtom (xwem-dpy) _NET_WM_NAME)
 365                    (XInternAtom (xwem-dpy) UTF8_STRING)
 366                    X-format-32 X-PropModeReplace
 367                    (list xwem-version)))
 368
 369 (defun xwem-nwm-set-client-list (&rest notused)
 370   "Set _NET_CLIENT_LIST and _NET_CLIENT_LIST_STACKING."
 371   (XChangeProperty (xwem-dpy) (xwem-rootwin)
 372                    (XInternAtom (xwem-dpy) _NET_CLIENT_LIST)
 373                    XA-window X-format-32 X-PropModeReplace
 374                    (mapcar 'xwem-cl-xwin xwem-clients))
 375
 376   ;; TODO: order
 377   (XChangeProperty (xwem-dpy) (xwem-rootwin)
 378                    (XInternAtom (xwem-dpy) _NET_CLIENT_LIST_STACKING)
 379                    XA-window X-format-32 X-PropModeReplace
 380                    (mapcar 'xwem-cl-xwin xwem-clients)))
 381
 382 ;;;; ---- Fullscreen manage methods ----
 383 ;;
 384
 385 ;;; Fullscreen major mode
 386
 387 ;; Supported CL properties:
 388
 389 ;;    `fs-real-size'           - Do not resize client, use its size.
 390
 391 ;;    `fs-avoid-minib-overlap' - Resize client to fullscreen avoiding
 392 ;;                               xwem minibuffer overlaping.
 393
 394 (defvar xwem-fullscreen-mode-hook nil
 395   "*Hooks to call when client enters fullscreen mode.
 396 Called with one argument - client.")
 397
 398 (defvar xwem-fullscreen-mode-map
 399   (let ((map (make-sparse-keymap 'XWEM-fullscreen-map)))
 400     (define-key map (kbd "C-S-<button1>") 'xwem-client-imove)
 401     (define-key map (kbd "C-S-<button3>") 'xwem-client-iresize)
 402     map)
 403   "Keymap for fullscreen clients.")
 404
 405 ;; Properties
 406 (define-xwem-client-property fs-real-size fullscreen
 407   "Non-nil to manage fullscreen clients in their real sizes.
 408 I.e. no resize to fullfill screen."
 409   :type 'boolean
 410   :set 'xwem-fullscreen-set-fs-real-size)
 411
 412 (define-xwem-client-property fs-avoid-minib-overlap fullscreen
 413   "Non-nil to not overlap xwem minibuffer."
 414   :type 'boolean
 415   :set 'xwem-fullscreen-set-fs-avoid-minib-overlap)
 416
 417 (defun xwem-fullscreen-set-fs-real-size (cl prop val)
 418   "Set `fs-real-size' property."
 419   (xwem-cl-put-prop cl prop val)
 420
 421   (if val
 422       (xwem-client-resize cl (X-Geom-width (xwem-cl-initial-xgeom cl))
 423                           (X-Geom-height (xwem-cl-initial-xgeom cl)))
 424     (xwem-refit cl)))
 425
 426 (defun xwem-fullscreen-set-fs-avoid-minib-overlap (cl prop val)
 427   "Set `fs-avoid-minib-overlap' property."
 428   (xwem-cl-put-prop cl prop val)
 429
 430   (xwem-refit cl))
 431
 432 (defun xwem-netwm-fullscreen-p (cl)
 433   "Return non-nil if CL is very like to be managed at fullscreen mode."
 434   (let ((states (cddr (XGetWindowProperty (xwem-dpy) (xwem-cl-xwin cl)
 435                         (XInternAtom (xwem-dpy) _NET_WM_STATE)))))
 436     (member (X-Atom-id (XInternAtom (xwem-dpy) _NET_WM_STATE_FULLSCREEN))
 437             states)))
 438
 439 (defun xwem-cl-fullscreen-p (cl)
 440   "Return non-nil if CL is managed using fullscreen manage model."
 441   (eq (xwem-cl-manage-type cl) 'fullscreen))
 442
 443 ;;;###autoload(autoload 'xwem-fullscreen-mode "xwem-netwm" nil t)
 444 (define-xwem-command xwem-fullscreen-mode (cl)
 445   "Toggle fullscreen major mode for selected client CL.
 446 It is an alias for `xwem-toggle-fullscreen' command."
 447   (xwem-interactive (list (xwem-cl-selected)))
 448
 449   (xwem-toggle-fullscreen cl))
 450
 451 ;;;###autoload
 452 (defun xwem-manage-fullscreen (cl)
 453   "Manage method for fullscreen client CL."
 454   ;; Find out the place where to manage client
 455   (let ((tpnt (car (XTranslateCoordinates
 456                     (xwem-dpy) (xwem-cl-xwin cl)
 457                     (xwem-rootwin) 0 0)))
 458         (xin (X-XIneramaQueryScreens (xwem-dpy)))
 459         (rx 0) (ry 0))
 460     ;; Xinerama stuff
 461     (when (car xin)
 462       ;; XInerama enabled
 463       (while (setq xin (cdr xin))
 464         (when (and (>= (X-Point-x tpnt) (X-Rect-x (car xin)))
 465                    (<= (X-Point-x tpnt)
 466                        (+ (X-Rect-x (car xin)) (X-Rect-width (car xin))))
 467                    (>= (X-Point-y tpnt) (X-Rect-y (car xin)))
 468                    (<= (X-Point-y tpnt)
 469                        (+ (X-Rect-y (car xin)) (X-Rect-height (car xin)))))
 470           (setq rx (X-Rect-x (car xin))
 471                 ry (X-Rect-y (car xin))
 472                 xin nil))))
 473
 474     (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) (xwem-rootwin) rx ry))
 475
 476   ;; Set geometry to initial
 477   (setf (xwem-cl-new-xgeom cl)
 478         (copy-X-Geom (xwem-cl-initial-xgeom cl)))
 479   (setf (X-Geom-border-width (xwem-cl-new-xgeom cl)) nil)
 480   (xwem-refit cl)
 481
 482   (xwem-use-local-map xwem-fullscreen-mode-map cl)
 483   (xwem-select-client cl)               ; XXX
 484
 485   (run-hook-with-args 'xwem-fullscreen-mode-hook cl))
 486
 487 ;;;###autoload(put 'manage 'fullscreen 'xwem-manage-fullscreen)
 488
 489 (defun xwem-fullscreen-refit-full (cl)
 490   "Refit CL to fullscreen."
 491   (let* ((tpnt (car (XTranslateCoordinates (xwem-dpy) (xwem-cl-xwin cl)
 492                                            (xwem-rootwin) 0 0)))
 493          (crect (make-X-Rect :x (X-Point-x tpnt) :y (X-Point-y tpnt)
 494                              :width (X-Geom-width (xwem-cl-xgeom cl))
 495                              :height (X-Geom-height (xwem-cl-xgeom cl))))
 496          (xin (X-XIneramaQueryScreens (xwem-dpy))))
 497     (if (car xin)
 498         (progn
 499           ;; XInerama enabled
 500           (while (and (setq xin (cdr xin))
 501                       (not (X-Rect-intersect-p (car xin) crect))))
 502           (setq xin (X-Rect-to-X-Geom (car xin))))
 503
 504       ;; No XInerama, so use root geometry
 505       (setq xin (xwem-rootgeom)))
 506
 507     ;; Update geometry to not overlap xwem minibuffer, if
 508     ;; 'no-minib-overlap CL property is set.
 509     (when (xwem-client-property cl 'fs-avoid-minib-overlap)
 510       (setf (X-Geom-height xin)
 511             (- (X-Geom-height xin)
 512                (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)))))
 513
 514     (setf (X-Geom-border-width xin)
 515           (X-Geom-border-width (xwem-cl-xgeom cl)))
 516
 517     ;; Update CL geometry
 518     (xwem-cl-correct-size-for-size cl xin)))
 519
 520 (defun xwem-fullscreen-refit-real (cl)
 521   "Refit to real CL's size."
 522   (xwem-cl-apply-new-xgeom cl))
 523
 524 (defun xwem-refit-fullscreen (cl)
 525   "Refit method for fullscreen client CL."
 526   (cond ((xwem-client-property cl 'fs-real-size)
 527          (xwem-fullscreen-refit-real cl))
 528         (t (xwem-fullscreen-refit-full cl)))
 529
 530   (xwem-cl-apply-xgeom cl))
 531
 532 (define-xwem-deffered xwem-fullscreen-apply-state (cl)
 533   "Apply CL's state to life."
 534   (when (xwem-cl-p cl)
 535     (case (xwem-cl-state cl)
 536       (active
 537        (xwem-misc-set-xwin-always-on-top
 538         (xwem-cl-xwin cl) (car xwem-fullscreen-ai-rank))
 539        (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)))
 540
 541       (inactive
 542        (xwem-misc-set-xwin-always-on-top
 543         (xwem-cl-xwin cl) (cdr xwem-fullscreen-ai-rank))
 544        (when (and xwem-fullscreen-iconify-when-inactive
 545                   ;; XXX skip dummy clients and special
 546                   (not (or (xwem-dummy-client-p (xwem-cl-selected))
 547                            (xwem-special-p (xwem-cl-selected)))))
 548          (xwem-iconify cl)))
 549
 550       (iconified
 551        (xwem-misc-set-xwin-always-on-top
 552         (xwem-cl-xwin cl) (cdr xwem-fullscreen-ai-rank))
 553        (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl))))))
 554
 555 (defun xwem-activate-fullscreen (cl &optional type)
 556   "Activate method for fullscreen client CL."
 557   (xwem-fullscreen-apply-state cl))
 558
 559 (defun xwem-deactivate-fullscreen (cl &optional type)
 560   "Deactivate fullscreen client CL."
 561   (cond ((eq type 'deactivate)
 562          (xwem-fullscreen-apply-state cl))
 563
 564         ((eq type 'deselect)
 565          (when (xwem-cl-active-p cl)
 566            (xwem-client-change-state cl 'inactive))
 567          (xwem-fullscreen-apply-state cl))))
 568
 569 (defun xwem-iconify-fullscreen (cl)
 570   "Iconify method for fullscreen client CL."
 571   (xwem-fullscreen-apply-state cl))
 572
 573 ;;; Additional methods
 574 (define-xwem-method other-client fullscreen (cl)
 575   "Return fullscreen client other then CL."
 576   (or (xwem-cl-other cl :clients (xwem-clients-list 'xwem-cl-fullscreen-p))
 577       (and xwem-fullscreen-switch-any-other
 578            (xwem-cl-other cl))))
 579
 580 ;;;; ---- Fullscreen Commands ----
 581
 582 ;;;###autoload(autoload 'xwem-toggle-fullscreen "xwem-netwm" nil t)
 583 (define-xwem-command xwem-toggle-fullscreen (cl &optional force)
 584   "Enable/disable fullscreen mode for CL.
 585 Optional argument FORCE is one of:
 586   `on'  - Force fullscreen.
 587   `off' - Force non-fullscreen."
 588   (xwem-interactive (list (xwem-cl-selected)))
 589
 590   (let ((xwin (xwem-cl-xwin cl)))
 591     (cond ((and (eq (xwem-cl-manage-type cl) 'fullscreen)
 592                 (or (null force) (eq force 'off)))
 593            (xwem-nwm-set-state xwin nil)
 594            (let ((mspec (xwem-manda-find-match-1 cl xwem-manage-internal-list)))
 595              (if (and mspec (not (eq (car mspec) 'fullscreen)))
 596                  ;; If there some other than 'fullscreen manda entry - use it!
 597                  (xwem-client-change-manage-type cl mspec)
 598                ;; Otherwise try default 'generic manda
 599                (xwem-client-change-manage-type cl '(generic)))))
 600
 601           ((and (not (eq (xwem-cl-manage-type cl) 'fullscreen))
 602                 (or (null force) (eq force 'on)))
 603            (xwem-nwm-set-state xwin _NET_WM_STATE_FULLSCREEN)
 604            (xwem-client-change-manage-type cl '(fullscreen))))))
 605
 606 ;;;###autoload(autoload 'xwem-switch-to-fullscreen-cl "xwem-netwm" nil t)
 607 (define-xwem-command xwem-switch-to-fullscreen-cl ()
 608   "Switch to client that in fullscreen mode."
 609   (xwem-interactive)
 610
 611   (let* ((fsclients (xwem-clients-list 'xwem-cl-fullscreen-p))
 612          (cl (and fsclients (xwem-read-client "Fullscreen CL: " fsclients))))
 613
 614     (unless (xwem-cl-alive-p cl)
 615       (error 'xwem-error "No fullscreen clients"))
 616
 617     (xwem-select-client cl)))
 618
 619 \f
 620 (provide 'xwem-netwm)
 621 ;;;; On-load actions
 622
 623 ;; Fullscreen manage type
 624 (define-xwem-manage-model fullscreen
 625   "Managing model to show client at fullscreen size."
 626   :match-spec '(function xwem-netwm-fullscreen-p)
 627   :manage-properties '(omit-aspect-ratio t) ; disregard aspect ratio
 628
 629   :manage-method 'xwem-manage-fullscreen
 630   :activate-method 'xwem-activate-fullscreen
 631   :deactivate-method 'xwem-deactivate-fullscreen
 632   :refit-method 'xwem-refit-fullscreen
 633   :iconify-method 'xwem-iconify-fullscreen)
 634
 635 (if xwem-started
 636     (xwem-nwm-init)
 637   (add-hook 'xwem-after-init-hook 'xwem-nwm-init))
 638
 639 ;;; xwem-netwm.el ends here