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 (defparameter *circulate-leave-key* nil)
  37
  38 (defun draw-circulate-mode-window ()
  39   (raise-window *circulate-window*)
  40   (clear-pixmap-buffer *circulate-window* *circulate-gc*)
  41   (let* ((text (format nil "~A [~A]"
  42                        (limit-length (ensure-printable (child-name (xlib:input-focus *display*)))
  43                                      *circulate-text-limite*)
  44                        (limit-length (ensure-printable (child-name *current-child*))
  45                                      *circulate-text-limite*)))
  46          (len (length text)))
  47     (xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
  48                       (truncate (/ (- *circulate-width* (* (xlib:max-char-width *circulate-font*) len)) 2))
  49                       (truncate (/ (+ *circulate-height* (- (xlib:font-ascent *circulate-font*) (xlib:font-descent *circulate-font*))) 2))
  50                       text))
  51   (copy-pixmap-buffer *circulate-window* *circulate-gc*))
  52
  53
  54
  55 (defun leave-circulate-mode ()
  56   "Leave the circulate mode"
  57   (throw 'exit-circulate-loop nil))
  58
  59
  60
  61 (defun reset-circulate-child ()
  62   (setf *circulate-hit* 0
  63         *circulate-parent* nil
  64         *circulate-orig* (frame-child *current-child*)))
  65
  66 (defun reset-circulate-brother ()
  67   (setf *circulate-parent* (find-parent-frame *current-child*))
  68   (when (frame-p *circulate-parent*)
  69     (setf *circulate-orig* (frame-child *circulate-parent*))))
  70
  71
  72
  73 (defun reorder-child (direction)
  74   (no-focus)
  75   (with-slots (child) *current-child*
  76     (unless *circulate-orig*
  77       (reset-circulate-child))
  78     (let ((len (length *circulate-orig*)))
  79       (when (plusp len)
  80         (let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
  81           (setf child (nconc (list elem) (remove elem *circulate-orig*)))))
  82       (show-all-children)
  83       (draw-circulate-mode-window))))
  84
  85
  86 (defun reorder-brother (direction)
  87   (no-focus)
  88   (let ((frame-is-root? (and (equal *current-root* *current-child*)
  89                              (not (equal *current-root* *root-frame*)))))
  90     (if frame-is-root?
  91         (hide-all *current-root*)
  92         (select-current-frame nil))
  93     (unless (and *circulate-orig* *circulate-parent*)
  94       (reset-circulate-brother))
  95     (let ((len (length *circulate-orig*)))
  96       (when (plusp len)
  97         (when (frame-p *circulate-parent*)
  98           (let ((elem (nth (mod  (incf *circulate-hit* direction) len) *circulate-orig*)))
  99             (setf (frame-child *circulate-parent*) (nconc (list elem) (remove elem *circulate-orig*))
 100                   *current-child* (frame-selected-child *circulate-parent*))))
 101         (when frame-is-root?
 102           (setf *current-root* *current-child*))))
 103     (show-all-children (if frame-is-root?
 104                            *current-child*
 105                            (find-parent-frame *current-child*)))
 106     (draw-circulate-mode-window)))
 107
 108
 109
 110
 111
 112 (defun circulate-select-next-child ()
 113   "Select the next child"
 114   (when (frame-p *current-child*)
 115     (when *circulate-parent*
 116       (reset-circulate-child))
 117     (reorder-child +1)))
 118
 119 (defun circulate-select-previous-child ()
 120   "Select the previous child"
 121   (when (frame-p *current-child*)
 122     (when *circulate-parent*
 123       (reset-circulate-child))
 124     (reorder-child -1)))
 125
 126
 127 (defun circulate-select-next-brother ()
 128   "Select the next brother"
 129   (unless *circulate-parent*
 130     (reset-circulate-brother))
 131   (reorder-brother +1))
 132
 133 (defun circulate-select-previous-brother ()
 134   "Select the previous borther"
 135   (unless *circulate-parent*
 136     (reset-circulate-brother))
 137   (reorder-brother -1))
 138
 139
 140
 141 (add-hook *binding-hook* 'set-default-circulate-keys)
 142
 143 (defun set-default-circulate-keys ()
 144   (define-circulate-key ("Escape") 'leave-circulate-mode)
 145   (define-circulate-key ("g" :control) 'leave-circulate-mode)
 146   (define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
 147   (define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
 148   (define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
 149   (define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
 150   (define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
 151   (define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
 152   (define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
 153   (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode))
 154
 155
 156 (defun set-circulate-leave-key ()
 157   (maphash #'(lambda (key value)
 158                (when (and (listp value) (member 'leave-circulate-mode value))
 159                  (setf *circulate-leave-key* (typecase (first key)
 160                                                (character (list (char->keycode (first key))))
 161                                                (number (list (first key)))
 162                                                (string (multiple-value-list
 163                                                         (xlib:keysym->keycodes *display* (keysym-name->keysym (first key)))))))))
 164            *circulate-keys-release*))
 165
 166
 167
 168
 169
 170
 171
 172
 173 (defun circulate-leave-function ()
 174   (when *circulate-window*
 175     (xlib:destroy-window *circulate-window*))
 176   (when *circulate-font*
 177     (xlib:close-font *circulate-font*))
 178   (xlib:display-finish-output *display*)
 179   (setf *circulate-window* nil
 180         *circulate-font* nil))
 181
 182 (defun circulate-loop-function ()
 183   ;;; Check if the key modifier is alway pressed
 184   (let ((leave t))
 185     (loop for k across (xlib:query-keymap *display*)
 186        for i from 0
 187        do (when (and (plusp k) (member i *circulate-leave-key*))
 188             (setf leave nil)
 189             (return)))
 190     (when leave
 191       (leave-circulate-mode))))
 192
 193 (define-handler circulate-mode :key-press (code state)
 194   (unless (funcall-key-from-code *circulate-keys* code state)
 195     (setf *circulate-hit* 0
 196           *circulate-orig* nil
 197           *circulate-parent* nil)
 198     (funcall-key-from-code *main-keys* code state)))
 199
 200
 201 (define-handler circulate-mode :key-release (code state)
 202   (funcall-key-from-code *circulate-keys-release* code state))
 203
 204
 205
 206 (defun circulate-mode (&key child-direction brother-direction)
 207   (setf *circulate-hit* 0)
 208   (set-circulate-leave-key)
 209   (with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
 210     (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
 211           *circulate-window* (xlib:create-window :parent *root*
 212                                                  :x x
 213                                                  :y y
 214                                                  :width *circulate-width*
 215                                                  :height *circulate-height*
 216                                                  :background (get-color *circulate-background*)
 217                                                  :border-width 1
 218                                                  :border (get-color *circulate-border*)
 219                                                  :colormap (xlib:screen-default-colormap *screen*)
 220                                                  :event-mask '(:exposure :key-press))
 221           *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
 222                                                :foreground (get-color *circulate-foreground*)
 223                                                :background (get-color *circulate-background*)
 224                                                :font *circulate-font*
 225                                                :line-style :solid))
 226     (map-window *circulate-window*)
 227     (draw-circulate-mode-window)
 228     (when child-direction
 229       (reorder-child child-direction))
 230     (when brother-direction
 231       (reorder-brother brother-direction))
 232     (let ((grab-keyboard-p (xgrab-keyboard-p))
 233           (grab-pointer-p (xgrab-pointer-p)))
 234       (xgrab-pointer *root* 92 93)
 235       (unless grab-keyboard-p
 236         (ungrab-main-keys)
 237         (xgrab-keyboard *root*))
 238       (generic-mode 'circulate-mode 'exit-circulate-loop
 239                     :loop-function #'circulate-loop-function
 240                     :leave-function #'circulate-leave-function
 241                     :original-mode '(main-mode))
 242       (circulate-leave-function)
 243       (unless grab-keyboard-p
 244         (xungrab-keyboard)
 245         (grab-main-keys))
 246       (if grab-pointer-p
 247           (xgrab-pointer *root* 66 67)
 248           (xungrab-pointer)))))
 249
 250
 251 (defun select-next-child ()
 252   "Select the next child"
 253   (when (frame-p *current-child*)
 254     (setf *circulate-orig* (frame-child *current-child*)
 255           *circulate-parent* nil)
 256     (circulate-mode :child-direction +1)))
 257
 258 (defun select-previous-child ()
 259   "Select the previouschild"
 260   (when (frame-p *current-child*)
 261     (setf *circulate-orig* (frame-child *current-child*)
 262           *circulate-parent* nil)
 263     (circulate-mode :child-direction -1)))
 264
 265
 266 (defun select-next-brother ()
 267   "Select the next brother"
 268   (setf *circulate-parent* (find-parent-frame *current-child*))
 269   (when (frame-p *circulate-parent*)
 270     (setf *circulate-orig* (frame-child *circulate-parent*)))
 271   (circulate-mode :brother-direction +1))
 272
 273 (defun select-previous-brother ()
 274   "Select the previous brother"
 275   (setf *circulate-parent* (find-parent-frame *current-child*))
 276   (when (frame-p *circulate-parent*)
 277     (setf *circulate-orig* (frame-child *circulate-parent*)))
 278   (circulate-mode :brother-direction -1))
 279