Commit c3de58d7 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

- move resize improvements:

  We now use the :pointer-potion-hint in the event-mask. The server is
  now free to send only one :motion-notify event, until either the key
  or button state changes, the pointer leaves the event window, or the
  client calls query-pointer or motion-events.

  This allow us to be served only for event when we can deal with. As
  effect opaque move and resize are smoother.

  side effects:
   decoration time slot removed.  (wm.lisp)
   modify (event-process motion-notify root)

  modified files: input.lisp, wm.lisp

- Christian point out a bug/inconsitency with emacs and multiple
  frame. Changing frames with C-x 5-o was not raising frames. It is
  now fix.

  the fix consist in:
   # add :susbstructure-redirect in the decoration event mask. (wm.lisp)
   # add a (event-process configure-request decoration).
   # add a (event-process map-request decoration).
   # modify (event-process configure-NOTIFY decoration). (input.lisp)
   # modify (setf fullscreen-mode). (widget.lisp)

  modified files: widgets.lisp, wm.lisp, input.lisp

- bug fix and code clean up.

  # error handling in initialize-manager (eclipse.lisp)
  # exit-eclipse condition (wm.lisp)
  # exit part in eclipse-internal-loop (wm.lisp)
  # close-som-connection (widget.lisp)
  # (event-process selection-notify null) (input.lisp)
  # bug fix and typo in gestures.lisp
