Commit eaabc4cf authored by hatchond's avatar hatchond
Browse files

ICCCM complience and extended window manager specification complience.

 - bugs fix relative to ewt 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

we still need gnome session managment conection.
parent afc32f42
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.3 2002/11/12 17:13:01 hatchond Exp $ ;;; $Id: eclipse.lisp,v 1.4 2003/04/07 13:35:32 hatchond Exp $
;;; ;;;
;;; ECLIPSE. The Common Lisp Window Manager. ;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO ;;; Copyright (C) 2002 Iban HATCHONDO
...@@ -27,6 +27,65 @@ ...@@ -27,6 +27,65 @@
;;; Initializations and Main. ;;; Initializations and Main.
;; ICCCM section 2.8
(defun initialize-manager (display root-window)
(setf +xa-wm+ (format nil "WM_S~A" (xlib:display-display display)))
(xlib:intern-atom display +xa-wm+)
(let ((managing-since)
(old-wm (xlib:selection-owner display +xa-wm+))
(manager (xlib:create-window :parent root-window
:override-redirect :on
:width 1 :height 1
:x -5 :y -5)))
(when old-wm
(setf (xlib:window-event-mask old-wm) '(:structure-notify)))
;; Get a valid timestamp.
(with-event-mask (manager '(:property-change))
(xlib:change-property manager :wm_name '(0) :string 8)
(xlib:event-case (display :force-output-p t :discard-p t)
(:property-notify (window time)
(when (xlib:window-equal window manager) (setf managing-since time)))
(t nil)))
;; Ask for selection ownership, and wait for the old owner destruction.
(setf (xlib:selection-owner display +xa-wm+ managing-since) manager)
(when old-wm
(xlib:event-case (display :force-output-p t :discard-p t :timeout 10)
(:destroy-notify (window) (xlib:window-equal window old-wm))
(t nil)))
;; Are we the selection owner after all ?
(unless (xlib:window-equal manager (xlib:selection-owner display +xa-wm+))
(format *error-output*
"ICCCM Error : failed to aquire selection ownership~%")
(%quit%))
;; Check if a non ICCCM complient window manager is not running.
(flet ((handle-redirect-error (condition)
(declare (ignorable condition))
(format *error-output* "Redirect error - another WM is running~%")
(xlib:close-display display)
(%quit%)))
(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)))
;; Notify all the other X clients of the new manager.
(xlib:send-event root-window
:client-message
'(:structure-notify)
:window root-window
:type :MANAGER
:format 32
:data (list managing-since
(xlib:find-atom display +xa-wm+)
(xlib:window-id manager)))
manager))
(defun initialize-root (display root-window) (defun initialize-root (display root-window)
(flet ((handle-redirect-error (condition) (flet ((handle-redirect-error (condition)
(declare (ignorable condition)) (declare (ignorable condition))
...@@ -43,15 +102,16 @@ ...@@ -43,15 +102,16 @@
(defun initialize (display-specification) (defun initialize (display-specification)
(multiple-value-bind (display screen) (multiple-value-bind (display screen)
(open-clx-display display-specification) (open-clx-display display-specification)
(let ((colormap (xlib:screen-default-colormap screen)) (let* ((colormap (xlib:screen-default-colormap screen))
(root-window (xlib:screen-root screen)) (root-window (xlib:screen-root screen))
(menu-font (xlib:open-font display "fixed"))) (manager (initialize-manager display root-window))
(menu-font (xlib:open-font display "fixed")))
(initialize-root display root-window) (initialize-root display root-window)
(setf *display* display) (setf *display* display)
;; Specific for X display ;; Specific for X display
(setf (xlib:display-error-handler display) #'default-handler (setf (xlib:display-error-handler display) #'default-handler
(xlib:display-after-function display) #'xlib:display-force-output) (xlib:display-after-function display) #'xlib:display-force-output)
(setf *root* (make-instance 'root :window root-window) (setf *root* (make-instance 'root :window root-window :manager manager)
*root-window* root-window *root-window* root-window
(root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr)) (root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr))
;; init all gnome properties on root. ;; init all gnome properties on root.
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: global.lisp,v 1.6 2003/04/07 13:35:32 hatchond Exp $ ;;; $Id: global.lisp,v 1.7 2003/05/13 14:54:01 hatchond Exp $
;;; ;;;
;;; This file is part of Eclipse. ;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO ;;; Copyright (C) 2001, 2002 Iban HATCHONDO
...@@ -58,6 +58,7 @@ ...@@ -58,6 +58,7 @@
(defvar *root-window* nil) (defvar *root-window* nil)
(defvar *gcontext* nil) (defvar *gcontext* nil)
(defvar *widget-table* (make-hash-table)) (defvar *widget-table* (make-hash-table))
(defvar +xa-wm+ nil)
;; Default value of all the "customisable" environment variables ;; Default value of all the "customisable" environment variables
(defparameter *close-display-p* t) (defparameter *close-display-p* t)
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.5 2003/04/07 13:35:32 hatchond Exp $ ;;; $Id: input.lisp,v 1.6 2003/05/13 14:54:01 hatchond Exp $
;;; ;;;
;;; ECLIPSE. The Common Lisp Window Manager. ;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...@@ -47,6 +47,21 @@ ...@@ -47,6 +47,21 @@
(register-all-mouse-strokes))) (register-all-mouse-strokes)))
(:pointer nil)))) (:pointer nil))))
;; handle the selection clear, to be able to stop window managing when needed.
(defmethod event-process ((event selection-clear) null-widget)
(declare (ignorable null-widget))
(with-slots (event-window selection) event
(when (and (xlib:window-equal event-window (root-manager *root*))
(string= selection +xa-wm+))
(loop for val being each hash-value in *widget-table*
when (application-p val) do (undecore-application val))
(xlib:display-finish-output *display*)
(setf (xlib:window-event-mask *root-window*) '())
(xlib:destroy-window (root-manager *root*))
(xlib:display-finish-output *display*)
(xlib:close-display *display*)
(%quit%))))
(defmethod event-process ((event configure-request) (widget base-widget)) (defmethod event-process ((event configure-request) (widget base-widget))
(declare (ignorable widget)) ;; should only be root ? (declare (ignorable widget)) ;; should only be root ?
(with-slots (window x y width height stack-mode value-mask above-sibling) (with-slots (window x y width height stack-mode value-mask above-sibling)
...@@ -299,7 +314,7 @@ ...@@ -299,7 +314,7 @@
(:WM_STATE (:WM_STATE
(update-lists app (car (wm-state window)) *root*))))) (update-lists app (car (wm-state window)) *root*)))))
(defun fullscreenable (application) (defun fullscreenable-p (application)
(with-slots (window) application (with-slots (window) application
(let ((hint (ignore-errors (xlib:wm-normal-hints window)))) (let ((hint (ignore-errors (xlib:wm-normal-hints window))))
(symbol-macrolet ((max-w (xlib:wm-size-hints-max-width hint)) (symbol-macrolet ((max-w (xlib:wm-size-hints-max-width hint))
...@@ -349,7 +364,7 @@ ...@@ -349,7 +364,7 @@
(if (= action 0) (uniconify application) (iconify application))) (if (= action 0) (uniconify application) (iconify application)))
(when (or (eql prop1 :_net_wm_state_fullscreen) (when (or (eql prop1 :_net_wm_state_fullscreen)
(eql prop2 :_net_wm_state_fullscreen)) (eql prop2 :_net_wm_state_fullscreen))
(when (fullscreenable application) (when (fullscreenable-p application)
(setf (full-screen-mode application) (if (= action 0) :off :on)))) (setf (full-screen-mode application) (if (= action 0) :off :on))))
(when master (when master
(when (or (eql prop1 :_net_wm_state_maximized_vert) (when (or (eql prop1 :_net_wm_state_maximized_vert)
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: misc.lisp,v 1.4 2003/04/07 13:35:32 hatchond Exp $ ;;; $Id: misc.lisp,v 1.5 2003/05/13 14:54:01 hatchond Exp $
;;; ;;;
;;; This file is part of Eclipse. ;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO ;;; Copyright (C) 2002 Iban HATCHONDO
...@@ -67,6 +67,10 @@ ...@@ -67,6 +67,10 @@
(defun make-view-port-property () (defun make-view-port-property ()
(make-list (* 2 *nb-vscreen*) :initial-element 0)) (make-list (* 2 *nb-vscreen*) :initial-element 0))
(defun window-transient-p (app-window)
(or (xlib:transient-for app-window)
(member :_net_wm_window_type_dialog (netwm:net-wm-state app-window))))
(defun wm-state (window) (defun wm-state (window)
(xlib:get-property window :WM_STATE)) (xlib:get-property window :WM_STATE))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: $ ;;; $Id: themer.lisp,v 1.1 2002/11/07 14:54:27 hatchond Exp $
;;; ;;;
;;; This file is part of Eclipse. ;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO ;;; Copyright (C) 2002 Iban HATCHONDO
...@@ -198,7 +198,7 @@ ...@@ -198,7 +198,7 @@
(defun find-decoration-frame-style (theme window) (defun find-decoration-frame-style (theme window)
(with-slots (default-style transient-style) theme (with-slots (default-style transient-style) theme
(if (ignore-errors (xlib:transient-for window)) (if (ignore-errors (window-transient-p window))
(or transient-style default-style) (or transient-style default-style)
default-style))) default-style)))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.5 2003/03/21 09:54:47 hatchond Exp $ ;;; $Id: widgets.lisp,v 1.6 2003/05/13 14:54:01 hatchond Exp $
;;; ;;;
;;; ECLIPSE. The Common Lisp Window Manager. ;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...@@ -165,6 +165,7 @@ ...@@ -165,6 +165,7 @@
(defgeneric focus-widget (widget timestamp)) (defgeneric focus-widget (widget timestamp))
(defgeneric draw-on-focus-in (widget)) (defgeneric draw-on-focus-in (widget))
(defgeneric draw-on-focus-out (widget)) (defgeneric draw-on-focus-out (widget))
(defgeneric root-manager (widget))
(macrolet ((define-null-method (name &rest args) (macrolet ((define-null-method (name &rest args)
(let ((%name% (with-standard-io-syntax (format nil "~A" name)))) (let ((%name% (with-standard-io-syntax (format nil "~A" name))))
...@@ -175,11 +176,15 @@ ...@@ -175,11 +176,15 @@
(define-null-method close-widget widget) (define-null-method close-widget widget)
(define-null-method focus-widget widget timestamp) (define-null-method focus-widget widget timestamp)
(define-null-method draw-on-focus-in widget) (define-null-method draw-on-focus-in widget)
(define-null-method draw-on-focus-out widget)) (define-null-method draw-on-focus-out widget)
(define-null-method root-manager widget))
(defmethod remove-widget ((widget base-widget)) (defmethod remove-widget ((widget base-widget))
(remhash (widget-window widget) *widget-table*)) (remhash (widget-window widget) *widget-table*))
(defmethod root-manager ((widget base-widget))
(root-manager (lookup-widget (xlib:drawable-root (widget-window widget)))))
(defun base-widget-p (widget) (defun base-widget-p (widget)
(typep widget 'base-widget)) (typep widget 'base-widget))
...@@ -197,6 +202,7 @@ ...@@ -197,6 +202,7 @@
(default-cursor :initform nil :accessor root-default-cursor) (default-cursor :initform nil :accessor root-default-cursor)
(current-active-decoration :initform nil) (current-active-decoration :initform nil)
(decoration-theme :initform nil :accessor root-decoration-theme) (decoration-theme :initform nil :accessor root-decoration-theme)
(properties-manager-window :initform nil :initarg :manager)
(menu1 :initform nil) (menu1 :initform nil)
(menu2 :initform nil) (menu2 :initform nil)
(menu3 :initform nil) (menu3 :initform nil)
...@@ -205,6 +211,9 @@ ...@@ -205,6 +211,9 @@
(desktop :initform nil :accessor root-desktop) (desktop :initform nil :accessor root-desktop)
(vscreens :initform (create-eclipse-virtual-screens) :reader root-vscreens))) (vscreens :initform (create-eclipse-virtual-screens) :reader root-vscreens)))
(defmethod root-manager ((root root))
(slot-value root 'properties-manager-window))
(defmethod get-root-desktop ((root root) &optional window-p) (defmethod get-root-desktop ((root root) &optional window-p)
(with-slots (desktop) root (with-slots (desktop) root
(when (first desktop) (when (first desktop)
...@@ -293,11 +302,25 @@ ...@@ -293,11 +302,25 @@
(defun create-application (window master) (defun create-application (window master)
(let* ((input (find-input-model window)) (let* ((input (find-input-model window))
(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 (app (make-instance
'application :window window :master master :input input))) 'application :window window :master master :input input)))
(ignore-errors (ignore-errors
(create-icon app (or master *root*)) (create-icon app (or master *root*))
(grab-button window :any '(:button-press) :sync-pointer-p t) (if (or desktop-p dock-p)
(let* ((prec-desk (get-root-desktop *root* t))
(stack-mode (if prec-desk :above :below))
(netwm-state (ignore-errors (netwm:net-wm-state window))))
(push :_net_wm_state_skip_pager netwm-state)
(push :_net_wm_state_skip_taskbar netwm-state)
(when desktop-p
(add-desktop-application *root* app)
(setf (xlib:window-priority window prec-desk) stack-mode))
(setf (netwm:net-wm-state window) netwm-state
(window-desktop-num window) +any-desktop+))
(grab-button window :any '(:button-press) :sync-pointer-p t))
(setf (xlib:window-event-mask window) (setf (xlib:window-event-mask window)
(if (eq input :no-input) +unfocusable-mask+ +focusable-mask+))) (if (eq input :no-input) +unfocusable-mask+ +focusable-mask+)))
app)) app))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.10 2003/03/21 09:54:48 hatchond Exp $ ;;; $Id: wm.lisp,v 1.11 2003/05/13 14:54:01 hatchond Exp $
;;; ;;;
;;; ECLIPSE. The Common Lisp Window Manager. ;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
...@@ -600,12 +600,16 @@ ...@@ -600,12 +600,16 @@
(unwind-protect (unwind-protect
(let ((application (create-application win nil)) (let ((application (create-application win nil))
(win-workspace (or (gnome-desktop-num win) +any-desktop+)) (win-workspace (or (gnome-desktop-num win) +any-desktop+))
(stick-p (stick-p win))) (stick-p (stick-p win))
(netwm-type (netwm:net-wm-window-type win)))
(xlib:add-to-save-set win) (xlib:add-to-save-set win)
(unless (or stick-p (< -1 win-workspace *nb-vscreen*)) (unless (or stick-p (< -1 win-workspace *nb-vscreen*))
(setf win-workspace (vs:current-screen vscreens))) (setf win-workspace (vs:current-screen vscreens)))
(setf (window-desktop-num win) win-workspace) (setf (window-desktop-num win) win-workspace)
(cond ((eql (motif-wm-decoration win) :OFF) (cond ((or (eql (motif-wm-decoration win) :OFF)
(member :_net_wm_window_type_splash netwm-type)
(member :_net_wm_window_type_desktop netwm-type)
(member :_net_wm_window_type_dock netwm-type))
(setf (wm-state win) 1) (setf (wm-state win) 1)
(if (or (= win-workspace (vs:current-screen vscreens)) stick-p) (if (or (= win-workspace (vs:current-screen vscreens)) stick-p)
(xlib:map-window win) (xlib:map-window win)
...@@ -616,15 +620,10 @@ ...@@ -616,15 +620,10 @@
(t (with-event-mask (*root-window*) (t (with-event-mask (*root-window*)
(decore-application win application :map nil) (decore-application win application :map nil)
(update-lists application 1 *root*)))) (update-lists application 1 *root*))))
(if (member :_net_wm_window_type_desktop (netwm:net-wm-window-type win)) (unless (member :_net_wm_window_type_desktop netwm-type)
(let* ((prec-desk (get-root-desktop *root* t)) (with-slots (wants-focus-p input-model) application
(stack-mode (if prec-desk :above :below))) (unless (eq input-model :no-input)
(add-desktop-application *root* application) (setf wants-focus-p *focus-new-mapped-window*)))))))
(xlib:ungrab-button win :any :modifiers #x8000)
(setf (xlib:window-priority win prec-desk) stack-mode))
(with-slots (wants-focus-p input-model) application
(unless (eq input-model :no-input)
(setf wants-focus-p *focus-new-mapped-window*)))))))
;;;; The main loop. ;;;; The main loop.
......
Supports Markdown
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