Commit 7ffaeacc authored by hatchond's avatar hatchond
Browse files

- lib/clx-ext/clx-extensions.lisp, lib/clx-ext/cursor.lisp:

  Documentation is almost complete.

- lib/clx-ext/keysyms.lisp:
  The init function had been supressed. Instead we create our cache when needed
  and invalidate it when needed (e.g: if modifier-map-changed-p returns t).

  The modifier->modifier-mask now takes a display as first parameter

- eclipse.lisp gestures.lisp: was calling init-keyboard.

- gestures.lisp:
  The modifier->modifier-mask now takes a display as first parameter
parent 4dbc7301
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: eclipse.lisp,v 1.6 2003/08/28 14:50:35 hatchond Exp $
;;; $Id: eclipse.lisp,v 1.7 2003/09/12 01:16:46 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -125,7 +125,6 @@
(root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr))
;; init all gnome properties on root.
(init-gnome-compliance display root-window manager)
(keyboard:init-keyboard display)
(ppm:initialize colormap)
;; load personal configuration file, or the default one.
(or (load-config-file (home-subdirectory cl-user::*eclipse-initfile*))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.4 2003/06/11 18:29:23 hatchond Exp $
;;; $Id: gestures.lisp,v 1.5 2003/08/28 14:50:35 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -135,15 +135,15 @@
;;;;
(defun translate-modifiers (modifiers)
(defun translate-modifiers (display modifiers)
(cond ((keywordp modifiers)
(list (kb:modifier->modifier-mask modifiers)))
(list (kb:modifier->modifier-mask display modifiers)))
((numberp modifiers)
(list modifiers))
((eq (car modifiers) :and)
(list (loop for mod in (cdr modifiers)
sum (kb:modifier->modifier-mask mod))))
(t (mapcar #'kb:modifier->modifier-mask modifiers))))
sum (kb:modifier->modifier-mask display mod))))
(t (mapcar #'kb:modifier->modifier-mask display modifiers))))
(defmacro action ((&rest f1) (&rest f2))
(when (or (eq (car f1) :release) (eq (car f2) :press)) (rotatef f1 f2))
......@@ -192,9 +192,10 @@
(defmacro undefine-combo-internal (stroke dest-window &key mouse-p)
`(with-slots (name modifiers default-modifiers-p action) ,stroke
(remhash name ,(if mouse-p '*mousestrokes* '*keystrokes*))
(loop with num-l = (kb:modifier->modifier-mask :NUM-LOCK)
with caps-l = (kb:modifier->modifier-mask :CAPS-LOCK)
for mask in (translate-modifiers modifiers) do
(loop with dpy = (xlib:drawable-display ,dest-window)
with num-l = (kb:modifier->modifier-mask dpy :NUM-LOCK)
with caps-l = (kb:modifier->modifier-mask dpy :CAPS-LOCK)
for mask in (translate-modifiers dpy modifiers) do
(loop for key in (stroke-keys ,stroke) do
(unrealize (,dest-window :mouse-p ,mouse-p) key mask)
(when (and default-modifiers-p (not (eql mask :any)))
......@@ -225,9 +226,10 @@
(defmacro define-combo-internal (stroke dest-window &key mouse-p)
`(with-slots (name modifiers default-modifiers-p action) ,stroke
(loop with num-l = (kb:modifier->modifier-mask :NUM-LOCK)
with caps-l = (kb:modifier->modifier-mask :CAPS-LOCK)
for mask in (translate-modifiers modifiers) do
(loop with dpy = (xlib:drawable-display ,dest-window)
with num-l = (kb:modifier->modifier-mask dpy :NUM-LOCK)
with caps-l = (kb:modifier->modifier-mask dpy :CAPS-LOCK)
for mask in (translate-modifiers dpy modifiers) do
(loop for key in (stroke-keys ,stroke) do
(realize (,dest-window :mouse-p ,mouse-p)
key mask name action)
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.14 2003/09/12 09:10:02 hatchond Exp $
;;; $Id: input.lisp,v 1.15 2003/09/16 14:24:41 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -39,7 +39,6 @@
(register-all-keystrokes)))
(:modifier
(when (kb:modifier-map-changed-p *display*)
(kb:init-keyboard *display*)
(unregister-all-keystrokes)
(unregister-all-mouse-strokes)
(xlib:mapping-notify *display* request start count)
......
;;; -*- Mode: Lisp; Package: CLX-EXTENSIONS -*-
;;; $Id: clx-extensions.lisp,v 1.2 2003/08/28 14:44:40 hatchond Exp $
;;; $Id: clx-extensions.lisp,v 1.3 2003/09/10 23:54:20 hatchond Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
......@@ -25,24 +25,33 @@
(declaim (inline window-geometry window-size window-position))
(defun window-geometry (window)
"Returns the window geometry as a multiple values. The values order is:
x, y, width, height."
(values (xlib:drawable-x window) (xlib:drawable-y window)
(xlib:drawable-width window) (xlib:drawable-height window)))
(defun drawable-sizes (window)
(values (xlib:drawable-width window) (xlib:drawable-height window)))
(defun drawable-sizes (drawable)
"Returns the sizes of the given drawable as a multiple values. The values
order is: width, height."
(values (xlib:drawable-width drawable) (xlib:drawable-height drawable)))
(defun window-position (window)
(defun window-position (window)
"Returns the window position of the given window relatives to its parent."
(values (xlib:drawable-x window) (xlib:drawable-y window)))
(defsetf drawable-sizes (window) (width height)
`(setf (xlib:drawable-width ,window) ,width
(xlib:drawable-height ,window) ,height))
(defsetf drawable-sizes (drawable) (width height)
"Set the sizes of the given drawable. The values order is: width, height."
`(setf (xlib:drawable-width ,drawable) ,width
(xlib:drawable-height ,drawable) ,height))
(defsetf window-position (window) (x y)
"Set the window position of the given window. The values order is: x, y."
`(setf (xlib:drawable-x ,window) ,x
(xlib:drawable-y ,window) ,y))
(defmacro with-event-mask ((window &optional (ev-mask 0)) &body body)
"Changes the indicated window event mask to the specified value only within
the dynamic extent of the body."
(let ((original-mask (gensym)))
`(let ((,original-mask (xlib:window-event-mask ,window)))
(unwind-protect
......@@ -134,6 +143,9 @@
&key (modifiers #x8000) owner-p
sync-pointer-p sync-keyboard-p
confine-to cursor)
"The interpretation of the arguments is the same as with xlib:grab-button.
But NO modifiers is equivalent to issuing the request for all possible
modifier-key combinations (including the combination of no modifiers)."
(xlib:grab-button window button event-mask
:modifiers modifiers :owner-p owner-p
:sync-pointer-p sync-pointer-p
......@@ -144,16 +156,18 @@
&key (start 0) end
width (size :default)
(translate #'translate))
"The interpretation of the arguments is the same as with xlib:draw-glyphs.
Only the default translate function differs."
(xlib:draw-glyphs drawable gctxt x y seq
:start start :end end
:width width :size size
:translate translate))
(defun translate (src src-start src-end afont dst dst-start)
;; This is for replacing the clx-translate-default-function
;; who does'nt know about accentated characters because
;; of a call to cl:graphic-char-p that return nil with accentated characters.
;; For further informations, on a clx-translate-function, see the clx-man.
;; This is for replacing the clx-translate-default-function who doesn't
;; know about accentuated characters because of a call to cl:graphic-char-p
;; that return nil with accentuated characters. For further informations,
;; on a clx-translate-function, see the clx-man.
(declare (type sequence src)
(type xlib:array-index src-start src-end dst-start)
(type (or null xlib:font) afont)
......@@ -173,10 +187,19 @@
else do (loop-finish)
finally (return i)))
(defun text-width (font seq)
(xlib:text-width font seq :translate #'translate))
(defun text-width (font sequence &key (start 0) end (translate #'translate))
"Returns the total pixel width of the given sequence when drawn in the given
font. The font can be a gcontext, in which case the font attribute of the
given graphics context is used. :start and :end define the elements of the
sequence which are used. The second value returned is nil if all elements
of the sequence were successfully translated; otherwise the index of the
first untranslated element is returned."
(xlib:text-width font seq :start start :end end :translate #'translate))
(defun draw-centered-text (window gctxt seq &key color x y)
"Draw the filled text characters represented by the given sequence `seq'.
The given x and y specify the left baseline position for the first
character. Otherwise they are computed so the text appears centered."
(declare (optimize (speed 3) (safety 0)))
(declare (type (or null (signed-byte 16)) x y))
(declare (inline draw-glyphs))
......@@ -191,6 +214,7 @@
(draw-glyphs window gctxt (max x 0) y seq :width text-w))))
(defun send-configuration-notify (window)
"Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
(multiple-value-bind (x y)
(xlib:translate-coordinates window 0 0 (xlib:drawable-root window))
(xlib:send-event window
......
;;; -*- Mode: Lisp; Package: Clx-Extensions -*-
;;; $Id: cursor.lisp,v 1.2 2002/06/24 07:33:44 james Exp $
;;; $Id: cursor.lisp,v 1.1 2002/11/07 14:22:42 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; This file is part of Eclipse. It gives an other (shortest)
......@@ -35,6 +35,7 @@
(gethash cursor-key-name +cursor-table+))
(defun get-x-cursor (display cursor-key-name &key reverse)
"Returns the cursor designed by `cursor-key-name' of the \"cursor\" font."
(let ((index (cursor-key-name->cursor-font-index cursor-key-name)))
(unless +cursor-font+
(setf +cursor-font+ (xlib:open-font display "cursor")))
......
;;; -*- Mode: Lisp; Package: Keyboard -*-
;;; $Id: keysyms.lisp,v 1.1 2002/11/07 14:22:42 hatchond Exp $
;;; $Id: keysyms.lisp,v 1.2 2003/03/16 00:34:38 hatchond Exp $
;;;
;;; This is a CLX extension for managing keyboard.
;;;
......@@ -33,8 +33,7 @@
keyname->keycodes
keycode->keyname
modifier->modifier-mask
modifier-map-changed-p
init-keyboard))
modifier-map-changed-p))
(in-package :keyboard)
......@@ -42,6 +41,16 @@
(defvar *keysym->keyname* (make-hash-table :test #'eql))
(defvar *modifier->modifier-mask* nil)
(defun make-modifier-mask-table (disp)
(loop with map = '(:any #x8000)
for mods in (multiple-value-list (xlib:modifier-mapping disp))
for i = 1 then (* 2 i) do
(loop for mod in mods
for key-name = (keycode->keyname disp mod)
for prec = (getf map key-name) do
(setf (getf map key-name) (+ (if (numberp prec) prec 0) i)))
finally (return map)))
(defun define-keysym (name value)
(pushnew name (gethash value *keysym->keyname* nil))
(setf (gethash name *keyname->keysyms*) value))
......@@ -58,24 +67,15 @@
(defun keycode->keyname (disp keycode)
(keysym->keyname (xlib:keycode->keysym disp keycode 0)))
(defun modifier->modifier-mask (modifier-name)
(defun modifier->modifier-mask (disp modifier-name)
(unless *modifier->modifier-mask*
(setf *modifier->modifier-mask* (make-modifier-mask-table disp)))
(getf *modifier->modifier-mask* modifier-name))
(defsetf modifier->modifier-mask (disp mod) (value)
`(setf (getf *modifier->modifier-mask* (keycode->keyname ,disp ,mod)) ,value))
(defun make-modifier->mofier-mask (disp)
(loop with map = '(:any #x8000)
for mods in (multiple-value-list (xlib:modifier-mapping disp))
for i = 1 then (* 2 i) do
(loop for mod in mods
for key-name = (keycode->keyname disp mod)
for prec = (getf map key-name) do
(setf (getf map key-name) (+ (if (numberp prec) prec 0) i)))
finally (return map)))
(defun modifier-map-changed-p (display)
(eql (make-modifier->mofier-mask display) *modifier->modifier-mask*))
(defun init-keyboard (disp)
(setf *modifier->modifier-mask* (make-modifier->mofier-mask disp)))
(unless (eql (make-modifier-mask-table display) *modifier->modifier-mask*)
(setf *modifier->modifier-mask* nil)
t))
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