Commit 276e0cd8 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

Fix: hacking around *root-window* ...

parent 3d01339b
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.25 2006/01/14 15:40:55 ihatchondo Exp $
;;; $Id: eclipse.lisp,v 1.26 2007/05/08 22:33:17 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -129,7 +129,7 @@
(let ((first-desknum (current-vscreen window))
(nb-vs (number-of-virtual-screens window))
(srcw (screen-width)) (srch (screen-height)))
(xlib:with-server-grabbed (*display*)
(xlib:with-server-grabbed (display)
(delete-properties window +netwm-protocol+)
(unless (< -1 first-desknum nb-vs) (setf first-desknum 0))
(setf (gnome:win-protocols window) +gnome-protocols+
......@@ -166,7 +166,7 @@
(xlib:display-after-function display) #'xlib:display-force-output)
(setf *root* (make-instance 'root :window root-window :manager manager)
*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)
(root-sm-conn *root*) (connect-to-session-manager
display-specification sm-client-id))
;; init all gnome properties on root.
......@@ -177,7 +177,7 @@
*white* (xlib:screen-white-pixel screen)
*background1* (xlib:alloc-color colormap *menu-color*)
*background2* (xlib:alloc-color colormap *menu-hilighted-color*)
*cursor-2* (get-x-cursor *display* :xc_fleur)
*cursor-2* (get-x-cursor display :xc_fleur)
*gctxt* (xlib:create-gcontext :drawable root-window :font menu-font)
*max-char-width* (xlib:max-char-width menu-font)
*gcontext* (xlib:create-gcontext
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: global.lisp,v 1.29 2005/03/01 22:41:31 ihatchondo Exp $
;;; $Id: global.lisp,v 1.30 2008/04/23 09:54:46 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
......@@ -119,17 +119,20 @@
(defsetf decoration-theme (&key free-old-theme-p) (name)
"Sets the theme that must be used for window decoration. This theme will
be used for all existing applications as well as futur one."
`(with-slots (decoration-theme) *root*
(let ((theme (load-theme *root-window* ,name)))
(when decoration-theme
(loop with old-name = (theme-name decoration-theme)
for val being each hash-value in *widget-table*
when (and (application-p val) (application-master val)) do
(with-slots (window master) val
`(set-decoration-theme ,name ,free-old-theme-p))
(defun set-decoration-theme (name free-old-theme-p)
(with-slots (decoration-theme window) *root*
(let ((theme (load-theme window name)))
(when decoration-theme
(loop with old-name = (theme-name decoration-theme)
for val being each hash-value in *widget-table*
when (and (application-p val) (application-master val)) do
(with-slots (window master) val
(setf (decoration-frame-style master)
(find-decoration-frame-style theme window)))
finally (and ,free-old-theme-p (free-theme old-name))))
(setf decoration-theme theme))))
finally (and free-old-theme-p (free-theme old-name))))
(setf decoration-theme theme))))
(defsetf maximize-modifier () (modifier-key)
"Sets the modifier to use to activate window maximization second behavior."
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.47 2007/05/07 13:22:50 ihatchondo Exp $
;;; $Id: input.lisp,v 1.48 2008/04/23 09:54:46 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -90,7 +90,8 @@
(when (or (decoration-p widget) (application-p (lookup-widget window)))
(if (eq *focus-type* :on-click)
(give-focus-to-next-widget-in-desktop)
(multiple-value-bind (x y s child) (xlib:query-pointer *root-window*)
(multiple-value-bind (x y s child)
(xlib:query-pointer (xlib:drawable-root window))
(declare (ignore x y s))
(let ((e (make-event :enter-notify :kind :nonlinear :mode :normal)))
(event-process e (or (lookup-widget child) *root*))))))))
......@@ -316,7 +317,7 @@
(with-slots (master window) application
(unless (eql (event-mode event) :grab)
(when master (dispatch-repaint master :focus t))
(setf (netwm:net-active-window *root-window*) window)
(setf (netwm:net-active-window (xlib:drawable-root window)) window)
(xlib:delete-property
(widget-window (root-property-holder *root*))
:_net_active_window))))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: misc.lisp,v 1.40 2007/11/02 09:33:08 ihatchondo Exp $
;;; $Id: misc.lisp,v 1.41 2008/04/23 09:54:46 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -91,14 +91,16 @@
(defsetf wm-state (window &key (icon-id 0)) (state)
"Sets the wm_state property of a window. Note that its _net_wm_state property
will be updated accordingly to the value given for the wm_state."
(let ((net-wm-state (gensym)))
`(let ((,net-wm-state (netwm:net-wm-state ,window)))
(if (or (= ,state 3) (= ,state 0))
(pushnew :_net_wm_state_hidden ,net-wm-state)
(setf ,net-wm-state (delete :_net_wm_state_hidden ,net-wm-state)))
(setf (netwm:net-wm-state ,window) ,net-wm-state)
(xlib:change-property ,window :WM_STATE
(list ,state ,icon-id)
(with-gensym (_window _state _net-wm-state)
`(let* ((,_window ,window)
(,_state ,state)
(,_net-wm-state (netwm:net-wm-state ,_window)))
(if (or (= ,_state 3) (= ,_state 0))
(pushnew :_net_wm_state_hidden ,_net-wm-state)
(setf ,_net-wm-state (delete :_net_wm_state_hidden ,_net-wm-state)))
(setf (netwm:net-wm-state ,_window) ,_net-wm-state)
(xlib:change-property ,_window :WM_STATE
(list ,_state ,icon-id)
:WM_STATE
32))))
......@@ -107,12 +109,12 @@
between _net_wm_desktop_names and _win_workspace_names respectively."
(or (netwm:net-desktop-names window) (gnome:win-workspace-names window)))
(defsetf workspace-names () (names)
(defsetf workspace-names (window) (names)
"Sets both the _win_workspace_names and the _net_wm_desktop_names properties
to the given list of name."
`(when ,names
(setf (netwm:net-desktop-names *root-window*) ,names
(gnome:win-workspace-names *root-window*) ,names)))
(setf (netwm:net-desktop-names ,window) ,names
(gnome:win-workspace-names ,window) ,names)))
(defun wm-name (window)
"Returns the name of the window according to the first property that is set
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: move-resize.lisp,v 1.17 2004/08/20 21:51:08 ihatchondo Exp $
;;; $Id: move-resize.lisp,v 1.18 2005/01/17 09:30:40 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -31,9 +31,9 @@
(when *geometry-info-box*
(xlib:unmap-window (widget-window *geometry-info-box*))))
(defun initialize-geometry-info-box ()
(defun initialize-geometry-info-box (parent-window)
(unless *geometry-info-box*
(setf *geometry-info-box* (create-message-box nil :parent *root-window*)))
(setf *geometry-info-box* (create-message-box nil :parent parent-window)))
(with-slots (window) *geometry-info-box*
(xlib:map-window window)
(setf (xlib:window-priority window) :above)))
......@@ -59,9 +59,9 @@
(defparameter *clone* nil)
(defun initialize-clone ()
(defun initialize-clone (parent-window)
(let ((win (xlib:create-window
:parent *root-window* :x 0 :y 0 :width 100 :height 100)))
:parent parent-window :x 0 :y 0 :width 100 :height 100)))
(setf *clone* (make-decoration win (create-application win nil)))))
(defun update-*clone* (x y w h decoration-frame-style &optional wm-hints)
......@@ -96,13 +96,13 @@
(with-slots (resize-status move-status current-active-widget window) root
(with-slots ((widget-window window) gcontext active-p) widget
(when (and active-p (not (or resize-status move-status)))
(or *clone* (initialize-clone))
(or *clone* (initialize-clone window))
(update-clone widget)
(grab-root-pointer)
(setf (slot-value root status) t
current-active-widget widget)
(when verbose-p
(initialize-geometry-info-box)
(initialize-geometry-info-box window)
(multiple-value-bind (x y w h) (window-geometry widget-window)
(if (and (eq status 'resize-status) (decoration-p widget))
(multiple-value-bind (a b c d iw ih bw bh)
......@@ -255,7 +255,8 @@
;; called when button-release on root and root-resize-status is not nil.
(with-slots (window gcontext) master
(when (and (decoration-active-p master) (eql mode :box))
(draw-window-grid (widget-window *clone*) gcontext *root-window*)
(draw-window-grid
(widget-window *clone*) gcontext (xlib:drawable-root window))
(multiple-value-bind (x y w h)
(window-geometry (widget-window *clone*))
(setf (window-position window) (values x y)
......@@ -296,9 +297,10 @@
(update-edges-geometry master)
(resize-from master))
(with-slots (window gcontext) *clone*
(draw-window-grid window gcontext *root-window*)
(resize-internal *clone* event verbose-p)
(draw-window-grid window gcontext *root-window*))))
(let ((root-window (xlib:drawable-root window)))
(draw-window-grid window gcontext root-window)
(resize-internal *clone* event verbose-p)
(draw-window-grid window gcontext root-window)))))
;;;; Move.
......@@ -403,10 +405,11 @@
(when verbose-p (display-coordinates new-x new-y))
(if (and (or (decoration-p widget) (application-p widget))
(eql mode :box))
(with-slots (window) *clone*
(draw-window-grid window gcontext *root-window*)
(setf (window-position window) (values new-x new-y))
(draw-window-grid window gcontext *root-window*))
(with-slots (window) *clone*
(let ((root-window (xlib:drawable-root window)))
(draw-window-grid window gcontext root-window)
(setf (window-position window) (values new-x new-y))
(draw-window-grid window gcontext root-window)))
(setf (window-position window) (values new-x new-y)))))))
(defun finish-move (widget &optional verbose-p mode)
......@@ -414,7 +417,7 @@
(with-slots ((widget-window window) active-p) widget
(when (eql mode :box)
(with-slots (window gcontext) *clone*
(draw-window-grid window gcontext *root-window*)
(draw-window-grid window gcontext (xlib:drawable-root window))
(setf (window-position widget-window) (window-position window))))
(setf active-p nil)
(when verbose-p (undraw-geometry-info-box)))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.53 2008/04/24 08:24:45 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.54 2008/04/25 08:42:44 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -400,7 +400,7 @@
(setf (netwm:net-wm-state window) prop))
(if (eq mode :on)
;; put in fullscreen mode.
(with-event-mask (*root-window*)
(with-event-mask ((xlib:drawable-root window))
(multiple-value-bind (x y w h) (window-geometry window)
(when master
(with-slots (children (master-win window) frame-style) master
......@@ -414,7 +414,7 @@
(configure-window window :x x :y y :width w :height h))
(focus-widget application 0))
;; revert: restore precedent geometry and decoration style.
(with-event-mask (*root-window*)
(with-event-mask ((xlib:drawable-root window))
(setf (drawable-sizes window) (geometry-sizes fgeometry))
(unless (window-not-decorable-p window)
(setf (decoration-frame-style master)
......@@ -440,7 +440,7 @@
(with-slots (master window) application
(when (shaded-p application) (shade application))
(setf (window-desktop-num window) new-screen-number)
(with-event-mask (*root-window*)
(with-event-mask ((xlib:drawable-root window))
(let ((master-window (when master (widget-window master))))
(funcall operation (or master-window window))
(when master-window
......@@ -457,10 +457,11 @@
"Removes all decoration of this application widget and reparent it to root."
(with-slots (window master icon) application
(if master
(multiple-value-bind (x y)
(xlib:translate-coordinates window 0 0 *root-window*)
(xlib:reparent-window window *root-window* x y)
(event-process (make-event :destroy-notify) master))
(let ((root-window (xlib:drawable-root window)))
(multiple-value-bind (x y)
(xlib:translate-coordinates window 0 0 root-window)
(xlib:reparent-window window root-window x y)
(event-process (make-event :destroy-notify) master)))
(event-process (make-event :destroy-notify :window window) *root*))
(when state
(setf (wm-state window) state)
......@@ -823,7 +824,7 @@
(setf bkgrd pix))))
(setf icon (create-button 'icon
:event-mask '(:pointer-motion-hint . #.+std-button-mask+)
:parent *root-window* :master master
:parent (xlib:drawable-root window) :master master
:x 0 :y 0 :width width :height height
:item (unless bkgrd (wm-icon-name window))
:background (or bkgrd bg-color)))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.53 2008/04/23 09:54:46 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.54 2008/04/25 08:42:45 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -362,16 +362,16 @@
(setf (drawable-sizes window)
(values (max 1 (- width hm)) (max 1 (- height vm))))))))
(defun initial-coordinates (app-window frame-style)
(defun initial-coordinates (window frame-style)
"Returns as multiple values the decoration initial coordinates."
(let ((hint (ignore-errors (xlib:wm-normal-hints app-window))))
(let ((hint (ignore-errors (xlib:wm-normal-hints window))))
(with-slots (top-margin left-margin vmargin hmargin) frame-style
(flet ((default-coordinates ()
(let* ((n (or (window-desktop-num app-window) 0))
(let* ((n (or (window-desktop-num window) 0))
(k (if (= +any-desktop+ n) 0 (* 4 n)))
(areas (netwm:net-workarea *root-window*))
(areas (netwm:net-workarea (xlib:drawable-root window)))
(ax (aref areas k)) (ay (aref areas (1+ k))))
(multiple-value-bind (x y) (window-position app-window)
(multiple-value-bind (x y) (window-position window)
(values (max ax (- x left-margin))
(max ay (- y top-margin)))))))
(if (and hint (xlib:wm-size-hints-user-specified-position-p hint))
......
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