Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hmouse-mod.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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)