Do not raise window on each event
[clfswm.git] / src / package.lisp
blob43919f1a0ad05578837758a46c91b242f384bb34
1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
3 ;;;
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Package definition
6 ;;; --------------------------------------------------------------------------
7 ;;;
8 ;;; (C) 2005-2014 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 ;;; --------------------------------------------------------------------------
26 (in-package :cl-user)
28 (defpackage clfswm
29 (:use :common-lisp :my-html :tools :version)
30 ;; (:shadow :defun)
31 (:export :main
32 :reload-clfswm
33 :reset-clfswm
34 :exit-clfswm))
37 ;;;;; Uncomment the line below if you want to see all ignored X errors
38 ;;(pushnew :xlib-debug *features*)
40 ;;;;; Uncomment the line below if you want to see all event debug messages
41 ;;(pushnew :event-debug *features*)
43 (in-package :clfswm)
45 ;;; CONFIG - Compress motion notify ?
46 ;; This variable may be useful to speed up some slow version of CLX.
47 ;; It is particulary useful with CLISP/MIT-CLX (and others).
48 (defconfig *have-to-compress-notify* t
49 nil "Compress event notify?
50 This variable may be useful to speed up some slow version of CLX.
51 It is particulary useful with CLISP/MIT-CLX.")
53 (defconfig *transparent-background* t
54 nil "Enable transparent background: one of nil, :pseudo, t (xcompmgr must be started)")
56 (defconfig *default-transparency* 0.8
57 nil "Default transparency for all windows when in xcompmgr transparency mode")
59 (defconfig *show-root-frame-p* nil
60 nil "Show the root frame information or not")
63 (defconfig *border-size* 1
64 nil "Windows and frames border size")
68 (defparameter *modifier-alias* '((:alt :mod-1) (:alt-l :mod-1)
69 (:numlock :mod-2)
70 (:super_l :mod-4)
71 (:alt-r :mod-5) (:alt-gr :mod-5)
72 (:capslock :lock))
73 "Syntax: (modifier-alias effective-modifier)")
76 (defparameter *display* nil)
77 (defparameter *screen* nil)
78 (defparameter *root* nil)
79 (defparameter *no-focus-window* nil)
81 (defparameter *sm-window* nil)
82 (defparameter *sm-font* nil)
83 (defparameter *sm-gc* nil)
86 (defparameter *background-image* nil)
87 (defparameter *background-gc* nil)
89 (defparameter *expose-current-number* 0)
90 (defparameter *expose-child-list* nil)
92 (defconfig *loop-timeout* 1 nil
93 "Maximum time (in seconds) to wait before calling *loop-hook*")
95 (defparameter *pixmap-buffer* nil)
97 (defparameter *contrib-dir* "contrib/")
99 (defparameter *default-font* nil)
100 ;;(defparameter *default-font-string* "9x15")
101 (defconfig *default-font-string* "fixed" nil
102 "The default font used in clfswm")
104 (defconfig *color-move-window* "DeepPink" 'Main-mode
105 "Color when moving or resizing a windows")
107 (defparameter *child-selection* nil)
109 ;;; CONFIG - Default frame datas
110 (defconfig *default-frame-data*
111 (list '(:tile-size 0.8) '(:tile-space-size 0.1)
112 '(:fast-layout (tile-left-layout tile-layout))
113 '(:main-layout-windows nil))
115 "Default slots set in frame date")
118 ;;; CONFIG - Default managed window type for a frame
119 ;;; type can be :all, :normal, :transient, :maxsize, :desktop, :dock, :toolbar, :menu, :utility, :splash, :dialog
120 (defconfig *default-managed-type* '(:normal) nil
121 "Default managed window types")
122 ;;(defparameter *default-managed-type* '(:normal :maxsize :transient))
123 ;;(defparameter *default-managed-type* '(:normal :transient :maxsize :desktop :dock :toolbar :menu :utility :splash :dialog))
124 ;;(defparameter *default-managed-type* '())
125 ;;(defparameter *default-managed-type* '(:all))
128 ;;; CONFIG - Default focus policy
129 (defconfig *default-focus-policy* :click nil
130 "Default mouse focus policy. One of :click, :sloppy, :sloppy-strict, :sloppy-select or
131 :sloppy-select-window.")
134 (defconfig *show-hide-policy* #'<=
135 nil "'NIL': always display all children (better with transparency support).
136 '<': Hide only children less than children above.
137 '<=': Hide children less or equal to children above (better for performance on slow machine).")
139 (defconfig *show-hide-policy-type* '(:normal)
140 nil "Windows types which are optimized by the show hide policy")
142 (defstruct child-rect child parent selected-p x y w h)
144 (defstruct root child original current-child x y w h)
146 (defclass frame ()
147 ((name :initarg :name :accessor frame-name :initform nil)
148 (number :initarg :number :accessor frame-number :initform 0)
149 ;;; Float size between 0 and 1 - Manipulate only those variables and not real size
150 (x :initarg :x :accessor frame-x :initform 0.1)
151 (y :initarg :y :accessor frame-y :initform 0.1)
152 (w :initarg :w :accessor frame-w :initform 0.8)
153 (h :initarg :h :accessor frame-h :initform 0.8)
154 ;;; Real size (integer) in screen size - Don't set directly those variables
155 ;;; they may be recalculated by the layout manager.
156 (rx :initarg :rx :accessor frame-rx :initform 0)
157 (ry :initarg :ry :accessor frame-ry :initform 0)
158 (rw :initarg :rw :accessor frame-rw :initform 800)
159 (rh :initarg :rh :accessor frame-rh :initform 600)
160 ;; (root :initarg :root :accessor frame-root :initform nil
161 ;; :documentation "A list a physical coordinates (x y w h) if frame is a root frame. Nil otherwise")
162 (layout :initarg :layout :accessor frame-layout :initform nil
163 :documentation "Layout to display windows on a frame")
164 (nw-hook :initarg :nw-hook :accessor frame-nw-hook :initform nil
165 :documentation "Hook done by the frame when a new window is mapped")
166 (managed-type :initarg :managed-type :accessor frame-managed-type
167 :initform *default-managed-type*
168 :documentation "Managed window type")
169 (forced-managed-window :initarg :forced-managed-window
170 :accessor frame-forced-managed-window
171 :initform nil
172 :documentation "A list of forced managed windows (xlib:wm-name or window)")
173 (forced-unmanaged-window :initarg :forced-unmanaged-window
174 :accessor frame-forced-unmanaged-window
175 :initform nil
176 :documentation "A list of forced unmanaged windows (xlib:wm-name or window)")
177 (show-window-p :initarg :show-window-p :accessor frame-show-window-p :initform t)
178 (hidden-children :initarg :hidden-children :accessor frame-hidden-children :initform nil
179 :documentation "A list of hidden children")
180 (selected-pos :initarg :selected-pos :accessor frame-selected-pos :initform 0
181 :documentation "The position in the child list of the selected child")
182 (focus-policy :initarg :focus-policy :accessor frame-focus-policy
183 :initform *default-focus-policy*)
184 (window :initarg :window :accessor frame-window :initform nil)
185 (gc :initarg :gc :accessor frame-gc :initform nil)
186 (child :initarg :child :accessor frame-child :initform nil)
187 (data :initarg :data :accessor frame-data
188 :initform *default-frame-data*
189 :documentation "An assoc list to store additional data")))
193 (defparameter *root-frame* nil
194 "Root of the root - ie the root frame")
196 (defparameter *main-keys* nil)
197 (defparameter *main-mouse* nil)
198 (defparameter *second-keys* nil)
199 (defparameter *second-mouse* nil)
200 (defparameter *info-keys* nil)
201 (defparameter *info-mouse* nil)
202 (defparameter *query-keys* nil)
203 (defparameter *circulate-keys* nil)
204 (defparameter *circulate-keys-release* nil)
205 (defparameter *expose-keys* nil)
206 (defparameter *expose-mouse* nil)
209 (defparameter *other-window-manager* nil)
212 (defstruct menu name item doc)
213 (defstruct menu-item key value)
216 (defparameter *menu* (make-menu :name 'main :doc "Main menu"))
221 (defconfig *binding-hook* nil 'Hook
222 "Hook executed when keys/buttons are bounds")
224 (defconfig *loop-hook* nil 'Hook
225 "Hook executed on each event loop")
227 (defconfig *main-entrance-hook* nil 'Hook
228 "Hook executed on the main function entrance after
229 loading configuration file and before opening the display.")
231 (defconfig *root-size-change-hook* nil 'Hook
232 "Hook executed when the root size has changed for example when adding/removing a monitor")
235 (defparameter *in-second-mode* nil)
238 ;;; Placement variables. A list of two absolute coordinates
239 ;;; or a function: 'Y-X-placement' for absolute placement or
240 ;;; 'Y-X-child-placement' for child relative placement or
241 ;;; 'Y-X-root-placement' for root relative placement.
242 ;;; Where Y-X are one of:
244 ;;; top-left top-middle top-right
245 ;;; middle-left middle-middle middle-right
246 ;;; bottom-left bottom-middle bottom-right
248 (defconfig *banish-pointer-placement* 'bottom-right-root-placement
249 'Placement "Pointer banishment placement")
250 (defconfig *second-mode-placement* 'top-middle-root-placement
251 'Placement "Second mode window placement")
252 (defconfig *info-mode-placement* 'top-left-root-placement
253 'Placement "Info mode window placement")
254 (defconfig *query-mode-placement* 'top-left-root-placement
255 'Placement "Query mode window placement")
256 (defconfig *circulate-mode-placement* 'bottom-middle-root-placement
257 'Placement "Circulate mode window placement")
258 (defconfig *expose-mode-placement* 'top-left-child-placement
259 'Placement "Expose mode window placement (Selection keys position)")
260 (defconfig *expose-query-placement* 'bottom-left-root-placement
261 'Placement "Expose mode query window placement")
262 (defconfig *fastswitch-mode-placement* 'top-left-root-placement
263 'Placement "Fastswitch mode window placement")
264 (defconfig *notify-window-placement* 'bottom-right-root-placement
265 'Placement "Notify window placement")
266 (defconfig *ask-close/kill-placement* 'top-right-root-placement
267 'Placement "Ask close/kill window placement")
268 (defconfig *unmanaged-window-placement* 'middle-middle-root-placement
269 'Placement "Unmanager window placement")
272 (defparameter *in-process-existing-windows* nil)
274 ;; For debug - redefine defun
275 ;;(shadow :defun)
277 ;;(defmacro defun (name args &body body)
278 ;; `(progn
279 ;; (format t "defun: ~A ~A~%" ',name ',args)
280 ;; (force-output)
281 ;; (cl:defun ,name ,args
282 ;; (handler-case
283 ;; (progn
284 ;; ,@body)
285 ;; (error (c)
286 ;; (format t "New defun: Error in ~A : ~A~%" ',name c)
287 ;; (format t "Root tree=~A~%All windows=~A~%"
288 ;; (xlib:query-tree *root*) (get-all-windows))
289 ;; (force-output))))))
294 (defmacro make-x-drawable (argname type)
295 "Drawable wrapper to prevent type error in some CLX versions.
296 Replace xlib:drawable-* functions with x-drawable-* equivalents"
297 (let ((fun-symbol (create-symbol 'x-drawable- argname))
298 (set-symbol (create-symbol 'set-x-drawable- argname))
299 (xlib-equiv-symbol (create-symbol-in-package :xlib 'drawable- argname)))
300 `(progn
301 (declaim (inline ,fun-symbol))
302 (defun ,fun-symbol (window)
303 (,xlib-equiv-symbol window))
304 (defun ,set-symbol (window ,argname)
305 (if (typep ,argname ',type)
306 (setf (,xlib-equiv-symbol window) ,argname)
307 (dbg ',(create-symbol 'drawable-type-error- argname) window ,argname (xlib:wm-name window))))
308 (defsetf ,fun-symbol ,set-symbol))))
312 (make-x-drawable x (signed-byte 16))
313 (make-x-drawable y (signed-byte 16))
314 (make-x-drawable width (unsigned-byte 16))
315 (make-x-drawable height (unsigned-byte 16))
316 (make-x-drawable border-width (unsigned-byte 16))