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
|
;;; hmouse-key.el --- Setup Smart Key mouse bindings
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 30-May-94 at 00:11:57
;;
;; Copyright (C) 1994-2019 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;
;;; Commentary:
;;
;; Supports macOS, X, NEXTSTEP and MS Windows window systems.
;;
;; `hmouse-install' globally binds the Action and Assist Mouse Keys
;; to shifted mouse buttons and optionally binds the Action Mouse Key
;; to the middle mouse button.
;;
;; `hmouse-toggle-bindings' switches between the Hyperbole mouse
;; bindings and previous mouse key bindings any time after
;; `hmouse-install' has been called.
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(eval-when-compile (mapc #'require '(hsettings hmouse-drv hmouse-sh)))
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
(defun hmouse-check-action-key ()
"After use of the Action Mouse Key, ensure both depress and release events are assigned to the key.
Returns t iff the key is properly bound, else nil."
(and (or (and (eventp action-key-depress-args) (eventp action-key-release-args))
(not (or action-key-depress-args action-key-release-args)))
(where-is-internal 'action-key-depress-emacs (current-global-map) t)
(where-is-internal 'action-mouse-key-emacs (current-global-map) t)))
(defun hmouse-check-assist-key ()
"After use of the Assist Mouse Key, ensure both depress and release events are assigned to the key.
Returns t iff the key is properly bound, else nil."
(and (or (and (eventp assist-key-depress-args) (eventp assist-key-release-args))
(not (or assist-key-depress-args assist-key-release-args)))
(where-is-internal 'assist-key-depress-emacs (current-global-map) t)
(where-is-internal 'assist-mouse-key-emacs (current-global-map) t)))
(defun hmouse-set-bindings (key-binding-list)
"Sets mouse keys used as Smart Keys to bindings in KEY-BINDING-LIST.
KEY-BINDING-LIST is the value of either `hmouse-previous-bindings'
\(mouse bindings prior to Smart Key setup) or `hmouse-bindings' (mouse
bindings after Smart Key setup."
(cond
;; Do nothing when running in batch mode.
(noninteractive)
;;
;; GNU Emacs, XEmacs or InfoDock
(t
(mapcar
(lambda (key-and-binding)
(global-set-key (car key-and-binding) (cdr key-and-binding)))
key-binding-list))))
(defun hmouse-install (&optional arg)
"Binds the two rightmost shifted mouse keys to the Action and Assist Keys, initializing Hyperbole mouse buttons.
With optional prefix ARG or under InfoDock, also binds the unshifted middle mouse key to the Action Key.
The standard Hyperbole configuration is Action Key = shift-middle mouse key;
Assist Key = shift-right mouse key."
(interactive "P")
(unless hmouse-middle-flag
(setq hmouse-middle-flag (or arg (and (boundp 'infodock-version)
infodock-version))))
;; Replace any original mouse bindings before installing Hyperbole bindings and
;; then force reinitialization of hmouse-previous-bindings.
(if (and hmouse-bindings-flag hmouse-previous-bindings)
(hmouse-set-bindings hmouse-previous-bindings))
(setq hmouse-bindings-flag nil
hmouse-previous-bindings nil)
;; This function does the actual binding of the Hyperbole mouse keys.
(hmouse-shifted-setup hmouse-middle-flag)
(if (called-interactively-p 'interactive)
;; Assume emacs has support for 3 mouse keys.
(message "%s the Action Mouse Key; {Shift-Mouse-3} invokes the Assist Mouse Key."
(if hmouse-middle-flag "{Mouse-2} and {Shift-Mouse-2} invoke"
"{Shift-Mouse-2} invokes"))))
(defun hmouse-add-unshifted-smart-keys ()
"Binds mouse-2 to the Action Key and mouse-3 to the Assist Key."
(interactive)
(require 'hyperbole)
(hmouse-unshifted-setup))
(defun hmouse-toggle-bindings ()
"Toggles between Smart Mouse Key settings and their prior bindings.
Under InfoDock, the first invocation of this command will make the middle
mouse key the Paste Key instead of the Action Key."
(interactive)
(let ((key-binding-list (if hmouse-bindings-flag
hmouse-previous-bindings
hmouse-bindings))
(other-bindings-var (if hmouse-bindings-flag
'hmouse-bindings
'hmouse-previous-bindings)))
(if key-binding-list
(progn
(set other-bindings-var (hmouse-get-bindings nil))
(hmouse-set-bindings key-binding-list)
(setq hmouse-bindings-flag (not hmouse-bindings-flag))
(if (called-interactively-p 'interactive)
(message "%s mouse bindings are now in use."
(if hmouse-bindings-flag "Hyperbole" "Non-Hyperbole"))))
(error "(hmouse-toggle-bindings): `%s' is empty."
(if hmouse-bindings-flag 'hmouse-previous-bindings 'hmouse-bindings)))))
;; Define function to reload Smart Key bindings and actions after a source code change.
(defun hmouse-update-smart-keys ()
"Reloads the contexts and actions associated with the Smart Keys after any programmatic changes are made."
(interactive)
(hkey-initialize)
(makunbound 'hkey-alist)
(makunbound 'hmouse-alist)
(let ((load-prefer-newer t))
;; This also reloads "hui-window" where mouse-only actions are defined.
(mapc #'load '("hui-mouse" "hibtypes" "hactypes")))
(message "Hyperbole Smart Key and Smart Mouse Key actions have been updated."))
;;; ************************************************************************
;;; Private variables
;;; ************************************************************************
(defvar hmouse-bindings nil
"List of (key . binding) pairs for Hyperbole mouse keys.")
(defvar hmouse-bindings-flag nil
"True if Hyperbole mouse bindings are in use, else nil.")
(defvar hmouse-previous-bindings nil
"List of prior (key . binding) pairs for mouse keys rebound by Hyperbole.")
(provide 'hmouse-key)
;;; hmouse-key.el ends here
|
