src/clfswm-second-mode.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Second mode functions
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2005-2013 Philippe Brochard <pbrochard@common-lisp.net>
   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 *sm-window* nil)
  29 (defparameter *sm-font* nil)
  30 (defparameter *sm-gc* nil)
  31
  32 (defparameter *second-mode-leave-function* nil
  33   "Execute the function if not nil")
  34
  35
  36 (defun draw-second-mode-window ()
  37   (raise-window *sm-window*)
  38   (clear-pixmap-buffer *sm-window* *sm-gc*)
  39   (let* ((text (format nil "Second mode"))
  40          (len (length text)))
  41     (xlib:draw-glyphs *pixmap-buffer* *sm-gc*
  42                       (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
  43                       (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
  44                       text))
  45   (copy-pixmap-buffer *sm-window* *sm-gc*)
  46   (no-focus))
  47
  48
  49
  50
  51 ;;; Second mode handlers
  52 (define-handler second-mode :key-press (code state)
  53   (funcall-key-from-code *second-keys* code state)
  54   (draw-second-mode-window))
  55
  56 (define-handler second-mode :enter-notify ()
  57   (draw-second-mode-window))
  58
  59 (define-handler second-mode :motion-notify (window root-x root-y)
  60   (unless (compress-motion-notify)
  61     (funcall-button-from-code *second-mouse* 'motion
  62                               (modifiers->state *default-modifiers*)
  63                               window root-x root-y *fun-press*)))
  64
  65 (define-handler second-mode :button-press (window root-x root-y code state)
  66   (funcall-button-from-code *second-mouse* code state window root-x root-y *fun-press*)
  67   (draw-second-mode-window))
  68
  69 (define-handler second-mode :button-release (window root-x root-y code state)
  70   (funcall-button-from-code *second-mouse* code state window root-x root-y *fun-release*)
  71   (draw-second-mode-window))
  72
  73 (define-handler second-mode :configure-request ()
  74   (apply #'handle-event-fun-main-mode-configure-request event-slots)
  75   (draw-second-mode-window))
  76
  77
  78 (define-handler second-mode :configure-notify ()
  79   (draw-second-mode-window))
  80
  81
  82 (define-handler second-mode :destroy-notify ()
  83   (apply #'handle-event-fun-main-mode-destroy-notify event-slots)
  84   (draw-second-mode-window))
  85
  86 (define-handler second-mode :map-request ()
  87   (apply #'handle-event-fun-main-mode-map-request event-slots)
  88   (draw-second-mode-window))
  89
  90 (define-handler second-mode :unmap-notify ()
  91   (apply #'handle-event-fun-main-mode-unmap-notify event-slots)
  92   (draw-second-mode-window))
  93
  94 (define-handler second-mode :exposure ()
  95   (apply #'handle-event-fun-main-mode-exposure event-slots)
  96   (draw-second-mode-window))
  97
  98
  99
 100
 101 (defun sm-enter-function ()
 102   (with-placement (*second-mode-placement* x y *sm-width* *sm-height*)
 103     (setf *in-second-mode* t
 104           *sm-window* (xlib:create-window :parent *root*
 105                                           :x x :y y
 106                                           :width *sm-width* :height *sm-height*
 107                                           :background (get-color *sm-background-color*)
 108                                           :border-width *border-size*
 109                                           :border (get-color *sm-border-color*)
 110                                           :colormap (xlib:screen-default-colormap *screen*)
 111                                           :event-mask '(:exposure))
 112           *sm-font* (xlib:open-font *display* *sm-font-string*)
 113           *sm-gc* (xlib:create-gcontext :drawable *sm-window*
 114                                         :foreground (get-color *sm-foreground-color*)
 115                                         :background (get-color *sm-background-color*)
 116                                         :font *sm-font*
 117                                         :line-style :solid)))
 118   (setf (window-transparency *sm-window*) *sm-transparency*)
 119   (map-window *sm-window*)
 120   (draw-second-mode-window)
 121   (no-focus)
 122   (ungrab-main-keys)
 123   (xgrab-keyboard *root*)
 124   (xgrab-pointer *root* 66 67)
 125   (speed-mouse-reset))
 126
 127 (defun sm-loop-function ()
 128   (raise-window *sm-window*))
 129
 130 (defun sm-leave-function ()
 131   (setf *in-second-mode* nil)
 132   (when *sm-gc*
 133     (xlib:free-gcontext *sm-gc*)
 134     (setf *sm-gc* nil))
 135   (when *sm-font*
 136     (xlib:close-font *sm-font*)
 137     (setf *sm-font* nil))
 138   (when *sm-window*
 139     (xlib:destroy-window *sm-window*)
 140     (setf *sm-window* nil))
 141   (xungrab-keyboard)
 142   (xungrab-pointer)
 143   (grab-main-keys)
 144   (show-all-children)
 145   (display-all-frame-info)
 146   (raise-notify-window)
 147   (wait-no-key-or-button-press))
 148
 149 (defun second-key-mode ()
 150   "Switch to editing mode (second mode)"
 151   (generic-mode 'second-mode
 152                 'exit-second-loop
 153                 :enter-function #'sm-enter-function
 154                 :loop-function #'sm-loop-function
 155                 :leave-function #'sm-leave-function)
 156   (when *second-mode-leave-function*
 157     (funcall *second-mode-leave-function*)
 158     (setf *second-mode-leave-function* nil)))
 159
 160 (defun leave-second-mode ()
 161   "Leave second mode"
 162   (cond (*in-second-mode*
 163          (setf *in-second-mode* nil)
 164          (throw 'exit-second-loop nil))
 165         (t (setf *in-second-mode* nil)
 166            (show-all-children))))
 167
 168
 169 (defun sm-delete-focus-window ()
 170   "Close focus window: Delete the focus window in all frames and workspaces"
 171   (setf *second-mode-leave-function* 'delete-focus-window)
 172   (leave-second-mode))
 173
 174 (defun sm-ask-close/kill-current-window ()
 175   "Close or kill the current window (ask before doing anything)"
 176   (setf *second-mode-leave-function* #'ask-close/kill-current-window)
 177   (leave-second-mode))