src/clfswm-corner.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Corner 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
  29
  30 (symbol-macrolet ((sw (xlib:screen-width *screen*))
  31                   (sh (xlib:screen-height *screen*))
  32                   (cs *corner-size*))
  33   (defun in-corner (corner x y)
  34     "Return t if (x, y) is in corner.
  35 Corner is one of :bottom-right :bottom-left :top-right :top-left"
  36     (multiple-value-bind (xmin ymin xmax ymax)
  37         (case corner
  38           (:bottom-right (values (- sw cs)  (- sh cs)  sw  sh))
  39           (:bottom-left (values 0  (- sh cs)  cs  sh))
  40           (:top-left (values 0 0 cs cs))
  41           (:top-right (values (- sw cs)  0  sw  cs))
  42           (t (values 10 10 0 0)))
  43       (and (<= xmin x xmax)
  44            (<= ymin y ymax)))))
  45
  46
  47 (symbol-macrolet ((sw (xlib:screen-width *screen*))
  48                   (sh (xlib:screen-height *screen*))
  49                   (cs *corner-size*))
  50   (defun find-corner (x y)
  51     (cond ((and (< cs x (- sw cs)) (< cs y (- sh cs))) nil)
  52           ((and (<= 0 x cs) (<= 0 y cs)) :top-left)
  53           ((and (<= (- sw cs) x sw) (<= 0 y cs)) :top-right)
  54           ((and (<= 0 x cs) (<= (- sh cs) y sh)) :bottom-left)
  55           ((and (<= (- sw cs) x sw) (<= (- sh cs) y sh)) :bottom-right)
  56           (t nil))))
  57
  58
  59
  60
  61 (defun do-corner-action (x y corner-list)
  62   (when (frame-p *current-root*)
  63     (let ((corner (find-corner x y)))
  64       (when corner
  65         (let ((fun (second (assoc corner corner-list))))
  66           (when fun
  67             (funcall fun)))))))
  68
  69
  70
  71
  72
  73 ;;;***************************************;;;
  74 ;;; CONFIG - Corner actions definitions:  ;;;
  75 ;;;***************************************;;;
  76
  77 (defmacro present-windows-generic ((first-restore-frame) &body body)
  78   `(progn
  79      (with-all-frames (,first-restore-frame frame)
  80        (setf (frame-data-slot frame :old-layout) (frame-layout frame)
  81              (frame-layout frame) #'tile-space-layout))
  82      (show-all-children *current-root*)
  83      (wait-no-key-or-button-press)
  84      (wait-a-key-or-button-press )
  85      (wait-no-key-or-button-press)
  86      (multiple-value-bind (x y) (xlib:query-pointer *root*)
  87        (let* ((child (find-child-under-mouse x y))
  88               (parent (find-parent-frame child *root-frame*)))
  89          (when (and child parent)
  90            ,@body
  91            (focus-all-children child parent))))
  92      (with-all-frames (,first-restore-frame frame)
  93        (setf (frame-layout frame) (frame-data-slot frame :old-layout)
  94              (frame-data-slot frame :old-layout) nil))
  95      (show-all-children *current-root*)))
  96
  97 (defun present-windows ()
  98   "Present all windows in the current frame (An expose like)"
  99   (stop-button-event)
 100   (present-windows-generic (*current-root*))
 101   t)
 102
 103 (defun present-all-windows ()
 104   "Present all windows in all frames (An expose like)"
 105   (stop-button-event)
 106   (switch-to-root-frame :show-later t)
 107   (present-windows-generic (*root-frame*)
 108     (hide-all-children *root-frame*)
 109     (setf *current-root* parent))
 110   t)
 111
 112
 113
 114 (defun find-window-in-query-tree (target-win)
 115   (dolist (win (xlib:query-tree *root*))
 116     (when (child-equal-p win target-win)
 117       (return t))))
 118
 119 (defun wait-window-in-query-tree (wait-test)
 120   (loop
 121      (dolist (win (xlib:query-tree *root*))
 122        (when (funcall wait-test win)
 123          (return-from wait-window-in-query-tree win)))))
 124
 125
 126 (defun generic-present-body (cmd wait-test win &optional focus-p)
 127   (stop-button-event)
 128   (unless (find-window-in-query-tree win)
 129     (do-shell cmd)
 130     (setf win (wait-window-in-query-tree wait-test))
 131     (hide-window win))
 132   (cond ((window-hidden-p win) (unhide-window win)
 133          (when focus-p
 134            (focus-window win))
 135          (raise-window win))
 136         (t (hide-window win)
 137            (show-all-children nil)))
 138   win)
 139
 140
 141
 142 (let (win)
 143   (defun present-virtual-keyboard ()
 144     "Present a virtual keyboard"
 145     (setf win (generic-present-body *virtual-keyboard-cmd*
 146                                     (lambda (win)
 147                                       (string-equal (xlib:get-wm-class win) "xvkbd"))
 148                                     win))
 149     t))
 150
 151
 152 (let (win)
 153   (defun present-clfswm-terminal ()
 154     "Hide/Unhide a terminal"
 155     (setf win (generic-present-body *clfswm-terminal-cmd*
 156                                     (lambda (win)
 157                                       (string-equal (xlib:wm-name win) *clfswm-terminal-name*))
 158                                     win
 159                                     t))
 160     t))
 161