Commit 1f57da74 authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

lib/clx-ext/keysyms.lisp: multiple-value-list surrounding xlib:keysym->keycodes was missing.

lib/manager-commons.lisp: id control added in some translator lambda.
eclipse.in: new option --activate-log

eclipse.lisp gestures.lisp input.lisp virtual-screen.lisp widgets.lisp wm.lisp:
- Focus gestion modification to be fully ICCCM complient.
- circulate-window keystroke bug fix. (all modifiers keycodes were not took in account).
parent de6e4e12
@interp@ @SHELL@
# $Id: eclipse.in,v 1.8 2004/01/13 00:09:41 ihatchondo Exp $
# $Id: eclipse.in,v 1.9 2004/11/30 23:48:10 ihatchondo Exp $
#
# @configure_input@
# This file starts the eclipse window manager
usage () {
printf "\nusage: eclipse [ --display=dpy ] [ --sm-client-id=id ]\n\n";
printf "\nusage: eclipse [options]\n\n"
printf " --display=dpy specifies the X server to use.\n"
printf " --sm-client-id=id specifies the sesion manager id to use.\n"
printf " --activate-log specifies that errors must be logged.\n\n"
exit 1;
}
display_spec=""
sm_client_id=""
activate_log=""
options=""
## Parse and collect options.
if [ $# -gt 2 ] ; then usage ; fi
if [ $# -gt 3 ] ; then usage ; fi
while [ $# -gt 0 ] ; do
case "$1" in
......@@ -29,13 +33,17 @@ while [ $# -gt 0 ] ; do
sm_client_id=":sm-client-id \"$tmp\"";
shift ;
;;
--activate-log)
activate_log=":activate-log t";
shift ;
;;
-* | *)
printf "\n $1 unknow option \n";
usage ;;
esac
done
options="$display_spec $sm_client_id :die-on-init-error t"
options="$display_spec $sm_client_id :die-on-init-error t $activate_log"
##
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.21 2004/11/30 23:48:10 ihatchondo Exp $
;;; $Id: eclipse.lisp,v 1.22 2004/12/16 21:36:47 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -120,8 +120,8 @@
:data (list managing-since
(xlib:find-atom display +xa-wm+)
(xlib:window-id manager)))
(make-instance 'standard-property-holder :window manager)
manager))
(setf (xlib:window-event-mask manager) '(:property-change))
(make-instance 'standard-property-holder :window manager)))
(defun init-gnome-compliance (display window manager)
(gnome:intern-gnome-atom display)
......@@ -158,13 +158,13 @@
;; Specific for X display
(setf (xlib:display-error-handler display) #'default-handler
(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-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.
(init-gnome-compliance display root-window manager)
(init-gnome-compliance display root-window (widget-window manager))
(ppm:initialize colormap)
;; Eclipse globals vars.
(setf *black* (xlib:screen-black-pixel screen)
......@@ -191,7 +191,7 @@
(unless (root-decoration-theme *root*)
(setf (decoration-theme) "microGUI")))))
(defun eclipse (&key display sm-client-id die-on-init-error)
(defun eclipse (&key display sm-client-id die-on-init-error activate-log)
"Starts the Eclipse window manager.
- :display (or null string): if given it is expected it respects the
standard X DISPLAY specification: hostname:displaynumber.screennumber
......@@ -205,10 +205,12 @@
NIL (default) or the empty string.
- :die-on-init-error (boolean): indicates if Eclipse should prevent
from debugger or not during initialisation phase.
- :activate-log (boolean): indicates if errors should be logged.
If T then errors will be logged in a file named: eclipse-yyyy-mm-dd.log
If neither the DISPLAY environment variable is defined nor the :display
argument is defined then Eclipse will not be able to starts."
(declare (type (or null string) display sm-client-id))
(declare (type boolean die-on-init-error))
(declare (type boolean activate-log die-on-init-error))
(when *display*
(xlib:close-display *display*)
(setf *display* nil))
......@@ -216,7 +218,8 @@
(handler-case (initialize display sm-client-id)
(error () (%quit%)))
(initialize display sm-client-id))
;(init-log-file)
(when activate-log
(init-log-file))
;; This is for releasing any previous pointer grab.
(ignore-errors
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.20 2005/01/18 23:22:44 ihatchondo Exp $
;;; $Id: gestures.lisp,v 1.21 2005/02/03 22:47:04 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -323,7 +323,7 @@
(unless (or (decoration-p widget) (application-p widget))
(return-from mouse-stroke-for-move-and-resize nil))
(when (eq *focus-type* :on-click)
(focus-widget widget 0))
(focus-widget widget (event-time event)))
(xlib:grab-pointer (event-child event) +pointer-event-mask+)
(menu-3-process event widget :key action)
(unless (menu-3-process (make-event :motion-notify) widget :key action)
......@@ -340,9 +340,11 @@
(loop with map = *keystroke-map*
for mod in (stroke-modifiers (gethash :switch-win-up *keystrokes*))
for code = (unless (eq mod :and) (kb:keyname->keycodes dpy mod))
when code
do (setf (gethash (cons (if (listp code) (car code) code) #x8000) map)
#'circulate-window-modifier-callback))
when code do
(mapc #'(lambda (c)
(setf (gethash (cons c #x8000) map)
#'circulate-window-modifier-callback))
code))
(xlib:grab-keyboard root-window)
(unless *current-widget-info*
(setf *current-widget-info* (create-message-box nil :parent root-window)))
......@@ -358,8 +360,8 @@
(loop with map = *keystroke-map*
for mod in (stroke-modifiers (gethash :switch-win-up *keystrokes*))
for code = (unless (eq mod :and) (kb:keyname->keycodes *display* mod))
when code
do (remhash (cons (if (listp code) (car code) code) #x8000) map))
when code do
(mapc #'(lambda (c) (remhash (cons c #x8000) map)) code))
(let ((widget (lookup-widget (car *windows*))))
(when widget (setf (application-wants-iconic-p widget) nil)))
(xlib:unmap-window (widget-window *current-widget-info*))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.40 2005/01/05 23:13:07 ihatchondo Exp $
;;; $Id: input.lisp,v 1.41 2005/01/16 23:25:59 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -79,6 +79,13 @@
(when (string= (event-selection e) +xa-wm+)
(error 'exit-eclipse)))
(defmethod event-process ((e property-notify) (w standard-property-holder))
(when (eql (event-atom e) :_net_active_window)
(let* ((window (netwm:net-active-window (widget-window w) :window-list t))
(widget (lookup-widget window)))
(when (application-p widget)
(set-focus (application-input-model widget) window (event-time e))))))
;;; Events for the root window
(defmethod event-process ((event map-request) (root root))
......@@ -389,7 +396,8 @@
(defmethod event-process ((event button-press) (button menu-button))
(with-slots (window-menu) *root*
(with-slots (master window armed active-p) button
(when (eq *focus-type* :on-click) (focus-widget button 0))
(when (eq *focus-type* :on-click)
(focus-widget button (event-time event)))
(and window-menu (destroy-substructure window-menu))
(setf window-menu (make-menu-button-menu master))
(realize-pop-up window-menu (event-root-x event) (event-root-y event))
......@@ -405,7 +413,8 @@
(unless (eq 0 (logand mod state))
(setf fill-p (not *maximize-fill*)))
(maximize master (event-code event) :fill-p fill-p)))
(when (eq *focus-type* :on-click) (focus-widget max-b 0))))
(when (eq *focus-type* :on-click)
(focus-widget max-b (event-time event)))))
;; Initialize the resize process.
(defmethod event-process ((event button-press) (edge edge))
......
;;; -*- Mode: Lisp; Package: Keyboard -*-
;;; $Id: keysyms.lisp,v 1.6 2005/01/15 12:27:00 ihatchondo Exp $
;;; $Id: keysyms.lisp,v 1.7 2005/01/16 23:22:26 ihatchondo Exp $
;;;
;;; This is a CLX extension for managing keyboard.
;;;
......@@ -71,7 +71,7 @@
(defun keyname->keycodes (disp keyname)
"Returns the list of keycode associated with the specified keyname."
(xlib:keysym->keycodes disp (keyname->keysym keyname)))
(multiple-value-list (xlib:keysym->keycodes disp (keyname->keysym keyname))))
(defun modifier->modifier-mask (disp modifier-name)
"Returns the modifier-mask associated with this modifier-name."
......
;;; -*- Mode: Lisp; Package: MANAGER-COMMONS -*-
;;; $Id: manager-commons.lisp,v 1.6 2005/01/07 15:13:37 ihatchondo Exp $
;;; $Id: manager-commons.lisp,v 1.7 2005/01/07 22:34:57 ihatchondo Exp $
;;;
;;; This is the CLX support for the managing with gnome.
;;;
......@@ -101,7 +101,10 @@
(get-property window property-atom
:transform (when window-list-p
(lambda (id)
(xlib::lookup-window (xlib:drawable-display window) id)))))
(declare (type xlib:card29 id))
(unless (zerop id)
(xlib::lookup-window
(xlib:drawable-display window) id))))))
(defun utf8->strings (data)
"Converts a vector of (unsigned-byte 8) that represents utf8 string(s) into
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.43 2004/12/20 19:18:20 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.44 2005/01/16 23:25:59 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -137,7 +137,8 @@
;;;; The ROOT
(defclass root (base-widget)
((resize-status :initform nil :accessor root-resize-status)
((property-holder :initarg :manager :accessor root-property-holder)
(resize-status :initform nil :accessor root-resize-status)
(move-status :initform nil :accessor root-move-status)
(default-cursor :initform nil :accessor root-default-cursor)
(current-active-widget :initform nil)
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.47 2005/01/16 23:25:59 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.48 2005/01/18 23:22:44 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -437,13 +437,25 @@
Input model can be :globally-active :locally-active :passive :no-input.
For more information on the input-model sementic see ICCCM 4.1.7"))
(defmethod set-focus ((input-model (eql :globally-active)) window timestamp)
(send-wm-protocols-client-message window :wm_take_focus (or timestamp 0)))
(defmethod set-focus ((input-model (eql :locally-active)) window timestamp)
(defmethod set-focus :around (input-model window timestamp)
;; If we have a valid timestamp then assign focus directly
;; otherwise set the net-active-window to provoke a property-notify event
;; on the root-property-holder. Then the property-notify event will handled
;; and will assign the focus with a valid timestamp.
;; It seems a bit complicated but this is the bettter way I found to not
;; violate the ICCCM (section 4.1.7).
(if (and timestamp (> timestamp 0))
(and (next-method-p) (call-next-method))
(with-slots ((ww window)) (root-property-holder *root*)
(setf (netwm:net-active-window ww) window))))
(defmethod set-focus ((input-model (eql :globally-active)) window time)
(send-wm-protocols-client-message window :wm_take_focus (or time 0)))
(defmethod set-focus ((input-model (eql :locally-active)) window time)
(when (eql (xlib:window-map-state window) :viewable)
(xlib:set-input-focus *display* window :pointer-root)
(send-wm-protocols-client-message window :wm_take_focus (or timestamp 0))))
(send-wm-protocols-client-message window :wm_take_focus (or time 0))))
(defmethod set-focus ((input-model (eql :passive)) window timestamp)
(declare (ignorable timestamp))
......
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