Commit 7ea81e7d authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

support added for :_net_workarea property (netwm complience) and clean up.

- global.lisp:
  added :_net_workarea :_net_moveresize_window as supported.

- input.lisp:
  :_net_wm_strut_partial :_net_wm_strut are now handled in property notify
  to reflect changes in the net_workarea property.

  + clean up.

- virtual-screen.lisp
  added a call to update-workarea-property in (setf number-of-virtual-screens)

- widgets.lisp
  a slot named type has been added.
  remove-widget :after ((application application)) added.

  + clean up.

- wm.lisp
  added a call to update-workarea-property in decore-application.
parent 85d75f56
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: global.lisp,v 1.16 2004/01/07 11:21:41 ihatchondo Exp $
;;; $Id: global.lisp,v 1.17 2004/01/15 15:35:34 ihatchondo Exp $
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
......@@ -36,7 +36,7 @@
'(:_net_client_list :_net_client_list_stacking :_net_number_of_desktops
:_net_current_desktop :_net_active_window :_net_close_window :_net_wm_state
:_net_wm_desktop :_net_wm_window_type :_net_desktop_names :_net_wm_strut
:_net_wm_strut_partial :_net_workarea :_net_moveresize_window
:_net_wm_window_type_desktop :_net_wm_window_type_dock
:_net_wm_window_type_toolbar :_net_wm_window_type_menu
:_net_wm_window_type_utility :_net_wm_window_type_splash
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.28 2004/01/15 15:35:34 ihatchondo Exp $
;;; $Id: input.lisp,v 1.29 2004/01/17 18:22:34 ihatchondo Exp $
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -108,9 +108,7 @@
(when (and (application-p app) (not (application-master app)))
(ignore-errors (update-lists app 0 root))
(mapc #'remove-widget (list app (application-icon app)))
(xlib:destroy-window (widget-window (application-icon app)))
(when (member app (root-desktop root))
(remove-desktop-application root app))))))
(xlib:destroy-window (widget-window (application-icon app)))))))
(defmethod event-process ((event enter-notify) (root root))
(with-slots (resize-status move-status) root
......@@ -196,10 +194,8 @@
(when (or move-status resize-status)
(xlib:ungrab-server *display*)
(xlib:ungrab-pointer *display*)
(setf (decoration-active-p current-active-decoration) nil
current-active-decoration nil
move-status nil
resize-status nil))))
(setf (values current-active-decoration move-status resize-status) nil)
(setf (decoration-active-p current-active-decoration) nil))))
;;; Events for master (type: decoration)
......@@ -217,8 +213,7 @@
(event-process (make-event :destroy-notify) master)))
(defmethod event-process ((event unmap-notify) (master decoration))
(with-slots (window) master
(xlib:unmap-window window)))
(xlib:unmap-window (widget-window master)))
(defmethod event-process ((event map-request) (master decoration))
(xlib:map-window (event-window event)))
......@@ -281,20 +276,23 @@
(setf (netwm:net-active-window *root-window*) window))))
(defmethod event-process ((event property-notify) (app application))
(with-slots (window master) app
(with-slots (window master type) app
(case (event-atom event)
(when master
(with-slots (hmargin vmargin) (decoration-frame-style master)
(with-slots (application-gravity wm-size-hints) master
(multiple-value-setq (wm-size-hints application-gravity)
(recompute-wm-normal-hints window hmargin vmargin))))))
((:wm_name :_net_wm_name)
(when (and master (get-child master :title-bar))
(with-slots (window item-to-draw) (get-child master :title-bar)
(setf item-to-draw (wm-name (widget-window app)))
(xlib:queue-event *display* :exposure :window window :count 0))))
((:_net_wm_strut_partial :_net_wm_strut)
(when (eq type :_net_wm_window_type_dock)
(update-workarea-property *root*)))
(update-lists app (car (wm-state window)) *root*)))))
(defmethod event-process ((event client-message) (application application))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: virtual-screen.lisp,v 1.16 2003/12/04 16:12:42 ihatchondo Exp $
;;; $Id: virtual-screen.lisp,v 1.17 2004/01/15 00:00:11 ihatchondo Exp $
;;;Copyright (C) 2002 Iban HATCHONDO
;;; contact :
......@@ -85,7 +85,8 @@
((= cur (1- ,n)) (map-or-unmap-vscreen #'xlib:map-window cur)))
(setf (netwm:net-desktop-viewport window) (make-viewport-property ,n)
(gnome:win-workspace-count window) ,n
(netwm:net-number-of-desktops window) ,n)))))
(netwm:net-number-of-desktops window) ,n)
(update-workarea-property *root*)))))
(defun input-focus (display)
"Find the application that is currently focused if anyone is."
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.28 2004/01/13 13:52:15 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.29 2004/01/15 15:35:34 ihatchondo Exp $
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -164,9 +164,7 @@
(when (or *verbose-move* *verbose-resize*) (undraw-geometry-info-box))
(when (or (and (eql *move-mode* :opaque) move-status)
(and (eql *resize-mode* :opaque) resize-status))
(setf move-status nil
resize-status nil
current-active-decoration nil)
(setf (values move-status resize-status current-active-decoration) nil)
(xlib:ungrab-pointer *display*))))
(defun close-sm-connection (root &key (exit-p t))
......@@ -191,7 +189,15 @@
(wants-iconic-p :initform nil :accessor application-wants-iconic-p)
(wants-focus-p :initform nil :accessor application-wants-focus-p)
(initial-geometry :initform (make-geometry))
(full-geometry :initform (make-geometry))))
(full-geometry :initform (make-geometry))
(type :initarg :type :accessor application-type)))
(defmethod remove-widget :after ((app application))
(with-slots (window type) app
(let ((root (lookup-widget (xlib:drawable-root window))))
(case type
(:_net_wm_window_type_desktop (remove-desktop-application root app))
(:_net_wm_window_type_dock (update-workarea-property root))))))
(defmethod close-widget ((application application))
(with-slots (window) application
......@@ -213,8 +219,7 @@
finally (return (xlib:window-equal window foc))))
(defmethod shaded-p ((widget application))
(with-slots (window) widget
(member :_net_wm_state_shaded (netwm:net-wm-state window))))
(member :_net_wm_state_shaded (netwm:net-wm-state (widget-window widget))))
(defmethod shade ((application application))
(with-slots (master) application
......@@ -261,19 +266,15 @@
(setf w (xlib:mode-info-hdisplay ml)
h (xlib:mode-info-vdisplay ml)))
(setf x 0 y 0 w (screen-width) h (screen-height)))
(xlib:with-state (window)
(with-slots (window) (or master application)
(setf (window-position window) (values x y)))
(setf (drawable-sizes window) (values w h))))
(configure-window window :x x :y y :width w :height h))
(focus-widget application 0))
(with-event-mask (*root-window*)
(setf (drawable-sizes window) (geometry-sizes fgeometry))
(unless (window-not-decorable-p window)
(setf (decoration-frame-style master)
(slot-value master 'old-frame-style)))
(with-slots ((win window)) (or master application)
(setf (window-position win) (geometry-coordinates fgeometry)))))
(send-configuration-notify window)
(multiple-value-bind (x y) (geometry-coordinates fgeometry)
(configure-window window :x x :y y))))
(let ((prop (netwm:net-wm-state window)))
(if (eq ,mode :on)
(pushnew :_net_wm_state_fullscreen prop)
......@@ -308,8 +309,8 @@
(type (ignore-errors (netwm:net-wm-window-type window)))
(desktop-p (member :_net_wm_window_type_desktop type))
(dock-p (member :_net_wm_window_type_dock type))
(app (make-instance
'application :window window :master master :input input)))
(app (make-instance 'application
:window window :master master :input input :type type)))
(create-icon app master)
(if (or desktop-p dock-p)
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.30 2004/01/13 13:50:38 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.31 2004/01/15 15:35:34 ihatchondo Exp $
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -710,7 +710,9 @@
(unless (member :_net_wm_window_type_desktop netwm-type)
(with-slots (wants-focus-p input-model) application
(unless (eq input-model :no-input)
(setf wants-focus-p *focus-new-mapped-window*))))))
(setf wants-focus-p *focus-new-mapped-window*))))
(when (member :_net_wm_window_type_dock netwm-type)
(update-workarea-property *root*))))
;;;; The main loop.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment