<commit_before>;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLIM-XCOMMON; -*-
;;; --------------------------------------------------------------------------------------
;;;     Title: X11 keysym handling
;;;   Created: 2002-02-11
;;;    Author: <NAME> <<EMAIL>>
;;;   License: LGPL (See file COPYING for details).
;;; --------------------------------------------------------------------------------------
;;;  (c) copyright 2002 by <NAME>

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the 
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
;;; Boston, MA  02111-1307  USA.

;;; Support and port mixin for X based backends, handling keycode to
;;; keysym and character mapping, and handling of modifiers.

(in-package :clim-xcommon)

;;; Recall some terminology.  A KEYCODE is an integer between 8 and
;;; 255 and it corresponds to some key on the keyboard.  The
;;; correspondence is arbitrary in that it can vary from one X11
;;; server to another.
;;;
;;; A KEYSYM is non-negative integer with an equivalent Common Lisp
;;; type of (UNSIGNED-BYTE 32).  A keysym has a fixed meaning as a
;;; some upper or lower-case letter, as some special character, or as
;;; some operation that does not have a character equivalent, for
;;; example the UP arrow key or the CapsLock key.
;;;
;;; In addition, we give one or more NAMEs to some important keysyms.
;;; Such a KEYSYM NAME is a symbol in the KEYWORD package.  Even
;;; ordinary letters follow this pattern, so that the keysym name for
;;; the lower-case letter #\a is the symbol :|a|.
;;;
;;; Let us introduce some terminology related to modifiers.  A
;;; MODIFIER is some abstract concept with no representation in code.
;;; Examples of modifiers are SHIFT, CONTROL, CAPSLOCK, HYPER, etc.  A
;;; MODIFIER KEYCODE is a keycode that is currently working as a
;;; modifier.  A MODIFIER KEYSYM is one of the keysyms in the fixed
;;; set of keysyms corresponding to modifier keys.  A MODIFIER NAME is
;;; the keysym name of modifier keysym.  A MODIFIER VALUE is an
;;; integer that is a power of 2 and that uniquely identifies a
;;; particular modifier.  A MODIFIER MASK is an integer made up the
;;; logical OR of modifier values.

