Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hmouse-reg.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 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: hmouse-reg.el
4 ;; SUMMARY: System-dependent Smart Mouse Key bindings (no shift key).
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia, mouse
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Brown U.
10 ;;
11 ;; ORIG-DATE: 3-Sep-91 at 21:40:58
12 ;; LAST-MOD: 14-Sep-95 at 18:39:04 by Bob Weiner
13 ;;; ************************************************************************
14 ;;; Public functions
15 ;;; ************************************************************************
16
17 (defun hmouse-get-bindings ()
18 "Returns list of bindings for mouse keys prior to their use as Smart Keys."
19 (eval
20 (cdr (assoc
21 ;; Get mouse bindings under Emacs 19 or XEmacs, even if not under a
22 ;; window system since it can have frames on ttys and windowed
23 ;; displays at the same time.
24 (or hyperb:window-system
25 (and (not noninteractive) hyperb:xemacs-p "lemacs")
26 (and (not noninteractive) hyperb:emacs19-p "emacs19"))
27 '(("emacs19" .
28 (mapcar (function
29 (lambda (key) (cons key (lookup-key global-map key))))
30 (if (memq window-system '(ns dps))
31 ;; NEXTSTEP offers only 2 mouse buttons which we use
32 ;; as the Smart Keys. We move the mouse-set-point
33 ;; command to shift-left.
34 '([down-mouse-1] [mouse-1] [down-mouse-2] [mouse-2]
35 [double-mouse-1] [triple-mouse-1]
36 [double-mouse-2] [triple-mouse-2]
37 [vertical-line down-mouse-1] [vertical-line mouse-1]
38 [vertical-line down-mouse-2] [vertical-line mouse-2]
39 [mode-line down-mouse-1] [mode-line mouse-1]
40 [mode-line down-mouse-2] [mode-line mouse-2]
41 [S-mouse-1]
42 )
43 ;; X
44 '([down-mouse-2] [mouse-2] [down-mouse-3] [mouse-3]
45 [double-mouse-2] [triple-mouse-2]
46 [double-mouse-3] [triple-mouse-3]
47 [vertical-line down-mouse-2] [vertical-line mouse-2]
48 [vertical-line down-mouse-3] [vertical-line mouse-3]
49 [mode-line down-mouse-2] [mode-line mouse-2]
50 [mode-line down-mouse-3] [mode-line mouse-3]
51 ))))
52 ("lemacs" .
53 (nconc
54 (mapcar (function
55 (lambda (key)
56 (cons key (lookup-key global-map key))))
57 '([button2] [button2up] [button3] [button3up]))
58 (if (boundp 'mode-line-map)
59 (mapcar (function
60 (lambda (key)
61 (cons key (lookup-key mode-line-map key))))
62 '([button3] [button3up])))))
63 ("xterm" .
64 (mapcar (function
65 (lambda (key) (cons key (lookup-key mouse-map key))))
66 (list x-button-middle x-button-middle-up
67 x-button-right x-button-right-up)))
68 ("epoch" .
69 (mapcar (function
70 (lambda (key) (cons key (aref mouse::global-map key))))
71 (list (mouse::index mouse-middle mouse-down)
72 (mouse::index mouse-middle mouse-up)
73 (mouse::index mouse-right mouse-down)
74 (mouse::index mouse-right mouse-up)
75 ;; Modeline mouse map
76 (mouse::index mouse-mode-middle mouse-down)
77 (mouse::index mouse-mode-middle mouse-up)
78 (mouse::index mouse-mode-right mouse-down)
79 (mouse::index mouse-mode-right mouse-up)
80 )))
81 ("next" .
82 (mapcar (function
83 (lambda (key)
84 (cons key (mousemap-get
85 (mouse-list-to-mouse-code key)
86 current-global-mousemap))))
87 (apply 'nconc
88 (mapcar (function
89 (lambda (region)
90 (mapcar (function
91 (lambda (key)
92 (cons region key)))
93 '((left) (up left) (shift left)
94 (right) (up right)
95 ))))
96 '(text scrollbar modeline minibuffer)))
97 ))
98 ;; SunView
99 ("sun" .
100 (mapcar (function
101 (lambda (key)
102 (setq key (mouse-list-to-mouse-code key))
103 (cons key (mousemap-get
104 key current-global-mousemap))))
105 (apply 'nconc
106 (mapcar (function
107 (lambda (region)
108 (mapcar (function
109 (lambda (key)
110 (cons region key)))
111 '((middle) (up middle)
112 (right) (up right)
113 ))))
114 '(text scrollbar modeline minibuffer)))
115 ))
116 ("apollo" .
117 (mapcar (function
118 (lambda (key-str) (apollo-mouse-key-and-binding
119 key-str)))
120 '("M2D" "M2U" "M3D" "M3U")))
121 )))))
122
123 (defun hmouse-setup ()
124 "Binds mouse keys for use as Smart Keys."
125 (interactive)
126 (or hmouse-bindings-flag hmouse-previous-bindings
127 (setq hmouse-previous-bindings (hmouse-get-bindings)))
128 ;; Ensure Gillespie's Info mouse support is off since
129 ;; Hyperbole handles that.
130 (setq Info-mouse-support nil)
131 ;;
132 (cond ;; GNU Emacs 19
133 ((if (not noninteractive) hyperb:emacs19-p)
134 (setq hmouse-set-point-command 'mouse-set-point)
135 ;; Get rid of Info-mode [mouse-2] binding since Hyperbole performs
136 ;; a superset of what it does.
137 (add-hook 'Info-mode-hook
138 (function (lambda () (define-key Info-mode-map [mouse-2] nil))))
139 ;;
140 (if (memq window-system '(ns dps))
141 ;; NEXTSTEP offers only 2 mouse buttons which we use
142 ;; as the Smart Keys. We move the mouse-set-point
143 ;; command to shift-left.
144 (progn
145 (global-set-key [S-down-mouse-1] 'mouse-drag-region)
146 (global-set-key [S-mouse-1] 'mouse-set-point)
147 (global-set-key [down-mouse-1] 'action-key-depress-emacs19)
148 (global-set-key [mouse-1] 'action-mouse-key-emacs19)
149 (global-set-key [double-mouse-1] 'action-mouse-key-emacs19)
150 (global-set-key [triple-mouse-1] 'action-mouse-key-emacs19)
151 (global-set-key [down-mouse-2] 'assist-key-depress-emacs19)
152 (global-set-key [mouse-2] 'assist-mouse-key-emacs19)
153 (global-set-key [double-mouse-2] 'assist-mouse-key-emacs19)
154 (global-set-key [triple-mouse-2] 'assist-mouse-key-emacs19)
155 (global-set-key [vertical-line down-mouse-1] 'action-key-depress-emacs19)
156 (global-set-key [vertical-line mouse-1] 'action-mouse-key-emacs19)
157 (global-set-key [vertical-line down-mouse-2] 'assist-key-depress-emacs19)
158 (global-set-key [vertical-line mouse-2] 'assist-mouse-key-emacs19)
159 (global-set-key [mode-line down-mouse-2] 'action-key-depress-emacs19)
160 (global-set-key [mode-line mouse-2] 'action-mouse-key-emacs19)
161 (global-set-key [mode-line down-mouse-3] 'assist-key-depress-emacs19)
162 (global-set-key [mode-line mouse-3] 'assist-mouse-key-emacs19))
163 ;; X
164 (global-set-key [down-mouse-2] 'action-key-depress-emacs19)
165 (global-set-key [mouse-2] 'action-mouse-key-emacs19)
166 (global-set-key [double-mouse-2] 'action-mouse-key-emacs19)
167 (global-set-key [triple-mouse-2] 'action-mouse-key-emacs19)
168 (global-set-key [down-mouse-3] 'assist-key-depress-emacs19)
169 (global-set-key [mouse-3] 'assist-mouse-key-emacs19)
170 (global-set-key [double-mouse-3] 'assist-mouse-key-emacs19)
171 (global-set-key [triple-mouse-3] 'assist-mouse-key-emacs19)
172 (global-set-key [vertical-line down-mouse-2] 'action-key-depress-emacs19)
173 (global-set-key [vertical-line mouse-2] 'action-mouse-key-emacs19)
174 (global-set-key [vertical-line down-mouse-3] 'assist-key-depress-emacs19)
175 (global-set-key [vertical-line mouse-3] 'assist-mouse-key-emacs19)
176 (global-set-key [mode-line down-mouse-2] 'action-key-depress-emacs19)
177 (global-set-key [mode-line mouse-2] 'action-mouse-key-emacs19)
178 (global-set-key [mode-line down-mouse-3] 'assist-key-depress-emacs19)
179 (global-set-key [mode-line mouse-3] 'assist-mouse-key-emacs19)))
180 ;;
181 ;; XEmacs
182 ((if (not noninteractive) hyperb:xemacs-p)
183 ;; Set mouse bindings under XEmacs, even if not under a window
184 ;; system since it can have frames on ttys and windowed displays at
185 ;; the same time.
186 (setq hmouse-set-point-command 'hmouse-move-point-xemacs)
187 ;; Get rid of Info-mode buttons 2 and 3 bindings since Hyperbole
188 ;; handles things in Info.
189 (add-hook 'Info-mode-hook
190 (function (lambda ()
191 (define-key Info-mode-map 'button2 nil))))
192 ;;
193 (global-set-key 'button2 'action-key-depress)
194 (global-set-key 'button2up 'action-mouse-key)
195 (if (fboundp 'infodock-set-mouse-bindings)
196 (infodock-set-mouse-bindings)
197 (let ((unbind-but3
198 (function (lambda ()
199 (define-key Info-mode-map 'button3 nil)))))
200 (if (and (boundp 'Info-mode-map) (keymapp Info-mode-map))
201 (funcall unbind-but3)
202 (add-hook 'Info-mode-hook unbind-but3)))
203 (if (boundp 'mode-line-map)
204 (progn (define-key mode-line-map 'button3 'assist-key-depress)
205 (define-key mode-line-map 'button3up 'assist-mouse-key)))
206 (global-set-key 'button3 'assist-key-depress)
207 (global-set-key 'button3up 'assist-mouse-key)))
208 ;;
209 ;; X
210 ((equal hyperb:window-system "xterm")
211 (setq hmouse-set-point-command 'x-mouse-set-point)
212 (define-key mouse-map x-button-middle 'action-key-depress)
213 (define-key mouse-map x-button-middle-up 'action-mouse-key)
214 (define-key mouse-map x-button-right 'assist-key-depress)
215 (define-key mouse-map x-button-right-up 'assist-mouse-key)
216 ;; Use these instead of the above for a true META-BUTTON binding.
217 ;; (define-key mouse-map x-button-m-middle 'assist-key-depress)
218 ;; (define-key mouse-map x-button-m-middle-up 'assist-mouse-key)
219 )
220 ;;
221 ;; Epoch
222 ((equal hyperb:window-system "epoch")
223 (setq hmouse-set-point-command 'mouse::set-point)
224 (global-set-mouse mouse-middle mouse-down 'action-key-depress)
225 (global-set-mouse mouse-middle mouse-up 'action-mouse-key)
226 (global-set-mouse mouse-right mouse-down 'assist-key-depress)
227 (global-set-mouse mouse-right mouse-up 'assist-mouse-key)
228 ;; Modeline mouse map
229 (global-set-mouse mouse-mode-middle mouse-down 'action-key-depress)
230 (global-set-mouse mouse-mode-middle mouse-up 'action-mouse-key)
231 (global-set-mouse mouse-mode-right mouse-down 'assist-key-depress)
232 (global-set-mouse mouse-mode-right mouse-up 'assist-mouse-key)
233 )
234 ;;
235 ;; NeXT
236 ((equal hyperb:window-system "next")
237 (setq hmouse-set-point-command 'hmouse-move-point-eterm)
238 ;; Use shift-left button to set point.
239 ;; Use left button instead of non-existent middle as Smart Key.
240 (mapcar
241 (function
242 (lambda (region)
243 (global-set-mouse (cons region '(shift left)) 'mouse-move-point)
244 (global-set-mouse (cons region '(left)) 'action-key-depress)
245 (global-set-mouse (cons region '(up left)) 'action-mouse-key)
246 (global-set-mouse (cons region '(right)) 'assist-key-depress)
247 (global-set-mouse (cons region '(up right)) 'assist-mouse-key)
248 ;; Use these instead of the above for a true META-BUTTON binding.
249 ;; (global-set-mouse (cons region '(meta right)) 'assist-key-depress)
250 ;; (global-set-mouse (cons region '(meta up right)) 'assist-mouse-key)
251 ))
252 '(text scrollbar modeline minibuffer))
253 )
254 ;;
255 ;; SunView
256 ((equal hyperb:window-system "sun")
257 (setq hmouse-set-point-command 'hmouse-move-point-eterm)
258 (mapcar
259 (function
260 (lambda (region)
261 (global-set-mouse (cons region '(middle)) 'action-key-depress)
262 (global-set-mouse (cons region '(up middle)) 'action-mouse-key)
263 (global-set-mouse (cons region '(right)) 'assist-key-depress)
264 (global-set-mouse (cons region '(up right)) 'assist-mouse-key)
265 ;; Use these instead of the above for a true META-BUTTON binding.
266 ;; (global-set-mouse (cons region '(meta middle)) 'assist-key-depress)
267 ;; (global-set-mouse (cons region '(meta up middle)) 'assist-mouse-key)
268 ))
269 '(text scrollbar modeline minibuffer))
270 )
271 ;;
272 ;; Apollo DM
273 ((equal hyperb:window-system "apollo")
274 (setq hmouse-set-point-command 'apollo-mouse-move-point)
275 (bind-apollo-mouse-button "M2D" 'action-key-depress)
276 (bind-apollo-mouse-button "M2U" 'action-mouse-key)
277 (bind-apollo-mouse-button "M3D" 'assist-key-depress)
278 (bind-apollo-mouse-button "M3U" 'assist-mouse-key)
279 ;; Use these instead of the above for a true META-BUTTON binding.
280 ;; (bind-apollo-mouse-button "M2U" 'action-mouse-key
281 ;; 'assist-mouse-key)
282 ;; (bind-apollo-mouse-button "M2D" 'action-key-depress 'assist-key-depress)
283 ))
284 (setq hmouse-bindings (hmouse-get-bindings)
285 hmouse-bindings-flag t))