src/clfswm-second-mode.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Second mode functions
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2011 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 *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
  47
  48
  49
  50 ;;; Second mode handlers
  51 (define-handler second-mode :key-press (code state)
  52   (funcall-key-from-code *second-keys* code state)
  53   (draw-second-mode-window))
  54
  55 (define-handler second-mode :enter-notify ()
  56   (draw-second-mode-window))
  57
  58 (define-handler second-mode :motion-notify (window root-x root-y)
  59   (unless (compress-motion-notify)
  60     (funcall-button-from-code *second-mouse* 'motion
  61                               (modifiers->state *default-modifiers*)
  62                               window root-x root-y *fun-press*)))
  63
  64 (define-handler second-mode :button-press (window root-x root-y code state)
  65   (funcall-button-from-code *second-mouse* code state window root-x root-y *fun-press*)
  66   (draw-second-mode-window))
  67
  68 (define-handler second-mode :button-release (window root-x root-y code state)
  69   (funcall-button-from-code *second-mouse* code state window root-x root-y *fun-release*)
  70   (draw-second-mode-window))
  71
  72 (define-handler second-mode :configure-request ()
  73   (apply #'handle-event-fun-main-mode-configure-request event-slots)
  74   (draw-second-mode-window))
  75
  76
  77 (define-handler second-mode :configure-notify ()
  78   (draw-second-mode-window))
  79
  80
  81 (define-handler second-mode :destroy-notify ()
  82   (apply #'handle-event-fun-main-mode-destroy-notify event-slots)
  83   (draw-second-mode-window))
  84
  85 (define-handler second-mode :map-request ()
  86   (apply #'handle-event-fun-main-mode-map-request event-slots)
  87   (draw-second-mode-window))
  88
  89 (define-handler second-mode :unmap-notify ()
  90   (apply #'handle-event-fun-main-mode-unmap-notify event-slots)
  91   (draw-second-mode-window))
  92
  93 (define-handler second-mode :exposure ()
  94   (apply #'handle-event-fun-main-mode-exposure event-slots)
  95   (draw-second-mode-window))
  96
  97
  98
  99
 100 (defun sm-enter-function ()
 101   (with-placement (*second-mode-placement* x y *sm-width* *sm-height*)
 102     (setf *in-second-mode* t
 103           *sm-window* (xlib:create-window :parent *root*
 104                                           :x x :y y
 105                                           :width *sm-width* :height *sm-height*
 106                                           :background (get-color *sm-background-color*)
 107                                           :border-width *border-size*
 108                                           :border (get-color *sm-border-color*)
 109                                           :colormap (xlib:screen-default-colormap *screen*)
 110                                           :event-mask '(:exposure))
 111           *sm-font* (xlib:open-font *display* *sm-font-string*)
 112           *sm-gc* (xlib:create-gcontext :drawable *sm-window*
 113                                         :foreground (get-color *sm-foreground-color*)
 114                                         :background (get-color *sm-background-color*)
 115                                         :font *sm-font*
 116                                         :line-style :solid)))
 117   (map-window *sm-window*)
 118   (draw-second-mode-window)
 119   (no-focus)
 120   (ungrab-main-keys)
 121   (xgrab-keyboard *root*)
 122   (xgrab-pointer *root* 66 67)
 123   (speed-mouse-reset))
 124
 125 (defun sm-loop-function ()
 126   (raise-window *sm-window*))
 127
 128 (defun sm-leave-function ()
 129   (xlib:free-gcontext *sm-gc*)
 130   (xlib:close-font *sm-font*)
 131   (xlib:destroy-window *sm-window*)
 132   (xungrab-keyboard)
 133   (xungrab-pointer)
 134   (grab-main-keys)
 135   (show-all-children)
 136   (display-all-frame-info)
 137   (wait-no-key-or-button-press)
 138   (setf *in-second-mode* nil))
 139
 140 (defun second-key-mode ()
 141   "Switch to editing mode (second mode)"
 142   (generic-mode 'second-mode
 143                 'exit-second-loop
 144                 :enter-function #'sm-enter-function
 145                 :loop-function #'sm-loop-function
 146                 :leave-function #'sm-leave-function)
 147   (when *second-mode-leave-function*
 148     (funcall *second-mode-leave-function*)
 149     (setf *second-mode-leave-function* nil)))
 150
 151 (defun leave-second-mode ()
 152   "Leave second mode"
 153   (cond (*in-second-mode*
 154          (setf *in-second-mode* nil)
 155          (throw 'exit-second-loop nil))
 156         (t (setf *in-second-mode* nil)
 157            (show-all-children))))
 158