1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Package definition
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2005-2013 Philippe Brochard <pbrochard@common-lisp.net>
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.
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.
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.
24 ;;; --------------------------------------------------------------------------
29 (:use
:common-lisp
:my-html
:tools
:version
)
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*)
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
)
71 (:alt-r
:mod-5
) (:alt-gr
:mod-5
)
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 *background-image
* nil
)
82 (defparameter *background-gc
* nil
)
84 (defparameter *expose-current-number
* 0)
85 (defparameter *expose-child-list
* nil
)
87 (defconfig *loop-timeout
* 1 nil
88 "Maximum time (in seconds) to wait before calling *loop-hook*")
90 (defparameter *pixmap-buffer
* nil
)
92 (defparameter *contrib-dir
* "contrib/")
94 (defparameter *default-font
* nil
)
95 ;;(defparameter *default-font-string* "9x15")
96 (defconfig *default-font-string
* "fixed" nil
97 "The default font used in clfswm")
99 (defconfig *color-move-window
* "DeepPink" 'Main-mode
100 "Color when moving or resizing a windows")
102 (defparameter *child-selection
* nil
)
104 ;;; CONFIG - Default frame datas
105 (defconfig *default-frame-data
*
106 (list '(:tile-size
0.8) '(:tile-space-size
0.1)
107 '(:fast-layout
(tile-left-layout tile-layout
))
108 '(:main-layout-windows nil
))
110 "Default slots set in frame date")
113 ;;; CONFIG - Default managed window type for a frame
114 ;;; type can be :all, :normal, :transient, :maxsize, :desktop, :dock, :toolbar, :menu, :utility, :splash, :dialog
115 (defconfig *default-managed-type
* '(:normal
) nil
116 "Default managed window types")
117 ;;(defparameter *default-managed-type* '(:normal :maxsize :transient))
118 ;;(defparameter *default-managed-type* '(:normal :transient :maxsize :desktop :dock :toolbar :menu :utility :splash :dialog))
119 ;;(defparameter *default-managed-type* '())
120 ;;(defparameter *default-managed-type* '(:all))
123 ;;; CONFIG - Default focus policy
124 (defconfig *default-focus-policy
* :click nil
125 "Default mouse focus policy. One of :click, :sloppy, :sloppy-strict, :sloppy-select or
126 :sloppy-select-window.")
129 (defconfig *show-hide-policy
* #'<=
130 nil
"'NIL': always display all children (better with transparency support).
131 '<': Hide only children less than children above.
132 '<=': Hide children less or equal to children above (better for performance on slow machine).")
134 (defconfig *show-hide-policy-type
* '(:normal
)
135 nil
"Windows types which are optimized by the show hide policy")
137 (defstruct child-rect child parent selected-p x y w h
)
139 (defstruct root child original current-child x y w h
)
142 ((name :initarg
:name
:accessor frame-name
:initform nil
)
143 (number :initarg
:number
:accessor frame-number
:initform
0)
144 ;;; Float size between 0 and 1 - Manipulate only those variables and not real size
145 (x :initarg
:x
:accessor frame-x
:initform
0.1)
146 (y :initarg
:y
:accessor frame-y
:initform
0.1)
147 (w :initarg
:w
:accessor frame-w
:initform
0.8)
148 (h :initarg
:h
:accessor frame-h
:initform
0.8)
149 ;;; Real size (integer) in screen size - Don't set directly those variables
150 ;;; they may be recalculated by the layout manager.
151 (rx :initarg
:rx
:accessor frame-rx
:initform
0)
152 (ry :initarg
:ry
:accessor frame-ry
:initform
0)
153 (rw :initarg
:rw
:accessor frame-rw
:initform
800)
154 (rh :initarg
:rh
:accessor frame-rh
:initform
600)
155 ;; (root :initarg :root :accessor frame-root :initform nil
156 ;; :documentation "A list a physical coordinates (x y w h) if frame is a root frame. Nil otherwise")
157 (layout :initarg
:layout
:accessor frame-layout
:initform nil
158 :documentation
"Layout to display windows on a frame")
159 (nw-hook :initarg
:nw-hook
:accessor frame-nw-hook
:initform nil
160 :documentation
"Hook done by the frame when a new window is mapped")
161 (managed-type :initarg
:managed-type
:accessor frame-managed-type
162 :initform
*default-managed-type
*
163 :documentation
"Managed window type")
164 (forced-managed-window :initarg
:forced-managed-window
165 :accessor frame-forced-managed-window
167 :documentation
"A list of forced managed windows (wm-name or window)")
168 (forced-unmanaged-window :initarg
:forced-unmanaged-window
169 :accessor frame-forced-unmanaged-window
171 :documentation
"A list of forced unmanaged windows (wm-name or window)")
172 (show-window-p :initarg
:show-window-p
:accessor frame-show-window-p
:initform t
)
173 (hidden-children :initarg
:hidden-children
:accessor frame-hidden-children
:initform nil
174 :documentation
"A list of hidden children")
175 (selected-pos :initarg
:selected-pos
:accessor frame-selected-pos
:initform
0
176 :documentation
"The position in the child list of the selected child")
177 (focus-policy :initarg
:focus-policy
:accessor frame-focus-policy
178 :initform
*default-focus-policy
*)
179 (window :initarg
:window
:accessor frame-window
:initform nil
)
180 (gc :initarg
:gc
:accessor frame-gc
:initform nil
)
181 (child :initarg
:child
:accessor frame-child
:initform nil
)
182 (data :initarg
:data
:accessor frame-data
183 :initform
*default-frame-data
*
184 :documentation
"An assoc list to store additional data")))
188 (defparameter *root-frame
* nil
189 "Root of the root - ie the root frame")
191 (defparameter *main-keys
* nil
)
192 (defparameter *main-mouse
* nil
)
193 (defparameter *second-keys
* nil
)
194 (defparameter *second-mouse
* nil
)
195 (defparameter *info-keys
* nil
)
196 (defparameter *info-mouse
* nil
)
197 (defparameter *query-keys
* nil
)
198 (defparameter *circulate-keys
* nil
)
199 (defparameter *circulate-keys-release
* nil
)
200 (defparameter *expose-keys
* nil
)
201 (defparameter *expose-mouse
* nil
)
204 (defparameter *other-window-manager
* nil
)
207 (defstruct menu name item doc
)
208 (defstruct menu-item key value
)
211 (defparameter *menu
* (make-menu :name
'main
:doc
"Main menu"))
216 (defconfig *binding-hook
* nil
'Hook
217 "Hook executed when keys/buttons are bounds")
219 (defconfig *loop-hook
* nil
'Hook
220 "Hook executed on each event loop")
222 (defconfig *main-entrance-hook
* nil
'Hook
223 "Hook executed on the main function entrance after
224 loading configuration file and before opening the display.")
226 (defconfig *root-size-change-hook
* nil
'Hook
227 "Hook executed when the root size has changed for example when adding/removing a monitor")
230 (defparameter *in-second-mode
* nil
)
233 ;;; Placement variables. A list of two absolute coordinates
234 ;;; or a function: 'Y-X-placement' for absolute placement or
235 ;;; 'Y-X-child-placement' for child relative placement or
236 ;;; 'Y-X-root-placement' for root relative placement.
237 ;;; Where Y-X are one of:
239 ;;; top-left top-middle top-right
240 ;;; middle-left middle-middle middle-right
241 ;;; bottom-left bottom-middle bottom-right
243 (defconfig *banish-pointer-placement
* 'bottom-right-root-placement
244 'Placement
"Pointer banishment placement")
245 (defconfig *second-mode-placement
* 'top-middle-root-placement
246 'Placement
"Second mode window placement")
247 (defconfig *info-mode-placement
* 'top-left-root-placement
248 'Placement
"Info mode window placement")
249 (defconfig *query-mode-placement
* 'top-left-root-placement
250 'Placement
"Query mode window placement")
251 (defconfig *circulate-mode-placement
* 'bottom-middle-root-placement
252 'Placement
"Circulate mode window placement")
253 (defconfig *expose-mode-placement
* 'top-left-child-placement
254 'Placement
"Expose mode window placement (Selection keys position)")
255 (defconfig *expose-query-placement
* 'bottom-left-root-placement
256 'Placement
"Expose mode query window placement")
257 (defconfig *fastswitch-mode-placement
* 'top-left-root-placement
258 'Placement
"Fastswitch mode window placement")
259 (defconfig *notify-window-placement
* 'bottom-right-root-placement
260 'Placement
"Notify window placement")
261 (defconfig *ask-close
/kill-placement
* 'top-right-root-placement
262 'Placement
"Ask close/kill window placement")
263 (defconfig *unmanaged-window-placement
* 'middle-middle-root-placement
264 'Placement
"Unmanager window placement")
267 (defparameter *in-process-existing-windows
* nil
)
269 ;; For debug - redefine defun
272 ;;(defmacro defun (name args &body body)
274 ;; (format t "defun: ~A ~A~%" ',name ',args)
276 ;; (cl:defun ,name ,args
281 ;; (format t "New defun: Error in ~A : ~A~%" ',name c)
282 ;; (format t "Root tree=~A~%All windows=~A~%"
283 ;; (xlib:query-tree *root*) (get-all-windows))
284 ;; (force-output))))))
289 (defmacro make-x-drawable
(argname type
)
290 "Drawable wrapper to prevent type error in some CLX versions.
291 Replace xlib:drawable-* functions with x-drawable-* equivalents"
292 (let ((fun-symbol (create-symbol 'x-drawable- argname
))
293 (set-symbol (create-symbol 'set-x-drawable- argname
))
294 (xlib-equiv-symbol (create-symbol-in-package :xlib
'drawable- argname
)))
296 (declaim (inline ,fun-symbol
))
297 (defun ,fun-symbol
(window)
298 (,xlib-equiv-symbol window
))
299 (defun ,set-symbol
(window ,argname
)
300 (if (typep ,argname
',type
)
301 (setf (,xlib-equiv-symbol window
) ,argname
)
302 (dbg ',(create-symbol 'drawable-type-error- argname
) window
,argname
(xlib:wm-name window
))))
303 (defsetf ,fun-symbol
,set-symbol
))))
307 (make-x-drawable x
(signed-byte 16))
308 (make-x-drawable y
(signed-byte 16))
309 (make-x-drawable width
(unsigned-byte 16))
310 (make-x-drawable height
(unsigned-byte 16))
311 (make-x-drawable border-width
(unsigned-byte 16))