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) 2010 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       (hide-all *current-root*)
 162       (setf *current-root* parent
 163             *current-child* parent)
 164       (set-layout-once #'tile-space-layout)
 165       (setf *current-child* new-frame)
 166       (default-window-placement new-frame window)
 167       (show-all-children *current-root*)
 168       t)))
 169
 170
 171 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
 172   "Open the next window in a new frame in the parent frame"
 173   (set-nw-hook #'open-in-new-frame-in-parent-frame-nw-hook))
 174
 175 (register-nw-hook 'set-open-in-new-frame-in-parent-frame-nw-hook)
 176
 177
 178
 179 ;;; Open a new window but leave the focus on the current child
 180 (defun leave-focus-frame-nw-hook (frame window)
 181   "Open the next window in the current frame and leave the focus on the current child"
 182   (clear-nw-hook frame)
 183   (leave-if-not-frame *current-child*)
 184   (when (frame-p *current-child*)
 185     (with-slots (child) *current-child*
 186       (pushnew window child)
 187       (setf child (rotate-list child))))
 188   (default-window-placement *current-child* window)
 189   t)
 190
 191 (defun set-leave-focus-frame-nw-hook ()
 192   "Open the next window in the current frame and leave the focus on the current child"
 193   (set-nw-hook #'leave-focus-frame-nw-hook))
 194
 195 (register-nw-hook 'set-leave-focus-frame-nw-hook)
 196
 197
 198
 199
 200
 201 (defun nw-hook-open-in-frame (window frame)
 202   (when (frame-p frame)
 203     (pushnew window (frame-child frame))
 204     (unless (find-child frame *current-root*)
 205       (hide-all *current-root*)
 206       (setf *current-root* frame))
 207     (setf *current-child* frame)
 208     (focus-all-children window frame)
 209     (default-window-placement frame window)
 210     (show-all-children *current-root*)
 211     t))
 212
 213 ;;; Open a new window in a named frame
 214 (defun named-frame-nw-hook (frame window)
 215   (clear-nw-hook frame)
 216   (let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
 217          (new-frame (find-frame-by-name frame-name)))
 218     (nw-hook-open-in-frame window new-frame))
 219   t)
 220
 221 (defun set-named-frame-nw-hook ()
 222   "Open the next window in a named frame"
 223   (set-nw-hook #'named-frame-nw-hook))
 224
 225 (register-nw-hook 'set-named-frame-nw-hook)
 226
 227
 228 ;;; Open a new window in a numbered frame
 229 (defun numbered-frame-nw-hook (frame window)
 230   (clear-nw-hook frame)
 231   (let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
 232     (nw-hook-open-in-frame window new-frame))
 233   t)
 234
 235 (defun set-numbered-frame-nw-hook ()
 236   "Open the next window in a numbered frame"
 237   (set-nw-hook #'numbered-frame-nw-hook))
 238
 239 (register-nw-hook 'set-numbered-frame-nw-hook)
 240
 241
 242 ;;; Absorb window.
 243 ;;; The frame absorb the new window if it match the absorb-nw-test
 244 ;;; frame data slot.
 245 (defun absorb-window-nw-hook (frame window)
 246   (let ((absorb-nw-test (frame-data-slot frame :nw-absorb-test)))
 247     (when (and absorb-nw-test
 248                (funcall absorb-nw-test window))
 249       (pushnew window (frame-child frame))
 250       (unless *in-process-existing-windows*
 251         (unless (find-child frame *current-root*)
 252           (hide-all *current-root*)
 253           (setf *current-root* frame))
 254         (setf *current-child* frame)
 255         (focus-all-children window frame)
 256         (default-window-placement frame window)
 257         (show-all-children *current-root*))
 258       (throw 'nw-hook-loop t)))
 259   nil)
 260
 261 (defun set-absorb-window-nw-hook ()
 262   "Open the window in this frame if it match absorb-nw-test"
 263   (set-nw-hook #'absorb-window-nw-hook))
 264
 265 (register-nw-hook 'set-absorb-window-nw-hook)
 266
 267
 268 (defun nw-absorb-test-class (class-string)
 269   (lambda (c)
 270     (and (xlib:window-p c)
 271          (string-equal (xlib:get-wm-class c) class-string))))
 272