src/clfswm-circulate-mode.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Main functions
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2010 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     (if frame-is-root?
  89         (hide-all *current-root*)
  90         (select-current-frame nil))
  91     (unless (and *circulate-orig* *circulate-parent*)
  92       (reset-circulate-brother))
  93     (let ((len (length *circulate-orig*)))
  94       (when (plusp len)
  95         (when (frame-p *circulate-parent*)
  96           (let ((elem (nth (mod  (incf *circulate-hit* direction) len) *circulate-orig*)))
  97             (setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
  98                   *current-child* (frame-selected-child *circulate-parent*))))
  99         (when frame-is-root?
 100           (setf *current-root* *current-child*))))
 101     (show-all-children (if frame-is-root?
 102                            *current-child*
 103                            (find-parent-frame *current-child*)))
 104     (draw-circulate-mode-window)))
 105
 106 (defun reorder-subchild (direction)
 107   (declare (ignore direction))
 108   (when (frame-p *current-child*)
 109     (let ((selected-child (frame-selected-child *current-child*)))
 110       (when (frame-p selected-child)
 111         (no-focus)
 112         (with-slots (child) selected-child
 113           (let ((elem (first (last child))))
 114             (setf child (cons elem (child-remove elem child)))
 115             (show-all-children selected-child)
 116             (draw-circulate-mode-window)))))))
 117
 118
 119
 120
 121
 122 (defun circulate-select-next-child ()
 123   "Select the next child"
 124   (when (frame-p *current-child*)
 125     (when *circulate-parent*
 126       (reset-circulate-child))
 127     (reorder-child +1)))
 128
 129 (defun circulate-select-previous-child ()
 130   "Select the previous child"
 131   (when (frame-p *current-child*)
 132     (when *circulate-parent*
 133       (reset-circulate-child))
 134     (reorder-child -1)))
 135
 136
 137 (defun circulate-select-next-brother ()
 138   "Select the next brother"
 139   (unless *circulate-parent*
 140     (reset-circulate-brother))
 141   (reorder-brother +1))
 142
 143 (defun circulate-select-previous-brother ()
 144   "Select the previous borther"
 145   (unless *circulate-parent*
 146     (reset-circulate-brother))
 147   (reorder-brother -1))
 148
 149 (defun circulate-select-next-subchild ()
 150   "Select the next subchild"
 151   (reorder-subchild +1))
 152
 153
 154
 155 (add-hook *binding-hook* 'set-default-circulate-keys)
 156
 157 (defun set-default-circulate-keys ()
 158   (define-circulate-key ("Escape") 'leave-circulate-mode)
 159   (define-circulate-key ("g" :control) 'leave-circulate-mode)
 160   (define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
 161   (define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
 162   (define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
 163   (define-circulate-key ("Tab" :mod-1 :control) 'circulate-select-next-subchild)
 164   (define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
 165   (define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
 166   (define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
 167   (define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
 168   (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode)
 169   (define-circulate-release-key ("Alt_L") 'leave-circulate-mode))
 170
 171
 172 (defun circulate-leave-function ()
 173   (when *circulate-gc*
 174     (xlib:free-gcontext *circulate-gc*))
 175   (when *circulate-window*
 176     (xlib:destroy-window *circulate-window*))
 177   (when *circulate-font*
 178     (xlib:close-font *circulate-font*))
 179   (xlib:display-finish-output *display*)
 180   (setf *circulate-window* nil
 181         *circulate-gc* nil
 182         *circulate-font* nil))
 183
 184 (defun circulate-loop-function ()
 185   (unless (is-a-key-pressed-p)
 186     (leave-circulate-mode)))
 187
 188 (define-handler circulate-mode :key-press (code state)
 189   (unless (funcall-key-from-code *circulate-keys* code state)
 190     (setf *circulate-hit* 0
 191           *circulate-orig* nil
 192           *circulate-parent* nil)
 193     (funcall-key-from-code *main-keys* code state)))
 194
 195
 196 (define-handler circulate-mode :key-release (code state)
 197   (funcall-key-from-code *circulate-keys-release* code state))
 198
 199
 200
 201 (defun circulate-mode (&key child-direction brother-direction subchild-direction)
 202   (setf *circulate-hit* 0)
 203   (with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
 204     (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
 205           *circulate-window* (xlib:create-window :parent *root*
 206                                                  :x x
 207                                                  :y y
 208                                                  :width *circulate-width*
 209                                                  :height *circulate-height*
 210                                                  :background (get-color *circulate-background*)
 211                                                  :border-width 1
 212                                                  :border (get-color *circulate-border*)
 213                                                  :colormap (xlib:screen-default-colormap *screen*)
 214                                                  :event-mask '(:exposure :key-press))
 215           *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
 216                                                :foreground (get-color *circulate-foreground*)
 217                                                :background (get-color *circulate-background*)
 218                                                :font *circulate-font*
 219                                                :line-style :solid))
 220     (map-window *circulate-window*)
 221     (draw-circulate-mode-window)
 222     (when child-direction
 223       (reorder-child child-direction))
 224     (when brother-direction
 225       (reorder-brother brother-direction))
 226     (when subchild-direction
 227       (reorder-subchild subchild-direction))
 228     (let ((grab-keyboard-p (xgrab-keyboard-p))
 229           (grab-pointer-p (xgrab-pointer-p)))
 230       (xgrab-pointer *root* 92 93)
 231       (unless grab-keyboard-p
 232         (ungrab-main-keys)
 233         (xgrab-keyboard *root*))
 234       (generic-mode 'circulate-mode 'exit-circulate-loop
 235                     :loop-function #'circulate-loop-function
 236                     :leave-function #'circulate-leave-function
 237                     :original-mode '(main-mode))
 238       (circulate-leave-function)
 239       (unless grab-keyboard-p
 240         (xungrab-keyboard)
 241         (grab-main-keys))
 242       (if grab-pointer-p
 243           (xgrab-pointer *root* 66 67)
 244           (xungrab-pointer)))))
 245
 246
 247 (defun select-next-child ()
 248   "Select the next child"
 249   (when (frame-p *current-child*)
 250     (setf *circulate-orig* (frame-child *current-child*)
 251           *circulate-parent* nil)
 252     (circulate-mode :child-direction +1)))
 253
 254 (defun select-previous-child ()
 255   "Select the previous child"
 256   (when (frame-p *current-child*)
 257     (setf *circulate-orig* (frame-child *current-child*)
 258           *circulate-parent* nil)
 259     (circulate-mode :child-direction -1)))
 260
 261
 262 (defun select-next-brother ()
 263   "Select the next brother"
 264   (setf *circulate-parent* (find-parent-frame *current-child*))
 265   (when (frame-p *circulate-parent*)
 266     (setf *circulate-orig* (frame-child *circulate-parent*)))
 267   (circulate-mode :brother-direction +1))
 268
 269 (defun select-previous-brother ()
 270   "Select the previous brother"
 271   (setf *circulate-parent* (find-parent-frame *current-child*))
 272   (when (frame-p *circulate-parent*)
 273     (setf *circulate-orig* (frame-child *circulate-parent*)))
 274   (circulate-mode :brother-direction -1))
 275
 276 (defun select-next-subchild ()
 277   "Select the next subchild"
 278   (when (and (frame-p *current-child*)
 279              (frame-p (frame-selected-child *current-child*)))
 280     (setf *circulate-orig* (frame-child *current-child*)
 281           *circulate-parent* nil)
 282     (circulate-mode :subchild-direction +1)))