From 6ae7b50f0b4400934a85eaaa45190d9e1c6f11d4 Mon Sep 17 00:00:00 2001 From: layer <layer> Date: Wed, 6 Jun 2007 17:15:06 +0000 Subject: [PATCH] 2007-05-16 Andreas Fuchs <afuchs@franz.com> --- ChangeLog.n | 9 ++++++- tk-silica/xt-silica.lisp | 57 +++++++++++++++++++++++++++++++++++----- xlib/xlib-funs.lisp | 8 +++++- 3 files changed, 66 insertions(+), 8 deletions(-) diff --git a/ChangeLog.n b/ChangeLog.n index 4b57e57c..96bde7c0 100644 --- a/ChangeLog.n +++ b/ChangeLog.n @@ -1,3 +1,10 @@ +2007-05-16 Andreas Fuchs <afuchs@franz.com> + + * xlib/xlib-funs.lisp: new function xkeycodetokeysym + * tk-silica/xt-silica.lisp: find out the meta/super/hyper mod + bits from the X server, then use the bit masks in + state->modifiers. + 2007-05-17 <layer@HOBART> * aclpc/acl-class.lisp: bug17020: clim process browser in win64 @@ -6178,4 +6185,4 @@ IGNORE JDI SPECIFIC CHANGES TO Makefile Lots of other stuff ******************************************************************************* -$Revision: 2.34 $ +$Revision: 2.35 $ diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp index de2f1b44..c29521cd 100644 --- a/tk-silica/xt-silica.lisp +++ b/tk-silica/xt-silica.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xt-silica.lisp,v 2.9 2007/04/17 21:45:54 layer Exp $ +;; $Id: xt-silica.lisp,v 2.10 2007/06/06 17:15:06 layer Exp $ (in-package :xm-silica) @@ -87,7 +87,6 @@ (make-instance 'tk::gcontext :drawable pixmap)) (tk::destroy-pixmap pixmap)))))) - (defmethod restart-port ((port xt-port)) (let ((process (port-process port))) (when process @@ -99,7 +98,9 @@ :priority 1000) #'port-event-loop port)) (setf (getf (mp:process-property-list process) :no-interrupts) t) - (setf (port-process port) process))) + (setf (port-process port) process)) + ;; Find out the modifier->modbit mapping on the display. + (setup-modifier-key-mapping port)) (defparameter *use-color* t) ; For debugging monochrome @@ -1430,15 +1431,59 @@ setup." character (excl::old-code-char (char-code character) bits))) +(defvar +super-modifier-mask+ 0) +(defvar +hyper-modifier-mask+ 0) +(defvar +meta-modifier-mask+ 0) + +(defun setup-modifier-key-mapping (port) + (let* ((display (slot-value port 'tk-silica::display)) + (modifier-map (x11:xgetmodifiermapping display)) + (mods (x11:xmodifierkeymap-modifiermap modifier-map)) + (max-keypermod (x11:xmodifierkeymap-max-keypermod modifier-map)) + (skip-modbits 3) ; assuming that shift, lock, control are + ; always bound to sane values. + ) + (labels ((translate-key (key &aux keysym) + (loop for index from 0 below max-keypermod + do (setf keysym (x11:xkeycodetokeysym display key index)) + while (zerop keysym) + + finally (return keysym)))) + (unwind-protect + ;; "The modifiermap member of the XModifierKeymap structure + ;; contains 8 sets of max_keypermod KeyCodes" -- XGetModifierMap(3X11) + (loop for i from skip-modbits to 8 + for mod-keyword in `(,x11:mod1mask ,x11:mod2mask ,x11:mod3mask + ,x11:mod4mask ,x11:mod5mask) + do (loop for j from 0 below max-keypermod + for key = (sys:memref-int mods + (+ (* i max-keypermod) j) + 0 :unsigned-byte) + unless (zerop key) + do (case (translate-key key) + ((#.x11:XK-Meta-L #.x11:XK-Meta-R) + (setf +meta-modifier-mask+ mod-keyword)) + ((#.x11:XK-Super-L #.x11:XK-Super-R) + (setf +super-modifier-mask+ mod-keyword)) + ((#.x11:XK-Hyper-L #.x11:XK-Hyper-R) + (setf +hyper-modifier-mask+ mod-keyword))))) + (x11:xfreemodifiermap modifier-map))) + (values +meta-modifier-mask+ +super-modifier-mask+ +hyper-modifier-mask+))) + (defun state->modifiers (x) (declare (optimize (speed 3) (safety 0)) (fixnum x)) + ;; 2007-05-09/asf This is not entirely optimal yet: In recent linux + ;; distributions (Ubuntu, specifically), Hyper and Super cause the + ;; same modifier bit to be set on x events. Maybe it would be better + ;; to observe the press/release events of modifier keys (this could + ;; also enable sticky ESC to be Meta, the way emacs has it). (logior (if (logtest x x11:shiftmask) +shift-key+ 0) (if (logtest x x11:controlmask) +control-key+ 0) - (if (logtest x x11:mod1mask) +meta-key+ 0) - (if (logtest x x11:mod2mask) +super-key+ 0) - (if (logtest x x11:mod3mask) +hyper-key+ 0))) + (if (logtest x +meta-modifier-mask+) +meta-key+ 0) + (if (logtest x +super-modifier-mask+) +super-key+ 0) + (if (logtest x +hyper-modifier-mask+) +hyper-key+ 0))) (defmethod get-application-resources ((port xt-port)) (multiple-value-bind (names classes) diff --git a/xlib/xlib-funs.lisp b/xlib/xlib-funs.lisp index a04a9584..80e64f7f 100644 --- a/xlib/xlib-funs.lisp +++ b/xlib/xlib-funs.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xlib-funs.lisp,v 2.8 2007/04/17 21:45:54 layer Exp $ +;; $Id: xlib-funs.lisp,v 2.9 2007/06/06 17:15:06 layer Exp $ ;;; (c) Copyright 1990 Sun Microsystems, Inc. All Rights Reserved. ;; (c) Copyright 1989, 1990, 1991 Sun Microsystems, Inc. Sun design @@ -1382,6 +1382,12 @@ (keysyms (:pointer keysym)) (nkeycodes int)) +(def-exported-foreign-function (xkeycodetokeysym (:return-type int) + (:name "XKeycodeToKeysym")) + (dpy (:pointer display)) + (keycode int) + (index int)) + (def-exported-foreign-function (xsetselectionowner (:name "XSetSelectionOwner")) (dpy (:pointer display)) (selection :unsigned-32bit) -- GitLab