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 (nconc (list elem) (remove elem *circulate-orig* :test #'child-equal-p)))))
  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*) (nconc (list elem) (remove elem *circulate-orig* :test #'child-equal-p))
  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
 107
 108
 109
 110 (defun circulate-select-next-child ()
 111   "Select the next child"
 112   (when (frame-p *current-child*)
 113     (when *circulate-parent*
 114       (reset-circulate-child))
 115     (reorder-child +1)))
 116
 117 (defun circulate-select-previous-child ()
 118   "Select the previous child"
 119   (when (frame-p *current-child*)
 120     (when *circulate-parent*
 121       (reset-circulate-child))
 122     (reorder-child -1)))
 123
 124
 125 (defun circulate-select-next-brother ()
 126   "Select the next brother"
 127   (unless *circulate-parent*
 128     (reset-circulate-brother))
 129   (reorder-brother +1))
 130
 131 (defun circulate-select-previous-brother ()
 132   "Select the previous borther"
 133   (unless *circulate-parent*
 134     (reset-circulate-brother))
 135   (reorder-brother -1))
 136
 137
 138
 139 (add-hook *binding-hook* 'set-default-circulate-keys)
 140
 141 (defun set-default-circulate-keys ()
 142   (define-circulate-key ("Escape") 'leave-circulate-mode)
 143   (define-circulate-key ("g" :control) 'leave-circulate-mode)
 144   (define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
 145   (define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
 146   (define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
 147   (define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
 148   (define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
 149   (define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
 150   (define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
 151   (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode))
 152
 153
 154 (defun circulate-leave-function ()
 155   (when *circulate-window*
 156     (xlib:destroy-window *circulate-window*))
 157   (when *circulate-font*
 158     (xlib:close-font *circulate-font*))
 159   (xlib:display-finish-output *display*)
 160   (setf *circulate-window* nil
 161         *circulate-font* nil))
 162
 163 (defun circulate-loop-function ()
 164   (unless (is-a-key-pressed-p)
 165     (leave-circulate-mode)))
 166
 167 (define-handler circulate-mode :key-press (code state)
 168   (unless (funcall-key-from-code *circulate-keys* code state)
 169     (setf *circulate-hit* 0
 170           *circulate-orig* nil
 171           *circulate-parent* nil)
 172     (funcall-key-from-code *main-keys* code state)))
 173
 174
 175 (define-handler circulate-mode :key-release (code state)
 176   (funcall-key-from-code *circulate-keys-release* code state))
 177
 178
 179
 180 (defun circulate-mode (&key child-direction brother-direction)
 181   (setf *circulate-hit* 0)
 182   (with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
 183     (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
 184           *circulate-window* (xlib:create-window :parent *root*
 185                                                  :x x
 186                                                  :y y
 187                                                  :width *circulate-width*
 188                                                  :height *circulate-height*
 189                                                  :background (get-color *circulate-background*)
 190                                                  :border-width 1
 191                                                  :border (get-color *circulate-border*)
 192                                                  :colormap (xlib:screen-default-colormap *screen*)
 193                                                  :event-mask '(:exposure :key-press))
 194           *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
 195                                                :foreground (get-color *circulate-foreground*)
 196                                                :background (get-color *circulate-background*)
 197                                                :font *circulate-font*
 198                                                :line-style :solid))
 199     (map-window *circulate-window*)
 200     (draw-circulate-mode-window)
 201     (when child-direction
 202       (reorder-child child-direction))
 203     (when brother-direction
 204       (reorder-brother brother-direction))
 205     (let ((grab-keyboard-p (xgrab-keyboard-p))
 206           (grab-pointer-p (xgrab-pointer-p)))
 207       (xgrab-pointer *root* 92 93)
 208       (unless grab-keyboard-p
 209         (ungrab-main-keys)
 210         (xgrab-keyboard *root*))
 211       (generic-mode 'circulate-mode 'exit-circulate-loop
 212                     :loop-function #'circulate-loop-function
 213                     :leave-function #'circulate-leave-function
 214                     :original-mode '(main-mode))
 215       (circulate-leave-function)
 216       (unless grab-keyboard-p
 217         (xungrab-keyboard)
 218         (grab-main-keys))
 219       (if grab-pointer-p
 220           (xgrab-pointer *root* 66 67)
 221           (xungrab-pointer)))))
 222
 223
 224 (defun select-next-child ()
 225   "Select the next child"
 226   (when (frame-p *current-child*)
 227     (setf *circulate-orig* (frame-child *current-child*)
 228           *circulate-parent* nil)
 229     (circulate-mode :child-direction +1)))
 230
 231 (defun select-previous-child ()
 232   "Select the previouschild"
 233   (when (frame-p *current-child*)
 234     (setf *circulate-orig* (frame-child *current-child*)
 235           *circulate-parent* nil)
 236     (circulate-mode :child-direction -1)))
 237
 238
 239 (defun select-next-brother ()
 240   "Select the next brother"
 241   (setf *circulate-parent* (find-parent-frame *current-child*))
 242   (when (frame-p *circulate-parent*)
 243     (setf *circulate-orig* (frame-child *circulate-parent*)))
 244   (circulate-mode :brother-direction +1))
 245
 246 (defun select-previous-brother ()
 247   "Select the previous brother"
 248   (setf *circulate-parent* (find-parent-frame *current-child*))
 249   (when (frame-p *circulate-parent*)
 250     (setf *circulate-orig* (frame-child *circulate-parent*)))
 251   (circulate-mode :brother-direction -1))
 252