Mercurial > hg > xemacs-beta

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