Commit b20c403d authored by hatchond's avatar hatchond
Browse files

shade is now implemented (wm.lisp).

  To {un}shade a window double click on title bar.

  shaded-p widget: [generic function]
  return the actual shade state in the sens of the extended wm

  timestamp: slot of the title-bar class. (NEW)
  :_net_wm_state_shaded added in +netwm-protocol+

- *double-click-speed*: [global variable]
  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

- added support for :net_wm_state_{below, above} in input.lisp

- the following methods have created for manipulating widgets stacking

  - put-on-top widget [generic function]
    sets the widget stacking order on top of the others.

  - put-on-bottom widget [generic function]
    sets the widget stacking order on bottom of the others (except if
    any widget with :_net_wm_type_desktop is present and widget is or
    an application or a decoration).

- various  bug fix and improvements:

  - typo fix *wRAp-pointer-when-cycle* => *wARp-pointer-when-cycle*

  - set-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.

  - minor change in the unmap-notify event handling. Closing an
    application should not any more systematically provoke a
    window-error error. (input.lisp)

  - fullscreen-mode should now be correct: the spec say it would be
    better to undecore the window when in fullscreen. It is now how it
    works. (widgets.lisp)

    (One more feature of this function is still under discussion in
    the freedesktop team that may introduce modifications in the

    typo fix full-screen-mode => fullscreen-mode

  - maximize-window signature changes (wm.lisp):
    It now expect an application instead of a decoration.
    This have been done because non decorated window should be
    able to be maximized as well as decorated one. It is now the
    case. It has serval side effects:
     - slot initial-geometry in class decoration doesn't exist
     - new private slot added in class application: max-geometry.

  - minor changes in update-edges-geometry, and move-resize.lisp.

  - clean up in eclipse.lisp (delete unused code).

  - 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 a substructure hold by the root object
    that has to be updated each time you destroy, iconify, unicofy,
    shade, unshade, etc.
parent d2bb1ef2
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.4 2003/04/07 13:35:32 hatchond Exp $
;;; $Id: eclipse.lisp,v 1.5 2003/05/14 08:56:16 hatchond Exp $
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -86,18 +86,28 @@
(xlib:window-id manager)))
(defun initialize-root (display root-window)
(flet ((handle-redirect-error (condition)
(declare (ignorable condition))
(format *error-output* "Redirect error - another WM is running~%")
(xlib:close-display display)
(handler-bind ((error #'handle-redirect-error)) ; xlib:access-error
(setf (xlib:window-event-mask root-window)
'(:substructure-redirect :button-press :button-release :focus-change
:key-release :substructure-notify :owner-grab-button :key-press
:enter-window :leave-window))
(xlib:display-finish-output display))))
(defun init-gnome-compliance (display window manager)
(gnome:intern-gnome-atom display)
(netwm:intern-atoms display)
(let ((first-desknum (current-vscreen window))
(nb-vs (number-of-virtual-screens window)))
(unless (< -1 first-desknum nb-vs) (setf first-desknum 0))
(setf (gnome:win-protocols window) +gnome-protocols+
(gnome:win-supporting-wm-check manager) manager
(gnome:win-supporting-wm-check window) manager
(gnome:win-workspace-count window) nb-vs
(gnome:win-workspace window) first-desknum
(netwm:net-supported window) +netwm-protocol+
(netwm:net-supporting-wm-check window) manager
(netwm:net-supporting-wm-check manager) manager
(netwm:net-number-of-desktops window) nb-vs
(netwm:net-current-desktop window) first-desknum
(netwm:net-desktop-viewport window) (make-viewport-property nb-vs)
(netwm:net-desktop-geometry window)
(list (screen-width) (screen-height))
(defun initialize (display-specification)
(multiple-value-bind (display screen)
......@@ -106,7 +116,6 @@
(root-window (xlib:screen-root screen))
(manager (initialize-manager display root-window))
(menu-font (xlib:open-font display "fixed")))
(initialize-root display root-window)
(setf *display* display)
;; Specific for X display
(setf (xlib:display-error-handler display) #'default-handler
......@@ -115,7 +124,7 @@
*root-window* root-window
(root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr))
;; init all gnome properties on root.
(init-gnome-compliance display)
(init-gnome-compliance display root-window manager)
(keyboard:init-keyboard display)
(ppm:initialize colormap)
;; load personal configuration file, or the default one.
......@@ -146,33 +155,6 @@
(defun init-gnome-compliance (display)
(gnome:intern-gnome-atom display)
(netwm:intern-atoms display)
(let ((win (xlib:create-window :parent *root-window*
:override-redirect :on
:width 1 :height 1 :x -5 :y -5))
(first-desknum (or (netwm:net-current-desktop *root-window*)
(gnome:win-workspace *root-window*) 0)))
(unless (< -1 first-desknum *nb-vscreen*) (setf first-desknum 0))
(setf (vs:current-screen (root-vscreens *root*)) first-desknum
(gnome:win-protocols *root-window*) +gnome-protocols+
(gnome:win-supporting-wm-check win) win
(gnome:win-supporting-wm-check *root-window*) win
(gnome:win-workspace-count *root-window*) *nb-vscreen*
(gnome:win-workspace *root-window*) first-desknum
(netwm:net-supported *root-window*) +netwm-protocol+
(netwm:net-supporting-wm-check *root-window*) win
(netwm:net-supporting-wm-check win) win
(netwm:net-number-of-desktops *root-window*) *nb-vscreen*
(netwm:net-current-desktop *root-window*) first-desknum
(netwm:net-desktop-viewport *root-window*) (make-view-port-property)
(netwm:net-desktop-geometry *root-window*)
(list (screen-width) (screen-height))
(defun eclipse (&optional display-specification)
(initialize display-specification)
......@@ -184,16 +166,11 @@
(mp::start-lisp-connection-listener :port 6789 :password "clara"))
(catch 'end
(handler-bind ((end-of-file #'handle-end-of-file-condition))
(xlib:close-display *display*)))
(format t "Eclipse exited. Bye.~%")
;; should be part of the handler-bind form ; use it for "halting" the WM.
(loop for val being each hash-value in *widget-table*
when (application-p val) do
(kill-client-window (widget-window val)))
(catch 'end
(handler-bind ((end-of-file #'handle-end-of-file-condition))
(ignore-errors (xlib:close-display *display*))))
(format t "Eclipse exited. Bye.~%")
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.3 2003/03/17 11:13:17 hatchond Exp $
;;; $Id: gestures.lisp,v 1.4 2003/06/11 18:29:23 hatchond Exp $
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -154,30 +154,31 @@
(key-release ,@(cdr f2)))))
(defun action-key->lambda (action-keyword)
(with-slots (vscreens) *root*
(case action-keyword
(action () (:press (circulate-window vscreens :direction :above))))
(action () (:press (circulate-window vscreens :direction :below))))
(:switch-screen-left (action (:press (change-vscreen vscreens #'-)) ()))
(:switch-screen-right (action (:press (change-vscreen vscreens #'+)) ()))
(:move-right (action (:press (move-cursor-right)) ()))
(:move-left (action (:press (move-cursor-left)) ()))
(:move-up (action (:press (move-cursor-up)) ()))
(:move-down (action (:press (move-cursor-down)) ()))
(:left-click #'(lambda (event) (perform-click 1 event)))
(:middle-click #'(lambda (event) (perform-click 2 event)))
(:right-click #'(lambda (event) (perform-click 3 event)))
(:scroll-up #'(lambda (event) (perform-click 4 event)))
(:scroll-down #'(lambda (event) (perform-click 5 event)))
#'(lambda (event)
(mouse-stroke-for-move-and-resize event :action :move)))
#'(lambda (event)
(mouse-stroke-for-move-and-resize event :action :resize)))
(case action-keyword
(action () (:press (circulate-window *root* :direction :above))))
(action () (:press (circulate-window *root* :direction :below))))
(action (:press (change-vscreen *root* :direction #'-)) ()))
(action (:press (change-vscreen *root* :direction #'+)) ()))
(:move-right (action (:press (move-cursor-right)) ()))
(:move-left (action (:press (move-cursor-left)) ()))
(:move-up (action (:press (move-cursor-up)) ()))
(:move-down (action (:press (move-cursor-down)) ()))
(:left-click #'(lambda (event) (perform-click 1 event)))
(:middle-click #'(lambda (event) (perform-click 2 event)))
(:right-click #'(lambda (event) (perform-click 3 event)))
(:scroll-up #'(lambda (event) (perform-click 4 event)))
(:scroll-down #'(lambda (event) (perform-click 5 event)))
#'(lambda (event)
(mouse-stroke-for-move-and-resize event :action :move)))
#'(lambda (event)
(mouse-stroke-for-move-and-resize event :action :resize)))
(defmacro unrealize ((window &key mouse-p) code mask)
......@@ -245,10 +246,10 @@
(default-modifiers-p t)
(modifiers :any)
;;; modifiers can be:
;;; - composition of modifiers as '(:and :ALT-LEFT :CONTROL-RIGHT)
;;; - a simple modifier as :ALT-LEFT or 18 (a modifier mask)
;;; - a list of possible modifiers as '(:ALT-LEFT :CONTOL-RIGHT)
" modifiers can be:
- composition of modifiers as '(:and :ALT-LEFT :CONTROL-RIGHT)
- a simple modifier as :ALT-LEFT or 18 (a modifier mask)
- a list of possible modifiers as '(:ALT-LEFT :CONTOL-RIGHT)"
(catch 'keystroke-definition
((error #'(lambda (condition)
......@@ -266,10 +267,10 @@
(default-modifiers-p t)
(modifiers :any)
;;; modifiers can be:
;;; - composition of modifiers as '(:and :ALT-LEFT :CONTROL-RIGHT)
;;; - a simple modifier as :ALT-LEFT or 18 (a modifier mask)
;;; - a list of possible modifiers as '(:ALT-LEFT :CONTOL-RIGHT)
" modifiers can be:
- composition of modifiers as '(:and :ALT-LEFT :CONTROL-RIGHT)
- a simple modifier as :ALT-LEFT or 18 (a modifier mask)
- a list of possible modifiers as '(:ALT-LEFT :CONTOL-RIGHT)"
(catch 'mouse-stroke-definition
((error #'(lambda (condition)
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: global.lisp,v 1.7 2003/05/13 14:54:01 hatchond Exp $
;;; $Id: global.lisp,v 1.8 2003/05/14 08:56:17 hatchond Exp $
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
......@@ -20,8 +20,6 @@
(use-package :clx-extensions)
(defparameter *eclipse-directory* (directory-namestring *load-truename*))
(defun eclipse-path (&rest names)
......@@ -29,8 +27,8 @@
(or cl-user::*eclipse-eclipsedir* *eclipse-directory*)
;; This constant represents all the gnome protocols and extensions,
;; that we are actually dealling with.
;; The two following constants represent all the gnome protocols
;; and Extended Window Manager Hints actions we want to be responsible for.
(defconstant +gnome-protocols+
'(:_win_workspace :_win_workspace_count :_win_client_list
......@@ -39,19 +37,15 @@
:_net_current_desktop :_net_active_window :_net_close_window :_net_wm_state
:_net_wm_desktop :_net_wm_window_type :_net_desktop_names
:_net_wm_state_maximized_horz :_net_wm_state_maximized_vert
:_net_wm_state_skip_taskbar :_net_wm_state_skip_pager
:_net_wm_state_sticky :_net_wm_state_fullscreen :_net_wm_state_hidden))
:_net_wm_state_skip_taskbar :_net_wm_state_skip_pager :_net_wm_state_shaded
:_net_wm_state_sticky :_net_wm_state_fullscreen :_net_wm_state_hidden
:_net_wm_state_above :_net_wm_state_below))
(defconstant +pointer-event-mask+
'(:button-press :button-release :button-motion :enter-window :leave-window))
(defconstant +any-desktop+ #xFFFFFFFF)
(defmacro deftypedparameter (type symbol value &optional documentation)
(defparameter ,symbol ,value ,documentation)
(declaim (type ,type ,symbol))))
(defvar *cursor-2* nil)
(defvar *display* nil)
(defvar *root* nil)
......@@ -63,13 +57,13 @@
;; Default value of all the "customisable" environment variables
(defparameter *close-display-p* t)
(defparameter *menu-1-items* nil)
(defparameter *nb-vscreen* 4)
(defparameter *change-desktop-message-active-p* t)
(defparameter *verbose-move* t)
(defparameter *verbose-resize* t)
(defparameter *wrap-pointer-when-cycle* t)
(defparameter *warp-pointer-when-cycle* t)
(defparameter *focus-new-mapped-window* t)
(defparameter *focus-when-window-cycle* t)
(defparameter *double-click-speed* 200 "the speed of the double click")
(defparameter *move-mode* :opaque "values are: :box :opaque")
(defparameter *resize-mode* :opaque "values are: :box :opaque")
(defparameter *focus-type* :none "values are: :none :on-click")
......@@ -104,6 +98,13 @@ NIL corresponds to the default which is to sort on order of creation
finally (and ,free-old-theme-p (free-theme old-name))))
(setf decoration-theme theme))))
(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."
(defparameter ,symbol ,value ,documentation)
(declaim (type ,type ,symbol))))
;;;; debug purpose.
(defparameter *stderr* t)
......@@ -150,6 +151,9 @@ NIL corresponds to the default which is to sort on order of creation
;; For debug purpose: it use *stderr* as output stream.
;; The default value for *stderr* is t (standard output) but can be set,
;; through init-log-file, to a file. (named eclipse-year-month-day.log)
(define-condition already-handled-xerror (error) ())
(defun default-handler (dpy err
&rest keys
&key resource-id asynchronous
......@@ -165,4 +169,4 @@ NIL corresponds to the default which is to sort on order of creation
(or (application-master widget) *root*))
(format *stderr* "Dead window removed from table~%"))))
(finish-output *stderr*)
(throw 'general-error nil))
(error 'already-handled-xerror))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.7 2003/05/14 08:56:17 hatchond Exp $
;;; $Id: input.lisp,v 1.8 2003/06/11 18:29:23 hatchond Exp $
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -72,13 +72,23 @@
(when (logbitp 2 value-mask) (setf (xlib:drawable-width window) width))
(when (logbitp 3 value-mask) (setf (xlib:drawable-height window) height))
(when (logbitp 6 value-mask)
(setf (xlib:window-priority window above-sibling) stack-mode)))
(setf (window-priority window above-sibling) stack-mode)))
;; Acording to the ICCCM we should send a synthetic configure-notify,
;; when we move a window but without resizing it.
(unless (or (logbitp 2 value-mask) (logbitp 3 value-mask))
(send-configuration-notify window))
(defmethod event-process :after ((event destroy-notify) (widget base-widget))
(with-slots (window) event
(when (or (decoration-p widget) (application-p (lookup-widget window)))
(if (eq *focus-type* :on-click)
(multiple-value-bind (x y s child) (xlib:query-pointer *root-window*)
(declare (ignore x y s))
(let ((e (make-event :enter-notify :kind :inferior :mode :normal)))
(event-process e (or (lookup-widget child) *root*))))))))
;; Specialized ones.
;;; Events for the root window
......@@ -89,16 +99,22 @@
(when icon (uniconify icon))
(xlib:map-window (event-window event)))
(xlib:with-server-grabbed (*display*)
(procede-decoration (event-window event) (root-vscreens root)))))
(procede-decoration (event-window event)))))
(defmethod event-process ((event unmap-notify) (root root))
(declare (ignorable root))
(with-slots (window send-event-p) event
(when (application-p (lookup-widget window))
(if (and send-event-p (eql (xlib:window-map-state window) :unmapped))
;; client withdraws its top-level (ICCCM 4.2.1)
(undecore-application (lookup-widget window) :state 0)
(setf (wm-state window) 3)))))
(let ((widget (lookup-widget window)))
(typecase widget
(let ((state (ignore-errors (xlib:window-map-state window))))
(when state
(if (and send-event-p (eql state :unmapped))
;; client withdraws its top-level (ICCCM 4.2.1)
(undecore-application widget :state 0)
(setf (wm-state window) 3)))))
(setf (wm-state (get-child widget :application :window t)) 3))))))
(defmethod event-process ((event destroy-notify) (root root))
(xlib:with-server-grabbed (*display*)
......@@ -107,10 +123,8 @@
(ignore-errors (update-lists app 0 root))
(mapc #'remove-widget (list app (application-icon app)))
(xlib:destroy-window (widget-window (application-icon app)))
(when (eql app (get-root-desktop root))
(remove-desktop-application root app)))))
(when (eq *focus-type* :on-click)
(give-focus-to-next-widget-in-desktop root)))
(when (member app (root-desktop root))
(remove-desktop-application root app))))))
(defmethod event-process ((event enter-notify) (root root))
(with-slots (kind mode) event
......@@ -123,17 +137,18 @@
(defmethod event-process ((event focus-in) (root root))
(when (eql (event-kind event) :pointer)
(if (eql *focus-type* :on-click)
(give-focus-to-next-widget-in-desktop root)
(setf (netwm:net-active-window *root-window*) :none))))
(setf (netwm:net-active-window (widget-window root)) :none))))
(defmethod event-process ((event client-message) (root root))
(with-slots (type data event-window) event
(case type
(with-slots (vscreens) root
(unless (= (vs:current-screen vscreens) (aref data 0))
(change-vscreen vscreens nil (aref data 0)))))
(:_NET_NUMBER_OF_DESKTOPS (setf *nb-vscreen* (aref data 0)))
(with-slots (window) root
(unless (= (number-of-virtual-screens window) (aref data 0))
(change-vscreen root :n (aref data 0)))))
(setf (number-of-virtual-screens) (aref data 0)))
(:_NET_CLOSE_WINDOW (close-widget (lookup-widget event-window)))
(when (eq :wm_delete_window (id->atom-name (aref data 0)))
......@@ -147,7 +162,7 @@
(funcall callback event)))))
(defmethod event-process ((event button-press) (root root))
(with-slots (menu1 menu2 menu3 vscreens resize-status move-status) root
(with-slots (menu1 menu2 menu3 resize-status move-status) root
(with-slots (code state x y) event
(let ((callback (lookup-mouse-stroke code state)))
(when callback
......@@ -157,35 +172,33 @@
(when (and (eql resize-status move-status) (< 0 code 4)) ; nil nil 1|2|3
(when (= 2 (event-code event))
(when menu2 (destroy-substructure menu2))
(setf menu2 (make-running-menu vscreens)))
(setf menu2 (make-running-menu root)))
(realize-pop-up (case code (1 menu1) (2 menu2) (3 menu3)) x y)))))
(defmethod event-process ((event motion-notify) (root root))
(declare (optimize (speed 3)))
(with-slots (move-status resize-status) root
(move-status resize-status (master current-active-decoration)) root
(when (or move-status resize-status)
(let* ((master (slot-value root 'current-active-decoration))
(timestamp (event-time event))
(precedent-timestamp (decoration-precedent-time master)))
(let ((timestamp (event-time event))
(precedent-timestamp (decoration-precedent-time master)))
(declare (type (unsigned-byte 32) timestamp precedent-timestamp))
(if (decoration-active-p master)
(when (or (< timestamp precedent-timestamp)
(> (- timestamp precedent-timestamp) 15))
(setf (decoration-precedent-time master) timestamp)
(cond (move-status (move-widget master event *verbose-move*))
(resize-status (resize master event))))
(with-slots (root-x root-y) event
(resize-status (resize master event *verbose-resize*))))
(format t "The pointer has been frozen !!~%")
(setf (decoration-active-p master) t)
(make-event :button-release :root-x root-x :root-y root-y)
(event-process (make-event :button-release) root)))))))
(defmethod event-process ((event button-release) (root root))
(with-slots (move-status resize-status current-active-decoration
(with-slots (move-status resize-status (master current-active-decoration)
menu1 menu2 menu3 window-menu) root
(cond (move-status (finalize-move current-active-decoration))
(resize-status (finish-resize current-active-decoration))
(cond (move-status (finalize-move master *verbose-move*))
(resize-status (finish-resize master *verbose-resize*))
(with-slots (code) event
(when window-menu
......@@ -209,15 +222,15 @@
(defmethod event-process ((event configure-notify) (master decoration))
(when (application-p (lookup-widget (event-window event)))
(with-slots (event-window window x y) event
(with-slots ((ev-win event-window) window x y) event
(with-slots (left-margin top-margin) (decoration-frame-style master)
(multiple-value-bind (old-x old-y) (window-position window)
(when (eql (decoration-application-gravity master) :static)
(decf x left-margin) (decf y top-margin))
(unless (= old-x left-margin) (setf (xlib:drawable-x event-window) x))
(unless (= old-y top-margin) (setf (xlib:drawable-y event-window) y)))
(unless (= old-x left-margin) (setf (xlib:drawable-x ev-win) x))
(unless (= old-y top-margin) (setf (xlib:drawable-y ev-win) y)))
(resize-from (get-child master :application))
(with-event-mask (event-window)
(with-event-mask (ev-win)
(update-edges-geometry master)
(setf (window-position window) (values left-margin top-margin))
(send-configuration-notify window))))))
......@@ -227,19 +240,19 @@
(event-process (make-event :destroy-notify) master)))
(defmethod event-process ((event unmap-notify) (master decoration))
(with-slots (event-window window) event
(xlib:unmap-window event-window)
(setf (wm-state window) 3)))
(with-slots (event-window) event
(xlib:unmap-window event-window)))
(defmethod event-process ((event map-notify) (master decoration))
(with-slots (window event-window) event
(when (application-p (lookup-widget window))
(unmap-icon-window (get-child master :icon))
(xlib:map-window event-window)
(setf (xlib:window-priority event-window) :above
(wm-state window) 1)
(unless (stick-p window)
(setf (window-desktop-num window) (current-desk))))))
(unless (eq (xlib:window-map-state window) :unmapped)
(unmap-icon-window (get-child master :icon))
(xlib:map-window event-window)
(setf (window-priority event-window) :above
(wm-state window) 1)
(setf (window-desktop-num window)
(if (stick-p window) +any-desktop+ (current-desk)))))))
(defmethod event-process ((event destroy-notify) (master decoration))
(with-event-mask (*root-window*)
......@@ -248,9 +261,7 @@
(ignore-errors (update-lists (get-child master :application) 0 *root*))
(mapc #'remove-widget (cons master (decoration-children master)))
(xlib:destroy-window (get-child master :icon :window t))
(dismiss-move-resize *root*)))
(when (eq *focus-type* :on-click)
(give-focus-to-next-widget-in-desktop *root*)))
(dismiss-move-resize *root*))))
(defmethod event-process ((event visibility-notify) (master decoration))
(event-process event (get-child master :application)))
......@@ -264,8 +275,7 @@
(defmethod event-process ((event visibility-notify) (application application))
(with-slots (wants-focus-p unobscured-p input-model window) application
(setf unobscured-p (eq (event-state event) :unobscured))
(when (and unobscured-p wants-focus-p)
(when (and (eq (event-state event) :unobscured) wants-focus-p)
(set-focus input-model window 0)
(setf wants-focus-p nil))))
......@@ -275,11 +285,8 @@
(set-focus input-model window (event-time event)))))
(defmethod event-process ((event button-press) (application application))
(with-slots (window unobscured-p input-model) application
(xlib:allow-events *display* :replay-pointer)
(unless unobscured-p (put-on-top window))
(when (and (not (focused-p application)) (eq *focus-type* :on-click))
(set-focus input-model window (event-time event)))))
(xlib:allow-events *display* :replay-pointer)
(put-on-top application))
(defmethod event-process ((event focus-out) (application application))
(with-slots (master) application
......@@ -289,11 +296,8 @@
(defmethod event-process ((event focus-in) (application application))
(with-slots (master window) application
(unless (eql (event-mode event) :ungrab)
;; Put the focused window in first position in its screen
;; if focus policy is on-click.
(when (eq *focus-type* :on-click)
(vs:restack-window window (vs:nth-vscreen (root-vscreens *root*))))
(when master (dispatch-repaint master :focus t))
(when master
(dispatch-repaint master :focus t))
(setf (netwm:net-active-window *root-window*) window))))
(defmethod event-process ((event property-notify) (app application))
......@@ -302,10 +306,9 @@
(when master
(with-slots (hmargin vmargin) (decoration-frame-style master)
(multiple-value-bind (gravity wm-sizes)
(recompute-wm-normal-hints window hmargin vmargin)
(setf (slot-value master 'wm-size-hints) wm-sizes
(decoration-application-gravity master) gravity)))))
(with-slots (application-gravity wm-size-hints) master
(multiple-value-setq (wm-size-hints application-gravity)
(recompute-wm-normal-hints window hmargin vmargin))))))
(when master
(with-slots (window item-to-draw) (get-child master :title-bar)
......@@ -314,21 +317,12 @@
(update-lists app (car (wm-state window)) *root*)))))
(defun fullscreenable-p (application)
(with-slots (window) application
(let ((hint (ignore-errors (xlib:wm-normal-hints window))))
(symbol-macrolet ((max-w (xlib:wm-size-hints-max-width hint))
(max-h (xlib:wm-size-hints-max-height hint)))
(and (if max-w (= max-w (screen-width)) t)
(if max-h (= max-h (screen-height)) t))))))
(defmethod event-process ((event client-message) (application application))
(with-slots (data type) event
(with-slots (master window) application
(case type
(let* ((vs (root-vscreens *root*))
(to-change (aref data 0))
(let* ((to-change (aref data 0))
(mask (or (gnome:win-state window :result-type t) 0))
(new-mask (logior (logandc1 (aref data 0) mask)
(logand (aref data 0) (aref data 1)))))
......@@ -336,54 +330,50 @@
;; win_state_sticky
(when (logbitp 0 to-change)
(cond ((and (logbitp 0 mask) (not (logbitp 0 new-mask)))
(setf (window-desktop-num window) (current-desk))
(vs:remove-from-all vs window :except (current-desk)))
(setf (window-desktop-num window) (current-desk)))
((logbitp 0 new-mask)
(setf (window-desktop-num window) +any-desktop+)
(add-to-vscreen vs window :n +any-desktop+)
(xlib:map-window window))))
(when master
;; win_state_maximized_vert
(when (logbitp 2 to-change) (maximize-window master 2))
;; win_state_maximized_horiz
(when (logbitp 3 to-change) (maximize-window master 3)))))
;; win_state_maximized_vert
(when (logbitp 2 to-change) (maximize-window application 2))
;; win_state_maximized_horiz
(when (logbitp 3 to-change) (maximize-window application 3))
;; win_state_shaded
(when (and (logbitp 5 to-change) master) (shade master))))
(let ((mode (aref data 0))