Mercurial > hg > xemacs-beta

comparison lisp/x-win-sun.el @ 253:157b30c96d03 r20-5b25

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b25
author cvs
date Mon, 13 Aug 2007 10:20:27 +0200
parents 434959a2fba3
children c5d627a313b1
comparison
equal deleted inserted replaced
252:afb15df44434 253:157b30c96d03
1 ;;; x-win-sun.el --- runtime initialization for Sun X servers and keyboards 1 ;;; x-win-sun.el --- runtime initialization for Sun X servers and keyboards
2 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 2 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 3
4 ;; Authors: jwz@netscape.com, wing@666.com, mrb@eng.sun.com 4 ;; Authors: jwz, ben, martin
5 ;; Keywords: terminals 5 ;; Keywords: terminals
6 6
7 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
8 8
9 ;; XEmacs is free software; you can redistribute it and/or modify it 9 ;; XEmacs is free software; you can redistribute it and/or modify it
64 64
65 ;;; Code: 65 ;;; Code:
66 66
67 (defun x-win-init-sun () 67 (defun x-win-init-sun ()
68 68
69 (defun x-remap-keysyms-using-function-key-map (from-key to-key) 69 (defun x-remap-keysyms-using-function-key-map (from-key to-key)
70 (dolist (prefix '(() (shift) (control) (meta) (alt) 70 (dolist (prefix '(() (shift) (control) (meta) (alt)
71 (shift control) (shift alt) (shift meta) 71 (shift control) (shift alt) (shift meta)
72 (control alt) (control meta) (alt meta) 72 (control alt) (control meta) (alt meta)
73 (shift control alt) (shift control meta) 73 (shift control alt) (shift control meta)
74 (shift alt meta) (control alt meta) 74 (shift alt meta) (control alt meta)
75 (shift control alt meta))) 75 (shift control alt meta)))
76 (define-key function-key-map 76 (define-key function-key-map
77 (append prefix (list from-key)) 77 (append prefix (list from-key))
78 (vector (append prefix (list to-key)))))) 78 (vector (append prefix (list to-key))))))
79 79
80 ;; help is ok 80 ;; help is ok
81 ;; num_lock is ok 81 ;; num_lock is ok
82 ;; up is ok 82 ;; up is ok
83 ;; left is ok 83 ;; left is ok
84 ;; right is ok 84 ;; right is ok
85 ;; kp-add is ok 85 ;; kp-add is ok
86 ;; down is ok 86 ;; down is ok
87 ;; insert is ok 87 ;; insert is ok
88 ;; delete is ok 88 ;; delete is ok
89 ;; kp-enter is ok 89 ;; kp-enter is ok
90 ;; Sun Function keys 90 ;; Sun Function keys
91 (loop for (x-name from-key to-key) in 91 (loop for (from-key to-key) in
92 `(("F21" f21 pause) 92 `((f21 pause)
93 ("F22" f22 print) 93 (f22 print)
94 ("F23" f23 scroll_lock) 94 (f23 scroll_lock)
95 95
96 ;; X11 R6 mappings 96 ;; X11 R6 mappings
97 ("SunProps" SunProps props) 97 (SunProps props)
98 ("SunFront" SunFront front) 98 (SunFront front)
99 ("SunOpen" SunOpen open) 99 (SunOpen open)
100 ("SunFind" SunFind find) 100 (SunFind find)
101 ("Cancel" cancel stop) 101 (cancel stop)
102 ("Undo" Undo undo) 102 (Undo undo)
103 ("SunCopy" SunCopy copy) 103 (SunCopy copy)
104 ("SunPaste" SunPaste paste) 104 (SunPaste paste)
105 ("SunCut" SunCut cut) 105 (SunCut cut)
106 106
107 ("F13" f13 props) 107 (f13 props)
108 ("F14" f14 undo) 108 (f14 undo)
109 ("F15" f15 front) 109 (f15 front)
110 ("F16" f16 copy) 110 (f16 copy)
111 ("F17" f17 open) 111 (f17 open)
112 ("F18" f18 paste) 112 (f18 paste)
113 ("F19" f19 find) 113 (f19 find)
114 ("F20" f20 cut) 114 (f20 cut)
115 115
116 ("F25" f25 kp-divide) 116 (f25 kp-divide)
117 ("F26" f26 kp-multiply) 117 (f26 kp-multiply)
118 ("F31" f31 kp-5) 118 (f31 kp-5)
119 119
120 ;; Map f33 and r13 to end or kp-end 120 ;; Map f33 and r13 to end or kp-end
121 ,@(cond 121 ,@(cond
122 ((not (x-keysym-on-keyboard-sans-modifiers-p "End")) 122 ((not (x-keysym-on-keyboard-sans-modifiers-p 'end))
123 '(("F33" f33 end) 123 '((f33 end)
124 ("R13" r13 end))) 124 (r13 end)))
125 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_End")) 125 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-end))
126 '(("F33" f33 kp-end) 126 '((f33 kp-end)
127 ("R13" r13 kp-end)))) 127 (r13 kp-end))))
128 128
129 ,@(if (x-keysym-on-keyboard-sans-modifiers-p "F36") 129 ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f36)
130 '(("F36" f36 stop) 130 '((f36 stop)
131 ("F37" f37 again))) 131 (f37 again)))
132 132
133 ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `=' 133 ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `='
134 ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-' 134 ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-'
135 ,@(when (x-keysym-on-keyboard-sans-modifiers-p "F24") 135 ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f24)
136 `(("F24" f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p "KP_Subtract") 136 `((f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p 'kp-subtract)
137 'kp-equal 137 'kp-equal
138 'kp-subtract)))) 138 'kp-subtract))))
139 139
140 ;; Map f27 to home or kp-home, as appropriate 140 ;; Map f27 to home or kp-home, as appropriate
141 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p "Home")) 141 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'home))
142 '(("F27" f27 home))) 142 '((f27 home)))
143 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_Home")) 143 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-home))
144 '(("F27" f27 kp-home)))) 144 '((f27 kp-home))))
145 145
146 ;; Map f29 to prior or kp-prior, as appropriate 146 ;; Map f29 to prior or kp-prior, as appropriate
147 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p "Prior")) 147 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'prior))
148 '(("F29" f29 prior))) 148 '((f29 prior)))
149 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_Prior")) 149 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-prior))
150 '(("F29" f29 kp-prior)))) 150 '((f29 kp-prior))))
151 151
152 ;; Map f35 to next or kp-next, as appropriate 152 ;; Map f35 to next or kp-next, as appropriate
153 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p "Next")) 153 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'next))
154 '(("F35" f35 next))) 154 '((f35 next)))
155 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_Next")) 155 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-next))
156 '(("F35" f35 kp-next)))) 156 '((f35 kp-next))))
157 157
158 ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p "apRead") ; SunOS 4.1.1 158 ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p 'apRead) ; SunOS 4.1.1
159 '(("apRead" apRead f11) ("apEdit" apEdit f12))) 159 '((apRead f11) (apEdit f12)))
160 ((x-keysym-on-keyboard-sans-modifiers-p "SunF36") ; SunOS 5 160 ((x-keysym-on-keyboard-sans-modifiers-p 'SunF36) ; SunOS 5
161 '(("SunF36" SunF36 f11) 161 '((SunF36 f11)
162 ("SunF37" SunF37 f12) 162 (SunF37 f12)
163 ("F11" f11 stop) 163 (f11 stop)
164 ("F12" f12 again)))) 164 (f12 again))))
165 ) 165 )
166 do (when (x-keysym-on-keyboard-sans-modifiers-p x-name) 166 do (when (x-keysym-on-keyboard-sans-modifiers-p from-key)
167 (x-remap-keysyms-using-function-key-map from-key to-key))) 167 (x-remap-keysyms-using-function-key-map from-key to-key)))
168 168
169 (unintern 'x-remap-keysyms-using-function-key-map) 169 (unintern 'x-remap-keysyms-using-function-key-map)
170 170
171 ;; for each element in the left column of the above table, alias it 171 ;; for each element in the left column of the above table, alias it
172 ;; to the thing in the right column. Then do the same for many, but 172 ;; to the thing in the right column. Then do the same for many, but
173 ;; not all, modifier combinations. 173 ;; not all, modifier combinations.
174 ;; 174 ;;
175 ;; (Well, we omit hyper and super. #### Handle this some other way!) 175 ;; (Well, we omit hyper and super. #### Handle this some other way!)
176 ; (while mapping 176 ;; (while mapping
177 ; (let ((mods '(() (shift) (control) (meta) (alt)))) 177 ;; (let ((mods '(() (shift) (control) (meta) (alt))))
178 ; (while mods 178 ;; (while mods
179 ; (let ((k1 (vector (append (car mods) (list (car (car mapping)))))) 179 ;; (let ((k1 (vector (append (car mods) (list (car (car mapping))))))
180 ; (k2 (vector (append (car mods) (list (cdr (car mapping))))))) 180 ;; (k2 (vector (append (car mods) (list (cdr (car mapping)))))))
181 ; (define-key global-map k1 k2)) 181 ;; (define-key global-map k1 k2))
182 ; (setq mods (cdr mods)))) 182 ;; (setq mods (cdr mods))))
183 ; (setq mapping (cdr mapping)))) 183 ;; (setq mapping (cdr mapping))))
184 184
185 ;;; I've extended keyboard-translate-table to work over keysyms. 185 ;;; I've extended keyboard-translate-table to work over keysyms.
186 ;;; [FSF Emacs has something called `system-key-alist' that is 186 ;;; [FSF Emacs has something called `system-key-alist' that is
187 ;;; supposed to accomplish approximately the same thing. Unfortunately, 187 ;;; supposed to accomplish approximately the same thing. Unfortunately,
188 ;;; it's brain-dead in the typically FSF way, and associates *numbers* 188 ;;; it's brain-dead in the typically FSF way, and associates *numbers*
189 ;;; (who knows where the hell they come from?) with symbols.] --ben 189 ;;; (who knows where the hell they come from?) with symbols.] --ben
190 190
191 ;;; And I've made it into a function which is NOT called by default --mrb 191 ;;; And I've made it into a function which is NOT called by default --martin
192 192
193 (defun sun-x11-keyboard-translate () 193 (defun sun-x11-keyboard-translate ()
194 "Remap Sun's X11 keyboard. 194 "Remap Sun's X11 keyboard.
195 Keys with names like `f35' are remapped, at a low level, 195 Keys with names like `f35' are remapped, at a low level,
196 to more mnemonic ones,like `kp-3'." 196 to more mnemonic ones,like `kp-3'."
197 (interactive) 197 (interactive)
198 198
199 (keyboard-translate 199 (keyboard-translate
200 'f11 'stop ; the type4 keyboard Sun/MIT name 200 'f11 'stop ; the type4 keyboard Sun/MIT name
201 'f36 'stop ; the type5 keyboard Sun name 201 'f36 'stop ; the type5 keyboard Sun name
202 'cancel 'stop ; R6 binding 202 'cancel 'stop ; R6 binding
203 'f12 'again ; the type4 keyboard Sun/MIT name 203 'f12 'again ; the type4 keyboard Sun/MIT name
204 'f37 'again ; the type5 keyboard Sun name 204 'f37 'again ; the type5 keyboard Sun name
205 'f13 'props ; 205 'f13 'props ;
206 'SunProps 'props ; R6 binding 206 'SunProps 'props ; R6 binding
207 'f14 'undo ; 207 'f14 'undo ;
208 'f15 'front ; 208 'f15 'front ;
209 'SunFront 'front ; R6 binding 209 'SunFront 'front ; R6 binding
210 'f16 'copy ; 210 'f16 'copy ;
211 'SunCopy 'copy ; R6 binding 211 'SunCopy 'copy ; R6 binding
212 'f17 'open ; 212 'f17 'open ;
213 'SunOpen 'open ; R6 binding 213 'SunOpen 'open ; R6 binding
214 'f18 'paste ; 214 'f18 'paste ;
215 'SunPaste 'paste ; R6 binding 215 'SunPaste 'paste ; R6 binding
216 'f19 'find ; 216 'f19 'find ;
217 'f20 'cut ; 217 'f20 'cut ;
218 'SunCut 'cut ; R6 binding 218 'SunCut 'cut ; R6 binding
219 ;; help is ok 219 ;; help is ok
220 'f21 'pause 220 'f21 'pause
221 'f22 'prsc 221 'f22 'prsc
222 'f23 'scroll 222 'f23 'scroll
223 ;; num_lock is ok 223 ;; num_lock is ok
224 ;;'f24 'kp-equal) ; type4 only! 224 ;;'f24 'kp-equal) ; type4 only!
225 'f25 'kp-divide ; 225 'f25 'kp-divide ;
226 'f26 'kp-multiply ; 226 'f26 'kp-multiply ;
227 'f24 'kp-subtract ; type5 only! 227 'f24 'kp-subtract ; type5 only!
228 'f27 'kp-7 ; 228 'f27 'kp-7 ;
229 ;; up is ok 229 ;; up is ok
230 'f29 'kp-9 230 'f29 'kp-9
231 ;; left is ok 231 ;; left is ok
232 'f31 'kp-5 232 'f31 'kp-5
233 ;; right is ok 233 ;; right is ok
234 ;; kp-add is ok 234 ;; kp-add is ok
235 'f33 'kp-1 ; the Sun name 235 'f33 'kp-1 ; the Sun name
236 'r13 'end ; the MIT name 236 'r13 'end ; the MIT name
237 ;; down is ok 237 ;; down is ok
238 'f35 'kp-3 238 'f35 'kp-3
239 ;; insert is ok 239 ;; insert is ok
240 ;; delete is ok 240 ;; delete is ok
241 ;; kp-enter is ok 241 ;; kp-enter is ok
242 'SunF36 'f11 ; Type 5 keyboards 242 'SunF36 'f11 ; Type 5 keyboards
243 'SunF37 'f12 ; Used to be Stop & Again 243 'SunF37 'f12 ; Used to be Stop & Again
244 )) 244 ))
245 245
246 246
247 ;;; OpenWindows-like "find" processing. 247 ;;; OpenWindows-like "find" processing.
248 ;;; As far as I know, the `find' key is a Sunism, so we do that binding 248 ;;; As far as I know, the `find' key is a Sunism, so we do that binding
249 ;;; here. This is the only Sun-specific keybinding. (The functions 249 ;;; here. This is the only Sun-specific keybinding. (The functions
250 ;;; themselves are in x-win.el in case someone wants to use them when 250 ;;; themselves are in x-win.el in case someone wants to use them when
251 ;;; not running on a Sun display.) 251 ;;; not running on a Sun display.)
252 252
253 (define-key global-map 'find 'ow-find) 253 (define-key global-map 'find 'ow-find)
254 (define-key global-map '(shift find) 'ow-find-backward) 254 (define-key global-map '(shift find) 'ow-find-backward)
255 255
256 ) 256 )
257 257
258 ;;; x-win-sun.el ends here 258 ;;; x-win-sun.el ends here