parent e9a19bd3
.TH Eclipse 1 "(c) 2001 Iban HATCHONDO"
.\"$Id: eclipse.1,v 1.11 2004/01/07 11:21:42 ihatchondo Exp $
.\"$Id: eclipse.1,v 1.12 2004/01/12 11:22:06 ihatchondo Exp $
.SH NAME
eclipse - a window manager in Common Lisp
......@@ -613,9 +613,6 @@ we'll only present an example of predefined mouse stroke.
.SH BUGS
The exit part is in progress so it does not work as expected.
Finally I have to write something to be fully gnome compliant: the
session-manager connection.
.SH SEE ALSO
\fBX\fP(1), \fBXserver\fP(1), \fBxdm\fP(1), \fBCMUCL\fP(1) or other
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.15 2004/01/12 11:22:05 ihatchondo Exp $
;;; $Id: eclipse.lisp,v 1.16 2004/01/12 12:56:11 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -28,27 +28,19 @@
;;; Initializations and Main.
;; ICE & SM.
(defun get-username ()
"Returns the real user name (a string) associated with the current process."
#+sbcl (sb-unix:uid-username (sb-unix:unix-getuid))
#+cmu (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid)))
#+allegro-v6.2 (excl.osi:pwent-name (excl.osi:getpwent (excl.osi:getuid)))
#-(or sbcl cmu allegro-v6.2) "nobody")
(defun sm-init (sm-conn dpy)
"Sets the xsmp properties that are required by the protocols."
(declare (type (or null string) dpy))
(flet ((encode (&rest rest)
(loop for s in rest collect (map 'sm-lib:array8 #'char-code s))))
(let ((sm-client-id (sm-lib:sm-client-id sm-conn)))
(let ((id (format nil "--sm-client-id=~a" (sm-lib:sm-client-id sm-conn)))
(display (format nil "--display=~a" dpy)))
(ice-lib:post-request :set-properties sm-conn
:properties
(list (sm-lib:make-property
:name "CloneCommand"
:type "LISTofARRAY8"
:values
(if dpy (encode "eclipse" "--display=" dpy) (encode "eclipse")))
:values (if dpy (encode "eclipse" display) (encode "eclipse")))
(sm-lib:make-property
:name "Program"
:type "ARRAY8"
......@@ -56,7 +48,7 @@
(sm-lib:make-property
:name "RestartCommand"
:type "LISTofARRAY8"
:values (encode "eclipse" "--sm-client-id=" sm-client-id))
:values (encode "eclipse" id))
(sm-lib:make-property
:name "UserID"
:type "ARRAY8"
......@@ -114,33 +106,23 @@
;; 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%))
(error "ICCCM Error: failed to aquire selection ownership~%"))
;; 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)))
(handler-case
(progn
(setf (xlib:window-event-mask root-window) +root-event-mask+)
(xlib:display-finish-output display))
(error () (error "Redirect error: another WM is running~%")))
;; 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)))
(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 init-gnome-compliance (display window manager)
......@@ -202,8 +184,7 @@
;; load personal configuration file, or the default one.
(or (load-config-file (home-subdirectory cl-user::*eclipse-initfile*))
(load-config-file (eclipse-path "eclipserc"))
(format *error-output* "Unable to read a configuration file.~%")
(%quit%))
(error "Unable to read a configuration file.~%"))
(setf (xlib:window-cursor root-window) (root-default-cursor *root*))
(setf (slot-value *root* 'gcontext) *gcontext*)
(unless (xlib:gcontext-font *gcontext*)
......@@ -213,7 +194,11 @@
(defun eclipse (&key display sm-client-id)
(declare (type (or null string) display sm-client-id))
(initialize display sm-client-id)
(handler-case (initialize display sm-client-id)
(error (condition)
(format t "~a~%" condition)
(when *display* (xlib:close-display *display*))
(%quit%)))
;(init-log-file)
;; Create a socket connection to communicate with the window manager.
......@@ -225,9 +210,8 @@
(unwind-protect
(catch 'end
(handler-bind ((end-of-file #'handle-end-of-file-condition))
(eclipse-internal-loop)
(ignore-errors (xlib:close-display *display*))))
(eclipse-internal-loop)))
(progn
(ignore-errors (xlib:close-display *display*))
(format t "Eclipse exited. Bye.~%")
(%QUIT%)
)))
(%quit%))))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.13 2003/11/28 11:02:39 ihatchondo Exp $
;;; $Id: gestures.lisp,v 1.14 2004/01/06 16:52:48 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -28,6 +28,13 @@
(defvar *keystrokes* (make-hash-table :test #'eq))
(defvar *mousestrokes* (make-hash-table :test #'eq))
(defun register-callback (action-keyword callback)
(setf (get action-keyword 'callback) callback))
(defun action-key->lambda (action-keyword)
"Returns the associated callback for the given action keyword."
(get action-keyword 'callback))
(defun lookup-keystroke (code state)
"Find the associated callback if any for this pair code modifier state."
(or (gethash (cons code state) *keystroke-map*)
......@@ -63,7 +70,7 @@
"Register, at the X server level, all declared mouse strokes."
(loop for mouse-stroke being each hash-value in *mousestrokes*
do (define-combo-internal mouse-stroke *root-window* :mouse-p t)))
;;;; stroke
(defclass stroke ()
......@@ -88,11 +95,9 @@
nil)
(defmethod stroke-equal :around ((s1 stroke) (s2 stroke))
(with-slots (name1 default-modifiers-p1 modifiers1) s1
(with-slots (name2 default-modifiers-p2 modifiers2) s2
(and (eq name1 name2)
(and default-modifiers-p1 default-modifiers-p2)
(equal modifiers1 modifiers2)
(with-slots ((name1 name) (dmp1 default-modifiers-p) (mods1 modifiers)) s1
(with-slots ((name2 name) (dmp2 default-modifiers-p) (mods2 modifiers)) s2
(and (eq name1 name2) (and dmp1 dmp2) (equal mods1 mods2)
(if (next-method-p) (call-next-method) t)))))
;;;; keystroke
......@@ -117,7 +122,7 @@
(defmethod stroke-equal ((s1 keystroke) (s2 keystroke))
(equal (slot-value s1 'keysyms) (slot-value s2 'keysyms)))
;;;; mouse stroke
(defclass mouse-stroke (stroke)
......@@ -148,9 +153,8 @@
(when (or (eq (car f1) :release) (eq (car f2) :press)) (rotatef f1 f2))
`(lambda (event)
(typecase event
(button-press ,@(cdr f1))
(key-press ,@(cdr f1))
(key-release ,@(cdr f2)))))
(button-press ,@(cdr f1)) (button-release ,@(cdr f2))
(key-press ,@(cdr f1)) (key-release ,@(cdr f2)))))
(defmacro unrealize ((window &key mouse-p) code mask)
`(progn
......@@ -225,35 +229,9 @@
(t
(mapcar #'(lambda (m) (kb:modifier->modifier-mask dpy m)) modifiers))))
(defun action-key->lambda (action-keyword)
"Returns the associated predefined callback for the given action keyword."
(case action-keyword
(: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
(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)))
(:move-window
#'(lambda (event)
(mouse-stroke-for-move-and-resize event :action :move)))
(:resize-window
#'(lambda (event)
(mouse-stroke-for-move-and-resize event :action :resize)))
))
(defun define-key-combo (name &key keys
(default-modifiers-p t)
(modifiers :any)
(modifiers '(:any))
fun)
" modifiers can be:
- composition of modifiers as '(:and :ALT-LEFT :CONTROL-RIGHT)
......@@ -271,7 +249,7 @@
(defun define-mouse-combo (name &key button
(default-modifiers-p t)
(modifiers :any)
(modifiers '(:any))
fun)
" modifiers can be:
- composition of modifiers as '(:and :ALT-LEFT :CONTROL-RIGHT)
......@@ -389,3 +367,27 @@
(xlib:map-window window)
(setf (xlib:window-priority window) :above)
(repaint *current-widget-info* nil nil)))))
;;;; register predefined callbacks.
(register-callback :move-right (action (:press (move-cursor-right)) ()))
(register-callback :move-left (action (:press (move-cursor-left)) ()))
(register-callback :move-up (action (:press (move-cursor-up)) ()))
(register-callback :move-down (action (:press (move-cursor-down)) ()))
(register-callback :left-click #'(lambda (event) (perform-click 1 event)))
(register-callback :middle-click #'(lambda (event) (perform-click 2 event)))
(register-callback :right-click #'(lambda (event) (perform-click 3 event)))
(register-callback :scroll-up #'(lambda (event) (perform-click 4 event)))
(register-callback :scroll-down #'(lambda (event) (perform-click 5 event)))
(register-callback :move-window
#'(lambda (event) (mouse-stroke-for-move-and-resize event :action :move)))
(register-callback :resize-window
#'(lambda (event) (mouse-stroke-for-move-and-resize event :action :resize)))
(register-callback :switch-win-up
#'(lambda (e) (circulate-window-up-and-down e :above)))
(register-callback :switch-win-down
#'(lambda (e) (circulate-window-up-and-down e :below)))
(register-callback :switch-screen-left
(action (:press (change-vscreen *root* :direction #'-)) ()))
(register-callback :switch-screen-right
(action (:press (change-vscreen *root* :direction #'+)) ()))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: global.lisp,v 1.15 2003/12/02 19:07:06 ihatchondo Exp $
;;; $Id: global.lisp,v 1.16 2004/01/07 11:21:41 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
......@@ -46,8 +46,14 @@
:_net_wm_state_sticky :_net_wm_state_fullscreen :_net_wm_state_hidden
:_net_wm_state_above :_net_wm_state_below))
(defconstant +root-event-mask+
'(:substructure-redirect :substructure-notify :button-press :button-release
:owner-grab-button :key-press :key-release :enter-window :leave-window
:focus-change))
(defconstant +pointer-event-mask+
'(:button-press :button-release :button-motion :enter-window :leave-window))
'(:button-press :button-release :button-motion :pointer-motion-hint
:enter-window :leave-window))
(defconstant +any-desktop+ #xFFFFFFFF)
......@@ -148,7 +154,7 @@
(defgeneric event-process (event widget))
;;;; System dependant functions.
;;;; System dependent functions.
(defun %quit% (&optional code)
#+allegro (excl:exit code)
......@@ -174,6 +180,13 @@
#+clisp (lisp:run-program program :arguments arguments)
)
(defun get-username ()
"Returns the real user name (a string) associated with the current process."
#+sbcl (sb-unix:uid-username (sb-unix:unix-getuid))
#+cmu (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid)))
#+allegro-v6.2 (excl.osi:pwent-name (excl.osi:getpwent (excl.osi:getuid)))
#-(or sbcl cmu allegro-v6.2) "nobody")
;;;; Error handler.
;; The X errors handler.
;; For debug purpose: it use *stderr* as output stream.
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.26 2004/01/07 11:21:41 ihatchondo Exp $
;;; $Id: input.lisp,v 1.27 2004/01/12 10:57:58 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -46,38 +46,13 @@
(register-all-mouse-strokes)))
(:pointer nil))))
;; handle the selection clear, to be able to stop window managing when needed.
(defmethod event-process ((event selection-clear) null-widget)
;; handle the selection clear to stop window managing (see ICCCM 2.8).
(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))
(declare (ignorable widget)) ;; should only be root ?
(with-slots (window x y width height stack-mode value-mask above-sibling)
event
(xlib:with-state (window)
(when (logbitp 0 value-mask) (setf (xlib:drawable-x window) x))
(when (logbitp 1 value-mask) (setf (xlib:drawable-y window) y))
(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 (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))
(when (application-p (lookup-widget window))
(send-configuration-notify window)))
))
(and (xlib:window-equal event-window (root-manager *root*))
(string= selection +xa-wm+)
(error 'exit-eclipse))))
(defmethod event-process :after ((event destroy-notify) (widget base-widget))
(with-slots (window) event
......@@ -93,6 +68,22 @@
;;; Events for the root window
(defmethod event-process ((ev configure-request) (root root))
(declare (ignorable root))
(with-slots (window x y width height stack-mode value-mask above-sibling) ev
(xlib:with-state (window)
(when (logbitp 0 value-mask) (setf (xlib:drawable-x window) x))
(when (logbitp 1 value-mask) (setf (xlib:drawable-y window) y))
(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 (window-priority window above-sibling) stack-mode)))
(when (< 0 (logand value-mask #x0F) 4)
;; Acording to the ICCCM: send a synthetic configure-notify,
;; when we moved a application window without resizing it.
(when (application-p (lookup-widget window))
(send-configuration-notify window)))))
(defmethod event-process ((event map-request) (root root))
(if (lookup-widget (event-window event))
(with-slots (icon) (lookup-widget (event-window event))
......@@ -157,14 +148,17 @@
(xlib:allow-events *display* :async-keyboard)
(funcall callback event)))))
(defmethod event-process :around ((event pointer-event) (root root))
(with-slots (code state) event
(let ((callback (lookup-mouse-stroke code state)))
(if callback
(unwind-protect (funcall callback event)
(xlib:allow-events *display* :async-pointer))
(and (next-method-p) (call-next-method))))))
(defmethod event-process ((event button-press) (root 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
(funcall callback event)
(xlib:allow-events *display* :async-pointer)
(return-from event-process nil)))
(with-slots (code x y) event
(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))
......@@ -176,21 +170,17 @@
(with-slots
(move-status resize-status (master current-active-decoration)) root
(when (or move-status resize-status)
(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* *move-mode*))
(resize-status
(resize master event *verbose-resize* *resize-mode*))))
(progn
(format t "The pointer has been frozen !!~%")
(setf (decoration-active-p master) t)
(event-process (make-event :button-release) root)))))))
(if (decoration-active-p master)
(when (event-hint-p event)
(cond (move-status
(move-widget master event *verbose-move* *move-mode*))
(resize-status
(resize master event *verbose-resize* *resize-mode*)))
(xlib:query-pointer (widget-window root)))
(progn
(format t "The pointer has been frozen !!~%")
(setf (decoration-active-p master) t)
(event-process (make-event :button-release) root))))))
(defmethod event-process ((event button-release) (root root))
(with-slots (move-status resize-status (master current-active-decoration)
......@@ -218,21 +208,38 @@
;;; Events for master (type: decoration)
(defmethod event-process ((event configure-request) (master decoration))
(with-slots (window (parent event-window) (mask value-mask)
x y width height above-sibling stack-mode) event
(when (application-p (lookup-widget window))
(xlib:with-state (parent)
;; update coordinates.
(with-slots (left-margin top-margin) (decoration-frame-style master)
(let ((static (eq (decoration-application-gravity master) :static)))
(when (logbitp 0 mask)
(setf (xlib:drawable-x parent) (if static (- x left-margin) x)))
(when (logbitp 1 mask)
(setf (xlib:drawable-y parent) (if static (- y top-margin) y)))))
;; update sizes.
(xlib:with-state (window)
(when (logbitp 2 mask) (setf (xlib:drawable-width window) width))
(when (logbitp 3 mask) (setf (xlib:drawable-height window) height)))
;; restack.
(when (logbitp 6 mask)
(let ((tmp (lookup-widget above-sibling)))
(when (and (application-p tmp) (application-master tmp))
(setf above-sibling (widget-window (application-master tmp)))))
(setf (window-priority parent above-sibling) stack-mode)))
;; Acording to the ICCCM: send a synthetic configure-notify,
;; when we moved a applicaiton window without resizing it.
(when (< 0 (logand mask #x0F) 4) (send-configuration-notify window)))))
(defmethod event-process ((event configure-notify) (master decoration))
(when (application-p (lookup-widget (event-window event)))
(with-slots ((master-win event-window) (app-window window) x y) event
(with-slots (left-margin top-margin) (decoration-frame-style master)
(if (eql (decoration-application-gravity master) :static)
(setf (window-position master-win) (values (- x left-margin)
(- y top-margin)))
(multiple-value-bind (ax ay) (window-position app-window)
(unless (= ax left-margin) (setf (xlib:drawable-x master-win) x))
(unless (= ay top-margin) (setf (xlib:drawable-y master-win) y))))
(resize-from (lookup-widget app-window))
(with-event-mask (master-win)
(update-edges-geometry master)
(setf (window-position app-window) (values left-margin top-margin))
(send-configuration-notify app-window))))))
(with-slots ((master-window event-window) (app-window window)) event
(when (application-p (lookup-widget app-window))
(resize-from (lookup-widget app-window))
(with-event-mask (master-window)
(update-edges-geometry master)))))
(defmethod event-process ((event reparent-notify) (master decoration))
(unless (xlib:window-equal (event-event-window event) (event-parent event))
......@@ -242,16 +249,19 @@
(with-slots (window) master
(xlib:unmap-window window)))
(defmethod event-process ((event map-request) (master decoration))
(xlib:map-window (event-window event)))
(defmethod event-process ((event map-notify) (master decoration))
(with-slots ((app-window window) (master-window event-window)) event
(when (application-p (lookup-widget app-window))
(unless (eq (xlib:window-map-state app-window) :unmapped)
(unmap-icon-window (get-child master :icon))
(xlib:map-window master-window)
(setf (window-priority master-window) :above
(wm-state app-window) 1)
(setf (window-desktop-num app-window)
(if (stick-p app-window) +any-desktop+ (current-desk)))))))
(if (stick-p app-window) +any-desktop+ (current-desk)))
(setf (window-priority master-window) :above
(wm-state app-window) 1)))))
(defmethod event-process ((event destroy-notify) (master decoration))
(with-event-mask (*root-window*)
......@@ -486,8 +496,11 @@
(initialize-move icon event))
(defmethod event-process ((event motion-notify) (icon icon))
(move-widget icon event)
(setf (icon-desiconify-p icon) nil))
(declare (optimize (speed 3)))
(when (event-hint-p event)
(move-widget icon event)
(xlib:query-pointer (event-event-window event))
(setf (icon-desiconify-p icon) nil)))
(defmethod event-process ((event button-release) (icon icon))
(if (icon-desiconify-p icon)
......
;;; -*- Mode: Lisp; Package: User -*-
;;; $Id: package.lisp,v 1.12 2003/11/28 10:13:47 ihatchondo Exp $
;;; $Id: package.lisp,v 1.13 2004/01/07 12:48:28 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -239,7 +239,6 @@
"DECORATION-APPLICATION-GRAVITY" ;generic function
"DECORATION-CHILDREN" ;generic function
"DECORATION-FRAME-STYLE" ;generic function
"DECORATION-PRECEDENT-TIME" ;generic function
"DECORATION-WM-HINTS" ;generic function
"DECORATION-WM-SIZE-HINTS" ;generic function
"DEFAULT-MODIFIERS-P" ;generic function
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.27 2004/01/13 13:50:37 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.28 2004/01/13 13:52:15 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -169,14 +169,11 @@
current-active-decoration nil)
(xlib:ungrab-pointer *display*))))
(defun close-sm-connection (root)
(defun close-sm-connection (root &key (exit-p t))
(with-slots (sm-conn) root
(ice-lib:post-request :connection-closed sm-conn)
(ice-lib:ice-flush sm-conn)
(close (ice-lib:connection-stream sm-conn))
(sm-lib:close-sm-connection sm-conn)
(setf sm-conn nil)
(setf *close-display-p* nil)
(error 'exit-eclipse)))
(when exit-p (error 'exit-eclipse))))
;;;; Application
......@@ -251,8 +248,7 @@
(multiple-value-bind (x y w h) (window-geometry window)
(when master
(with-slots (children (master-win window) frame-style) master
(multiple-value-setq (x y)
(xlib:translate-coordinates master-win x y *root-window*))
(multiple-value-setq (x y) (window-position master-win))
(setf (slot-value master 'old-frame-style) frame-style)
(setf (decoration-frame-style master)
(theme-default-style (lookup-theme "no-decoration")))))
......@@ -266,15 +262,18 @@
h (xlib:mode-info-vdisplay ml)))
(setf x 0 y 0 w (screen-width) h (screen-height)))
(xlib:with-state (window)
(setf (window-position window) (values x y)
(drawable-sizes window) (values w h))))
(with-slots (window) (or master application)
(setf (window-position window) (values x y)))
(setf (drawable-sizes window) (values w h))))
(focus-widget application 0))
(with-event-mask (*root-window*)
(setf (window-position window) (geometry-coordinates fgeometry)
(drawable-sizes window) (geometry-sizes fgeometry))
(setf (drawable-sizes window) (geometry-sizes fgeometry))
(unless (window-not-decorable-p window)
(setf (decoration-frame-style master)
(slot-value master 'old-frame-style)))))
(slot-value master 'old-frame-style)))
(with-slots ((win window)) (or master application)
(setf (window-position win) (geometry-coordinates fgeometry)))))
(send-configuration-notify window)
(let ((prop (netwm:net-wm-state window)))
(if (eq ,mode :on)
(pushnew :_net_wm_state_fullscreen prop)
......@@ -563,7 +562,7 @@
:xc_bottom_left_corner :xc_bottom_right_corner))
(defconstant +side-cursors+