/
hmouse-mod.el
215 lines (192 loc) · 8.16 KB
/
hmouse-mod.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
;;; hmouse-mod.el --- Action Key acts as CONTROL modifier and Assist Key as META modifier. -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 8-Oct-92 at 19:08:31
;; Last-Mod: 20-Jan-24 at 20:16:52 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1992-2024 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;
;; This is presently not used because Emacs binds Control and Meta
;; mouse keys which interfere with this mode. To make this work,
;; Hyperbole will first have to unbind those mouse keys before
;; invoking this mode.
;;
;; ----
;;
;; This defines a single minor mode, hmouse-mod-mode (Hmouse
;; Modifier mode) which makes the Action Mouse Key operate as a
;; Control- modifier key and the Assist Mouse Key operate as a Meta-
;; modifier key.
;;
;; If the Action Key is held down while alpha characters are typed,
;; they are translated into Control keys instead. The Assist
;; Key translates them into Meta keys. When both Smart Keys
;; are depressed, Control-Meta keys are produced. The commands bound
;; to the characters produced are then run.
;;
;; So the Smart Keys modify the keys typed, e.g. Action Key + {a}
;; runs the function for {C-a}.
;;
;; If no keys are typed while the Smart Keys are down, they operate as
;; normally under Hyperbole.
;; This module is for balancing keypress energy across both hands to
;; reduce carpal tunnel stress. It may also be used with a chord keyboard
;; in one hand and a mouse in the other to point at things and
;; operate upon them simultaneously.
;; It requires that Hyperbole be loaded in order to work. Hyperbole
;; defines two Smart Keys, the Action Key and the Assist Key, on the
;; shift-middle and shift-right buttons by default. Use (hmouse-install
;; t) to add an additional Action Key Key on the middle mouse button.
;;
;; TO INVOKE:
;;
;; {C-u M-x hmouse-mod-mode RET} or in Lisp: (hmouse-mod-mode 1)
;;
;; TO QUIT:
;;
;; {C-u 0 M-x hmouse-mod-mode RET} or in Lisp: (hmouse-mod-mode 0)
;;
;; TO TOGGLE ON AND OFF:
;;
;; {M-x hmouse-mod-mode RET} or in Lisp: (hmouse-mod-mode 'toggle)
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(require 'hyperbole)
;;; ************************************************************************
;;; Private variables
;;; ************************************************************************
(defvar hmouse-mod--global-map nil
"Global key map installed by `hmouse-mod-enable' function.
Translates `self-insert-command' characters into control and meta characters if
the Action or Assist Keys are depressed at the time of key press.")
(defvar hmouse-mod--prior-global-map nil
"The global keymap prior to enabling of `hmouse-mod-mode'.
Restore it by calling (hmouse-mod-mode 0).")
(defvar hmouse-mod--prefix nil
"Prefix key part of current key sequence.")
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
;;;###autoload
(define-minor-mode hmouse-mod-mode
"Toggle use of Smart Keys as Control- and Meta- modifiers (Hmouse Modifier mode).
With a prefix argument ARG, enable Hmouse Mod mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
If the Action Key is held down while alpha characters are typed,
they are translated into Control keys instead. The Assist Key
translates them into Meta keys. When both Smart Keys are depressed,
Control-Meta keys are produced. The commands bound to the
characters produced are then run.
Hmouse Modifier mode is a global minor mode. It does not affect
unmodified keys. Normal Smart Key operations work with this
mode, if no other key is pressed while a Smart Key is depressed."
:global t :group 'hyperbole-keys :lighter " HyMod"
(if hmouse-mod-mode
(progn (hmouse-mod-enable)
(if (called-interactively-p 'interactive)
(message "Action Key acts as Control- modifier; Assist Key acts as Meta- modifier.")))
(hmouse-mod-disable)
(if (called-interactively-p 'interactive)
(message "Smart Keys no longer act as Control- and Meta- modifiers."))))
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
(defun hmouse-mod-disable ()
"Restore the global keymap to its state prior to enabling `hmouse-mod-mode'.
This stops the Smart Keys from acting as modifier keys."
(use-global-map (if (keymapp hmouse-mod--prior-global-map)
hmouse-mod--prior-global-map
global-map)))
(defun hmouse-mod-enable ()
"Create `hmouse-mod--global-map' and install it as the current global map.
It accounts for modifier Smart Keys."
(error "(hmouse-mod-mode): Don't use this; it conflicts with Emacs mouse bindings")
(setq hmouse-mod--global-map (copy-keymap global-map))
(substitute-key-definition
'self-insert-command 'hmouse-mod-insert-command hmouse-mod--global-map)
(substitute-key-definition
'keyboard-quit 'hmouse-mod-keyboard-quit hmouse-mod--global-map)
(unless (where-is-internal 'hmouse-mod-insert-command)
(setq hmouse-mod--prior-global-map (current-global-map)))
(use-global-map hmouse-mod--global-map))
(defun hmouse-mod-execute-command (key count)
"Execute command on keyboard KEY or if KEY is a prefix, record it.
Second argument COUNT is used as a prefix argument to the command."
(if (stringp key) (setq key (concat hmouse-mod--prefix key)))
(let ((binding (key-binding key))
(current-prefix-arg count))
(cond ((and (not (or (vectorp binding) (stringp binding)))
(commandp binding))
(if (> (length key) 1)
(or noninteractive (message (key-description key))))
(setq hmouse-mod--prefix nil)
(call-interactively
(if (eq binding 'hmouse-mod-insert-command)
#'self-insert-command
binding)))
((symbolp binding)
(setq hmouse-mod--prefix nil)
(error "(hmouse-mod-execute-command): {%s} not bound to a command"
key))
((integerp binding)
(setq hmouse-mod--prefix nil)
(error "(hmouse-mod-execute-command): {%s} invalid key sequence"
(key-description (vector key))))
((stringp key)
(or noninteractive (message (key-description key)))
(setq hmouse-mod--prefix key))
(t ;; Unrecognized key type, log an error message
(beep)
(message "(HyDebug): hmouse-mod-execute-command - `%s' invalid key" key)))))
(defun hmouse-mod-insert-command (count)
"Surrogate function for `self-insert-command'.
Accounts for modifier Smart Keys. COUNT is used as a prefix
argument to the command."
(interactive "p")
(if (and (boundp 'action-key-depressed-flag)
(boundp 'assist-key-depressed-flag))
(let (
;; (modifiers (event-modifiers last-command-event))
(c (hmouse-mod-last-char)))
(cond ((and c action-key-depressed-flag assist-key-depressed-flag)
(setq action-key-cancelled t
assist-key-cancelled t)
;; Control-Meta keys
(hmouse-mod-execute-command
(vector (list 'control 'meta c)) count))
((and c action-key-depressed-flag)
(setq action-key-cancelled t)
;; Emulate Control keys
(hmouse-mod-execute-command
(vector (list 'control c)) count))
((and c assist-key-depressed-flag)
(setq assist-key-cancelled t)
;; Emulate Meta keys
(hmouse-mod-execute-command
(vector (list 'meta c)) count))
((null c))
(t (self-insert-command count))))
(self-insert-command count))
(discard-input)
(setq this-command 'self-insert-command))
(defun hmouse-mod-keyboard-quit ()
"Surrogate function for `keyboard-quit'. Cancels any `hmouse-mod--prefix'."
(interactive)
(setq hmouse-mod--prefix nil)
(keyboard-quit))
(defun hmouse-mod-last-char ()
"When last command was a character return the event."
(when (characterp last-command-event)
last-command-event))
(provide 'hmouse-mod)
;;; hmouse-mod.el ends here