;;; This hash table maps a keysym to a list of keysym names for that
;;; keysym.
(defvar *keysym-name-table*
  (make-hash-table :test #'eql))

;;; This hash table maps a keysym name to the corresponding keysym.
(defvar *keysym-table*
  (make-hash-table :test #'eq))

(defun define-keysym (name value)
  (pushnew name (gethash value *keysym-name-table* nil))
  (setf (gethash name *keysym-table*) value))

(defun keysym-to-keysym-name (value)
  (car (last (gethash value *keysym-name-table*))))

(defun keysym-name-to-keysym (value)
  (gethash value *keysym-table*))

(defclass keysym-port-mixin ()
  ((modifier-cache :accessor modifier-cache :initform nil)))

(defgeneric modifier-mapping (port)
  (:documentation "Returns an array of lists of keysym keywords for
  each of the X modifiers shift lock control mod1 mod2 mod3 mod4 mod5"))

(defmethod modifier-mapping (port)
  (error "Define me!"))

;;; The X state is the state before the current event, so key events
;;; for the modifier keys don't reflect the state that results from
;;; pressing or releasing those keys.  We want the CLIM modifiers to
;;; reflect the post event state.

(defun x-keysym-to-clim-modifiers (port event-key keychar keysym-name state)
  "event-key is :key-press or :key-release"
  (multiple-value-bind (clim-modifiers shift-lock? caps-lock? mode-switch?)
      (x-event-state-modifiers port state)
    (declare (ignore shift-lock? caps-lock? mode-switch?))
    (if (characterp keychar)
	clim-modifiers	;; ?? true?
	(modify-modifiers event-key keysym-name clim-modifiers))))

;;; Modifier cache
;;;
;;; A cache entry is a CONS of two bit masks, each one represented as
;;; an integer.  Each bit mask is the logical OR of constants, each of
;;; which is a power of 2 and defining some modifier.
;;;
;;; The CAR of the cache entry is the bit mask for modifiers defined
;;; by the CLIM II specification.  The corresponding constants are not
;;; backend specific, so they are defined elsewhere.
;;;
;;; The CDR of the cache entry is the bit mask for backend-specific
;;; modifiers, in this case CLX modifiers for shift lock, caps lock,
;;; and mode switch.  Recall that the mode switch modifier is the one
;;; that determines which of the two groups of keysyms should be used
;;; as an interpretation of a particular keycode.

;;; Definition of constants for the backend-specific modifier mask.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +shift-lock+ 1)
(defconstant +caps-lock+ 2)
(defconstant +mode-switch+ 4)
)

;;; This dictionary maps CLX keysym names to the power-of-two
;;; constants that the CLIM II specification requires.
(defconstant +clim-modifiers+
  '(((:meta-left :meta-right) #.+meta-key+)
    ((:hyper-left :hyper-right) #.+hyper-key+)
    ((:super-left :super-right) #.+super-key+)
    ((:shift-left :shift-right) #.+shift-key+)
    ((:control-left :control-right) #.+control-key+)))

;;; This dictionary maps CLX keysym names to the power-of-two
;;; constants that are not required by the CLIM II specification, but
;;; that we need anyway, in order to determine what keysym to choose
;;; based on current modifiers.
(defconstant +other-modifiers+
  '((:shift-lock #.+shift-lock+)
    (:caps-lock #.+caps-lock+)
    (:mode-switch #.+mode-switch+)))

;;; Recall that the function MODIFIER-MAPPING is similar to the one
;;; with the same name in the XLIB package.  It returns a vector of
;;; length 8, where each element is a list of keysym names (which are
;;; Common Lisp symbols in the KEYWORD package).  The elements of the
;;; vector are as follows:
;;;
;;;   index  meaning
;;;     0    shift keysym names
;;;     1    lock keysym names
;;;     2    control keysym names
;;;     3    mod1 keysym names
;;;     4    mod2 keysym names
;;;     5    mod3 keysym names
;;;     6    mod4 keysym names
;;;     7    mod5 keysym names

(defun make-modifier-cache (port)
  (let* ((modifier-mapping (modifier-mapping port))
	 ;; This variable holds the number of different possible
	 ;; modifiers, and the X11 specification says that it will
	 ;; always be 8.
	 (modifier-count (length modifier-mapping))
	 ;; This variable holds the number of different possible
	 ;; modifier masks, and the X11 specification says that it
	 ;; will always be 256.
	 (modifier-mask-count (ash 1 modifier-count))
	 (cache (make-array modifier-mask-count)))
    (loop for x-modifier from 0 below modifier-mask-count
	  for clim-modifier = 0
	  for other-modifier = 0
	  do (loop for bit from 0 below modifier-count
		   for bit-modifiers = (aref modifier-mapping bit)
		   when (logbitp bit x-modifier)
		   do (progn
			(loop for (syms val) in +clim-modifiers+
			      when (intersection syms bit-modifiers)
			      do (setf clim-modifier
				       (logior clim-modifier val)))
			(loop for (sym val) in +other-modifiers+
			      when (member sym bit-modifiers)
			      do (setf other-modifier
				       (logior other-modifier val))))
		   finally (setf (aref cache x-modifier)
				 (cons clim-modifier other-modifier))))
    (setf (modifier-cache port) cache)))

(defgeneric x-event-state-modifiers (port state)
  (:documentation "For the X STATE, returns as multiple values, the
  corresponding set of CLIM modifiers and flags for shift lock, caps lock, and
  mode switch."))

(defmethod x-event-state-modifiers ((port keysym-port-mixin) state)
  (with-accessors ((modifier-cache modifier-cache))
      port
    (unless modifier-cache
      (setf modifier-cache (make-modifier-cache port)))
    (destructuring-bind (clim-modifiers . other-modifiers)
	;; Mask off the button state bits.
	(aref modifier-cache
	      (mod state (length modifier-cache)))
      (values clim-modifiers
	      (logtest +shift-lock+ other-modifiers)
	      (logtest +caps-lock+ other-modifiers)
	      (logtest +mode-switch+ other-modifiers)))))

(defun modify-modifiers (event-key keysym-name modifiers)
  (let ((keysym-modifier (loop for (keysyms modifier) in +clim-modifiers+
			       if (member keysym-name keysyms)
			       return modifier)))
    (cond ((and keysym-modifier (eq event-key :key-press))
	   (logior modifiers keysym-modifier))
	  ((and keysym-modifier (eq event-key :key-release))
	   (logandc2 modifiers keysym-modifier))
	  (t modifiers))))
<commit_msg>Rename local variable BIT-MODIFIERS -> MODIFIER-NAMES.<commit_after>;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLIM-XCOMMON; -*-
;;; --------------------------------------------------------------------------------------
;;;     Title: X11 keysym handling
;;;   Created: 2002-02-11
;;;    Author: <NAME> <<EMAIL>>
;;;   License: LGPL (See file COPYING for details).
;;; --------------------------------------------------------------------------------------
;;;  (c) copyright 2002 by <NAME>

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the 
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
;;; Boston, MA  02111-1307  USA.

;;; Support and port mixin for X based backends, handling keycode to
;;; keysym and character mapping, and handling of modifiers.

(in-package :clim-xcommon)

;;; Recall some terminology.  A KEYCODE is an integer between 8 and
;;; 255 and it corresponds to some key on the keyboard.  The
;;; correspondence is arbitrary in that it can vary from one X11
;;; server to another.
;;;
;;; A KEYSYM is non-negative integer with an equivalent Common Lisp
;;; type of (UNSIGNED-BYTE 32).  A keysym has a fixed meaning as a
;;; some upper or lower-case letter, as some special character, or as
;;; some operation that does not have a character equivalent, for
;;; example the UP arrow key or the CapsLock key.
;;;
;;; In addition, we give one or more NAMEs to some important keysyms.
;;; Such a KEYSYM NAME is a symbol in the KEYWORD package.  Even
;;; ordinary letters follow this pattern, so that the keysym name for
;;; the lower-case letter #\a is the symbol :|a|.
;;;
;;; Let us introduce some terminology related to modifiers.  A
;;; MODIFIER is some abstract concept with no representation in code.
;;; Examples of modifiers are SHIFT, CONTROL, CAPSLOCK, HYPER, etc.  A
;;; MODIFIER KEYCODE is a keycode that is currently working as a
;;; modifier.  A MODIFIER KEYSYM is one of the keysyms in the fixed
;;; set of keysyms corresponding to modifier keys.  A MODIFIER NAME is
;;; the keysym name of modifier keysym.  A MODIFIER VALUE is an
;;; integer that is a power of 2 and that uniquely identifies a
;;; particular modifier.  A MODIFIER MASK is an integer made up the
;;; logical OR of modifier values.

;;; This hash table maps a keysym to a list of keysym names for that
;;; keysym.
(defvar *keysym-name-table*
  (make-hash-table :test #'eql))

;;; This hash table maps a keysym name to the corresponding keysym.
(defvar *keysym-table*
  (make-hash-table :test #'eq))

(defun define-keysym (name value)
  (pushnew name (gethash value *keysym-name-table* nil))
  (setf (gethash name *keysym-table*) value))

(defun keysym-to-keysym-name (value)
  (car (last (gethash value *keysym-name-table*))))

(defun keysym-name-to-keysym (value)
  (gethash value *keysym-table*))

(defclass keysym-port-mixin ()
  ((modifier-cache :accessor modifier-cache :initform nil)))

(defgeneric modifier-mapping (port)
  (:documentation "Returns an array of lists of keysym keywords for
  each of the X modifiers shift lock control mod1 mod2 mod3 mod4 mod5"))

(defmethod modifier-mapping (port)
  (error "Define me!"))

;;; The X state is the state before the current event, so key events
;;; for the modifier keys don't reflect the state that results from
;;; pressing or releasing those keys.  We want the CLIM modifiers to
;;; reflect the post event state.

(defun x-keysym-to-clim-modifiers (port event-key keychar keysym-name state)
  "event-key is :key-press or :key-release"
  (multiple-value-bind (clim-modifiers shift-lock? caps-lock? mode-switch?)
      (x-event-state-modifiers port state)
    (declare (ignore shift-lock? caps-lock? mode-switch?))
    (if (characterp keychar)
	clim-modifiers	;; ?? true?
	(modify-modifiers event-key keysym-name clim-modifiers))))

;;; Modifier cache
;;;
;;; A cache entry is a CONS of two bit masks, each one represented as
;;; an integer.  Each bit mask is the logical OR of constants, each of
;;; which is a power of 2 and defining some modifier.
;;;
;;; The CAR of the cache entry is the bit mask for modifiers defined
;;; by the CLIM II specification.  The corresponding constants are not
;;; backend specific, so they are defined elsewhere.
;;;
;;; The CDR of the cache entry is the bit mask for backend-specific
;;; modifiers, in this case CLX modifiers for shift lock, caps lock,
;;; and mode switch.  Recall that the mode switch modifier is the one
;;; that determines which of the two groups of keysyms should be used
;;; as an interpretation of a particular keycode.

;;; Definition of constants for the backend-specific modifier mask.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant +shift-lock+ 1)
(defconstant +caps-lock+ 2)
(defconstant +mode-switch+ 4)
)

;;; This dictionary maps CLX keysym names to the power-of-two
;;; constants that the CLIM II specification requires.
(defconstant +clim-modifiers+
  '(((:meta-left :meta-right) #.+meta-key+)
    ((:hyper-left :hyper-right) #.+hyper-key+)
    ((:super-left :super-right) #.+super-key+)
    ((:shift-left :shift-right) #.+shift-key+)
    ((:control-left :control-right) #.+control-key+)))

;;; This dictionary maps CLX keysym names to the power-of-two
;;; constants that are not required by the CLIM II specification, but
;;; that we need anyway, in order to determine what keysym to choose
;;; based on current modifiers.
(defconstant +other-modifiers+
  '((:shift-lock #.+shift-lock+)
    (:caps-lock #.+caps-lock+)
    (:mode-switch #.+mode-switch+)))

;;; Recall that the function MODIFIER-MAPPING is similar to the one
;;; with the same name in the XLIB package.  It returns a vector of
;;; length 8, where each element is a list of keysym names (which are
;;; Common Lisp symbols in the KEYWORD package).  The elements of the
;;; vector are as follows:
;;;
;;;   index  meaning
;;;     0    shift keysym names
;;;     1    lock keysym names
;;;     2    control keysym names
;;;     3    mod1 keysym names
;;;     4    mod2 keysym names
;;;     5    mod3 keysym names
;;;     6    mod4 keysym names
;;;     7    mod5 keysym names

(defun make-modifier-cache (port)
  (let* ((modifier-mapping (modifier-mapping port))
	 ;; This variable holds the number of different possible
	 ;; modifiers, and the X11 specification says that it will
	 ;; always be 8.
	 (modifier-count (length modifier-mapping))
	 ;; This variable holds the number of different possible
	 ;; modifier masks, and the X11 specification says that it
	 ;; will always be 256.
	 (modifier-mask-count (ash 1 modifier-count))
	 (cache (make-array modifier-mask-count)))
    (loop for x-modifier from 0 below modifier-mask-count
	  for clim-modifier = 0
	  for other-modifier = 0
	  do (loop for bit from 0 below modifier-count
		   for modifier-names = (aref modifier-mapping bit)
		   when (logbitp bit x-modifier)
		   do (progn
			(loop for (syms val) in +clim-modifiers+
			      when (intersection syms modifier-names)
			      do (setf clim-modifier
				       (logior clim-modifier val)))
			(loop for (sym val) in +other-modifiers+
			      when (member sym modifier-names)
			      do (setf other-modifier
				       (logior other-modifier val))))
		   finally (setf (aref cache x-modifier)
				 (cons clim-modifier other-modifier))))
    (setf (modifier-cache port) cache)))

(defgeneric x-event-state-modifiers (port state)
  (:documentation "For the X STATE, returns as multiple values, the
  corresponding set of CLIM modifiers and flags for shift lock, caps lock, and
  mode switch."))

(defmethod x-event-state-modifiers ((port keysym-port-mixin) state)
  (with-accessors ((modifier-cache modifier-cache))
      port
    (unless modifier-cache
      (setf modifier-cache (make-modifier-cache port)))
    (destructuring-bind (clim-modifiers . other-modifiers)
	;; Mask off the button state bits.
	(aref modifier-cache
	      (mod state (length modifier-cache)))
      (values clim-modifiers
	      (logtest +shift-lock+ other-modifiers)
	      (logtest +caps-lock+ other-modifiers)
	      (logtest +mode-switch+ other-modifiers)))))

(defun modify-modifiers (event-key keysym-name modifiers)
  (let ((keysym-modifier (loop for (keysyms modifier) in +clim-modifiers+
			       if (member keysym-name keysyms)
			       return modifier)))
    (cond ((and keysym-modifier (eq event-key :key-press))
	   (logior modifiers keysym-modifier))
	  ((and keysym-modifier (eq event-key :key-release))
	   (logandc2 modifiers keysym-modifier))
	  (t modifiers))))

{'fraction_non_alphanumeric': 0.1273797733025201, 'fraction_numerical': 0.008253549026081214, 'mean_word_length': 3.4156948493683186, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 12, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7297569', 'n_tokens_mistral': 5750, 'n_tokens_neox': 5385, 'n_words': 2252}