|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hmouse-mod.el
|
|
|
4 ;; SUMMARY: Action Key acts as CONTROL modifier and Assist Key as META modifier.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia, mouse
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Motorola, Inc., PPG
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 8-Oct-92 at 19:08:31
|
|
|
12 ;; LAST-MOD: 14-Apr-95 at 16:06:26 by Bob Weiner
|
|
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;;
|
|
|
22 ;; This module is meant to be used with a chord keyboard in one hand for
|
|
|
23 ;; typing and a mouse in the other. It requires that Hyperbole be loaded
|
|
|
24 ;; in order to work. Hyperbole defines two Smart Keys, the Action Key and
|
|
|
25 ;; the Assist Key, on the middle and right buttons by default.
|
|
|
26 ;;
|
|
|
27 ;; If the Action Key is held down while alpha characters are typed,
|
|
|
28 ;; they are translated into Control keys instead. The Assist
|
|
|
29 ;; Key translates them into Meta keys. When both Smart Keys
|
|
|
30 ;; are depressed, Control-Meta keys are produced. The commands bound
|
|
|
31 ;; to the characters produced are then run.
|
|
|
32 ;;
|
|
|
33 ;; So the Smart Keys modify the keys typed, e.g. Action Key + {a}
|
|
|
34 ;; runs the function for {C-a}.
|
|
|
35 ;;
|
|
|
36 ;; If no keys are typed while the Smart Keys are down, they operate as
|
|
|
37 ;; normally under Hyperbole.
|
|
|
38 ;;
|
|
|
39 ;; TO INVOKE:
|
|
|
40 ;;
|
|
|
41 ;; (hmouse-mod-set-global-map)
|
|
|
42 ;;
|
|
|
43 ;; DESCRIP-END.
|
|
|
44
|
|
|
45 ;;; ************************************************************************
|
|
|
46 ;;; Other required Elisp libraries
|
|
|
47 ;;; ************************************************************************
|
|
|
48
|
|
|
49 (require 'hyperbole)
|
|
|
50
|
|
|
51 ;;; ************************************************************************
|
|
|
52 ;;; Public variables
|
|
|
53 ;;; ************************************************************************
|
|
|
54
|
|
|
55 (defvar hmouse-mod-global-map nil
|
|
|
56 "Global key map installed by hmouse-mod-set-global-map function.
|
|
|
57 Translates self-insert-command characters into control and meta characters if
|
|
|
58 the Action or Assist Keys are depressed at the time of key press.")
|
|
|
59
|
|
|
60 ;;; ************************************************************************
|
|
|
61 ;;; Public functions
|
|
|
62 ;;; ************************************************************************
|
|
|
63
|
|
|
64 (defun hmouse-mod-insert-command (count)
|
|
|
65 "Surrogate function for self-insert-command. Accounts for modifier Smart Keys."
|
|
|
66 (interactive "p")
|
|
|
67 (if (and (boundp 'action-key-depressed-flag)
|
|
|
68 (boundp 'assist-key-depressed-flag))
|
|
|
69 (cond ((and action-key-depressed-flag assist-key-depressed-flag)
|
|
|
70 (setq action-key-cancelled t
|
|
|
71 assist-key-cancelled t)
|
|
|
72 (let* ((c (downcase last-command-char))
|
|
|
73 (key (char-to-string (+ 128 (% (- c ?\`) 128)))))
|
|
|
74 (if (and (or (= c ?\C-@)
|
|
|
75 (>= c ?a) (<= c ?z)))
|
|
|
76 (hmouse-mod-execute-command key)
|
|
|
77 (beep)))
|
|
|
78 )
|
|
|
79 ;; Control keys
|
|
|
80 (action-key-depressed-flag
|
|
|
81 (setq action-key-cancelled t)
|
|
|
82 (let ((c (downcase last-command-char)))
|
|
|
83 (if (and (or (= c ?\C-@)
|
|
|
84 (>= c ?a) (<= c ?z)))
|
|
|
85 (hmouse-mod-execute-command
|
|
|
86 (char-to-string (- c ?\`)))
|
|
|
87 (beep)))
|
|
|
88 )
|
|
|
89 ;; Meta keys
|
|
|
90 (assist-key-depressed-flag
|
|
|
91 (setq assist-key-cancelled t)
|
|
|
92 (hmouse-mod-execute-command
|
|
|
93 (char-to-string (+ 128 (% last-command-char 128))))
|
|
|
94 )
|
|
|
95 (t (call-interactively 'self-insert-command)))
|
|
|
96 (call-interactively 'self-insert-command))
|
|
|
97 )
|
|
|
98
|
|
|
99 (defun hmouse-mod-keyboard-quit ()
|
|
|
100 "Surrogate function for keyboard-quit. Cancels any hmouse-mod-prefix."
|
|
|
101 (interactive)
|
|
|
102 (setq hmouse-mod-prefix nil)
|
|
|
103 (keyboard-quit))
|
|
|
104
|
|
|
105 (defun hmouse-mod-set-global-map ()
|
|
|
106 "Creates 'hmouse-mod-global-map' and installs as current global map.
|
|
|
107 It accounts for modifier Smart Keys."
|
|
|
108 (interactive)
|
|
|
109 (setq hmouse-mod-global-map (copy-keymap global-map))
|
|
|
110 (substitute-key-definition
|
|
|
111 'self-insert-command 'hmouse-mod-insert-command hmouse-mod-global-map)
|
|
|
112 (substitute-key-definition
|
|
|
113 'keyboard-quit 'hmouse-mod-keyboard-quit hmouse-mod-global-map)
|
|
|
114 (use-global-map hmouse-mod-global-map))
|
|
|
115
|
|
|
116 ;;; ************************************************************************
|
|
|
117 ;;; Private functions
|
|
|
118 ;;; ************************************************************************
|
|
|
119
|
|
|
120 (defun hmouse-mod-execute-command (key)
|
|
|
121 "Executes command associated with keyboard KEY or if KEY prefix, records it."
|
|
|
122 (setq key (concat hmouse-mod-prefix key))
|
|
|
123 (let ((binding (key-binding key)))
|
|
|
124 (cond ((and (not (or (vectorp binding) (stringp binding)))
|
|
|
125 (commandp binding))
|
|
|
126 (if (> (length key) 1)
|
|
|
127 (or noninteractive (message (key-description key))))
|
|
|
128 (setq hmouse-mod-prefix nil)
|
|
|
129 (call-interactively binding))
|
|
|
130 ((symbolp binding)
|
|
|
131 (setq hmouse-mod-prefix nil)
|
|
|
132 (error "(hmouse-mod-execute-command): {%s} not bound to a command."
|
|
|
133 (key-description key)))
|
|
|
134 ((integerp binding)
|
|
|
135 (setq hmouse-mod-prefix nil)
|
|
|
136 (error "(hmouse-mod-execute-command): {%s} invalid key sequence."
|
|
|
137 (key-description key)))
|
|
|
138 (t (or noninteractive (message (key-description key)))
|
|
|
139 (setq hmouse-mod-prefix key)))))
|
|
|
140
|
|
|
141 ;;; ************************************************************************
|
|
|
142 ;;; Private variables
|
|
|
143 ;;; ************************************************************************
|
|
|
144
|
|
|
145 (defvar hmouse-mod-prefix nil
|
|
|
146 "Prefix key part of current key sequence.")
|
|
|
147
|
|
|
148 (provide 'hmouse-mod)
|
