Commit 5abdb7f3 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

- Window rotation (Alt-Tab) re-designed. It now works as in almost

  every window managers. Press Alt-Tab once will raise the next
  application, on the current desktop, according to the current
  stacking order. If Alt is released then pressing again Alt-Tab will
  put back the precedent application. Otherwise if you kipped Alt down
  then Tab again and the next application will be brought on top of the
  others, and the precedent one is back on its depth. And so on
  until you come back on the first one.
  The same mechanism is available with say Alt-a. It just rotate
  windows on the other sens.

- The window rotation may be verbose by displaying a small window
  indicating the name and the icon, if provided, of the application
  that comes on top of the others.
  To disable it do (setf *verbose-window-cycling* nil) in your eclipse
  config file.

- The window rotation may also cycle the current desktop iconified
  applications. To disable it do (setf *cycle-icons-p* nil) in
  your eclipse config file.

- Screen edges are now resistant.

- fix menu bug. They don't anymore appear below their applications.

- a maximized window does not allow anymore to be resized in the
  directions in which it has been maximized.

- the message-box may now display a centered pixmap before the text.

- package.lisp updated.

- man page updated.

- changelog updated.
parent 67f8cca8
# -*- Mode: Makefile -*-
# $Id: Makefile.in,v 1.5 2002/11/07 15:54:34 hatchond Exp $
# $Id: Makefile.in,v 1.6 2003/04/07 13:35:32 hatchond Exp $
#
# Makefile for Eclipse window manager.
......@@ -101,7 +101,8 @@ install:
for theme in ${themes} ; do \
test -f "themes/$$theme/theme.o" && \
$(install) -d ${themedir}/$$theme && \
for file in themes/$$theme/* ; do \
$(install) ${themedir}/$$theme/theme.o && \
for file in themes/$$theme/*.pnm ; do \
$(install) $$file ${themedir}/$$theme/. ; \
done ; \
done ; \
......
-*- Mode: ChangeLog -*-
$Id: changelog,v 1.3 2002/07/02 14:54:39 hatchond Exp $
$Id: changelog,v 1.4 2002/11/07 14:54:27 hatchond Exp $
0.01 => 0.02
Eclipse should now compile on every ANSI-compliant Common Lisp
......@@ -54,4 +54,174 @@ pre 0.03=>0.03
- added coordinates display during move and resize.
- added opaque resize mode.
- new theme interface (needs to be documented).
- some new themes have been added (CoolClean, brushed-metal, Step).
\ No newline at end of file
- some new themes have been added (CoolClean, brushed-metal, Step).
0.03=>0.04
- created an eclipse-internals package.
- some bugs fix.
- some functionalities added.
- file splitting to reorganize the project a little:
- wm.lisp and global.lisp had been splitted into:
- widgets.lisp (base-widget, root, application, buttons, ...)
- input.lisp (general event processing)
- gestures.lisp (key-combo, cursor movement)
- eclipse.lisp (Top level functions)
- move-resize (moving and resizing master)
- misc.lisp (...)
- lib/clx-ext/clx-extensions.lisp
- gnome-manager.lisp had been splitted into:
- manager-commons.lisp
- gnome-manager.lisp
- netwm-manager.lisp
- one directory added with one sub-directory: lib and lib/clx-ext
- a new package clx-extensions in lib/clx-ext
- some files had moved:
- image-reader.lisp into lib
- event.lisp ...... into lib/clx-ext
- cursor.lisp ..... ----------------
- cursordef.lisp .. ----------------
- keysysms.lisp ... ----------------
- keysymdef.lisp .. ----------------
- commit Christian Lynbech patch:
CMUCL seems to have tighten the handling of certain things so this
patch will do three necessary things:
- in system.lisp (compile-theme) remove path from :output-file name as
this includes path specs from the input file.
- in wm.lisp (menu-3-prcess) removes the &allow-other-keys which CMUCL
18d chokes on (some previous versions seemed more lax, they also
accepted (lambda (&rest) ...) which 18d does not but you have gotten
rid of that).
- in lib/image-reader.lisp (load-ppm) changes function to use two
streams as there are many things you cannot do on a non-character
string including calling `unread-char'.
0.04=>0.05
- various bug fix. (with-state missing, undecore-application, some
unhandle events during menu-3 loop, ...)
- procede-decoration code is inside an unwind-protect.
- support for focus-new-mapped-window
- support for :_net_wm_state_maximized_{horz/vert},
and :_net_wm_state_fullscreen.
- fix typo parenthesis, and grid undraw in mouse stroke resize/move.
- more netwm complience improvement (fullscreen, hidden,
icon-name, maximized)
- Christian Lynbech patch for icon managment has been applied.
"It provides an icon box, ie. a configurable place where icons are
stacked. As part of this change, I have changed the default location
of icons from (750,50) to (0,0). If the icon box overflows, icons will
be created ayt (0,0). I have also decreased the default height from 60
to 20 to minimize the space waste (if the application supplies an
icon, it will of course take precedence).
The patch allso adds different kinds of sorting options. Icons can be
sorted by creation time (I have added a new slot in the `icon' class)
or name or class (or whatever else you can think of).
It still needs a few things, such as the possibility of disabling the
icon box and other fill orders than :top-right (ie. filling from the
top right corner of the box)."
- Unrelated to the icon box thing, the patch also contains a set of
application inspection function (see the end of "misc.lisp"), A
disabling of the expression that removes the "Exit" entry in the root
menu so that you can close Eclipse down and finally a new option,
*close-display-p*, that regulates whether exiting Eclipse also kills
the entire X session (if *close-display-p* is nil, Eclipse will just
exit).
- ICCCM complience and extended window manager specification complience.
- bugs fix relative to extended wm spec (i.e.: we now should interact
correctly with gnome 2.2)
- added ICCCM session managment complience: we now use/react to the
owning of the WM_S{screen number} selection. see ICCCM 2.8
0.05=>0.06
- The package now exports almost every symbols. They are sorted in
alphabetical order and type order (class, generic function,
function, ...)
- An application that does not support to be maximized in fullscreen
don't have the _net_wm_state_fullscreentom present in its
_net_wm_state property anymore.
- lib/clx-patch.lisp: fixed bug found in input-focus.
- few new methods:
dispatch-repaint: new method for the repaint protocol.
repaint: the main method of the repaint protocol.
(draw-focused-decoration & draw-unfocused-decoration: removed.)
- themes are now defined in their own packages.
All theme are updated.
0.06=>0.07
- shade is now implemented (wm.lisp).
To {un}shade a window double click on title bar.
- *double-click-speed* for user configuration.
use it to customize the time you want for double click.
Default value: 200 (timestamp unit of the X server)
- added support for the xvidmode extension
(lib/clx-ext/xvidmode.lisp).
- added support for :net_wm_state_{below, above}
- various changes in window stacking order manipulation.
(see put-on-top, and put-on-bottom)
- buttons are now able to display a pixmap that shows its state (e.g:
pressed or not).
- added support for _net_active_window message
- various bug fix and improvements:
- typo fix *wRAp-pointer-when-cycle* => *wARp-pointer-when-cycle*
full-screen-mode => fullscreen-mode
- changing the focus now cares of the map state of the window it
is supose to gives the focus to. (Should avoid lots of match-error).
Wrong nil timestamp has been fixed.
- fullscreen-mode should now be correct: the spec say it would be
better to undecore the window when in fullscreen. It does now.
- maximize-window signature changes. It now expect an application
instead of a decoration.
=> STROKES USING MAXIMIZE-WINDOW SHOULD BE UPDATED.
- minor changes in update-edges-geometry, and move-resize.lisp.
- virtual-screen.lisp re-implementation. It now use the X server
data such the root window tree, and window property that hold the
desktop number instead of an internal substructure that has to be
updated each time you destroy, un/iconify, shade, unshade, etc.
- fix incorect placement of the menu button when the title bar is
vertical.
- fix handling of message of type :_WIN_WORKSPACE :_NET_CURRENT_DESKTOP.
- fix the _net_active_window property handling for undecorated windows.
- fix missplaced handling for message of type _net_close_window.
- some code clean up (removed some unused code).
- lots of documentations added almost every where.
0.07=>0.08
\ No newline at end of file
.TH Eclipse 1 "(c) 2001 Iban HATCHONDO"
.\"$Id: eclipse.1,v 1.6 2003/09/30 12:18:37 hatchond Exp $
.\"$Id: eclipse.1,v 1.7 2003/10/01 09:02:53 hatchond Exp $
.SH NAME
eclipse - a window manager in Common Lisp
......@@ -145,6 +145,15 @@ If you want to have a small window that presents you the sizes
of the window you are resizing set it to \fIt\fP otherwise
\fInil\fP. The default value is \fIt\fP.
.TP
.B\-*verbose-window-cycling*\ \fIboolean\fP
During window rotation, if set to \fIt\fP eclipse will display, in a
small window, the name of the focus window and its icon if
exist. Default value is \fIt\fP.
.TP
.B\-*cycle-icons-p*\ \fIboolean\fP
During window rotation, if set to \fIt\fP iconified window will be
included in the rotation. Default value is \fIt\fP.
.TP
.B\-*warp-pointer-when-cycle*\ \fIboolean\fP
If set to \fIt\fP, the mouse pointer is warped around the upper-left
corner of the window that is virtually pointed to. Otherwise, nothing
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.8 2003/09/16 21:32:53 hatchond Exp $
;;; $Id: eclipse.lisp,v 1.9 2003/09/30 12:18:36 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -150,6 +150,7 @@
:exposures :OFF
:font (xlib:open-font display *font-name*)))
(setf (xlib:window-cursor root-window) (root-default-cursor *root*))
(setf (slot-value *root* 'gcontext) *gcontext*)
(unless (root-decoration-theme *root*)
(setf (decoration-theme) "microGUI"))
(init-edges-cursors))))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.7 2003/09/16 21:56:12 hatchond Exp $
;;; $Id: gestures.lisp,v 1.8 2003/09/30 12:18:36 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -30,11 +30,13 @@
(defun lookup-keystroke (code state)
"Find the associated callback if any for this pair code modifier state."
(gethash (cons code state) *keystroke-map*))
(or (gethash (cons code state) *keystroke-map*)
(gethash (cons code #x8000) *keystroke-map*)))
(defun lookup-mouse-stroke (button state)
"Find the associated callback if any for this pair button modifier state."
(gethash (cons button state) *mouse-stroke-map*))
(or (gethash (cons button state) *mouse-stroke-map*)
(gethash (cons button #x8000) *keystroke-map*)))
(defun keycode-registered-p (keycode &optional (count 1))
"Returns t if this keycode is used for any keystroke."
......@@ -104,7 +106,7 @@
:keysyms (mapcar #'kb:keyname->keysym key-name-set)
:default-modifiers-p default-modifiers-p
:modifiers modifiers
:action action))
:action (or action (action-key->lambda name))))
(defun keystroke-p (stroke)
(typep stroke 'keystroke))
......@@ -129,7 +131,7 @@
:button (list button)
:default-modifiers-p default-modifiers-p
:modifiers modifiers
:action action))
:action (or action (action-key->lambda name))))
(defun mouse-stroke-p (stroke)
(typep stroke 'mouse-stroke))
......@@ -156,10 +158,8 @@
(defun action-key->lambda (action-keyword)
"Returns the associated predefined callback for the given action keyword."
(case action-keyword
(:switch-win-up
(action () (:press (circulate-window *root* :direction :above))))
(:switch-win-down
(action () (:press (circulate-window *root* :direction :below))))
(:switch-win-up #'(lambda (e) (circulate-window-up-and-down e :above)))
(:switch-win-down #'(lambda (e) (circulate-window-up-and-down e :below)))
(:switch-screen-left
(action (:press (change-vscreen *root* :direction #'-)) ()))
(:switch-screen-right
......@@ -207,7 +207,7 @@
for mask in (translate-modifiers dpy modifiers) do
(loop for key in (stroke-keys ,stroke) do
(unrealize (,dest-window :mouse-p ,mouse-p) key mask)
(when (and default-modifiers-p (not (eql mask :any)))
(when (and default-modifiers-p (not (eql mask #x8000)))
(when caps-l
(unrealize (,dest-window :mouse-p ,mouse-p)
key (+ mask caps-l)))
......@@ -218,40 +218,38 @@
(unrealize (,dest-window :mouse-p ,mouse-p)
key (+ mask num-l caps-l))))))))
(defmacro realize ((window &key mouse-p) code mask action-keyword action)
(defmacro realize ((window &key mouse-p) code mask action)
`(progn
,@(if mouse-p
`((setf (gethash (cons ,code ,mask) *mouse-stroke-map*)
(or ,action (action-key->lambda ,action-keyword)))
`((setf (gethash (cons ,code ,mask) *mouse-stroke-map*) ,action)
(xlib:grab-button ,window
,code
'(:button-press)
:modifiers ,mask
:sync-pointer-p t))
`((setf (gethash (cons ,code ,mask) *keystroke-map*)
(or ,action (action-key->lambda ,action-keyword)))
`((setf (gethash (cons ,code ,mask) *keystroke-map*) ,action)
(setf (aref *registered-keycodes* ,code) 1)
(xlib:grab-key ,window ,code :modifiers ,mask :owner-p nil)))))
(defmacro define-combo-internal (stroke dest-window &key mouse-p)
`(with-slots (name modifiers default-modifiers-p action) ,stroke
`(with-slots (modifiers default-modifiers-p action) ,stroke
(loop with dpy = (xlib:drawable-display ,dest-window)
with num-l = (kb:modifier->modifier-mask dpy :NUM-LOCK)
with caps-l = (kb:modifier->modifier-mask dpy :CAPS-LOCK)
for mask in (translate-modifiers dpy modifiers) do
(loop for key in (stroke-keys ,stroke) do
(realize (,dest-window :mouse-p ,mouse-p)
key mask name action)
(when (and default-modifiers-p (not (eql mask :any)))
key mask action)
(when (and default-modifiers-p (not (eql mask #x8000)))
(when caps-l
(realize (,dest-window :mouse-p ,mouse-p)
key (+ mask caps-l) name action ))
key (+ mask caps-l) action ))
(when num-l
(realize (,dest-window :mouse-p ,mouse-p)
key (+ mask num-l) name action))
key (+ mask num-l) action))
(when (and num-l caps-l)
(realize (,dest-window :mouse-p ,mouse-p)
key (+ mask num-l caps-l) name action)))))))
key (+ mask num-l caps-l) action)))))))
(defun define-key-combo (name &key keys
(default-modifiers-p t)
......@@ -326,3 +324,57 @@
(xlib:grab-pointer (event-child event) +pointer-event-mask+)
(menu-3-process event widget :key action)
(funcall (define-menu-3 action))))
;;; Hook and Callbacks for :switch-win-{up, down} keystrokes.
(defvar *depth* nil)
(defvar *current-widget-info* nil)
(defun initialize-circulate-window (root-window dpy)
"Initialize gestures internal hooks before circulating windows."
(loop with map = *keystroke-map*
for mod in (stroke-modifiers (gethash :switch-win-up *keystrokes*))
for code = (unless (eq mod :and) (kb:keyname->keycodes dpy mod))
when code
do (setf (gethash (cons (if (listp code) (car code) code) #x8000) map)
#'circulate-window-modifier-callback))
(xlib:grab-keyboard root-window)
(unless *current-widget-info*
(setf *current-widget-info* (create-message-box nil :parent root-window)))
(setf *depth* 0))
(defun circulate-window-modifier-callback (event)
(when (typep event 'key-release)
(xlib:ungrab-keyboard *display*)
(loop with map = *keystroke-map*
for mod in (stroke-modifiers (gethash :switch-win-up *keystrokes*))
for code = (unless (eq mod :and) (kb:keyname->keycodes *display* mod))
when code
do (remhash (cons (if (listp code) (car code) code) #x8000) map))
(let ((widget (lookup-widget (input-focus *display*))))
(when widget (setf (application-wants-iconic-p widget) nil)))
(xlib:unmap-window (widget-window *current-widget-info*))
(setf *depth* nil)))
(defun circulate-window-up-and-down (event dir)
"Make window circulating according to the `dir' argument (or :above :below)."
(when (typep event 'key-press)
(with-slots ((root-win root)) event
(unless *depth*
(initialize-circulate-window root-win (xlib:drawable-display root-win)))
(if (eq dir :above) (incf *depth*) (decf *depth*))
(let ((widget (circulate-window
(lookup-widget root-win)
:direction dir
:nth *depth*
:icon-p *cycle-icons-p*)))
(when (and *verbose-window-cycling* widget)
(with-slots (window)
(if (decoration-p widget) (get-child widget :application) widget)
(setf (message-pixmap *current-widget-info*)
(clx-ext::wm-hints-icon-pixmap window))
(setf (button-item-to-draw *current-widget-info*) (wm-name window)))
(with-slots (window) *current-widget-info*
(xlib:map-window window)
(setf (xlib:window-priority window) :above)
(repaint *current-widget-info* nil nil)))))))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: global.lisp,v 1.10 2003/09/16 14:24:41 hatchond Exp $
;;; $Id: global.lisp,v 1.11 2003/09/30 12:18:36 hatchond Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
......@@ -55,12 +55,15 @@
(defvar +xa-wm+ nil)
;; Default value of all the "customisable" environment variables
(defparameter *menu-1-exit-p* t)
(defparameter *close-display-p* t)
(defparameter *menu-1-items* nil)
(defparameter *change-desktop-message-active-p* t)
(defparameter *verbose-move* t)
(defparameter *verbose-resize* t)
(defparameter *verbose-window-cycling* t)
(defparameter *warp-pointer-when-cycle* t)
(defparameter *cycle-icons-p* t "Alt-Tab shows or not iconified windows.")
(defparameter *focus-new-mapped-window* t)
(defparameter *focus-when-window-cycle* t)
(defparameter *double-click-speed* 200 "the speed of the double click")
......@@ -79,8 +82,8 @@
"icon box fill strategy, one of :{top,bottom}-{left,right}")
(defparameter *icon-box-sort-function* nil
"Function determining icon order within the box.
NIL corresponds to the default which is to sort on order of creation
\(aka `icon-sort-creation-order'\).")
NIL corresponds to the default which is to sort on order of creation
\(aka `icon-sort-creation-order'\).")
(defsetf font-name () (name)
`(setf *font-name* ,name
......@@ -101,7 +104,7 @@ NIL corresponds to the default which is to sort on order of creation
(defmacro deftypedparameter (type symbol value &optional documentation)
"define a parameter with the same syntax and behavior as defparameter
except that its type must be given first."
except that its type must be given first."
`(progn
(defparameter ,symbol ,value ,documentation)
(declaim (type ,type ,symbol))))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.16 2003/09/16 21:32:53 hatchond Exp $
;;; $Id: input.lisp,v 1.18 2003/10/01 18:26:35 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -283,8 +283,8 @@
(set-focus input-model window (event-time event)))))
(defmethod event-process ((event button-press) (application application))
(xlib:allow-events *display* :replay-pointer)
(put-on-top application))
(put-on-top application)
(xlib:allow-events *display* :replay-pointer))
(defmethod event-process ((event focus-out) (application application))
(with-slots (master) application
......@@ -294,7 +294,7 @@
(defmethod event-process ((event focus-in) (application application))
(with-slots (master window) application
(unless (eql (event-mode event) :ungrab)
(unless (eql (event-mode event) :grab)
(when master (dispatch-repaint master :focus t))
(setf (netwm:net-active-window *root-window*) window))))
......@@ -472,3 +472,8 @@
(defmethod event-process ((event button-release) (icon icon))
(when (icon-desiconify-p icon)
(uniconify icon)))
;;; Events for Message Box
(defmethod event-process ((event visibility-notify) (box box-button))
(setf (window-priority (widget-window box)) :above))
\ No newline at end of file
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: misc.lisp,v 1.10 2003/09/16 14:24:41 hatchond Exp $
;;; $Id: misc.lisp,v 1.11 2003/09/16 14:47:12 hatchond Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -121,7 +121,7 @@
(defun motif-wm-decoration (window)
"Returns the state (or :on :off) of the :_MOTIF_WM_HINT property that
indicates the application wants or not to be decorated."
indicates the application wants or not to be decorated."
(let ((prop (xlib:get-property window :_MOTIF_WM_HINTS)))
(or (and prop (logbitp 1 (first prop)) (zerop (third prop)) :OFF) :ON)))
......@@ -133,7 +133,7 @@
(defun send-wm-protocols-client-message (window atom &rest data)
"Send a client-message of type :wm-protocol to the specified window
with data being the given atom plus the rest of the function args."
with data being the given atom plus the rest of the function args."
(xlib:send-event window
:client-message
nil
......@@ -144,8 +144,8 @@
(defsetf window-priority (window &optional sibling) (priority)
"Set the window priority such as (setf xlib:window-priority) but
also invoke update-client-list-stacking to reflect the priority
change in all the root properties that are involved in."
also invoke update-client-list-stacking to reflect the priority
change in all the root properties that are involved in."
`(progn
(setf (xlib:window-priority ,window ,sibling) ,priority)
(update-client-list-stacking *root*)))
......@@ -160,8 +160,8 @@
(defun query-application-tree (root-window)
"Returns the children of the specified root-window as if all applications
where undecorated. The children are returned as a sequence of windows in
current stacking order, from bottom-most (first) to top-most (last)."
where undecorated. The children are returned as a sequence of windows in
current stacking order, from bottom-most (first) to top-most (last)."
(loop for window in (xlib:query-tree root-window)
for obj = (lookup-widget window)
for appw = (typecase obj
......@@ -175,8 +175,8 @@
(defun run-application (program &rest arguments)
"Returns a lambda of zero arguments which when funcalled will try to
run the program named `program' with arguments `arguments'. If the
invocation failed a pop-up window will appear reporting the error."
run the program named `program' with arguments `arguments'. If the
invocation failed a pop-up window will appear reporting the error."
(lambda ()
(catch 'wrong-name
(handler-bind ((error #'handle-wrong-name-condition))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: move-resize.lisp,v 1.4 2003/08/28 14:50:35 hatchond Exp $
;;; $Id: move-resize.lisp,v 1.5 2003/09/30 12:18:36 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -33,8 +33,7 @@
(defun initialize-geometry-info-box ()
(unless *geometry-info-box*
(setf *geometry-info-box*
(create-message-box '("nil") :parent *root-window* :border-width 0)))
(setf *geometry-info-box* (create-message-box nil :parent *root-window*)))
(with-slots (window) *geometry-info-box*
(xlib:map-window window)
(setf (xlib:window-priority window) :above)))
......@@ -114,16 +113,28 @@
(defun initialize-resize (master edge pointer-event)
"Initialize the internal settings for the resize process."
(setf (window-priority (widget-window master)) :above
(decoration-active-p master) t)
(setf (window-priority (widget-window master)) :above)
(if (base-widget-p edge)
(where-is-pointer edge)
(with-slots (root-x root-y) pointer-event
(find-corner root-x root-y (widget-window master)))))
(find-corner root-x root-y (widget-window master))))
(let ((prop (netwm:net-wm-state (get-child master :application :window t))))
(when (member :_net_wm_state_maximized_vert prop)
(case *card-point*
((:ne :se) (setf *card-point* :east))
((:nw :sw) (setf *card-point* :west))
((:north :south) (setf *card-point* nil))))
(when (member :_net_wm_state_maximized_horz prop)
(case *card-point*
((:ne :nw) (setf *card-point* :north))
((:se :sw) (setf *card-point* :south))
((:east :west) (setf *card-point* nil))))
(setf (decoration-active-p master) (if *card-point* t nil))))
(defgeneric resize-from (widget)
(:documentation "Resize an application or a master according
to the given master or application respectively."))
(:documentation
"Resize an application or a master according to the given master or
application respectively."))
(defmethod resize-from ((master decoration))
(declare (optimize (speed 3) (safety 0)))
......@@ -166,7 +177,7 @@
(defun find-corner (root-x root-y window)
"Initialize the resize process when activated from somewhere else
than a decoration edge."
than a decoration edge."
(declare (optimize (speed 3) (safety 0))
(type xlib:int16 root-x root-y))
(multiple-value-bind (x y w h) (window-geometry window)
......@@ -183,7 +194,7 @@
(defun check-size (size base inc min-size max-size)
"If the given size respects all the given constraints, then return size.
Otherwise returns the nearest satisfying size."
Otherwise returns the nearest satisfying size."
(declare (optimize (speed 3) (safety 0))
(type xlib:card16 size base inc min-size max-size))
(if (< min-size size max-size)
......@@ -287,7 +298,20 @@
(with-slots (window active-p gcontext) widget
(when active-p
(let ((new-x (- (the (signed-byte 16) (event-root-x event)) *delta-x*))
(new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*)))
(new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*))
(scr-w (screen-width)) (scr-h (screen-height)))
(declare (type (signed-byte 16) new-x new-y))
(declare (type (unsigned-byte 16) scr-w scr-h))
(multiple-value-bind (x y w h)
(window-geometry (if (eq mode :box) (widget-window *clone*) window))
(declare (type (signed-byte 16) x y))
(declare (type (unsigned-byte 16) w h))
(when (and (>= x 0) (< -40 new-x 0)) (setf new-x 0))
(when (and (>= y 0) (< -40 new-y 0)) (setf new-y 0))
(when (and (>= (- scr-w x w) 0) (< -40 (- scr-w new-x w) 0))
(setf new-x (- scr-w w)))
(when (and (>= (- scr-h y h) 0) (< -40 (- scr-h new-y h) 0))
(setf new-y (- scr-h h))))
(when verbose-p (display-coordinates new-x new-y))
(if (and (decoration-p widget) (eql mode :box))
(with-slots (window) *clone*
......