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
  87 (defun set-default-frame-nw-hook ()
  88   "Open the next window in the current frame"
  89   (set-nw-hook #'default-frame-nw-hook))
  90
  91 (register-nw-hook 'set-default-frame-nw-hook)
  92
  93
  94 ;;; Open new window in current root hook
  95 (defun open-in-current-root-nw-hook (frame window)
  96   "Open the next window in the current root"
  97   (clear-nw-hook frame)
  98   (leave-if-not-frame *current-root*)
  99   (pushnew window (frame-child *current-root*))
 100   (setf *current-child* (frame-selected-child *current-root*))
 101   (default-window-placement *current-root* window))
 102
 103 (defun set-open-in-current-root-nw-hook ()
 104   "Open the next window in the current root"
 105   (set-nw-hook #'open-in-current-root-nw-hook))
 106
 107 (register-nw-hook 'set-open-in-current-root-nw-hook)
 108
 109
 110 ;;; Open new window in a new frame in the current root hook
 111 (defun open-in-new-frame-in-current-root-nw-hook (frame window)
 112   "Open the next window in a new frame in the current root"
 113   (clear-nw-hook frame)
 114   (leave-if-not-frame *current-root*)
 115   (let ((new-frame (create-frame)))
 116     (pushnew new-frame (frame-child *current-root*))
 117     (pushnew window (frame-child new-frame))
 118     (setf *current-child* new-frame)
 119     (default-window-placement new-frame window)))
 120
 121 (defun set-open-in-new-frame-in-current-root-nw-hook ()
 122   "Open the next window in a new frame in the current root"
 123   (set-nw-hook #'open-in-new-frame-in-current-root-nw-hook))
 124
 125 (register-nw-hook 'set-open-in-new-frame-in-current-root-nw-hook)
 126
 127
 128 ;;; Open new window in a new frame in the root frame hook
 129 (defun open-in-new-frame-in-root-frame-nw-hook (frame window)
 130   "Open the next window in a new frame in the root frame"
 131   (clear-nw-hook frame)
 132   (let ((new-frame (create-frame)))
 133     (pushnew new-frame (frame-child *root-frame*))
 134     (pushnew window (frame-child new-frame))
 135     (switch-to-root-frame :show-later t)
 136     (setf *current-child* *current-root*)
 137     (set-layout-once #'tile-space-layout)
 138     (setf *current-child* new-frame)
 139     (default-window-placement new-frame window)))
 140
 141 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
 142   "Open the next window in a new frame in the root frame"
 143   (set-nw-hook #'open-in-new-frame-in-root-frame-nw-hook))
 144
 145 (register-nw-hook 'set-open-in-new-frame-in-root-frame-nw-hook)
 146
 147
 148 ;;; Open new window in a new frame in the parent frame hook
 149 (defun open-in-new-frame-in-parent-frame-nw-hook (frame window)
 150   "Open the next window in a new frame in the parent frame"
 151   (clear-nw-hook frame)
 152   (let ((new-frame (create-frame))
 153         (parent (find-parent-frame frame)))
 154     (when parent
 155       (pushnew new-frame (frame-child parent))
 156       (pushnew window (frame-child new-frame))
 157       (hide-all *current-root*)
 158       (setf *current-root* parent
 159             *current-child* parent)
 160       (set-layout-once #'tile-space-layout)
 161       (setf *current-child* new-frame)
 162       (default-window-placement new-frame window)
 163       (show-all-children *current-root*))))
 164
 165
 166 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
 167   "Open the next window in a new frame in the parent frame"
 168   (set-nw-hook #'open-in-new-frame-in-parent-frame-nw-hook))
 169
 170 (register-nw-hook 'set-open-in-new-frame-in-parent-frame-nw-hook)
 171
 172
 173
 174 ;;; Open a new window but leave the focus on the current child
 175 (defun leave-focus-frame-nw-hook (frame window)
 176   "Open the next window in the current frame and leave the focus on the current child"
 177   (clear-nw-hook frame)
 178   (leave-if-not-frame *current-child*)
 179   (when (frame-p *current-child*)
 180     (with-slots (child) *current-child*
 181       (pushnew window child)
 182       (setf child (rotate-list child))))
 183   (default-window-placement *current-child* window))
 184
 185 (defun set-leave-focus-frame-nw-hook ()
 186   "Open the next window in the current frame and leave the focus on the current child"
 187   (set-nw-hook #'leave-focus-frame-nw-hook))
 188
 189 (register-nw-hook 'set-leave-focus-frame-nw-hook)
 190
 191
 192
 193
 194
 195 (defun nw-hook-open-in-frame (window frame)
 196   (when (frame-p frame)
 197     (pushnew window (frame-child frame))
 198     (unless (find-child frame *current-root*)
 199       (hide-all *current-root*)
 200       (setf *current-root* frame))
 201     (setf *current-child* frame)
 202     (focus-all-children window frame)
 203     (default-window-placement frame window)
 204     (show-all-children *current-root*)))
 205
 206 ;;; Open a new window in a named frame
 207 (defun named-frame-nw-hook (frame window)
 208   (clear-nw-hook frame)
 209   (let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
 210          (new-frame (find-frame-by-name frame-name)))
 211     (nw-hook-open-in-frame window new-frame)))
 212
 213 (defun set-named-frame-nw-hook ()
 214   "Open the next window in a named frame"
 215   (set-nw-hook #'named-frame-nw-hook))
 216
 217 (register-nw-hook 'set-named-frame-nw-hook)
 218
 219
 220 ;;; Open a new window in a numbered frame
 221 (defun numbered-frame-nw-hook (frame window)
 222   (clear-nw-hook frame)
 223   (let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
 224     (nw-hook-open-in-frame window new-frame)))
 225
 226 (defun set-numbered-frame-nw-hook ()
 227   "Open the next window in a numbered frame"
 228   (set-nw-hook #'numbered-frame-nw-hook))
 229
 230 (register-nw-hook 'set-numbered-frame-nw-hook)
 231