src/clfswm-second-mode.lisp

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