src/clfswm-nw-hooks.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: New window Hooks
   6 ;;;
   7 ;;;  Those hooks can be set for each frame to manage new window when they are
   8 ;;;  mapped.
   9 ;;; --------------------------------------------------------------------------
  10 ;;;
  11 ;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
  12 ;;;
  13 ;;; This program is free software; you can redistribute it and/or modify
  14 ;;; it under the terms of the GNU General Public License as published by
  15 ;;; the Free Software Foundation; either version 3 of the License, or
  16 ;;; (at your option) any later version.
  17 ;;;
  18 ;;; This program is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;; GNU General Public License for more details.
  22 ;;;
  23 ;;; You should have received a copy of the GNU General Public License
  24 ;;; along with this program; if not, write to the Free Software
  25 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  26 ;;;
  27 ;;; --------------------------------------------------------------------------
  28
  29 (in-package :clfswm)
  30
  31
  32 ;;; CONFIG - New window menu
  33 ;;;
  34 ;;; To add a new window hook (nw-hook):
  35 ;;;   1- define your own nw-hook
  36 ;;;   2- Define a seter function for your new hook
  37 ;;;   3- Register your new hook with register-nw-hook.
  38
  39
  40 (defparameter *nw-hook-current-key* (char-code #\a))
  41 (defparameter *permanent-nw-hook-frames* nil)
  42
  43
  44 (defun set-nw-hook (hook)
  45   "Set the hook of the current child"
  46   (let ((frame (if (xlib:window-p (current-child))
  47                    (find-parent-frame (current-child))
  48                    (current-child))))
  49     (unless (or (child-member frame *permanent-nw-hook-frames*)
  50                 (child-original-root-p frame))
  51       (setf (frame-nw-hook frame) hook)
  52       (leave-second-mode))))
  53
  54 (defun register-nw-hook (hook)
  55   (add-menu-key 'frame-nw-hook-menu (code-char *nw-hook-current-key*) hook)
  56   (incf *nw-hook-current-key*))
  57
  58
  59 (defun default-window-placement (frame window)
  60   (if (managed-window-p window frame)
  61       (adapt-child-to-parent window frame)
  62       (place-window-from-hints window)))
  63
  64 (defun leave-if-not-frame (child)
  65   "Leave the child if it's not a frame"
  66   (unless (frame-p child)
  67     (leave-frame)
  68     (select-previous-level)))
  69
  70 (defun clear-nw-hook (frame)
  71   "Clear the frame new window hook"
  72   (unless (child-member frame *permanent-nw-hook-frames*)
  73     (setf (frame-nw-hook frame) nil)))
  74
  75
  76 (defun clear-all-nw-hooks ()
  77   "Clear all new window hooks for all frames"
  78   (with-all-frames (*root-frame* frame)
  79     (clear-nw-hook frame)))
  80
  81
  82 (defun make-permanent-nw-hook-frame (frame)
  83   "Prevent to add or delete a new window hook for this frame"
  84   (when (frame-p frame)
  85     (push frame *permanent-nw-hook-frames*)))
  86
  87
  88 ;;; Default frame new window hook
  89 (defun default-frame-nw-hook (frame window)
  90   "Open the next window in the current frame"
  91   (declare (ignore frame))
  92   (leave-if-not-frame (current-child))
  93   (when (frame-p (current-child))
  94     (pushnew window (frame-child (current-child))))
  95   (default-window-placement (current-child) window)
  96   t)
  97
  98 (defun set-default-frame-nw-hook ()
  99   "Open the next window in the current frame"
 100   (set-nw-hook #'default-frame-nw-hook))
 101
 102 (register-nw-hook 'set-default-frame-nw-hook)
 103
 104
 105 ;;; Open new window in current root hook
 106 (defun open-in-current-root-nw-hook (frame window)
 107   "Open the next window in the current root"
 108   (clear-nw-hook frame)
 109   (leave-if-not-frame (find-current-root))
 110   (let ((root (find-current-root)))
 111     (pushnew window (frame-child root))
 112     (setf (current-child) (frame-selected-child root))
 113     (default-window-placement root window))
 114   t)
 115
 116 (defun set-open-in-current-root-nw-hook ()
 117   "Open the next window in the current root"
 118   (set-nw-hook #'open-in-current-root-nw-hook))
 119
 120 (register-nw-hook 'set-open-in-current-root-nw-hook)
 121
 122
 123 ;;; Open new window in a new frame in the current root hook
 124 (defun open-in-new-frame-in-current-root-nw-hook (frame window)
 125   "Open the next window in a new frame in the current root"
 126   (clear-nw-hook frame)
 127   (leave-if-not-frame (find-current-root))
 128   (let ((new-frame (create-frame))
 129         (root (find-current-root)))
 130     (pushnew new-frame (frame-child root))
 131     (pushnew window (frame-child new-frame))
 132     (setf (current-child) new-frame)
 133     (default-window-placement new-frame window))
 134   t)
 135
 136 (defun set-open-in-new-frame-in-current-root-nw-hook ()
 137   "Open the next window in a new frame in the current root"
 138   (set-nw-hook #'open-in-new-frame-in-current-root-nw-hook))
 139
 140 (register-nw-hook 'set-open-in-new-frame-in-current-root-nw-hook)
 141
 142
 143 ;;; Open new window in a new frame in the root frame hook
 144 (defun open-in-new-frame-in-root-frame-nw-hook (frame window)
 145   "Open the next window in a new frame in the root frame"
 146   (clear-nw-hook frame)
 147   (let ((new-frame (create-frame))
 148         (root (find-current-root)))
 149     (pushnew new-frame (frame-child root))
 150     (pushnew window (frame-child new-frame))
 151     (switch-to-root-frame :show-later t)
 152     (setf (current-child) root)
 153     (set-layout-once #'tile-space-layout)
 154     (setf (current-child) new-frame)
 155     (default-window-placement new-frame window))
 156   t)
 157
 158 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
 159   "Open the next window in a new frame in the root frame"
 160   (set-nw-hook #'open-in-new-frame-in-root-frame-nw-hook))
 161
 162 (register-nw-hook 'set-open-in-new-frame-in-root-frame-nw-hook)
 163
 164
 165 ;;; Open new window in a new frame in the parent frame hook
 166 (defun open-in-new-frame-in-parent-frame-nw-hook (frame window)
 167   "Open the next window in a new frame in the parent frame"
 168   (clear-nw-hook frame)
 169   (let ((new-frame (create-frame))
 170         (parent (find-parent-frame frame)))
 171     (when parent
 172       (pushnew new-frame (frame-child parent))
 173       (pushnew window (frame-child new-frame))
 174       (change-root (find-root parent) parent)
 175       (setf (current-child) parent)
 176       (set-layout-once #'tile-space-layout)
 177       (setf (current-child) new-frame)
 178       (default-window-placement new-frame window)
 179       (show-all-children t)
 180       t)))
 181
 182
 183 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
 184   "Open the next window in a new frame in the parent frame"
 185   (set-nw-hook #'open-in-new-frame-in-parent-frame-nw-hook))
 186
 187 (register-nw-hook 'set-open-in-new-frame-in-parent-frame-nw-hook)
 188
 189
 190
 191 ;;; Open a new window but leave the focus on the current child
 192 (defun leave-focus-frame-nw-hook (frame window)
 193   "Open the next window in the current frame and leave the focus on the current child"
 194   (clear-nw-hook frame)
 195   (leave-if-not-frame (current-child))
 196   (when (frame-p (current-child))
 197     (with-slots (child) (current-child)
 198       (pushnew window child)
 199       (setf child (rotate-list child))))
 200   (default-window-placement (current-child) window)
 201   t)
 202
 203 (defun set-leave-focus-frame-nw-hook ()
 204   "Open the next window in the current frame and leave the focus on the current child"
 205   (set-nw-hook #'leave-focus-frame-nw-hook))
 206
 207 (register-nw-hook 'set-leave-focus-frame-nw-hook)
 208
 209
 210
 211
 212
 213 (defun nw-hook-open-in-frame (window frame)
 214   (when (frame-p frame)
 215     (pushnew window (frame-child frame))
 216     (unless (find-child-in-all-root frame)
 217       (change-root (find-root frame) frame))
 218     (setf (current-child) frame)
 219     (focus-all-children window frame)
 220     (default-window-placement frame window)
 221     (show-all-children t)
 222     t))
 223
 224 ;;; Open a new window in a named frame
 225 (defun named-frame-nw-hook (frame window)
 226   (clear-nw-hook frame)
 227   (let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
 228          (new-frame (find-frame-by-name frame-name)))
 229     (nw-hook-open-in-frame window new-frame))
 230   t)
 231
 232 (defun set-named-frame-nw-hook ()
 233   "Open the next window in a named frame"
 234   (set-nw-hook #'named-frame-nw-hook))
 235
 236 (register-nw-hook 'set-named-frame-nw-hook)
 237
 238
 239 ;;; Open a new window in a numbered frame
 240 (defun numbered-frame-nw-hook (frame window)
 241   (clear-nw-hook frame)
 242   (let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
 243     (nw-hook-open-in-frame window new-frame))
 244   t)
 245
 246 (defun set-numbered-frame-nw-hook ()
 247   "Open the next window in a numbered frame"
 248   (set-nw-hook #'numbered-frame-nw-hook))
 249
 250 (register-nw-hook 'set-numbered-frame-nw-hook)
 251
 252
 253 ;;; Absorb window.
 254 ;;; The frame absorb the new window if it match the nw-absorb-test
 255 ;;; frame data slot.
 256 (defun absorb-window-nw-hook (frame window)
 257   (let ((absorb-nw-test (frame-data-slot frame :nw-absorb-test)))
 258     (when (and absorb-nw-test
 259                (funcall absorb-nw-test window))
 260       (pushnew window (frame-child frame))
 261       (unless *in-process-existing-windows*
 262         (unless (find-child-in-all-root frame)
 263           (change-root (find-root frame) frame))
 264         (setf (current-child) frame)
 265         (focus-all-children window frame)
 266         (default-window-placement frame window)
 267         (show-all-children t))
 268       (throw 'nw-hook-loop t)))
 269   nil)
 270
 271 (defun set-absorb-window-nw-hook ()
 272   "Open the window in this frame if it match nw-absorb-test"
 273   (set-nw-hook #'absorb-window-nw-hook))
 274
 275 (register-nw-hook 'set-absorb-window-nw-hook)
 276
 277
 278 (defun nw-absorb-test-class (class-string)
 279   (lambda (c)
 280     (and (xlib:window-p c)
 281          (string-equal (xlib:get-wm-class c) class-string))))
 282