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) 2011 Philippe Brochard <hocwp@free.fr>
  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
  42
  43 (defun set-nw-hook (hook)
  44   "Set the hook of the current child"
  45   (let ((frame (if (xlib:window-p *current-child*)
  46                    (find-parent-frame *current-child*)
  47                    *current-child*)))
  48     (setf (frame-nw-hook frame) hook)
  49     (leave-second-mode)))
  50
  51 (defun register-nw-hook (hook)
  52   (add-menu-key 'frame-nw-hook-menu (code-char *nw-hook-current-key*) hook)
  53   (incf *nw-hook-current-key*))
  54
  55
  56 (defun default-window-placement (frame window)
  57   (if (managed-window-p window frame)
  58       (adapt-child-to-parent window frame)
  59       (place-window-from-hints window)))
  60
  61 (defun leave-if-not-frame (child)
  62   "Leave the child if it's not a frame"
  63   (when (xlib:window-p child)
  64     (leave-frame)
  65     (select-previous-level)))
  66
  67 (defun clear-nw-hook (frame)
  68   "Clear the frame new window hook"
  69   (setf (frame-nw-hook frame) nil))
  70
  71 (defun clear-all-nw-hooks ()
  72   "Clear all new window hooks for all frames"
  73   (with-all-frames (*root-frame* frame)
  74     (clear-nw-hook frame)))
  75
  76
  77
  78 ;;; Default frame new window hook
  79 (defun default-frame-nw-hook (frame window)
  80   "Open the next window in the current frame"
  81   (declare (ignore frame))
  82   (leave-if-not-frame *current-child*)
  83   (when (frame-p *current-child*)
  84     (pushnew window (frame-child *current-child*)))
  85   (default-window-placement *current-child* window)
  86   t)
  87
  88 (defun set-default-frame-nw-hook ()
  89   "Open the next window in the current frame"
  90   (set-nw-hook #'default-frame-nw-hook))
  91
  92 (register-nw-hook 'set-default-frame-nw-hook)
  93
  94
  95 ;;; Open new window in current root hook
  96 (defun open-in-current-root-nw-hook (frame window)
  97   "Open the next window in the current root"
  98   (clear-nw-hook frame)
  99   (leave-if-not-frame *current-root*)
 100   (pushnew window (frame-child *current-root*))
 101   (setf *current-child* (frame-selected-child *current-root*))
 102   (default-window-placement *current-root* window)
 103   t)
 104
 105 (defun set-open-in-current-root-nw-hook ()
 106   "Open the next window in the current root"
 107   (set-nw-hook #'open-in-current-root-nw-hook))
 108
 109 (register-nw-hook 'set-open-in-current-root-nw-hook)
 110
 111
 112 ;;; Open new window in a new frame in the current root hook
 113 (defun open-in-new-frame-in-current-root-nw-hook (frame window)
 114   "Open the next window in a new frame in the current root"
 115   (clear-nw-hook frame)
 116   (leave-if-not-frame *current-root*)
 117   (let ((new-frame (create-frame)))
 118     (pushnew new-frame (frame-child *current-root*))
 119     (pushnew window (frame-child new-frame))
 120     (setf *current-child* new-frame)
 121     (default-window-placement new-frame window))
 122   t)
 123
 124 (defun set-open-in-new-frame-in-current-root-nw-hook ()
 125   "Open the next window in a new frame in the current root"
 126   (set-nw-hook #'open-in-new-frame-in-current-root-nw-hook))
 127
 128 (register-nw-hook 'set-open-in-new-frame-in-current-root-nw-hook)
 129
 130
 131 ;;; Open new window in a new frame in the root frame hook
 132 (defun open-in-new-frame-in-root-frame-nw-hook (frame window)
 133   "Open the next window in a new frame in the root frame"
 134   (clear-nw-hook frame)
 135   (let ((new-frame (create-frame)))
 136     (pushnew new-frame (frame-child *root-frame*))
 137     (pushnew window (frame-child new-frame))
 138     (switch-to-root-frame :show-later t)
 139     (setf *current-child* *current-root*)
 140     (set-layout-once #'tile-space-layout)
 141     (setf *current-child* new-frame)
 142     (default-window-placement new-frame window))
 143   t)
 144
 145 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
 146   "Open the next window in a new frame in the root frame"
 147   (set-nw-hook #'open-in-new-frame-in-root-frame-nw-hook))
 148
 149 (register-nw-hook 'set-open-in-new-frame-in-root-frame-nw-hook)
 150
 151
 152 ;;; Open new window in a new frame in the parent frame hook
 153 (defun open-in-new-frame-in-parent-frame-nw-hook (frame window)
 154   "Open the next window in a new frame in the parent frame"
 155   (clear-nw-hook frame)
 156   (let ((new-frame (create-frame))
 157         (parent (find-parent-frame frame)))
 158     (when parent
 159       (pushnew new-frame (frame-child parent))
 160       (pushnew window (frame-child new-frame))
 161       (setf *current-root* parent
 162             *current-child* parent)
 163       (set-layout-once #'tile-space-layout)
 164       (setf *current-child* new-frame)
 165       (default-window-placement new-frame window)
 166       (show-all-children t)
 167       t)))
 168
 169
 170 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
 171   "Open the next window in a new frame in the parent frame"
 172   (set-nw-hook #'open-in-new-frame-in-parent-frame-nw-hook))
 173
 174 (register-nw-hook 'set-open-in-new-frame-in-parent-frame-nw-hook)
 175
 176
 177
 178 ;;; Open a new window but leave the focus on the current child
 179 (defun leave-focus-frame-nw-hook (frame window)
 180   "Open the next window in the current frame and leave the focus on the current child"
 181   (clear-nw-hook frame)
 182   (leave-if-not-frame *current-child*)
 183   (when (frame-p *current-child*)
 184     (with-slots (child) *current-child*
 185       (pushnew window child)
 186       (setf child (rotate-list child))))
 187   (default-window-placement *current-child* window)
 188   t)
 189
 190 (defun set-leave-focus-frame-nw-hook ()
 191   "Open the next window in the current frame and leave the focus on the current child"
 192   (set-nw-hook #'leave-focus-frame-nw-hook))
 193
 194 (register-nw-hook 'set-leave-focus-frame-nw-hook)
 195
 196
 197
 198
 199
 200 (defun nw-hook-open-in-frame (window frame)
 201   (when (frame-p frame)
 202     (pushnew window (frame-child frame))
 203     (unless (find-child frame *current-root*)
 204       (setf *current-root* frame))
 205     (setf *current-child* frame)
 206     (focus-all-children window frame)
 207     (default-window-placement frame window)
 208     (show-all-children t)
 209     t))
 210
 211 ;;; Open a new window in a named frame
 212 (defun named-frame-nw-hook (frame window)
 213   (clear-nw-hook frame)
 214   (let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
 215          (new-frame (find-frame-by-name frame-name)))
 216     (nw-hook-open-in-frame window new-frame))
 217   t)
 218
 219 (defun set-named-frame-nw-hook ()
 220   "Open the next window in a named frame"
 221   (set-nw-hook #'named-frame-nw-hook))
 222
 223 (register-nw-hook 'set-named-frame-nw-hook)
 224
 225
 226 ;;; Open a new window in a numbered frame
 227 (defun numbered-frame-nw-hook (frame window)
 228   (clear-nw-hook frame)
 229   (let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
 230     (nw-hook-open-in-frame window new-frame))
 231   t)
 232
 233 (defun set-numbered-frame-nw-hook ()
 234   "Open the next window in a numbered frame"
 235   (set-nw-hook #'numbered-frame-nw-hook))
 236
 237 (register-nw-hook 'set-numbered-frame-nw-hook)
 238
 239
 240 ;;; Absorb window.
 241 ;;; The frame absorb the new window if it match the absorb-nw-test
 242 ;;; frame data slot.
 243 (defun absorb-window-nw-hook (frame window)
 244   (let ((absorb-nw-test (frame-data-slot frame :nw-absorb-test)))
 245     (when (and absorb-nw-test
 246                (funcall absorb-nw-test window))
 247       (pushnew window (frame-child frame))
 248       (unless *in-process-existing-windows*
 249         (unless (find-child frame *current-root*)
 250           (setf *current-root* frame))
 251         (setf *current-child* frame)
 252         (focus-all-children window frame)
 253         (default-window-placement frame window)
 254         (show-all-children t))
 255       (throw 'nw-hook-loop t)))
 256   nil)
 257
 258 (defun set-absorb-window-nw-hook ()
 259   "Open the window in this frame if it match absorb-nw-test"
 260   (set-nw-hook #'absorb-window-nw-hook))
 261
 262 (register-nw-hook 'set-absorb-window-nw-hook)
 263
 264
 265 (defun nw-absorb-test-class (class-string)
 266   (lambda (c)
 267     (and (xlib:window-p c)
 268          (string-equal (xlib:get-wm-class c) class-string))))
 269