Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
eclipse
eclipse
Commits
3d01339b
Commit
3d01339b
authored
Apr 25, 2008
by
Iban Hatchondo
Browse files
Fix: fullscreen state handling when decorating an application.
parent
db1167fb
Changes
2
Hide whitespace changes
Inline
Side-by-side
widgets.lisp
View file @
3d01339b
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.5
2
2008/04/2
3 15:16:32
ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.5
3
2008/04/2
4 08:24:45
ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...
...
@@ -290,29 +290,39 @@
(
and
(
if
max-w
(
=
max-w
(
screen-width
))
t
)
(
if
max-h
(
=
max-h
(
screen-height
))
t
))))))
(
defun
fullscreen-sizes
(
display
)
"Returns the fullscreen x, y, width and height as a multiple value."
(
if
(
xlib:query-extension
display
"XFree86-VidModeExtension"
)
(
let*
((
screen
(
xlib:display-default-screen
display
))
(
ml
(
xlib:xfree86-vidmode-get-mode-line
display
screen
)))
(
multiple-value-bind
(
x
y
)
(
xlib:xfree86-vidmode-get-viewport
display
screen
)
(
values
x
y
(
xlib:mode-info-hdisplay
ml
)
(
xlib:mode-info-vdisplay
ml
)))
(
values
0
0
(
screen-width
)
(
screen-height
)))))
;; Maximization helpers.
(
defun
find-max-geometry
(
application
direction
fill-p
&key
x
y
w
h
)
(
multiple-value-bind
(
rx
ry
rw
rh
)
(
rectangle-geometry
(
find-largest-empty-area
application
:area-include-me-p
(
or
(
/=
1
direction
)
fill-p
)
:panels-only-p
(
not
fill-p
)
:direction
(
case
direction
(
2
:vertical
)
(
3
:horizontal
)
(
t
:both
))))
(
find-largest-empty-area
application
:area-include-me-p
(
or
(
/=
1
direction
)
fill-p
)
:panels-only-p
(
not
fill-p
)
:direction
(
case
direction
(
2
:vertical
)
(
3
:horizontal
)
(
t
:both
))))
(
with-slots
(
window
master
)
application
(
with-slots
((
hm
hmargin
)
(
vm
vmargin
))
(
if
master
(
decoration-frame-style
master
)
(
theme-default-style
(
lookup-theme
"no-decoration"
)))
(
symbol-macrolet
((
minw
(
aref
wmsh
0
))
(
minh
(
aref
wmsh
1
))
(
maxw
(
aref
wmsh
2
))
(
maxh
(
aref
wmsh
3
))
(
incw
(
aref
wmsh
4
))
(
inch
(
aref
wmsh
5
))
(
basew
(
aref
wmsh
6
))
(
baseh
(
aref
wmsh
7
)))
(
let*
((
wmsh
(
recompute-wm-normal-hints
window
hm
vm
))
(
ww
(
or
w
(
check-size
(
-
rw
hm
)
basew
incw
minw
maxw
)))
(
hh
(
or
h
(
check-size
(
-
rh
vm
)
baseh
inch
minh
maxh
))))
(
when
(
>
(
+
ww
hm
)
rw
)
(
decf
ww
incw
))
(
when
(
>
(
+
hh
vm
)
rh
)
(
decf
hh
inch
))
(
make-geometry
:w
ww
:h
hh
:x
(
or
x
rx
)
:y
(
or
y
ry
))))))))
(
if
master
(
decoration-frame-style
master
)
(
theme-default-style
(
lookup-theme
"no-decoration"
)))
(
symbol-macrolet
((
minw
(
aref
wmsh
0
))
(
minh
(
aref
wmsh
1
))
(
maxw
(
aref
wmsh
2
))
(
maxh
(
aref
wmsh
3
))
(
incw
(
aref
wmsh
4
))
(
inch
(
aref
wmsh
5
))
(
basew
(
aref
wmsh
6
))
(
baseh
(
aref
wmsh
7
)))
(
let*
((
wmsh
(
recompute-wm-normal-hints
window
hm
vm
))
(
ww
(
or
w
(
check-size
(
-
rw
hm
)
basew
incw
minw
maxw
)))
(
hh
(
or
h
(
check-size
(
-
rh
vm
)
baseh
inch
minh
maxh
))))
(
when
(
>
(
+
ww
hm
)
rw
)
(
decf
ww
incw
))
(
when
(
>
(
+
hh
vm
)
rh
)
(
decf
hh
inch
))
(
make-geometry
:w
ww
:h
hh
:x
(
or
x
rx
)
:y
(
or
y
ry
))))))))
(
defun
compute-max-geometry
(
application
x
y
w
h
direction
fill-p
vert-p
horz-p
)
...
...
@@ -399,14 +409,8 @@
(
setf
(
decoration-frame-style
master
)
(
theme-default-style
(
lookup-theme
"no-decoration"
)))))
(
setf
(
geometry
fgeometry
)
(
values
x
y
w
h
))
(
if
(
xlib:query-extension
*display*
"XFree86-VidModeExtension"
)
(
let*
((
scr
(
first
(
xlib:display-roots
*display*
)))
(
ml
(
xlib:xfree86-vidmode-get-mode-line
*display*
scr
)))
(
multiple-value-setq
(
x
y
)
(
xlib:xfree86-vidmode-get-viewport
*display*
scr
))
(
setf
w
(
xlib:mode-info-hdisplay
ml
)
h
(
xlib:mode-info-vdisplay
ml
)))
(
setf
x
0
y
0
w
(
screen-width
)
h
(
screen-height
)))
(
multiple-value-setq
(
x
y
w
h
)
(
fullscreen-sizes
(
xlib:window-display
window
)))
(
configure-window
window
:x
x
:y
y
:width
w
:height
h
))
(
focus-widget
application
0
))
;; revert: restore precedent geometry and decoration style.
...
...
wm.lisp
View file @
3d01339b
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.5
2
200
7
/0
5/04 08:26:14
ihatchondo Exp $
;;; $Id: wm.lisp,v 1.5
3
200
8
/0
4/23 09:54:46
ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...
...
@@ -392,48 +392,55 @@
(
defun
make-decoration
(
app-window
application
&key
theme
)
"Returns a newly initialized decoration to hold the given application."
(
unless
theme
(
setf
theme
(
root-decoration-theme
*root*
)))
(
let*
((
dstyle
(
find-decoration-frame-style
theme
app-window
))
(
style
dstyle
))
(
when
(
member
:_net_wm_state_fullscreen
(
netwm:net-wm-state
app-window
))
(
let*
((
netwm-states
(
ignore-errors
(
netwm:net-wm-state
app-window
)))
(
dstyle
(
find-decoration-frame-style
theme
app-window
))
(
style
dstyle
)
(
fullscreen-p
(
member
:_net_wm_state_fullscreen
netwm-states
)))
(
when
fullscreen-p
(
setf
style
(
theme-default-style
(
lookup-theme
"no-decoration"
))))
(
with-slots
(
hmargin
vmargin
left-margin
top-margin
background
)
style
(
multiple-value-bind
(
wm-sizes
gravity
)
(
recompute-wm-normal-hints
app-window
hmargin
vmargin
)
(
multiple-value-bind
(
width
height
)
(
drawable-sizes
app-window
)
(
multiple-value-bind
(
x
y
)
(
initial-coordinates
app-window
style
)
(
let*
((
window
(
xlib:create-window
:parent
(
xlib:drawable-root
app-window
)
:x
x
:y
y
:width
(
+
width
hmargin
)
:height
(
+
height
vmargin
)
:background
background
:event-mask
+decoration-event-mask+
:do-not-propagate-mask
'
(
:button-press
:button-release
)))
(
master
(
make-instance
'decoration
:window
window
:old-frame-style
dstyle
:frame-style
style
:children
(
list
:application
application
)
:application-gravity
gravity
:wm-size-hints
wm-sizes
)))
(
make-frame-parts
master
)
(
make-title-bar
master
(
wm-name
app-window
))
(
update-edges-geometry
master
)
(
with-slots
(
icon
)
application
(
setf
(
getf
(
decoration-children
master
)
:icon
)
icon
(
slot-value
icon
'master
)
master
(
slot-value
application
'master
)
master
(
xlib:drawable-border-width
app-window
)
0
))
master
)))))))
(
multiple-value-bind
(
wm-sizes
gravity
)
(
recompute-wm-normal-hints
app-window
hmargin
vmargin
)
(
multiple-value-bind
(
width
height
)
(
drawable-sizes
app-window
)
(
multiple-value-bind
(
x
y
)
(
initial-coordinates
app-window
style
)
(
let*
((
window
(
xlib:create-window
:parent
(
xlib:drawable-root
app-window
)
:x
x
:y
y
:width
(
+
width
hmargin
)
:height
(
+
height
vmargin
)
:background
background
:event-mask
+decoration-event-mask+
:do-not-propagate-mask
'
(
:button-press
:button-release
)))
(
master
(
make-instance
'decoration
:window
window
:old-frame-style
dstyle
:frame-style
style
:children
(
list
:application
application
)
:application-gravity
gravity
:wm-size-hints
wm-sizes
)))
(
make-frame-parts
master
)
(
make-title-bar
master
(
wm-name
app-window
))
(
update-edges-geometry
master
)
(
with-slots
(
icon
(
fgeometry
full-geometry
))
application
(
setf
(
getf
(
decoration-children
master
)
:icon
)
icon
(
slot-value
icon
'master
)
master
(
slot-value
application
'master
)
master
(
xlib:drawable-border-width
app-window
)
0
)
(
when
fullscreen-p
(
multiple-value-bind
(
x
y
w
h
)
(
fullscreen-sizes
(
xlib:window-display
app-window
))
(
configure-window
app-window
:x
x
:y
y
:width
w
:height
h
))
(
setf
(
geometry
fgeometry
)
(
values
x
y
width
height
))))
master
)))))))
(
defun
decore-application
(
window
application
&key
(
map
t
)
theme
)
"Decores an application and map the resulting decoration as indicated
by the :map keyword argument. (default value is T).
Returns the newly created decoration instance."
(
let*
((
master
(
make-decoration
window
application
:theme
theme
))
(
master-window
(
widget-window
master
))
(
left-margin
(
style-left-margin
(
decoration-frame-style
master
)))
(
top-margin
(
style-top-margin
(
decoration-frame-style
master
))))
(
master-window
(
widget-window
master
))
(
left-margin
(
style-left-margin
(
decoration-frame-style
master
)))
(
top-margin
(
style-top-margin
(
decoration-frame-style
master
))))
(
with-event-mask
(
master-window
)
(
xlib:map-subwindows
master-window
))
(
with-event-mask
(
master-window
(
when
map
+decoration-event-mask+
))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment