cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-keyboard.el

   1 ;;; xwem-keyboard.el --- Keyboard support for XWEM.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Authors: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;          Steve Youngs  <steve@youngs.au.com>
   7 ;;          Alex Ott <ottalex@narod.ru>
   8 ;; Created: 21 Mar 2003
   9 ;; Keywords: xwem, xlib
  10 ;; X-CVS: $Id: xwem-keyboard.el,v 1.17 2005-04-08 08:38:07 youngs Exp $
  11
  12 ;; This file is part of XWEM.
  13
  14 ;; XWEM is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  21 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  22 ;; License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  26 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  27 ;; 02111-1307, USA.
  28
  29 ;;; Synched up with: Not in FSF
  30
  31 ;;; Commentary:
  32 ;;
  33 ;; `xwem-global-map' is normal keymap used by xwem.
  34 ;;
  35 ;; Set `xwem-keyboard-echo-keystrokes' to t if you want echoing of
  36 ;; incomplete commands in echo area.
  37
  38 ;;; Code:
  39 \f
  40 (require 'xlib-xlib)
  41 (require 'xlib-xtest)
  42 (require 'xlib-keysymdb)
  43
  44 (require 'xwem-load)
  45 (require 'xwem-misc)
  46
  47 ;;{{{ [-] Custamizable xwem-keyboard group
  48
  49 ;;; Customize variables
  50 (defgroup xwem-keyboard nil
  51   "Group to customize keyboard in XWEM."
  52   :prefix "xwem-"
  53   :group 'xwem)
  54
  55 ;;;###autoload
  56 (defcustom xwem-pre-command-hook nil
  57   "*Hooks to run just before executing command.
  58 This may examine `xwem-this-command' variable to find out which
  59 command is about to be run, or may change it to cause a different
  60 command to run."
  61   :type 'hook
  62   :group 'xwem-keyboard
  63   :group 'xwem-hooks)
  64
  65 ;;;###autoload
  66 (defcustom xwem-post-command-hook nil
  67   "*Hooks to run after command execution."
  68   :type 'hook
  69   :group 'xwem-keyboard
  70   :group 'xwem-hooks)
  71
  72 ;;;###autoload
  73 (defcustom xwem-keyboard-echo-keystrokes 1
  74   "*If non-nil than echo unfinished commands in echo area after this many seconds of pause."
  75   :type 'number
  76   :group 'xwem-keyboard)
  77
  78 (defcustom xwem-hyper-modifier 'hyper
  79   "*This is a little trick of how ``H'' interpretted in `xwem-kbd' specification."
  80   :type '(choice (const :tag "Meta" meta)
  81                  (const :tag "Control" control)
  82                  (const :tag "Super" super)
  83                  (const :tag "Hyper" hyper)
  84                  (const :tag "Alt" alt))
  85   :group 'xwem-keyboard)
  86
  87 (defcustom xwem-meta-modifier 'meta
  88   "*This is a little trick of how ``M'' interpretted in `xwem-kbd' specification."
  89   :type '(choice (const :tag "Meta" meta)
  90                  (const :tag "Control" control)
  91                  (const :tag "Super" super)
  92                  (const :tag "Hyper" hyper)
  93                  (const :tag "Alt" alt))
  94   :group 'xwem-keyboard)
  95
  96 (defcustom xwem-control-modifier 'control
  97   "*This is a little trick of how ``C'' interpretted in `xwem-kbd'."
  98   :type '(choice (const :tag "Meta" meta)
  99                  (const :tag "Control" control)
 100                  (const :tag "Super" super)
 101                  (const :tag "Hyper" hyper)
 102                  (const :tag "Alt" alt))
 103   :group 'xwem-keyboard)
 104
 105 (defcustom xwem-kbd-evillocks (list XK-NumLock XK-Caps-Lock)
 106   "List of evil locks."
 107   :type `(repeat (choice (const :tag "NumLock" ,XK-NumLock)
 108                          (const :tag "CapsLock" ,XK-Caps-Lock)
 109                          ;; TODO: add others .. which?
 110                          ))
 111   :group 'xwem-keyboard)
 112
 113 (defvar xwem-kbd-evilmasks (list 0)
 114   "List of evil masks.
 115 Internal variable, DO NOT MODIFY.")
 116
 117 ;;;###autoload
 118 (defcustom xwem-quit-key [(hyper ?g)]
 119   "Quit command key."
 120   :type 'sexp
 121   :group 'xwem-keyboard)
 122
 123 ;;;###autoload
 124 (defcustom xwem-quit-command 'xwem-keyboard-quit
 125   "Default command to be called when `xwem-quit-key' pressed."
 126   :type 'function
 127   :group 'xwem-keyboard)
 128
 129 ;;;###autoload
 130 (defcustom xwem-help-key [(hyper ?h)]
 131   "Help command key."
 132   :type 'sexp
 133   :group 'xwem-keyboard)
 134
 135 ;;;###autoload
 136 (defcustom xwem-prefix-help-command 'xwem-describe-prefix-bindings
 137   "Default command to be called when `xwem-help-key' pressed."
 138   :type 'function
 139   :group 'xwem-keys)
 140
 141 ;;;###autoload
 142 (defcustom xwem-universal-key [(hyper ?u)]
 143   "Key for universal argument commands."
 144   :type 'sexp
 145   :group 'xwem-keyboard)
 146
 147 ;;;###autoload
 148 (defcustom xwem-kbd-quit-hook nil
 149   "*Hooks to be runned when KBD exits.
 150 Runned only on \\<xwem-global-map>\\[xwem-kbd-quit], but not on
 151 \\<xwem-global-map>\\[xwem-keyboard-quit]."
 152   :type 'hook
 153   :group 'xwem-keyboard
 154   :group 'xwem-hooks)
 155
 156 ;;;###autoload
 157 (defcustom xwem-keyboard-init-hook nil
 158   "*Hooks called after xwem keyboard initialization."
 159   :type 'hook
 160   :group 'xwem-keyboard
 161   :group 'xwem-hooks)
 162
 163 (defcustom xwem-keyboard-use-synth-events nil
 164   "*Non-nil mean use XSendEvent instead of XTEST's FakeInput.
 165 Useful to set it to non-nil when using sticky modifiers or in any
 166 other case when xwem can't properly force modifiers releasing.
 167 However if having `xwem-keyboard-use-synth-events' to non-nil, make
 168 sure you've configured clients to accept synthetic X events (f.i. set
 169 `x-allow-sendevents' to non-nil to make XEmacs accept synthetic
 170 events).
 171 This is client local variable.  Each client have its own value for it."
 172   :type 'boolean
 173   :group 'xwem-keyboard)
 174 (xwem-make-variable-client-local 'xwem-keyboard-use-synth-events)
 175
 176 ;;; Internal variables
 177
 178 ;;;###autoload
 179 (defvar xwem-override-map nil
 180   "Keymap that overrides all other keymaps.
 181 And did not considered as global map.  You should control end of
 182 command execution for yourself if using it.
 183 You should *bind* this, not set it.")
 184
 185 ;;;###autoload
 186 (defvar xwem-override-local-map nil
 187   "Keymap that overrides all local keymaps.
 188 You should *bind* it, not set it.
 189 Normally you should use `xwem-overriding-local-map' function.")
 190
 191 (defvar xwem-override-global-map nil
 192   "Keymap that is lookuped straight after local map.
 193 You should *bind* it, not set it.")
 194
 195 ;;;###autoload
 196 (defvar xwem-kbd-now-grabbing nil
 197   "Non-nil indicates that we now grabbing keyboard.
 198 Internal variable, do not modify.")
 199
 200 (defvar xwem-xkeys-mapping nil
 201   "X KeyMapping fetched from X server.
 202 Internal variable, do not modify.")
 203
 204 (defvar xwem-xmods-mapping nil
 205   "List of keycodes for modifiers.
 206 Corresponds to Shift, Lock,Control, Mod1, Mod2, Mod3, Mod4, and Mod5, in order.
 207 INTERNAL VARIABLE, do not modify.")
 208
 209 ;;;###xwem-autoload
 210 (defvar xwem-event-client nil "Client where last key/mouse event occured.")
 211 ;;;###xwem-autoload
 212 (defvar xwem-last-event nil "Last key/mouse event(Emacs event).")
 213 ;;;###xwem-autoload
 214 (defvar xwem-last-xevent nil "Last key/mouse X Event.")
 215 ;;;###xwem-autoload
 216 (defvar xwem-this-command-keys []
 217   "Vector of events that were used to invoke this command.")
 218 ;;;###xwem-autoload
 219 (defvar xwem-this-command nil "The command now being executed.")
 220 ;;;###xwem-autoload
 221 (defvar xwem-last-command nil "The last command executed.")
 222
 223 ;; Private variables
 224 (defvar xwem-kbd-private-prefix-map nil
 225   "Private variable holds prefix keymap or symbol that holds keymap.
 226 Internal variable, do not modify.")
 227
 228 (defvar xwem-kbd-last-prefix-map nil "Last value of `xwem-kbd-private-prefix-map'.")
 229
 230 ;; Special modes for reading key or keysequence
 231 (defvar xwem-kbd-reading-key nil
 232   "Non-nil mean we are reading for key.
 233 Actually references symbol to which save readed key.
 234 Internal variable, do not modify.")
 235
 236 (defvar xwem-kbd-reading-keyseq nil
 237  "Non-nil mean we are reading key sequence.
 238 Actually references symbol to which save readed key sequence.
 239 Internal variable, do not modify.")
 240
 241 ;;}}}
 242
 243 \f
 244 ;;{{{ [-] Defining new key
 245
 246 ;;;###autoload
 247 (defun xwem-define-key (win keymap key command &optional pgrab-mode kgrab-mode)
 248   "Add KEY to KEYMAP to execute COMMAND and grab KEY on WIN.
 249 When command is `nil', then undefine KEY in KEYMAP and ungrab KEY.
 250
 251 PGRAB-MODE and KGRAB-MODE specifies grabbing mode for pointer and
 252 keyboard respectively."
 253   (define-key keymap key command)
 254   (xwem-kbd-graugra-key key win (if command 'grab 'ungrab) nil pgrab-mode kgrab-mode))
 255
 256 ;;;###autoload
 257 (defun xwem-global-set-key (key command)
 258   "Define KEY to call COMMAND, when xwem is already run.
 259 If command is `nil' then undefine KEY in `xwem-global-map' and ungrab KEY."
 260   (define-key xwem-global-map key command)
 261   (mapc #'(lambda (cl)
 262             (xwem-kbd-graugra-key key (xwem-cl-xwin cl) (if command 'grab 'ungrab)))
 263         (xwem-clients-list))
 264   nil)
 265
 266 ;;}}}
 267
 268 ;;{{{ [-] Reading key and keysequence
 269
 270 (defvar xwem-saved-this-command-keys nil
 271   "Saved value of `xwem-this-command-keys'.")
 272
 273 ;;;###autoload
 274 (defun xwem-kbd (spec)
 275   "Just like `kbd' but take into account values of `xwem-hyper-modifier' and `xwem-meta-modifier'."
 276   (let ((keys (key-sequence-list-description (kbd spec))))
 277     (mapvector #'(lambda (key)
 278                    (let ((rkey (last key))
 279                          (rmods (butlast key)))
 280                      (when (member 'meta key)
 281                        (setq rmods (delete 'meta rmods))
 282                        (setq rkey (cons xwem-meta-modifier rkey)))
 283                      (when (member 'hyper key)
 284                        (setq rmods (delete 'hyper rmods))
 285                        (setq rkey (cons xwem-hyper-modifier rkey)))
 286                      (when (member 'control key)
 287                        (setq rmods (delete 'control rmods))
 288                        (setq rkey (cons xwem-control-modifier rkey)))
 289
 290                      (when rmods
 291                        (setq rkey (nconc rmods rkey)))
 292                      rkey))
 293                keys)))
 294
 295 (defun xwem-read-keys-start (keyseq-p keyvar)
 296   "Start reading key or key sequence.
 297 KEYSEQ-P is non-nil when staring reading key sequence.
 298 KEYVAR is place where to store readed key or key sequence."
 299   (xwem-kbd-start-grabbing)
 300
 301   (setq xwem-saved-this-command-keys xwem-this-command-keys)
 302   (setq xwem-this-command-keys [])
 303   (if keyseq-p
 304       (setq xwem-kbd-reading-keyseq keyvar)
 305     (setq xwem-kbd-reading-key keyvar))
 306
 307   (xwem-recursive-edit))
 308
 309 (defun xwem-read-keys-stop (keyseq-p)
 310   "Stop reading key or key sequence.
 311 If KEYSEQ-P is non-nil than stop reading key sequence."
 312   (set (if keyseq-p xwem-kbd-reading-keyseq xwem-kbd-reading-key)
 313        xwem-this-command-keys)
 314   (if keyseq-p
 315     (setq xwem-kbd-reading-keyseq nil)
 316     (setq xwem-kbd-reading-key nil))
 317
 318   (xwem-kbd-set-current-prefix-keymap nil)
 319   (setq xwem-this-command-keys xwem-saved-this-command-keys)
 320
 321   (xwem-exit-recursive-edit))
 322
 323 ;; Read key, install active grab
 324 ;;;###autoload
 325 (defun xwem-read-key (&optional prompt no-minib-focus-p)
 326   "Read single key press, prompting PROMPT in `xwem-minibuffer'.
 327 If NO-MINIB-FOCUS-P is non-nil, focus `xwem-minibuffer' while reading."
 328   (car (if no-minib-focus-p
 329            (xwem-next-command-event prompt)
 330          (xwem-under-minibuffer
 331           (xwem-next-command-event prompt)))))
 332
 333 (defun xwem-read-key-sequence-1 (&optional continue-echo)
 334   (xwem-kbd-stop-command-keys-echoing)
 335   (let ((xwem-kbd-reading-keyseq t)
 336         (done nil)
 337         xev eev eevs bind)
 338     (while (not done)
 339       (setq xev (xwem-next-event))
 340       (when (setq eev (xwem-xevents->emacs-events (list xev) t))
 341         (setq xwem-last-xevent xev
 342 ;              xwem-event-client (xwem-event-client xev)
 343               xwem-last-event (car eev)
 344               xwem-this-command-keys (vconcat xwem-this-command-keys eev)
 345               eevs (vconcat eevs eev)
 346               bind (xwem-kbd-fixup-keymap (xwem-lookup-key xwem-event-client (events-to-keys eevs) t)))
 347         (xwem-kbd-schedule-command-keys-echoing)
 348         (unless (keymapp bind)
 349           (xwem-kbd-stop-command-keys-echoing)
 350           (setq done t))))
 351     eevs))
 352
 353 ;; Read keysequence which binds to command
 354 ;;;###autoload
 355 (defun xwem-read-key-sequence (&optional prompt no-minib-focus-p)
 356   "Read key sequence that call command prompting PROMPT."
 357   (when prompt
 358     (xwem-message 'prompt prompt))
 359
 360   (let ((keys (if no-minib-focus-p
 361                   (xwem-read-key-sequence-1)
 362                 (xwem-under-minibuffer
 363                  (xwem-read-key-sequence-1)))))
 364     (when prompt
 365       (xwem-clear-message))
 366     keys))
 367
 368 ;;}}}
 369
 370 ;;{{{ [-] local keymap
 371
 372 ;;;###autoload
 373 (defun xwem-local-map (cl)
 374   "Return CL's local keymap."
 375   (when (xwem-cl-p cl)
 376     (xwem-kbd-fixup-keymap (xwem-client-property cl 'xwem-local-keymap))))
 377 (defsetf xwem-local-map (cl) (keymap)
 378   "Set CL's local keymap to KEYMAP."
 379   `(let ((nkeymap (xwem-kbd-fixup-keymap ,keymap))
 380          (okeymap (xwem-local-map ,cl)))
 381      (when (keymapp okeymap)
 382        (xwem-focus-mode-invoke ,cl 'before-keymap-change)
 383        ;; But avoid ungrabbing keymaps!  Because it can use prefix
 384        ;; keymap of some other command.
 385        (xwem-kbd-uninstall-grab okeymap (xwem-cl-xwin ,cl)
 386                                 #'(lambda (key def)
 387                                     (not (keymapp (xwem-kbd-fixup-keymap def))))))
 388
 389      ;; Install new keymap
 390      (xwem-client-set-property ,cl 'xwem-local-keymap nkeymap)
 391      (when (keymapp nkeymap)
 392        (xwem-kbd-install-grab nkeymap (xwem-cl-xwin ,cl))
 393        (xwem-focus-mode-invoke ,cl 'after-keymap-change))))
 394
 395 ;;;###autoload
 396 (defun xwem-local-set-key (key command &optional cl pgrab-mode kgrab-mode)
 397   "Set KEY to call COMMAND in CL's local keymap.
 398 If COMMAND is `nil' then undefine KEY in CL's local map and ungrab KEY.
 399 If CL is ommited `xwem-cl-selected' assumed."
 400   (unless cl
 401     (setq cl (xwem-cl-selected)))
 402
 403   ;; Create new local keymap for client if needed
 404   (unless (keymapp (xwem-local-map cl))
 405     (setf (xwem-local-map cl) (make-sparse-keymap)))
 406
 407   (xwem-define-key (xwem-cl-xwin cl) (xwem-local-map cl) key command pgrab-mode kgrab-mode))
 408
 409 ;;;###xwem-autoload
 410 (defun xwem-use-local-map (keymap &optional cl)
 411   "Select KEYMAP as  local CL's keymap."
 412   (unless cl
 413     (setq cl (xwem-cl-selected)))
 414
 415   (setf (xwem-local-map cl) keymap))
 416
 417 ;;}}}
 418
 419 ;;{{{ [-] Undefined command processing
 420
 421 ;;;###autoload(autoload 'xwem-undefined-command "xwem-keyboard" "" t)
 422 (define-xwem-command xwem-undefined-command ()
 423   "Called when key is not binded."
 424   (xwem-interactive)
 425   (signal 'undefined-keystroke-sequence xwem-this-command-keys))
 426
 427 ;;;###autoload(autoload 'xwem-self-insert-or-undefined "xwem-keyboard" "" t)
 428 (define-xwem-command xwem-self-insert-or-undefined (arg)
 429   "Self insert or undefined command.
 430 Prefix ARG specifies how many characters to insert."
 431   (xwem-interactive "*_P")
 432
 433   (let ((self-insert-p nil))
 434     (cond ((and (> (length xwem-this-command-keys) 1)
 435                 (eq (aref xwem-this-command-keys 0) 'self-insert))
 436            ;; Adjust xwem-this-command-keys by removing leading 'self-insert
 437            (setq xwem-this-command-keys
 438                  (vconcat (cdr (append xwem-this-command-keys nil))))
 439            (setq self-insert-p t))
 440
 441           ((= (length xwem-this-command-keys) 1)
 442            (setq self-insert-p t)))
 443
 444     (if (not self-insert-p)
 445         (error 'xwem-error (format "%s is undefined"
 446                                    (key-description xwem-this-command-keys)))
 447
 448       ;; Self insert command allowed only for normal clients to avoid
 449       ;; infinite loops.
 450       (unless (xwem-dummy-client-p (xwem-cl-selected))
 451         (xwem-kbd-add-pending-keys
 452          (apply 'vconcat (make-list (prefix-numeric-value arg) xwem-this-command-keys))
 453          (xwem-cl-selected))))))
 454
 455 ;;}}}
 456
 457 ;;{{{ [-] Quiting keyboarding
 458
 459 ;;;###autoload(autoload 'xwem-keyboard-quit "xwem-keyboard" "" t)
 460 (define-xwem-command xwem-keyboard-quit ()
 461   "Send quit signal."
 462   (xwem-interactive)
 463
 464   (setq xwem-override-map nil)
 465   (signal 'quit '(xwem))
 466
 467   ;; NOT REACHED
 468   (xwem-message 'error "quit."))
 469
 470 ;;;###autoload(autoload 'xwem-kbd-quit "xwem-keyboard" "" t)
 471 (define-xwem-command xwem-kbd-quit ()
 472   "Quit from keyboard haldling."
 473   (xwem-interactive)
 474
 475   (xwem-kbd-stop-grabbing)
 476   (setq xwem-kbd-private-prefix-map nil)
 477   (XSetInputFocus (xwem-dpy) X-PointerRoot X-RevertToPointerRoot X-CurrentTime)
 478   (xwem-message 'note "[kbd-quit] InputFocus set PointerRoot")
 479
 480   (run-hooks 'xwem-kbd-quit-hook))
 481
 482 ;;}}}
 483
 484 ;;{{{ [-] Converters
 485
 486 ;; Convertors
 487 (defun xwem-kbd-xksym->emacs (ksym)
 488   "Convert KSYM to Emacs key symbol."
 489   (cond
 490    ;; ksym is list for buttons
 491    ((listp ksym)
 492     (let ((kval (car ksym)))
 493       (cond ((= kval 1) 'button1)
 494             ((= kval 2) 'button2)
 495             ((= kval 3) 'button3)
 496             ((= kval 4) 'button4)
 497             ((= kval 5) 'button5)
 498             (t nil))))                  ;can't be!!!
 499
 500    ((= ksym XK-BackSpace) 'backspace)
 501    ((= ksym XK-Tab) 'tab)
 502    ((= ksym XK-Linefeed) 'linefeed)
 503    ((= ksym XK-Return) 'return)
 504    ((= ksym XK-Escape) 'escape)
 505    ((= ksym XK-Delete) 'delete)
 506
 507    ((= ksym XK-Home) 'home)
 508    ((= ksym XK-End) 'end)
 509    ((= ksym XK-Left) 'left)
 510    ((= ksym XK-Right) 'right)
 511    ((= ksym XK-Up) 'up)
 512    ((= ksym XK-Down) 'down)
 513
 514    ((= ksym XK-Insert) 'insert)
 515    ((= ksym XK-Pause) 'pause)
 516    ((= ksym XK-Space) 'space)
 517
 518    ((= ksym XK-Next) 'next)
 519    ((= ksym XK-Prior) 'prior)
 520    ;; TODO: add more
 521
 522    ((= ksym XK-F1) 'f1)
 523    ((= ksym XK-F2) 'f2)
 524    ((= ksym XK-F3) 'f3)
 525    ((= ksym XK-F4) 'f4)
 526    ((= ksym XK-F5) 'f5)
 527    ((= ksym XK-F6) 'f6)
 528    ((= ksym XK-F7) 'f7)
 529    ((= ksym XK-F8) 'f8)
 530    ((= ksym XK-F9) 'f9)
 531    ((= ksym XK-F10) 'f10)
 532    ((= ksym XK-F11) 'f11)
 533    ((= ksym XK-F12) 'f12)
 534
 535    ((= ksym 0) nil)
 536
 537    (t (or (X-XKeysymDB-keysym->sym ksym)
 538           (XCharacter ksym))))) ;nil or proper character
 539
 540 (defun xwem-kbd-emacs->xksym (ksym)
 541   "Convert back from Emacs key symbol KSYM to proper X key symbol."
 542   (cond ((null ksym) 0)                 ;hmm
 543
 544         ((symbolp ksym)
 545          (let ((osymname (symbol-name ksym))
 546                (symname (downcase (symbol-name ksym))))
 547            (cond ((string= symname "backspace") XK-BackSpace)
 548                  ((string= symname "tab") XK-Tab)
 549                  ((string= symname "linefeed") XK-Return) ;XXX
 550                  ((string= symname "linefeed") XK-Linefeed)
 551                  ((string= symname "return") XK-Return)
 552                  ((string= symname "escape") XK-Escape)
 553                  ((string= symname "delete") XK-Delete)
 554                  ((string= symname "space") XK-Space)
 555
 556                  ((string= symname "home") XK-Home)
 557                  ((string= symname "end") XK-End)
 558                  ((string= symname "left") XK-Left)
 559                  ((string= symname "right") XK-Right)
 560                  ((string= symname "up") XK-Up)
 561                  ((string= symname "down") XK-Down)
 562
 563                  ((string= symname "insert") XK-Insert)
 564                  ((string= symname "pause") XK-Pause)
 565
 566                  ((string= symname "next") XK-Next)
 567                  ((string= symname "prior") XK-Prior)
 568
 569                  ;; Mouse buttons
 570                  ((string= symname "button1") (list X-XButton1))
 571                  ((string= symname "button2") (list X-XButton2))
 572                  ((string= symname "button3") (list X-XButton3))
 573                  ((string= symname "button4") (list X-XButton4))
 574                  ((string= symname "button5") (list X-XButton5))
 575
 576                  ;; Functional keys
 577                  ((string-match "^[fF]\\([0-9]+\\)$" symname)
 578                   (symbol-value
 579                    (intern
 580                     (concat "XK-F"
 581                             (substring symname (match-beginning 1)
 582                                        (match-end 1))))))
 583
 584                  (t (or (X-XKeysymDB-sym->keysym ksym)
 585          (Xforcenum (string-to-char osymname)))))))
 586
 587         ((characterp ksym) (Xforcenum ksym)) ;Should not be there
 588
 589         (t 0)))                         ;HMM!
 590
 591 (defun xwem-kbd-emods->xmodmask (emods)
 592   "Convert Emacs modifiers list EMODS to X modifers mask."
 593   (apply 'Xmask-or 0 (mapcar #'(lambda (mod)
 594                                  (or (get mod 'x-mod-mask) 0))
 595                              emods)))
 596
 597 (defun xwem-kbd-xmodmask->emods (mmask)
 598   "Convert X modifiers mask MMASK to Emacs modifiers list."
 599   (delq nil (mapcar #'(lambda (mod)
 600                         (and (Xtest mmask (or (get mod 'x-mod-mask) 0))
 601                              mod))
 602                     '(shift control alt meta hyper super))))
 603
 604 ;; keysyms and keycodes converters
 605 (defun xwem-kbd-xksym->xkcode (ksym)
 606   "Convert keysym KSYM to keycode.
 607 Convert keysym to cons cell where car is keycode and cdr is modifiers
 608 list, using `xwem-xkeys-mapping' list.
 609 NOTE: only 'shift modifier supported."
 610   (let* ((kcode (X-Dpy-min-keycode (xwem-dpy)))
 611          (kslist (car (last xwem-xkeys-mapping)))
 612          (ksyms-per-kcode (length (car kslist)))
 613          (ksym-off 0)
 614          (kmods nil))
 615     (while kslist
 616       (cond ((= ksym (nth ksym-off (car kslist)))
 617              (setq kslist nil))
 618             ((= ksym (nth (1+ ksym-off) (car kslist)))
 619              (setq kslist nil
 620                    kmods (cons 'shift kmods)))
 621             (t (setq kslist (cdr kslist)
 622                      kcode (1+ kcode))
 623                (when (and (null kslist)
 624                           (setq ksym-off (+ 2 ksym-off))
 625                           (< ksym-off ksyms-per-kcode))
 626                  (setq kslist (car (last xwem-xkeys-mapping))
 627                        kcode (X-Dpy-min-keycode (xwem-dpy)))))))
 628     (cons kcode kmods)))
 629
 630 (defun xwem-kbd-xkcode->xksym (kcode)
 631   "Convert key code KCODE to keysym.
 632 KeyCode -> KeySyms list in form (base shift caps ShiftCaps)."
 633   (nth (- kcode (X-Dpy-min-keycode (xwem-dpy))) (car (last xwem-xkeys-mapping)))
 634   )
 635
 636 ;;; Various subroutines
 637 (defun xwem-kbd-emod->kcode (emod &optional any)
 638   "Convert Emacs modifier EMOD to X keycode.
 639 Behaviour is undefined If ANY argument is supplied.
 640 DO NOT RELY ON THIS FUNCTION."
 641   (funcall (if any 'identity 'car) (get emod 'x-key-codes)))
 642
 643 (defun xwem-kbd-kcode->emod (kcode)
 644   "Convert key code KCODE to Emacs modifier, if KCODE is actually a modifier.
 645 See also `xwem-kbd-kcode-modifier-p'."
 646   (let ((emods '(shift control alt meta super hyper)))
 647     (while (and emods (not (member kcode (get (car emods) 'x-key-codes))))
 648       (setq emods (cdr emods)))
 649     (car emods)))
 650
 651 ;;;###xwem-autoload
 652 (defun xwem-kbd-kcode-modifier-p (kcode)
 653   "Return non-nil if key code KCODE is modifier."
 654   (member kcode (apply 'append xwem-xmods-mapping)))
 655
 656 (defun xwem-kbd-adjust-keycode (keycode modifiers)
 657   "Convert KEYCODE to keysym according to MODIFIERS."
 658   ;; XXX only 'shift modifier supported
 659   (if (and (member 'shift modifiers)
 660            (> (cadr (xwem-kbd-xkcode->xksym keycode)) 0))
 661       (cadr (xwem-kbd-xkcode->xksym keycode))
 662
 663     (car (xwem-kbd-xkcode->xksym keycode))))
 664
 665 (defun xwem-kbd-adjust-modifiers (keycode modifiers)
 666   "According to KEYCODE adjust MODIFIERS, i.e. remove 'shift."
 667   (if (and (member 'shift modifiers)
 668            keycode (> (cadr (xwem-kbd-xkcode->xksym keycode)) 0))
 669       ;; 'shift in modifiers and keysym is valid, so we remove 'shift
 670       (remove 'shift modifiers)
 671
 672     modifiers))
 673
 674 (defun xwem-kbd-hack-mouse (xev)
 675   "Return (X . Y) to be used in mouse Emacs event."
 676   (let ((cl (xwem-misc-find-cl-by-emacs-frame (last-nonminibuf-frame)))
 677         xpnt x y)
 678
 679     (if (member (X-Event-type xev) (list X-ButtonPress X-ButtonRelease))
 680         (setq x (X-Event-xbutton-root-x xev)
 681               y (X-Event-xbutton-root-y xev))
 682       (setq x (X-Event-xmotion-root-x xev)
 683             y (X-Event-xmotion-root-y xev)))
 684
 685     (when cl
 686       (setq xpnt (car (XTranslateCoordinates (xwem-dpy) (xwem-cl-xwin cl) (xwem-rootwin) 0 0))))
 687
 688     (when xpnt
 689       (setq x (- x (X-Point-x xpnt)))
 690       (setq y (- y (X-Point-y xpnt))))
 691     (cons x y)))
 692
 693 ;;;###xwem-autoload
 694 (defun xwem-xevents->emacs-events (xevs &optional trust-modbits)
 695   "Convert X-Events XEVS to Emacs events.
 696
 697 If TRUST-MODBITS is non-nil than we can trust modifier bits in
 698 X-Event, otherwise we are trying to keep track of modifiers presses
 699 and releases.  This is needed because core X events obtained from
 700 RECORD extension does not have valid inforamtion about modifiers
 701 bits."
 702
 703   ;; NOTE: events garbbed using RECORD extension does not have correct
 704   ;; state field.
 705   (let ((rxevs (cond ((listp xevs) (vconcat xevs))
 706                      ((vectorp xevs) xevs)
 707                      (t xevs)))
 708         eevs xevtype kcode mbutton current-modifiers)
 709
 710     ;; TODO:
 711     ;;   - Change `mapcar' to `mapvector'
 712     (setq eevs
 713           (mapcar #'(lambda (xev)
 714                       (setq xevtype (X-Event-type xev))
 715
 716                       (unless (member xevtype (list X-KeyPress X-KeyRelease X-ButtonPress X-ButtonRelease X-MotionNotify))
 717                         (error 'xwem-error "Invalid event type: %s" (X-Event-name xev)))
 718
 719                       (setq kcode nil
 720                             mbutton nil)
 721                       (cond ((member xevtype (list X-KeyPress X-KeyRelease))
 722                              (setq kcode (X-Event-xkey-keycode xev)))
 723                             ((member xevtype (list X-ButtonPress X-ButtonRelease))
 724                              (setq mbutton (X-Event-xbutton-button xev))))
 725
 726                       (if (xwem-kbd-kcode-modifier-p kcode)
 727                           ;; KCODE is actually modifier
 728                           (if (= (X-Event-type xev) X-KeyPress)
 729                               (setq current-modifiers (cons (xwem-kbd-kcode->emod kcode) current-modifiers))
 730                             (setq current-modifiers (delete (xwem-kbd-kcode->emod kcode) current-modifiers)))
 731
 732                         ;; Skip normal key realese events
 733                         (unless (eq xevtype X-KeyRelease)
 734
 735                           ;; If we can trust modifier bits, get information about
 736                           ;; modifiers currently pressed from state field.
 737                           (when trust-modbits
 738                             (setq current-modifiers
 739                                   (xwem-kbd-xmodmask->emods
 740                                    (cond ((eq xevtype X-KeyPress) (X-Event-xkey-state xev))
 741                                          ((member xevtype (list X-ButtonPress X-ButtonRelease))
 742                                           (X-Event-xbutton-state xev))
 743                                          ((eq xevtype X-MotionNotify) (X-Event-xmotion-state xev))))))
 744
 745                           (make-event (cond ((eq xevtype X-KeyPress) 'key-press)
 746                                             ((eq xevtype X-ButtonPress) 'button-press)
 747                                             ((eq xevtype X-ButtonRelease) 'button-release)
 748                                             ((eq xevtype X-MotionNotify) 'motion)
 749                                             (t (error 'xwem-error "Unknown event: %s" (X-Event-name xev))))
 750                                       (nconc (when (member xevtype (list X-ButtonPress X-ButtonRelease X-MotionNotify))
 751                                                (let ((xm (xwem-kbd-hack-mouse xev)))
 752                                                  (list 'x (car xm) 'y (cdr xm))))
 753                                              (list 'modifiers (xwem-kbd-adjust-modifiers kcode current-modifiers))
 754                                              (when (eq xevtype X-KeyPress)
 755                                                (list 'key (xwem-kbd-xksym->emacs
 756                                                            (xwem-kbd-adjust-keycode kcode current-modifiers))))
 757                                              (when (member xevtype (list X-ButtonPress X-ButtonRelease))
 758                                                (list 'button mbutton)))))))
 759                   rxevs))
 760
 761     ;; Remove non-events from list
 762     (delete* nil eevs :test #'(lambda (el1 el2) (not (eventp el2))))
 763     ))
 764
 765 (defun xwem-kbd-emacs-events->xevents (events)
 766   "Convert Emacs EVENTS list to X events list."
 767   )
 768
 769 (defun xwem-kbd-ekeys->eevents (ekeys)
 770   "Convert Emacs keys sequence EKEYS to Emacs events vector."
 771   (mapvector #'(lambda (key)
 772                  (let (mods keychar)
 773
 774                    (if (listp key)
 775                        (progn
 776                          (setq keychar (car (last key)))
 777                          (setq mods (butlast key)))
 778                      (setq keychar key))
 779
 780                    (make-event 'key-press (list 'modifiers mods
 781                                                 'key keychar))))
 782              ekeys))
 783
 784 ;;}}}
 785
 786 ;;{{{ [-] Sending
 787
 788 ;; Sending (using XTEST)
 789 (defun xwem-key-send-xtest-internal (&optional keycode-seq)
 790   "Emulate key presses/releases of KEYCODE-SEQ sequence using XTEST extension."
 791   (mapc #'(lambda (ksel)
 792             (let ((ktype (car ksel))
 793                   (kcode nil)
 794                   (ktime nil))
 795               (cond ((vectorp (cdr ksel))
 796                      (setq kcode (aref (cdr ksel) 0))
 797                      (setq ktime (aref (cdr ksel) 1)))
 798                     (t (setq kcode (cdr ksel))
 799                        (setq ktime X-CurrentTime)))
 800               (X-XTest-FakeInput (xwem-dpy) ktype kcode X-None 0 0 ktime)))
 801         keycode-seq))
 802
 803 (defun xwem-key-send-xtest (keys)
 804   "Send Emacs key sequence KEYS using XTEST extension."
 805   (let (lseq)
 806     (mapc #'(lambda (key)
 807               (let (mods code)
 808                 (setq mods (mapcar 'xwem-kbd-emod->kcode (butlast key)))
 809
 810                 ;; Now calculade key CODE maybe add shift modifier
 811                 (setq code (xwem-kbd-xksym->xkcode
 812                             (xwem-kbd-emacs->xksym (car (last key)))))
 813                 (setq mods (nconc mods
 814                                   (mapcar 'xwem-kbd-emod->kcode (cdr code))))
 815                 (setq code (car code))
 816
 817                 (mapc #'(lambda (mod)
 818                           (setq lseq (cons (cons X-Xtest-KeyPress mod) lseq)))
 819                       mods)
 820                 (setq lseq (cons (cons X-Xtest-KeyPress code) lseq))
 821                 (setq lseq (cons (cons X-Xtest-KeyRelease code) lseq))
 822                 (mapc #'(lambda (mod)
 823                           (setq lseq (cons (cons X-Xtest-KeyRelease mod) lseq)))
 824                       mods)))
 825           (key-sequence-list-description keys))
 826
 827     (setq lseq (nreverse lseq))
 828     (xwem-key-send-xtest-internal lseq)))
 829
 830 ;; Sending (using XSendEvent)
 831 (defun xwem-key-send-synth (keys &optional client)
 832   "Send synthesize KEYS to CLIENT.
 833 If CLIENT is ommited, selected client is used."
 834   (unless client
 835     (setq client (xwem-cl-selected)))
 836
 837   (when (xwem-cl-alive-p client)
 838     ;; Fix KEYS
 839     (setq keys (key-sequence-list-description keys))
 840
 841     (let (keycode keymods)
 842       (mapc #'(lambda (key)
 843                 (setq keymods (butlast key))
 844                 ;; Now calculade key KEYCODE maybe add shift modifier
 845                 (setq keycode (xwem-kbd-xksym->xkcode
 846                                (xwem-kbd-emacs->xksym (car (last key)))))
 847                 (setq keymods (nconc keymods (cdr keycode)))
 848                 (setq keycode (car keycode))
 849
 850                 (XSendEvent (xwem-dpy) (xwem-cl-xwin client)
 851                             nil XM-KeyPress
 852                             (X-Create-message
 853                              (list [1 X-KeyPress] ;type
 854                                    [1 keycode] ;detail
 855                                    [2 2806] ; XXX seq
 856                                    [4 X-CurrentTime] ; time
 857                                    [4 (X-Win-id (xwem-rootwin))] ; root
 858                                    [4 (X-Win-id (xwem-cl-xwin client))] ; event
 859                                    [4 X-None] ; child
 860                                    [2 0] ; root-x
 861                                    [2 0] ; root-y
 862                                    [2 0] ; event-x
 863                                    [2 0] ; event-y
 864                                    [2 (xwem-kbd-emods->xmodmask keymods)] ; state
 865                                    [1 t] ; same-screen
 866                                    [1 nil]))))
 867             keys))))
 868
 869 ;;;###xwem-autoload
 870 (defun xwem-kbd-wait-key-release (keycode)
 871   "Wait for key with KEYCODE for release."
 872   (unless (xwem-keymacro-executing-p)
 873     ;; Now wait key release event
 874     (XNextEvent (xwem-dpy) nil
 875                 #'(lambda (xev)
 876                     (and (= (X-Event-type xev) X-KeyRelease)
 877                          (= (X-Event-xkey-keycode xev) keycode))))))
 878
 879 ;;;###xwem-autoload
 880 (defun xwem-kbd-force-mods-release (&optional mods)
 881   "Force release of MODS modifiers."
 882   (unless xwem-keyboard-use-synth-events
 883     ;; Only needed when using XSendEvent for emulating keys
 884     (xwem-key-send-xtest-internal
 885      (mapcar #'(lambda (el) (cons X-Xtest-KeyRelease el))
 886              (apply 'append
 887                     (mapcar #'(lambda (mod)
 888                                 (get mod 'x-key-codes))
 889                             (or mods '(shift control meta super hyper))))))
 890     (XFlush (xwem-dpy))))
 891
 892 (defun xwem-kbd-wait-button-release (button)
 893   "Wait for BUTTON for release."
 894   )
 895
 896 (define-xwem-deffered xwem-cl-apply-pending-keys (cl)
 897   "Apply pending keys to CL."
 898   (when (and (xwem-cl-alive-p cl)
 899              (xwem-cl-get-sys-prop cl 'pending-keys))
 900     (if (xwem-client-local-variable-value cl 'xwem-keyboard-use-synth-events)
 901         ;; Using XSendEvent
 902         (xwem-key-send-synth (xwem-cl-get-sys-prop cl 'pending-keys) cl)
 903
 904       ;; Using XTEST
 905       (let ((xattr (XGetWindowAttributes (xwem-dpy) (xwem-cl-xwin cl)))
 906             qt)
 907         (unless (= (X-Attr-mapstate xattr) X-Viewable)
 908           (setq qt (XQueryTree (xwem-dpy) (xwem-cl-xwin cl)))
 909           ;; Make CL viewable
 910           (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl)
 911                            (xwem-cl-xwin (xwem-dummy-client)) 0 0)
 912           (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)))
 913
 914         (xwem-focus-push-set (xwem-cl-xwin cl))
 915         (xwem-key-send-xtest (xwem-cl-get-sys-prop cl 'pending-keys))
 916         (xwem-focus-pop-set)
 917         (XFlush (xwem-dpy))
 918
 919         (unless (= (X-Attr-mapstate xattr) X-Viewable)
 920           ;; Restore mapping
 921           (when (= (X-Attr-mapstate xattr) X-Unmapped)
 922             (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)))
 923           ;; Restore parent back to its parent
 924           (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) (nth 3 qt)
 925                            (X-Geom-x (xwem-cl-xgeom cl))
 926                            (X-Geom-y (xwem-cl-xgeom cl))))))
 927
 928     ;; Remove pending keys
 929     (xwem-cl-rem-sys-prop cl 'pending-keys)))
 930
 931 ;;;###xwem-autoload
 932 (defun xwem-kbd-add-pending-keys (keys &optional cl)
 933   "Add KEYS as pending to be pressed in CL.
 934 If CL is ommited selected client considered."
 935   (unless cl
 936     (setq cl (xwem-cl-selected)))
 937   (xwem-cl-put-sys-prop cl 'pending-keys
 938     (vconcat (xwem-cl-get-sys-prop cl 'pending-keys)
 939              keys))
 940   (xwem-cl-apply-pending-keys cl))
 941
 942 ;;}}}
 943
 944 ;;{{{ [-] keypress/KeyRelease processing
 945
 946 ;;;###xwem-autoload
 947 (defun xwem-kbd-add-default-keymap (keymap)
 948   "Add KEYMAP to default keymaps.
 949 KEYMAP MUST NOT HAS PARENTS!"
 950   (unless (memq keymap (keymap-parents xwem-default-parent-map))
 951     (set-keymap-parents xwem-default-parent-map
 952                         (cons keymap (keymap-parents xwem-default-parent-map)))))
 953
 954 \f
 955 ;;; Keys echoing
 956 (defvar xwem-kbd-echoing-keys nil "Non-nil mean we are echoing command keys.")
 957 (defvar xwem-kbd-scheduled-keys [] "Keys scheduled for echoing.")
 958 (defvar xwem-kbd-scheduled-timer nil)
 959
 960 (defun xwem-kbd-echo-command-keys (&optional skip)
 961   "Echo keys."
 962   (xwem-clear-message 'keys-continuator)
 963   ;; Clear echo area if not yet reading, otherwise remove continuator
 964   (if (and (not xwem-kbd-echoing-keys)
 965            (not (eq (current-message-label) 'prompt)))
 966       (xwem-clear-message)
 967     (xwem-clear-message 'keys))
 968   (xwem-message-append 'keys "%s " (key-description xwem-kbd-scheduled-keys))
 969   (unless skip
 970     (xwem-message-append 'keys-continuator "-"))
 971
 972   (setq xwem-kbd-echoing-keys t))
 973
 974 (defun xwem-kbd-echo-keys-timer (&rest not-used)
 975   "Timer to call when there a need to show command keys."
 976   (when (> (length xwem-kbd-scheduled-keys) 0)
 977     (xwem-kbd-echo-command-keys))
 978   (setq xwem-kbd-scheduled-timer nil))
 979
 980 ;;;###xwem-autoload
 981 (defun xwem-kbd-schedule-command-keys-echoing ()
 982   "Schedule echoing pressed KEY in minibuffer."
 983   (when (X-Event-p xwem-last-xevent)
 984     ;; Echo only for events which has corresponding X Event.
 985     (when xwem-kbd-scheduled-timer
 986       (disable-timeout xwem-kbd-scheduled-timer)
 987       (setq xwem-kbd-scheduled-timer nil))
 988     (when (numberp xwem-keyboard-echo-keystrokes)
 989       (setq xwem-kbd-scheduled-keys
 990             (vconcat xwem-kbd-scheduled-keys (list xwem-last-event)))
 991       (if xwem-kbd-echoing-keys
 992           (xwem-kbd-echo-command-keys t)
 993         (xwem-deffered-funcall
 994          #'(lambda ()
 995              (when (numberp xwem-keyboard-echo-keystrokes)
 996                (setq xwem-kbd-scheduled-timer
 997                      (add-timeout xwem-keyboard-echo-keystrokes
 998                                   'xwem-kbd-echo-keys-timer nil)))))))))
 999
1000 ;;;###xwem-autoload
1001 (defun xwem-kbd-stop-command-keys-echoing ()
1002   "Stop echoing."
1003   (when xwem-kbd-scheduled-timer
1004     (disable-timeout xwem-kbd-scheduled-timer)
1005     (setq xwem-kbd-scheduled-timer nil))
1006
1007   (unless xwem-kbd-echoing-keys
1008     (xwem-clear-message 'keys))
1009   (xwem-clear-message 'keys-continuator)
1010
1011   (setq xwem-kbd-scheduled-keys []
1012         xwem-kbd-echoing-keys nil))
1013
1014 ;;;###xwem-autoload
1015 (defun xwem-kbd-fixup-keymap (keymap)
1016   "Return fixed KEYMAP.
1017 KEYMAP might be valid keymap or symbol, which `symbol-function' is keymap.
1018 If KEYMAP can't be fixed, just return it."
1019   (unless (null keymap)
1020     (let (done kmap)
1021       (while (not done)
1022         (condition-case nil
1023             (setq kmap (indirect-function keymap))
1024           (t (setq kmap nil)))
1025         (cond ((keymapp kmap)
1026                (setq done t))
1027
1028               ;; Handle autoload
1029               ((and (symbolp keymap)
1030                     (consp kmap)
1031                     (eq (car kmap) 'autoload)
1032                     (eq (car (cdr (cdr (cdr (cdr kmap))))) 'keymap))
1033                (load (cadr kmap)))
1034
1035               (t (setq done t))))
1036       kmap)))
1037
1038 (defun xwem-kbd-keymap-plist (keymap)
1039   "Return KEYMAP's plist."
1040   (when (and (symbolp keymap)
1041              (keymapp (xwem-kbd-fixup-keymap keymap)))
1042     (symbol-plist keymap)))
1043
1044 ;;;###xwem-autoload
1045 (defun xwem-kbd-current-map ()
1046   "Return current prefix map."
1047   (let ((cm (or xwem-kbd-private-prefix-map
1048                 xwem-override-map
1049                 xwem-override-local-map
1050                 (and (xwem-cl-p xwem-event-client)
1051                      (xwem-local-map xwem-event-client))
1052                 xwem-override-global-map
1053                 xwem-global-map)))
1054     (xwem-kbd-fixup-keymap cm)))
1055
1056 ;;;###xwem-autoload
1057 (defun xwem-kbd-global-map-current-p ()
1058   "Return non-nil if `xwem-global-map' is current prefix map."
1059   (and (not xwem-kbd-private-prefix-map) (not xwem-override-map)))
1060
1061 ;;;###xwem-autoload
1062 (defun xwem-kbd-set-current-prefix-keymap (newkeymap)
1063   "Set current keymap to NEWKEYMAP.
1064
1065 Use (xwem-kbd-set-current-prefix-keymap nil) to set current keymap
1066 to `xwem-global-keymap' instead of
1067 (xwem-kbd-set-current-prefix-keymap xwem-global-map)."
1068   (setq xwem-kbd-private-prefix-map newkeymap))
1069
1070 (defun xwem-kbd-handle-keyrelease (xdpy win xev)
1071   "On XDPY and window WIN handle KeyRelease event XEV."
1072   ;; TODO:
1073   ;;  - modifiers tracker
1074   nil)
1075
1076 ;;;###xwem-autoload
1077 (defun xwem-lookup-map (client keys &optional accept-default)
1078   "Lookup keymap where KEYS command is defined."
1079   (unless client
1080     (setq client (xwem-cl-selected)))
1081
1082   (let (lkmap bind)
1083     (cond ((setq lkmap (or xwem-kbd-private-prefix-map
1084                            xwem-override-map
1085                            xwem-override-local-map))
1086            (and (lookup-key (xwem-kbd-fixup-keymap lkmap) keys accept-default)
1087                 lkmap))
1088
1089           ;; Try local keymap
1090           ((and (setq lkmap (xwem-local-map client))
1091                 (setq bind (lookup-key (xwem-kbd-fixup-keymap lkmap) keys accept-default)))
1092            (and bind lkmap))
1093
1094           ;; Try minor modes keymaps and global keymap
1095           (t (let* ((mm-bind (xwem-minor-mode-key-binding client keys accept-default))
1096                     (mm-km-sym (and mm-bind
1097                                     (cdr (assq (car mm-bind) xwem-minor-mode-map-alist))))
1098                     (mm-km (and mm-km-sym
1099                                 (if (xwem-client-local-variable-p mm-km-sym)
1100                                     (xwem-client-local-variable-value client mm-km-sym)
1101                                   (symbol-value mm-km-sym)))))
1102                ;; If no minor mode keymap, use global map
1103                (or mm-km
1104                    (and (lookup-key (xwem-kbd-fixup-keymap xwem-global-map)
1105                                     keys accept-default)
1106                         xwem-global-map)))))))
1107
1108 ;;;###xwem-autoload
1109 (defun xwem-global-key-binding (cl keys &optional accept-default)
1110   "Return global binding for KEYS."
1111   (lookup-key xwem-global-map keys accept-default))
1112
1113 ;;;###xwem-autoload
1114 (defun xwem-local-key-binding (cl keys &optional accept-default)
1115   "Return local binding for KEYS."
1116   (let ((lkmap (xwem-local-map cl)))
1117     (and (keymapp lkmap)
1118          (lookup-key lkmap keys accept-default))))
1119
1120 ;;;###xwem-autoload
1121 (defun xwem-minor-mode-key-binding (cl keys &optional accept-default)
1122   "Return CL's minor mode binding for KEYS.
1123 Retun cons cell in form `(MODENAME . BINDING)'."
1124   (let ((mlist xwem-minor-mode-map-alist)
1125         (bind nil))
1126     ;; Scan minor modes for binding
1127     (while (and mlist (not bind))
1128       (let ((mode-sym (car (car mlist)))
1129             (km-sym (cdr (car mlist)))
1130             kmap)
1131         (when (if (xwem-client-local-variable-p mode-sym)
1132                   (xwem-client-local-variable-value cl mode-sym)
1133                 (symbol-value mode-sym))
1134           (setq kmap (if (xwem-client-local-variable-p km-sym)
1135                          (xwem-client-local-variable-value cl km-sym)
1136                        (symbol-value km-sym)))
1137           (when (keymapp kmap)
1138             (setq bind (lookup-key kmap keys accept-default)))))
1139       (unless bind
1140         (setq mlist (cdr mlist))))
1141     (when bind
1142       (cons (car (car mlist)) bind))))
1143
1144 ;;;###xwem-autoload
1145 (defun xwem-lookup-key (client keys &optional accept-default)
1146   "In CLIENT's context, lookup for KEYS binding.
1147 `xwem-lookup-key' omits default binding unless ACCEPT-DEFAULT is
1148 non-nil."
1149   (unless client
1150     (setq client (xwem-cl-selected)))
1151
1152   (let (lkmap)
1153     (if (setq lkmap (or (and (= (length keys) 1)
1154                              xwem-kbd-private-prefix-map)
1155                         xwem-override-map
1156                         xwem-override-local-map))
1157         (lookup-key (xwem-kbd-fixup-keymap lkmap) keys accept-default)
1158
1159       ;; Try looking up in next order:
1160       ;;   - Minor modes map
1161       ;;   - Local map
1162       ;;   - Default parent map
1163       ;;   - Global map
1164       (or (cdr (xwem-minor-mode-key-binding client keys accept-default))
1165           (xwem-local-key-binding client keys accept-default)
1166           (xwem-global-key-binding client keys accept-default)))))
1167
1168 ;;;###xwem-autoload
1169 (defun xwem-kbd-get-binding (keys &optional client reject-default)
1170   "Get binding value for KEYS for CLIENT.
1171 By default CLIENT is currently selected client.
1172 If optional REJECT-DEFAULT is non-nil, skip looking up default binding
1173 \(pass `nil' as ACCEPT-DEFAULT to `lookup-key'\)."
1174   (xwem-lookup-key client keys (not reject-default)))
1175
1176 (defun xwem-kbd-fixate-current-lkm (lkm)
1177   "In case LKM is not usable, fixate it.
1178 Return fixated LKM."
1179   (when (null lkm)
1180     (let ((etk (events-to-keys (vector xwem-last-event))))
1181       (cond ((equal etk xwem-help-key)
1182              (setq lkm xwem-prefix-help-command))
1183             ((equal etk xwem-quit-key)
1184              (setq lkm xwem-quit-command))
1185
1186             ;; Last chance in re-lookup command keys
1187             (t (setq lkm (or (xwem-lookup-key xwem-event-client xwem-this-command-keys)
1188                              (xwem-lookup-key xwem-event-client xwem-this-command-keys t)))))))
1189   lkm)
1190
1191 ;;;###xwem-autoload
1192 (defun xwem-kbd-dispatch-binding (lkm)
1193   "Process keymap or command entry LKM after `lookup-key'.
1194 Return non-nil if some action was performed."
1195   ;; Check for special mode, when we just reading single keystroke
1196   (when xwem-kbd-reading-key
1197     (xwem-read-keys-stop nil))
1198
1199   ;; Fixate LKM, if it is bad
1200   (setq lkm (xwem-kbd-fixate-current-lkm lkm))
1201
1202   (xwem-debug 'xwem-event "KBD Dispatcher: %S, lkm = %S"
1203               'xwem-this-command-keys 'lkm)
1204
1205   (if (keymapp (xwem-kbd-fixup-keymap lkm))
1206       (progn
1207         ;; Subkeymap
1208         (xwem-kbd-set-current-prefix-keymap lkm)
1209         (xwem-kbd-start-grabbing (eval (plist-get (xwem-kbd-keymap-plist lkm) 'cursor)))
1210
1211         ;; Show keymap's prompt
1212         (let ((prompt (or (eval (plist-get (xwem-kbd-keymap-plist lkm) 'prompt))
1213                           (keymap-prompt lkm))))
1214           (if prompt
1215               (xwem-message 'prompt "%s" prompt)
1216             (xwem-kbd-schedule-command-keys-echoing))))
1217
1218     ;; Check are we reading keysequence now
1219     (when xwem-kbd-reading-keyseq
1220       (xwem-read-keys-stop t))
1221
1222     ;; Reset privat keymap prefix
1223     (xwem-kbd-set-current-prefix-keymap nil)
1224
1225     ;; Now run command or keyboard macro
1226     (xwem-unwind-protect
1227         (cond ((or (vectorp lkm) (stringp lkm))
1228                ;; Keyboard macro.
1229                ;; Wait for keyrelease, ungrab keyboard, than play it.
1230                (when (and (X-Event-p xwem-last-xevent)
1231                           (= (X-Event-type xwem-last-xevent) X-KeyPress))
1232                  (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent)))
1233                (xwem-kbd-schedule-command-keys-echoing)
1234                (xwem-kbd-stop-grabbing)
1235                (xwem-keymacro-internal-play lkm (prefix-numeric-value xwem-prefix-arg)))
1236
1237               ((commandp lkm)
1238                ;; Fix LKM in case it is frame command
1239                (when (and (symbolp lkm)
1240                           (get lkm 'xwem-frame-command)
1241                           (not (or (xwem-frame-p (xwem-cl-frame xwem-event-client))
1242                                    (eq (xwem-dummy-client) xwem-event-client))))
1243                  (setq lkm 'ignore))
1244                (xwem-kbd-schedule-command-keys-echoing)
1245
1246                ;; Execute LKM command
1247                (setq xwem-this-command lkm)
1248                (run-hooks 'xwem-pre-command-hook)
1249                (call-interactively xwem-this-command)
1250                (setq xwem-last-command xwem-this-command)
1251                (run-hooks 'xwem-post-command-hook))
1252
1253               ((null lkm)
1254                ;; Just echo key
1255                (xwem-kbd-schedule-command-keys-echoing))
1256
1257               (t (error 'xwem-error (format "Unknown command: '%S'" lkm))))
1258
1259       ;; XXX Generic post command processing
1260       (when (xwem-kbd-global-map-current-p)
1261         (setq xwem-this-command-keys []))
1262       ;; Do it deffering, becase there maybe pending command events
1263       ;; which need to be processed.
1264       (xwem-deffered-funcall
1265        #'(lambda ()
1266            (when (xwem-kbd-global-map-current-p)
1267              (xwem-kbd-stop-command-keys-echoing)
1268              (xwem-kbd-stop-grabbing)))))
1269
1270     (and lkm 'done)))
1271
1272 ;;}}}
1273
1274 ;;{{{ [-] Grabbing
1275
1276 ;;;###xwem-autoload
1277 (defun xwem-kbd-graugra-key (key win mode &optional button-mask pgrab-mode kgrab-mode)
1278   "Grab or Ungrab KEY on WIN.
1279 MODE is either 'grab or 'ungrab.
1280 BUTTON-MASK is mask passed to `XGrabButton' if MODE is 'grab and key
1281 is actually a mouse key."
1282   (xwem-keyboard-init)                  ; make sure keyboard initialised
1283
1284   (let* ((key (aref (key-sequence-list-description key) 0))
1285          (kmods (butlast key))
1286          (ksyko (xwem-kbd-emacs->xksym (car (last key))))
1287          mouse)
1288
1289     (if (listp ksyko)
1290         (setq mouse (car ksyko))
1291
1292       (setq ksyko (xwem-kbd-xksym->xkcode ksyko))
1293       (when (eq (cadr ksyko) 'shift)
1294         (setq kmods (cons 'shift kmods)))
1295       (setq ksyko (car ksyko)))
1296
1297     (setq kmods (xwem-kbd-emods->xmodmask kmods))
1298
1299     ;; Take into account evil masks
1300     (mapc #'(lambda (m1)
1301               (mapc #'(lambda (m2)
1302                         (if mouse
1303                             (if (eq mode 'grab)
1304                                 (XGrabButton (xwem-dpy) mouse (Xmask-or kmods m1 m2) win
1305                                              (or button-mask (Xmask-or XM-ButtonPress XM-ButtonRelease))
1306                                              nil t pgrab-mode kgrab-mode)
1307                               (XUngrabButton (xwem-dpy) mouse (Xmask-or kmods m1 m2) win))
1308
1309                           (if (eq mode 'grab)
1310                               (XGrabKey (xwem-dpy) ksyko (Xmask-or kmods m1 m2) win
1311                                         t pgrab-mode kgrab-mode)
1312                             (XUngrabKey (xwem-dpy) ksyko (Xmask-or kmods m1 m2) win))))
1313                     xwem-kbd-evilmasks))
1314           xwem-kbd-evilmasks)
1315     ))
1316
1317 (defun xwem-kbd-grab-key (key win &optional pgrab kgrab)
1318   "Grab KEY on WIN."
1319   (xwem-kbd-graugra-key key win 'grab nil pgrab kgrab))
1320
1321 (defun xwem-kbd-ungrab-key (key win)
1322   "Stop grabbing KEY on WIN."
1323   (xwem-kbd-graugra-key key win 'ungrab))
1324
1325 ;;;###xwem-autoload
1326 (defun xwem-kbd-install-grab (keymap win &optional pgrab kgrab)
1327   "Install KEYMAP grabs on X window WIN."
1328   (map-keymap #'(lambda (key bind)
1329                   (unless (and (symbolp bind) (get bind 'xwem-no-grab))
1330                     (xwem-kbd-grab-key key win pgrab kgrab)))
1331               (xwem-kbd-fixup-keymap keymap))
1332
1333   ;; Also grab KEYMAP's parents
1334   (mapc #'(lambda (pkeymap)
1335             (xwem-kbd-install-grab pkeymap win pgrab kgrab))
1336         (keymap-parents (xwem-kbd-fixup-keymap keymap))))
1337
1338 ;;;###xwem-autoload
1339 (defun xwem-kbd-uninstall-grab (keymap win &optional predict)
1340   "Uninstall KEYMAP grabs on X window WIN.
1341
1342 Optionally you can specify PREDICT to decide for which keys grabbing
1343 should be uinstalled.  PREDICT must accept two arguments - KEY and
1344 BINDING, and return non-nil if this KEY must be ungrabbed.
1345
1346 By default all keys are ungrabbed."
1347   (map-keymap #'(lambda (key bind)
1348                   (when (or (not predict)
1349                             (funcall predict key bind))
1350                     (xwem-kbd-ungrab-key key win)))
1351               (xwem-kbd-fixup-keymap keymap))
1352
1353   ;; Also ungrab KEYMAP's parents
1354   (mapc #'(lambda (pkeymap)
1355             (xwem-kbd-uninstall-grab pkeymap win predict))
1356         (keymap-parents (xwem-kbd-fixup-keymap keymap))))
1357
1358 (defun xwem-kbd-apply-grabbing ()
1359   "Start/stop grabbing according to `xwem-kbd-now-grabbing'."
1360   (if xwem-kbd-now-grabbing
1361       (unless (xwem-keymacro-executing-p)
1362         (XGrabKeyboard (xwem-dpy) (or (xwem-cl-xwin (xwem-dummy-client))
1363                                       (xwem-rootwin)))
1364         (xwem-mouse-grab xwem-kbd-now-grabbing)
1365         (XAllowEvents (xwem-dpy) X-SyncBoth))
1366     (unless (xwem-keymacro-executing-p)
1367       (XUngrabKeyboard (xwem-dpy))
1368       (xwem-mouse-ungrab))))
1369
1370 ;;;###xwem-autoload
1371 (defun xwem-kbd-start-grabbing (&optional cursor)
1372   "Begin grabbing keyboard (some key-prefix is entered).
1373 Optionally you can specify CURSOR to be used, while grabbing."
1374   (unless xwem-kbd-now-grabbing
1375     (setq xwem-kbd-now-grabbing (or cursor xwem-cursor-wait))
1376     (xwem-kbd-apply-grabbing)))
1377
1378 ;;;###xwem-autoload
1379 (defun xwem-kbd-stop-grabbing ()
1380   "Stop grabbing keyboard."
1381   (when xwem-kbd-now-grabbing
1382     (setq xwem-kbd-now-grabbing nil)
1383     (xwem-kbd-apply-grabbing)))
1384
1385 ;;;###autoload(autoload 'xwem-kbd-quote-command "xwem-keyboard" "" t)
1386 (define-xwem-command xwem-kbd-quote-command ()
1387   "Pass event EV to currently active window.
1388 DOES NOT WORK."
1389   (xwem-interactive "_")
1390
1391   (let ((xwin (xwem-focus-xcurrent))
1392         xev)
1393     (when (X-Win-p xwin)
1394       (XGrabKeyboard (xwem-dpy) xwin nil X-GrabModeSync X-GrabModeSync)
1395       (XGrabPointer (xwem-dpy) xwin (Xmask-or XM-ButtonPress XM-ButtonRelease)
1396                     xwem-cursor-quote nil X-GrabModeSync X-GrabModeSync)
1397       (XAllowEvents (xwem-dpy) X-SyncBoth)
1398
1399       (xwem-message 'prompt "[Quote key]")
1400       (xwem-unwind-protect
1401           (while (and (setq xev (xwem-next-event nil
1402                                                  (list X-KeyPress X-KeyRelease X-ButtonPress X-ButtonRelease)))
1403                       (not (xwem-xevents->emacs-events (list xev) t) ))
1404             (XAllowEvents (xwem-dpy) X-SyncBoth))
1405         (XAllowEvents (xwem-dpy) X-ReplayKeyboard)
1406         (XAllowEvents (xwem-dpy) X-ReplayPointer)
1407         (XUngrabKeyboard (xwem-dpy))
1408         (XUngrabPointer (xwem-dpy))
1409         (xwem-clear-message)))))
1410
1411 ;;}}}
1412
1413 ;;{{{ [-] Initializators
1414
1415 (defun xwem-kbd-filter-keycodes (keycodes)
1416   "Filter valid keycodes from KEYCODES list."
1417   (delq nil (mapcar #'(lambda (kc)
1418                         (and (>= kc (X-Dpy-min-keycode (xwem-dpy)))
1419                              (<= kc (X-Dpy-max-keycode (xwem-dpy)))
1420                              kc))
1421                     keycodes)))
1422
1423 ;;;###xwem-autoload
1424 (defun xwem-kbd-initialize-modifiers ()
1425   "Create internal modifier representation to speedup futher work.
1426 Also update `xwem-kbd-evilmasks' if `xwem-kbd-evillocks' is non-nil."
1427   (setq xwem-xmods-mapping
1428         (car (last (XGetModifierMapping (xwem-dpy)))))
1429
1430   (let* ((alts (list (car (xwem-kbd-xksym->xkcode XK-Alt-L))
1431                      (car (xwem-kbd-xksym->xkcode XK-Alt-R))))
1432          (metas (list (car (xwem-kbd-xksym->xkcode XK-Meta-L))
1433                       (car (xwem-kbd-xksym->xkcode XK-Meta-R))))
1434          (hypers (list (car (xwem-kbd-xksym->xkcode XK-Hyper-L))
1435                        (car (xwem-kbd-xksym->xkcode XK-Hyper-R))))
1436          (supers (list (car (xwem-kbd-xksym->xkcode XK-Super-L))
1437                        (car (xwem-kbd-xksym->xkcode XK-Super-R))))
1438          (numlocks (list (car (xwem-kbd-xksym->xkcode XK-NumLock))))
1439          (evils (mapcar #'(lambda (ks)
1440                             (car (xwem-kbd-xksym->xkcode ks)))
1441                         xwem-kbd-evillocks))
1442          (mlist (list X-Mod1 X-Mod2 X-Mod3 X-Mod4 X-Mod5))
1443          (slist (nthcdr 3 xwem-xmods-mapping)))
1444
1445     ;; Clear modifiers info
1446     (mapc #'(lambda (mod-sym)
1447               (put mod-sym 'x-key-codes nil)
1448               (put mod-sym 'x-mod-mask nil))
1449           '(shift lock control alt meta hyper super numlock))
1450
1451     ;; Shift
1452     (put 'shift 'x-key-codes
1453          (xwem-kbd-filter-keycodes (nth 0 xwem-xmods-mapping)))
1454     (put 'shift 'x-mod-mask X-Shift)
1455     ;; Lock
1456     (put 'lock 'x-key-codes
1457          (xwem-kbd-filter-keycodes (nth 1 xwem-xmods-mapping)))
1458     (put 'lock 'x-mod-mask X-Lock)
1459     ;; Control
1460     (put 'control 'x-key-codes
1461          (xwem-kbd-filter-keycodes (nth 2 xwem-xmods-mapping)))
1462     (put 'control 'x-mod-mask X-Control)
1463
1464     (while slist
1465       ;; Update some private modifier mask
1466       (mapc #'(lambda (mods mod-sym)
1467                 (let ((ism (xwem-kbd-filter-keycodes
1468                             (intersection (car slist) mods))))
1469                   (when ism
1470                     (put mod-sym 'x-key-codes
1471                          (nconc ism (get mod-sym 'x-key-codes)))
1472                     (put mod-sym 'x-mod-mask
1473                          (Xmask-or (car mlist)
1474                                    (or (get mod-sym 'x-mod-mask) 0))))))
1475             (list alts metas hypers supers numlocks)
1476             (list 'alt 'meta 'hyper 'super 'numlock))
1477
1478       ;; Update Evil locks
1479       (when (intersection (car slist) evils)
1480         (push (car mlist) xwem-kbd-evilmasks))
1481
1482       (setq slist (cdr slist)
1483             mlist (cdr mlist)))
1484
1485     ;; Hack over Alt-Meta problem
1486     (when (eql (get 'alt 'x-mod-mask) (get 'meta 'x-mod-mask))
1487       (put 'alt 'x-mod-mask 0))))
1488
1489 (defun xwem-keyboard-init ()
1490   "Initialize xwem keyboard.
1491 Fetches KeyboardMapping from the X server and stores it in
1492 `xwem-xkeys-mapping'"
1493   (unless (get 'xwem-keyboard 'initialized)
1494     (xwem-message 'init "Initializing keyboard ...")
1495
1496     (xwem-kbd-set-current-prefix-keymap nil)
1497
1498     ;; Hmm FSFmacs issued "invalid instraction" in `XGetKeyboardMapping'
1499     (setq xwem-xkeys-mapping
1500           (XGetKeyboardMapping (xwem-dpy)
1501                                (X-Dpy-min-keycode (xwem-dpy))
1502                                (- (X-Dpy-max-keycode (xwem-dpy))
1503                                   (X-Dpy-min-keycode (xwem-dpy)))))
1504
1505     ;; Initialize modifiers
1506     (xwem-kbd-initialize-modifiers)
1507
1508     ;; Some messaging configuration
1509     (add-to-list 'xwem-messages-ignore-labels 'keys)
1510     (add-to-list 'xwem-messages-ignore-labels 'keys-continuator)
1511
1512     (run-hooks 'xwem-keyboard-init-hook)
1513     (put 'xwem-keyboard 'initialized t)
1514     (xwem-message 'init "Initializing keyboard ... done")))
1515
1516 ;;}}}
1517
1518 ;;{{{ [-] Universal argument
1519
1520 ;;;###autoload
1521 (defvar xwem-prefix-arg nil
1522 "The value of the prefix argument for this editing command.
1523
1524 It may be a number, or the symbol `-' for just a minus sign as arg, or
1525 a list whose car is a number for just one or more
1526 \\<xwem-global-map>\\[xwem-universal-argument] or `nil' if no argument
1527 has been specified.  This is what `\\(xwem-interactive \"P\"\\)'
1528 returns.")
1529
1530 (defconst xwem-universal-map
1531   (let ((map (make-sparse-keymap)))
1532     (set-keymap-default-binding map 'xwem-universal-command)
1533     (define-key map xwem-universal-key 'xwem-universal-more)
1534     (define-key map [?-] 'xwem-universal-minus)
1535     (define-key map [?0] 'xwem-universal-digit)
1536     (define-key map [?1] 'xwem-universal-digit)
1537     (define-key map [?2] 'xwem-universal-digit)
1538     (define-key map [?3] 'xwem-universal-digit)
1539     (define-key map [?4] 'xwem-universal-digit)
1540     (define-key map [?5] 'xwem-universal-digit)
1541     (define-key map [?6] 'xwem-universal-digit)
1542     (define-key map [?7] 'xwem-universal-digit)
1543     (define-key map [?8] 'xwem-universal-digit)
1544     (define-key map [?9] 'xwem-universal-digit)
1545     map)
1546   "Keymap used while processing \\<xwem-global-map>\\[xwem-universal-argument].")
1547
1548 (defvar xwem-universal-argument-num-events nil
1549   "Number of argument-specifying events read by
1550 `xwem-universal-argument'.")
1551
1552 (defun xwem-universal-common-begin ()
1553   "Common begin for universal argument."
1554   (setq xwem-universal-argument-num-events
1555         (length xwem-this-command-keys))
1556   (if xwem-kbd-now-grabbing
1557       (setq xwem-override-map xwem-universal-map)
1558
1559     ;; Start grabbing
1560     (xwem-kbd-start-grabbing)
1561     (setq xwem-override-map xwem-universal-map)))
1562
1563 ;;;###autoload(autoload 'xwem-universal-argument "xwem-keyboard" "" t)
1564 (define-xwem-command xwem-universal-argument ()
1565   "Begin a numeric argument for the following command.
1566 Digits or minus sign following
1567 \\<xwem-global-map>\\[xwem-universal-argument] make up the numeric
1568 argument.  \\<xwem-global-map>\\[xwem-universal-argument] following the
1569 digits or minus sign ends the argument.
1570 \\<xwem-global-map>\\[xwem-universal-argument] without digits or minus
1571 sign provides 4 as argument.
1572 Repeating \\<xwem-global-map>\\[xwem-universal-argument] without digits or
1573 minus sign multiplies the argument by 4 each time."
1574   (xwem-interactive)
1575
1576   (setq xwem-prefix-arg (list 4))
1577   (xwem-universal-common-begin))
1578
1579 ;; A subsequent H-u means to multiply the factor by 4 if we've typed
1580 ;; nothing but H-u's otherwise it means to terminate the prefix arg.
1581 ;;;###autoload(autoload 'xwem-universal-more "xwem-keyboard" "" t)
1582 (define-xwem-command xwem-universal-more (arg)
1583   "A subsequent \\<xwem-universal-map>\\[xwem-universal-more] means to
1584   multiply the factor by 4 if we've typed nothing but
1585   \\<xwem-universal-map>\\[xwem-universal-more]'s; otherwise it means
1586   to terminate the prefix arg."
1587   (xwem-interactive "P")
1588
1589   (if (consp arg)
1590       (setq xwem-prefix-arg (list (* 4 (car arg))))
1591
1592     (setq xwem-prefix-arg arg)
1593     (setq xwem-override-map nil))
1594   (setq xwem-universal-argument-num-events (length xwem-this-command-keys)))
1595
1596 ;;;###autoload(autoload 'xwem-universal-minus "xwem-keyboard" "" t)
1597 (define-xwem-command xwem-universal-minus (arg)
1598   "Begin a negative numeric argument for the next command.
1599 \\<xwem-global-map>\\[xwem-universal-argument] following digits or
1600 minus sign ends the argument."
1601   (xwem-interactive "P")
1602
1603   (setq xwem-prefix-arg (cond ((integerp arg) (- arg))
1604                               ((eq arg '-) nil)
1605                               (t '-)))
1606   (xwem-universal-common-begin))
1607
1608 ;;;###autoload(autoload 'xwem-universal-digit "xwem-keyboard" "" t)
1609 (define-xwem-command xwem-universal-digit (arg)
1610   "Part of the numeric argument for the next command.
1611 \\<xwem-global-map>\\[xwem-universal-argument] following digits or
1612 minus sign ends the argument."
1613   (xwem-interactive "P")
1614
1615   (let* ((num (or (and (key-press-event-p xwem-last-event)
1616                        (event-key xwem-last-event))
1617                   (and (listp xwem-last-event)
1618                        (car (last xwem-last-event)))))
1619          (digit (- num ?0)))
1620     (cond ((integerp arg)
1621            (setq xwem-prefix-arg (+ (* arg 10) (if (< arg 0) (-  digit) digit))))
1622           ((eq arg '-)
1623            ;; Treat -0 as just -, so that -01 will work.
1624            (setq xwem-prefix-arg (if (zerop digit) '- (- digit))))
1625
1626           (t (setq xwem-prefix-arg digit)))
1627
1628     (xwem-universal-common-begin)))
1629
1630 ;;;###autoload(autoload 'xwem-universal-command "xwem-keyboard" "" t)
1631 (define-xwem-command xwem-universal-command (arg)
1632   "Handle universal argument functionality."
1633   (xwem-interactive "P")
1634
1635   (setq xwem-prefix-arg arg)
1636   (setq xwem-override-map nil)
1637
1638   ;; Reprocess last event
1639   ;; XXX Avoid double keys echoing
1640   (setq xwem-kbd-scheduled-keys
1641         (vconcat (butlast (append xwem-kbd-scheduled-keys nil))))
1642   (xwem-dispatch-command-event xwem-last-event xwem-last-xevent))
1643
1644 ;;}}}
1645
1646 \f
1647 (provide 'xwem-keyboard)
1648
1649 ;;;; On-load actions:
1650 (if xwem-started
1651     (xwem-keyboard-init)
1652   (add-hook 'xwem-before-init-wins-hook 'xwem-keyboard-init))
1653
1654 ;;; xwem-keyboard.el ends here