src/clfswm-circulate-mode.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Main functions
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2011 Philippe Brochard <hocwp@free.fr>
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software
  22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23 ;;;
  24 ;;; --------------------------------------------------------------------------
  25
  26 (in-package :clfswm)
  27
  28 (defparameter *circulate-window* nil)
  29 (defparameter *circulate-font* nil)
  30 (defparameter *circulate-gc* nil)
  31
  32 (defparameter *circulate-hit* 0)
  33 (defparameter *circulate-orig* nil)
  34 (defparameter *circulate-parent* nil)
  35
  36 (defun draw-circulate-mode-window ()
  37   (raise-window *circulate-window*)
  38   (clear-pixmap-buffer *circulate-window* *circulate-gc*)
  39   (let* ((text (format nil "~A [~A]"
  40                        (limit-length (ensure-printable (child-name (xlib:input-focus *display*)))
  41                                      *circulate-text-limite*)
  42                        (limit-length (ensure-printable (child-name *current-child*))
  43                                      *circulate-text-limite*)))
  44          (len (length text)))
  45     (xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
  46                       (truncate (/ (- *circulate-width* (* (xlib:max-char-width *circulate-font*) len)) 2))
  47                       (truncate (/ (+ *circulate-height* (- (xlib:font-ascent *circulate-font*) (xlib:font-descent *circulate-font*))) 2))
  48                       text))
  49   (copy-pixmap-buffer *circulate-window* *circulate-gc*))
  50
  51
  52
  53 (defun leave-circulate-mode ()
  54   "Leave the circulate mode"
  55   (throw 'exit-circulate-loop nil))
  56
  57
  58
  59 (defun reset-circulate-child ()
  60   (setf *circulate-hit* 0
  61         *circulate-parent* nil
  62         *circulate-orig* (frame-child *current-child*)))
  63
  64 (defun reset-circulate-brother ()
  65   (setf *circulate-parent* (find-parent-frame *current-child*))
  66   (when (frame-p *circulate-parent*)
  67     (setf *circulate-orig* (frame-child *circulate-parent*))))
  68
  69
  70
  71 (defun reorder-child (direction)
  72   (no-focus)
  73   (with-slots (child) *current-child*
  74     (unless *circulate-orig*
  75       (reset-circulate-child))
  76     (let ((len (length *circulate-orig*)))
  77       (when (plusp len)
  78         (let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
  79           (setf child (cons elem (child-remove elem *circulate-orig*)))))
  80       (show-all-children)
  81       (draw-circulate-mode-window))))
  82
  83
  84 (defun reorder-brother (direction)
  85   (no-focus)
  86   (let ((frame-is-root? (and (child-equal-p *current-root* *current-child*)
  87                              (not (child-equal-p *current-root* *root-frame*)))))
  88     (select-current-frame nil)
  89     (unless (and *circulate-orig* *circulate-parent*)
  90       (reset-circulate-brother))
  91     (let ((len (length *circulate-orig*)))
  92       (when (plusp len)
  93         (when (frame-p *circulate-parent*)
  94           (let ((elem (nth (mod  (incf *circulate-hit* direction) len) *circulate-orig*)))
  95             (setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
  96                   *current-child* (frame-selected-child *circulate-parent*))))
  97         (when frame-is-root?
  98           (setf *current-root* *current-child*))))
  99     (show-all-children t)
 100     (draw-circulate-mode-window)))
 101
 102 (defun reorder-subchild (direction)
 103   (declare (ignore direction))
 104   (when (frame-p *current-child*)
 105     (let ((selected-child (frame-selected-child *current-child*)))
 106       (when (frame-p selected-child)
 107         (no-focus)
 108         (with-slots (child) selected-child
 109           (let ((elem (first (last child))))
 110             (setf child (cons elem (child-remove elem child)))
 111             (show-all-children)
 112             (draw-circulate-mode-window)))))))
 113
 114
 115
 116
 117
 118 (defun circulate-select-next-child ()
 119   "Select the next child"
 120   (when (frame-p *current-child*)
 121     (when *circulate-parent*
 122       (reset-circulate-child))
 123     (reorder-child +1)))
 124
 125 (defun circulate-select-previous-child ()
 126   "Select the previous child"
 127   (when (frame-p *current-child*)
 128     (when *circulate-parent*
 129       (reset-circulate-child))
 130     (reorder-child -1)))
 131
 132
 133 (defun circulate-select-next-brother ()
 134   "Select the next brother"
 135   (unless *circulate-parent*
 136     (reset-circulate-brother))
 137   (reorder-brother +1))
 138
 139 (defun circulate-select-previous-brother ()
 140   "Select the previous borther"
 141   (unless *circulate-parent*
 142     (reset-circulate-brother))
 143   (reorder-brother -1))
 144
 145 (defun circulate-select-next-subchild ()
 146   "Select the next subchild"
 147   (reorder-subchild +1))
 148
 149
 150
 151 (add-hook *binding-hook* 'set-default-circulate-keys)
 152
 153 (defun set-default-circulate-keys ()
 154   (define-circulate-key ("Escape") 'leave-circulate-mode)
 155   (define-circulate-key ("g" :control) 'leave-circulate-mode)
 156   (define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
 157   (define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
 158   (define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
 159   (define-circulate-key ("Tab" :mod-1 :control) 'circulate-select-next-subchild)
 160   (define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
 161   (define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
 162   (define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
 163   (define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
 164   (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode)
 165   (define-circulate-release-key ("Alt_L") 'leave-circulate-mode))
 166
 167
 168 (defun circulate-leave-function ()
 169   (when *circulate-gc*
 170     (xlib:free-gcontext *circulate-gc*))
 171   (when *circulate-window*
 172     (xlib:destroy-window *circulate-window*))
 173   (when *circulate-font*
 174     (xlib:close-font *circulate-font*))
 175   (xlib:display-finish-output *display*)
 176   (setf *circulate-window* nil
 177         *circulate-gc* nil
 178         *circulate-font* nil))
 179
 180 (defun circulate-loop-function ()
 181   (unless (is-a-key-pressed-p)
 182     (leave-circulate-mode)))
 183
 184 (define-handler circulate-mode :key-press (code state)
 185   (unless (funcall-key-from-code *circulate-keys* code state)
 186     (setf *circulate-hit* 0
 187           *circulate-orig* nil
 188           *circulate-parent* nil)
 189     (funcall-key-from-code *main-keys* code state)))
 190
 191
 192 (define-handler circulate-mode :key-release (code state)
 193   (funcall-key-from-code *circulate-keys-release* code state))
 194
 195
 196
 197 (defun circulate-mode (&key child-direction brother-direction subchild-direction)
 198   (setf *circulate-hit* 0)
 199   (with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
 200     (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
 201           *circulate-window* (xlib:create-window :parent *root*
 202                                                  :x x
 203                                                  :y y
 204                                                  :width *circulate-width*
 205                                                  :height *circulate-height*
 206                                                  :background (get-color *circulate-background*)
 207                                                  :border-width *border-size*
 208                                                  :border (get-color *circulate-border*)
 209                                                  :colormap (xlib:screen-default-colormap *screen*)
 210                                                  :event-mask '(:exposure :key-press))
 211           *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
 212                                                :foreground (get-color *circulate-foreground*)
 213                                                :background (get-color *circulate-background*)
 214                                                :font *circulate-font*
 215                                                :line-style :solid))
 216     (map-window *circulate-window*)
 217     (draw-circulate-mode-window)
 218     (when child-direction
 219       (reorder-child child-direction))
 220     (when brother-direction
 221       (reorder-brother brother-direction))
 222     (when subchild-direction
 223       (reorder-subchild subchild-direction))
 224     (let ((grab-keyboard-p (xgrab-keyboard-p))
 225           (grab-pointer-p (xgrab-pointer-p)))
 226       (xgrab-pointer *root* 92 93)
 227       (unless grab-keyboard-p
 228         (ungrab-main-keys)
 229         (xgrab-keyboard *root*))
 230       (generic-mode 'circulate-mode 'exit-circulate-loop
 231                     :loop-function #'circulate-loop-function
 232                     :leave-function #'circulate-leave-function
 233                     :original-mode '(main-mode))
 234       (circulate-leave-function)
 235       (unless grab-keyboard-p
 236         (xungrab-keyboard)
 237         (grab-main-keys))
 238       (if grab-pointer-p
 239           (xgrab-pointer *root* 66 67)
 240           (xungrab-pointer)))))
 241
 242
 243 (defun select-next-child ()
 244   "Select the next child"
 245   (when (frame-p *current-child*)
 246     (setf *circulate-orig* (frame-child *current-child*)
 247           *circulate-parent* nil)
 248     (circulate-mode :child-direction +1)))
 249
 250 (defun select-previous-child ()
 251   "Select the previous child"
 252   (when (frame-p *current-child*)
 253     (setf *circulate-orig* (frame-child *current-child*)
 254           *circulate-parent* nil)
 255     (circulate-mode :child-direction -1)))
 256
 257
 258 (defun select-next-brother ()
 259   "Select the next brother"
 260   (setf *circulate-parent* (find-parent-frame *current-child*))
 261   (when (frame-p *circulate-parent*)
 262     (setf *circulate-orig* (frame-child *circulate-parent*)))
 263   (circulate-mode :brother-direction +1))
 264
 265 (defun select-previous-brother ()
 266   "Select the previous brother"
 267   (setf *circulate-parent* (find-parent-frame *current-child*))
 268   (when (frame-p *circulate-parent*)
 269     (setf *circulate-orig* (frame-child *circulate-parent*)))
 270   (circulate-mode :brother-direction -1))
 271
 272 (defun select-next-subchild ()
 273   "Select the next subchild"
 274   (when (and (frame-p *current-child*)
 275              (frame-p (frame-selected-child *current-child*)))
 276     (setf *circulate-orig* (frame-child *current-child*)
 277           *circulate-parent* nil)
 278     (circulate-mode :subchild-direction +1)))
 279
 280
 281 (defun select-next-child-simple ()
 282   "Select the next child (do not enter in circulate mode)"
 283   (when (frame-p *current-child*)
 284     (with-slots (child) *current-child*
 285       (setf child (rotate-list child)))
 286     (show-all-children)))
 287
 288
 289
 290 (defun reorder-brother-simple (reorder-fun)
 291   (unless (child-equal-p *current-child* *current-root*)
 292     (no-focus)
 293     (select-current-frame nil)
 294     (let ((parent-frame (find-parent-frame *current-child*)))
 295       (when (frame-p parent-frame)
 296         (with-slots (child) parent-frame
 297           (setf child (funcall reorder-fun child)
 298                 *current-child* (frame-selected-child parent-frame))))
 299       (show-all-children t))))
 300
 301
 302 (defun select-next-brother-simple ()
 303   "Select the next brother frame (do not enter in circulate mode)"
 304   (reorder-brother-simple #'rotate-list))
 305
 306 (defun select-previous-brother-simple ()
 307   "Select the previous brother frame (do not enter in circulate mode)"
 308   (reorder-brother-simple #'anti-rotate-list))