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
92115b2c
Commit
92115b2c
authored
Nov 17, 2009
by
Iban Hatchondo
Browse files
Fix: theme rework to remove eql specializer on theme name in favor of theme object.
parent
e5ba59a1
Changes
10
Hide whitespace changes
Inline
Side-by-side
.eclipse
View file @
92115b2c
...
...
@@ -58,7 +58,7 @@
:modifiers '(:and :ALT-LEFT :CONTROL-LEFT))
(define-key-combo :scroll-down
:keys '(:q)
:modifiers '(:and :
ALT-LE
FT :CONTROL-LEFT))
:modifiers '(:and :
ISO-LEVEL3-SHI
FT :CONTROL-LEFT))
;; example of user define keystroke:
;(define-key-combo :raise-pointered-window
...
...
input.lisp
View file @
92115b2c
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.5
2
200
8
-0
8
-2
9
1
4:57:47
ihatchondo Exp $
;;; $Id: input.lisp,v 1.5
3
200
9
-0
2
-2
0
1
8:03:55
ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...
...
@@ -148,13 +148,12 @@
(
undecore-application
widget
:state
0
)
(
setf
(
wm-state
window
)
3
)))))
(
decoration
(
let
((
application
(
get-child
widget
:application
)))
(
let
((
application
(
get-child
widget
:application
)))
(
if
(
application-iconic-p
application
)
(
setf
(
wm-state
(
widget-window
application
))
3
)
(
with-slots
(
window
send-event-p
)
event
(
progn
(
setf
send-event-p
t
)
(
setf
window
(
widget-window
application
))
(
format
t
"about to withdraw: ~a ~%"
(
wm-name
window
))
(
event-process
event
root
)))))))))
(
defmethod
event-process
((
event
destroy-notify
)
(
root
root
))
...
...
@@ -451,13 +450,13 @@
(
defmethod
event-process
((
event
exposure
)
(
button
button
))
(
when
(
zerop
(
event-count
event
))
(
let*
((
master
(
slot-value
button
'master
))
(
na
me
(
if
master
(
slot-value
(
decoration-frame-style
master
)
'
na
me
)
(
theme-name
(
root-decoration-theme
*root*
))))
)
(
repaint
button
na
me
(
and
master
(
focused-p
master
))))))
(
the
me
(
if
master
(
slot-value
(
decoration-frame-style
master
)
'
the
me
)
(
root-decoration-theme
*root*
))))
(
repaint
button
the
me
(
and
master
(
focused-p
master
))))))
(
defmethod
event-process
((
event
exposure
)
(
box
box-button
))
(
repaint
box
(
theme-name
(
root-decoration-theme
*root*
)
)
nil
))
(
repaint
box
(
root-decoration-theme
*root*
)
nil
))
(
defmethod
event-process
((
event
button-release
)
(
close
close-button
))
(
close-widget
(
get-child
(
button-master
close
)
:application
)))
...
...
package.lisp
View file @
92115b2c
;;; -*- Mode: Lisp; Package: User -*-
;;; $Id: package.lisp,v 1.1
8
200
4
/0
3/01 14:53
:5
7
ihatchondo Exp $
;;; $Id: package.lisp,v 1.1
9
200
5
/0
1/16 23:25
:5
9
ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
...
...
@@ -181,7 +181,7 @@
#:pixmap-width
;function
#:procede-decoration
;function
#:query-application-tree
;function
#:
%
quit
%
;function
#:quit
;function
#:realize-menu-items
;function
#:realize-pop-up
;function
#:recompute-wm-normal-hints
;function
...
...
@@ -254,6 +254,7 @@
#:frame-item-pixmaps
;generic function
#:frame-item-sizes
;generic function
#:frame-item-width
;generic function
#:frame-style-theme
;generic function
#:free-frame-style
;generic function
#:get-child
;generic function
#:get-pixmap
;generic function
...
...
themer.lisp
View file @
92115b2c
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: themer.lisp,v 1.1
1
200
5/03/01
1
0
:0
6:37
ihatchondo Exp $
;;; $Id: themer.lisp,v 1.1
2
200
9-11-17
1
8
:0
8:43
ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
...
...
@@ -31,11 +31,11 @@
(
gethash
name
*themes*
))
(
defclass
frame-style
()
((
na
me
:initform
"no name"
:type
string
:initarg
:theme-na
me
:reader
frame-style-theme
-name
)
((
the
me
:initform
nil
:type
(
or
null
theme
)
:initarg
style-the
me
:reader
frame-style-theme
)
(
title-bar-position
:initform
:top
:type
keyword
...
...
@@ -239,6 +239,9 @@
(
defmethod
initialize-instance
:after
((
theme
theme
)
&rest
options
)
(
declare
(
ignorable
options
))
(
with-slots
(
default-style
transient-style
)
theme
(
when
default-style
(
setf
(
slot-value
default-style
'theme
)
theme
))
(
when
transient-style
(
setf
(
slot-value
transient-style
'theme
)
theme
)))
(
setf
(
gethash
(
theme-name
theme
)
*themes*
)
theme
))
;;;; build-in no decoration theme.
...
...
@@ -247,7 +250,6 @@
(
make-instance
'theme
:name
"no-decoration"
:default-style
(
make-instance
'default-style
:theme-name
"no-decoration"
:title-bar-position
:none
))
;;;; misc functions.
...
...
@@ -299,11 +301,8 @@
;;;; theme manipulation.
;; I defined this here, just to avoid compilation warnings.
;; But it doesn't matter, because just before loading a theme
;; (fmakunbound 'initialize-frame) is called.
(
defun
initialize-frame
(
directory-name
window
)
(
declare
(
ignorable
directory-name
window
))
(
defmethod
initialize-frame
(
theme-class-symbol
directory-name
window
)
(
declare
(
ignorable
theme-class-symbol
directory-name
window
))
(
values
))
(
defun
free-theme
(
name
)
...
...
@@ -316,11 +315,13 @@
(
defun
load-theme
(
root-window
name
)
"Loads and returns theme named by parameter name. Themes are cached."
(
unless
(
lookup-theme
name
)
(
fmakunbound
'initialize-frame
)
(
setf
name
(
ensure-theme-directory-exists
name
))
(
load
(
concatenate
'string
name
"theme.o"
))
(
setf
name
(
theme-name
(
initialize-frame
name
root-window
))))
(
unless
(
lookup-theme
name
)
(
let*
((
tclass
(
string-upcase
name
))
(
theme-package
(
concatenate
'string
tclass
"-ECLIPSE-THEME"
)))
(
setf
name
(
ensure-theme-directory-exists
name
))
(
load
(
concatenate
'string
name
"theme.o"
))
(
let
((
tclass
(
with-standard-io-syntax
(
intern
tclass
theme-package
))))
(
setf
name
(
theme-name
(
initialize-frame
tclass
name
root-window
))))))
(
use-package
(
format
nil
"~:@(~A~)-ECLIPSE-THEME"
name
))
(
lookup-theme
name
))
...
...
@@ -407,28 +408,30 @@
((
style1
title-pos1
bkgrd1
parts-to-redraw-on-focus1
items1
)
(
style2
title-pos2
bkgrd2
parts-to-redraw-on-focus2
items2
))
(
mapcar
#'
parse-args
forms
)
`
(
defun
initialize-frame
(
dir
window
)
(
let
((
fs1
,
(
and
items1
(
let
((
theme-class
(
format
nil
"~:@(~a~)"
(
symbol-value
theme-name
))))
`
(
progn
(
defclass
,
(
intern
theme-class
)
(
eclipse::theme
)
()
(
:documentation
,
(
format
nil
"~a theme base class"
theme-name
)))
(
defmethod
eclipse-internals::initialize-frame
((
name
(
eql
',
(
intern
theme-class
)))
dir
window
)
(
let
((
fs1
,
(
and
items1
`
(
make-instance
',
(
intern
(
symbol-name
style1
)
"ECLIPSE-INTERNALS"
)
:theme-name
,
theme-name
:title-bar-position
,
title-pos1
:background
(
make-background
,
bkgrd1
window
dir
)
:parts-to-redraw-on-focus
',parts-to-redraw-on-focus1
)))
(
fs2
,
(
and
items2
(
fs2
,
(
and
items2
`
(
make-instance
',
(
intern
(
symbol-name
style2
)
"ECLIPSE-INTERNALS"
)
:theme-name
,
theme-name
:title-bar-position
,
title-pos2
:background
(
make-background
,
bkgrd2
window
dir
)
:parts-to-redraw-on-focus
',parts-to-redraw-on-focus2
))))
,
(
unless
items2
`
(
declare
(
ignorable
fs2
)))
,
(
when
items1
(
define-style
`
fs1
items1
`
dir
`
window
))
,
(
when
items2
(
define-style
`
fs2
items2
`
dir
`
window
`
fs1
))
(
make-instance
'
eclipse::theme
:name
,
theme-name
,@
(
and
style1
`
(
,
style1
fs1
))
,@
(
and
style2
`
(
,
style2
fs2
))))))))
,
(
unless
items2
`
(
declare
(
ignorable
fs2
)))
,
(
when
items1
(
define-style
`
fs1
items1
`
dir
`
window
))
,
(
when
items2
(
define-style
`
fs2
items2
`
dir
`
window
`
fs1
))
(
make-instance
'
,
(
intern
theme-class
)
:name
,
theme-name
,@
(
and
style1
`
(
,
style1
fs1
))
,@
(
and
style2
`
(
,
style2
fs2
))))))))
))
themes/CoolClean/theme.lisp
View file @
92115b2c
...
...
@@ -48,8 +48,8 @@
(
:right
(
"right"
))
(
:left
(
"left"
))))))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
CoolClean
+
)
)
(
focus
t
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
CoolClean
)
(
focus
t
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
((
window
eclipse::window
)
(
item-to-draw
eclipse::item-to-draw
)
(
gcontext
eclipse::gcontext
)
...
...
@@ -61,8 +61,8 @@
(
xlib:draw-rectangle
window
gcontext
0
0
width
height
t
)))))
(
draw-centered-text
window
gcontext
item-to-draw
:color
*white*
:x
5
)))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
CoolClean
+
)
)
(
focus
null
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
CoolClean
)
(
focus
null
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
((
window
eclipse::window
)
(
item-to-draw
eclipse::item-to-draw
)
(
gcontext
eclipse::gcontext
))
widget
...
...
themes/Step/theme.lisp
View file @
92115b2c
...
...
@@ -41,8 +41,8 @@
(
:right
(
"side"
))
(
:left
(
"side"
))))))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
Step
+
)
)
(
focus
t
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
Step
)
(
focus
t
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
((
window
eclipse::window
)
(
item-to-draw
eclipse::item-to-draw
)
(
gcontext
eclipse::gcontext
)
...
...
@@ -54,8 +54,8 @@
(
xlib:draw-rectangle
window
gcontext
0
0
width
height
t
)))))
(
draw-centered-text
window
gcontext
item-to-draw
:color
*white*
)))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
Step
+
)
)
(
focus
null
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
Step
)
(
focus
null
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
((
window
eclipse::window
)
(
item-to-draw
eclipse::item-to-draw
)
(
gcontext
eclipse::gcontext
))
widget
...
...
themes/brushed-metal/theme.lisp
View file @
92115b2c
...
...
@@ -91,16 +91,16 @@
(
multiple-value-bind
(
width
height
)
(
drawable-sizes
window
)
(
xlib:draw-rectangle
window
gcontext
0
0
width
height
t
)))))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
brushed-metal
+
)
)
(
focus
t
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
brushed-metal
)
(
focus
t
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
(
frame-style
)
(
button-master
widget
)
(
typecase
frame-style
(
default-style
(
default-draw-on-focus-in
widget
frame-style
))
(
transient-style
(
transient-draw-on-focus-in
widget
frame-style
)))))
(
defmethod
repaint
((
wget
title-bar
)
(
name
(
eql
+
brushed-metal
+
)
)
(
focus
null
))
(
declare
(
ignorable
na
me
focus
))
(
with-slots
(
frame-style
)
(
button-master
wget
)
(
defmethod
repaint
((
w
id
get
title-bar
)
(
theme
brushed-metal
)
(
focus
null
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
(
frame-style
)
(
button-master
w
id
get
)
(
typecase
frame-style
(
default-style
(
default-draw-on-focus-out
wget
frame-style
))
(
transient-style
(
xlib:clear-area
(
widget-window
wget
))))))
(
default-style
(
default-draw-on-focus-out
w
id
get
frame-style
))
(
transient-style
(
xlib:clear-area
(
widget-window
w
id
get
))))))
themes/microGUI/theme.lisp
View file @
92115b2c
...
...
@@ -73,16 +73,16 @@
(
xlib:draw-rectangle
window
gcontext
w
0
pix-w
h
t
))
(
draw-centered-text
window
gcontext
item-to-draw
:color
*white*
:x
5
))))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
microGUI
+
)
)
(
focus
t
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
microGUI
)
(
focus
t
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
((
frame-style
eclipse::frame-style
))
(
button-master
widget
)
(
when
(
default-style-p
frame-style
)
(
redraw-title-bar
widget
(
get-pixmap
frame-style
:top-blue
)
(
get-pixmap
frame-style
:top-curves
)))))
(
defmethod
repaint
((
widget
title-bar
)
(
name
(
eql
+
microGUI
+
)
)
(
focus
null
))
(
declare
(
ignorable
na
me
focus
))
(
defmethod
repaint
((
widget
title-bar
)
(
theme
microGUI
)
(
focus
null
))
(
declare
(
ignorable
the
me
focus
))
(
with-slots
((
frame-style
eclipse::frame-style
))
(
button-master
widget
)
(
when
(
default-style-p
frame-style
)
(
redraw-title-bar
widget
...
...
widgets.lisp
View file @
92115b2c
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.5
7
2009-
02-20 18:07:0
1 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.5
8
2009-
11-17 17:33:2
1 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...
...
@@ -73,12 +73,12 @@
maximization the widget will be enlarged to cover the whole screen except
any existing panels (e.g applications with the :_net_wm_window_type_dock
atom present in there _net_wm_window_type property.
widget (base-widget): the widget to (un)maximize.
code (integer 1 3):
1 operates on width and height.
2 operates on height.
3 operates on width.
:fill-p (boolean): If NIL, cover the whole screen (except dock type
-
widget (base-widget): the widget to (un)maximize.
-
code (integer 1 3):
--
1 operates on width and height.
--
2 operates on height.
--
3 operates on width.
-
:fill-p (boolean): If NIL, cover the whole screen (except dock type
applications). If T, finds the first region of the screen that does
not overlap applications not already overlapped by the widget."
))
...
...
@@ -96,14 +96,14 @@
(
:documentation
"Returns T if one of the state :win_state_fixed_position
:_net_wm_state_sticky is set for the widget."
))
(
defgeneric
repaint
(
widget
theme
-name
focus
)
(
:method
(
widget
theme
-name
focus
)
nil
)
(
defgeneric
repaint
(
widget
theme
focus
)
(
:method
(
widget
theme
focus
)
nil
)
(
:documentation
"This method is dedicated to widget repaint such as every buttons, icons,
edges ...
It is specialized on widget type, theme name (via an eql specializer) and a
boolean that indicate if the corresponding toplevel (type decoration) is or
not focused.
It is specialized on widget type, frame-style theme and a boolean that
indicate if the corresponding toplevel (type decoration) is or
not focused.
Except for standard expose events, the repaint dispatching on focus change
will be perform according to parts-to-redraw-on-focus list given in
...
...
@@ -567,16 +567,16 @@
(
defconstant
+std-button-mask+
'
(
:button-press
:button-release
:button-motion
:owner-grab-button
:exposure
))
(
defmethod
repaint
((
widget
button
)
theme
-name
(
focus
t
))
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
button
)
theme
(
focus
t
))
(
declare
(
ignorable
theme
focus
))
(
with-slots
(
item-to-draw
window
gcontext
)
widget
(
xlib:clear-area
window
)
(
typecase
item-to-draw
(
string
(
draw-centered-text
window
gcontext
item-to-draw
))
(
xlib:pixmap
(
draw-pixmap
window
gcontext
item-to-draw
)))))
(
defmethod
repaint
((
widget
button
)
theme
-name
(
focus
null
))
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
button
)
theme
(
focus
null
))
(
declare
(
ignorable
theme
focus
))
(
xlib:clear-area
(
widget-window
widget
)))
(
defmethod
shaded-p
((
widget
button
))
...
...
@@ -654,8 +654,8 @@
(
window-position
window
)
(
values
x
y
)
(
slot-value
box
'item-to-draw
)
m
))))))
(
defmethod
repaint
((
widget
box-button
)
theme
-name
focus
&aux
x
)
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
box-button
)
theme
focus
&aux
x
)
(
declare
(
ignorable
theme
focus
))
(
with-slots
(
window
item-to-draw
gcontext
pixmap
)
widget
(
xlib:clear-area
window
)
(
when
pixmap
...
...
@@ -713,19 +713,19 @@
(
declare
(
ignorable
value
))
(
with-slots
(
window
master
)
button
(
when
(
decoration-p
master
)
(
with-slots
(
na
me
)
(
decoration-frame-style
master
)
(
repaint
button
na
me
(
focused-p
master
))))))
(
with-slots
(
the
me
)
(
decoration-frame-style
master
)
(
repaint
button
the
me
(
focused-p
master
))))))
(
defmethod
repaint
((
widget
push-button
)
theme
-name
(
focus
t
))
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
push-button
)
theme
(
focus
t
))
(
declare
(
ignorable
theme
focus
))
(
with-slots
(
window
gcontext
armed
active-p
item-to-draw
)
widget
(
xlib:clear-area
window
)
(
let
((
p
(
and
armed
active-p
(
push-button-pixmap
widget
:focused-click
))))
(
when
(
or
p
item-to-draw
)
(
draw-pixmap
window
gcontext
(
or
p
item-to-draw
))))))
(
defmethod
repaint
((
widget
push-button
)
theme
-name
(
focus
null
))
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
push-button
)
theme
(
focus
null
))
(
declare
(
ignorable
theme
focus
))
(
with-slots
(
window
gcontext
armed
active-p
)
widget
(
xlib:clear-area
window
)
(
let
((
pixmap
(
push-button-pixmap
widget
:unfocused-click
)))
...
...
@@ -752,8 +752,8 @@
(
hmargin
:initform
0
)
(
parent
:initform
nil
)))
(
defmethod
repaint
((
widget
title-bar
)
theme
-name
focus
)
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
title-bar
)
theme
focus
)
(
declare
(
ignorable
theme
focus
))
(
with-slots
(
item-to-draw
window
gcontext
)
widget
(
xlib:clear-area
window
)
(
when
item-to-draw
...
...
@@ -931,8 +931,8 @@
(
and
pixmap-to-free
(
xlib:free-pixmap
pixmap-to-free
))
(
setf
pixmap-to-free
nil
)))
(
defmethod
repaint
((
widget
icon
)
theme
-name
focus
)
(
declare
(
ignorable
theme
-name
focus
))
(
defmethod
repaint
((
widget
icon
)
theme
focus
)
(
declare
(
ignorable
theme
focus
))
(
with-slots
(
window
item-to-draw
gcontext
)
widget
(
xlib:clear-area
window
)
(
draw-centered-text
window
gcontext
item-to-draw
:color
*white*
)))
...
...
wm.lisp
View file @
92115b2c
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.5
7
200
8-08-29 14:57:47
ihatchondo Exp $
;;; $Id: wm.lisp,v 1.5
8
200
9-11-17 17:31:25
ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...
...
@@ -159,9 +159,9 @@
(
defmethod
dispatch-repaint
((
master
decoration
)
&key
(
focus
(
focused-p
master
)))
(
declare
(
optimize
(
speed
3
)
(
safety
1
)))
(
with-slots
(
parts-to-redraw-on-focus
na
me
)
(
decoration-frame-style
master
)
(
declare
(
type
string
na
me
))
(
mapc
#'
(
lambda
(
k
)
(
repaint
(
get-child
master
k
)
na
me
focus
))
(
with-slots
(
parts-to-redraw-on-focus
the
me
)
(
decoration-frame-style
master
)
(
declare
(
type
theme
the
me
))
(
mapc
#'
(
lambda
(
k
)
(
repaint
(
get-child
master
k
)
the
me
focus
))
parts-to-redraw-on-focus
)))
(
defun
recompute-wm-normal-hints
(
window
hmargin
vmargin
)
...
...
@@ -720,7 +720,7 @@
((
window-not-decorable-p
window
(
application-type
application
))
(
setf
(
netwm:net-frame-extents
window
)
(
values
0
0
0
0
))
(
setf
(
wm-state
window
)
1
)
(
xlib:map-window
window
))
(
xlib:map-window
window
))
(
t
(
decore-application
window
application
:map
t
)))
(
with-slots
(
wants-focus-p
input-model
type
)
application
(
unless
(
member
:_net_wm_window_type_desktop
type
)
...
...
@@ -737,7 +737,7 @@
:type
boolean
:reader
close-application-p
)))
(
defun
eclipse-internal-loop
()
(
let*
((
exit
0
)
time
)
(
let*
((
exit
0
))
;; Sets the root window pop-up menu
(
when
*menu-1-exit-p*
...
...
@@ -765,10 +765,9 @@
(
xlib:with-server-grabbed
(
*display*
)
(
mapc
(
lambda
(
w
)
(
unless
(
ignore-errors
(
ignorable-window-p
w
))
(
unless
(
ignore-errors
(
ignorable-window-p
w
))
(
procede-decoration
w
)))
(
xlib:query-tree
*root-window*
))))
;; Main loop
(
loop
(
catch
'general-error
...
...
@@ -786,7 +785,7 @@
when
(
application-p
val
)
if
*close-display-p*
do
(
close-widget
val
)
else
do
(
undecore-application
val
))
(
setf
time
10
exit
2
))
(
setf
exit
2
))
(
2
(
when
(
root-sm-conn
*root*
)
(
close-sm-connection
*root*
:exit-p
nil
))
(
xlib:display-finish-output
*display*
)
...
...
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