Mercurial > hg > xemacs-beta

comparison lisp/x11/x-win-sun.el @ 187:b405438285a2 r20-3b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b20
author cvs
date Mon, 13 Aug 2007 09:56:28 +0200
parents 538048ae2ab8
children 489f57a838ef
comparison
equal deleted inserted replaced
186:24ac94803b48 187:b405438285a2
62 ;; stupid Sun names, but also allows indirection if no explicit 62 ;; stupid Sun names, but also allows indirection if no explicit
63 ;; key-binding exists. 63 ;; key-binding exists.
64 64
65 ;;; Code: 65 ;;; Code:
66 66
67 (defun x11-remap-keysyms-using-function-key-map (mapping) 67 (defun x-remap-keysyms-using-function-key-map (from-key to-key)
68 (while mapping 68 (dolist (prefix '(() (shift) (control) (meta) (alt)
69 (let ((k1 (caar mapping)) 69 (shift control) (shift alt) (shift meta)
70 (k2 (cdar mapping))) 70 (control alt) (control meta) (alt meta)
71 (mapc #'(lambda (prefix) 71 (shift control alt) (shift control meta)
72 (define-key function-key-map 72 (shift alt meta) (control alt meta)
73 (append prefix (list k1)) 73 (shift control alt meta)))
74 (vector (append prefix (list k2))))) 74 (define-key function-key-map
75 '(() (shift) (control) (meta) (alt) 75 (append prefix (list from-key))
76 (shift control) (shift alt) (shift meta) 76 (vector (append prefix (list to-key))))))
77 (control alt) (control meta) (alt meta) 77
78 (shift control alt) (shift control meta)
79 (shift alt meta) (control alt meta)
80 (shift control alt meta))
81 ))
82 (setq mapping (cdr mapping))))
83
84 (x11-remap-keysyms-using-function-key-map
85 ;; help is ok 78 ;; help is ok
86 ;; num_lock is ok 79 ;; num_lock is ok
87 ;; up is ok 80 ;; up is ok
88 ;; left is ok 81 ;; left is ok
89 ;; right is ok 82 ;; right is ok
90 ;; kp-add is ok 83 ;; kp-add is ok
91 ;; down is ok 84 ;; down is ok
92 ;; insert is ok 85 ;; insert is ok
93 ;; delete is ok 86 ;; delete is ok
94 ;; kp-enter is ok 87 ;; kp-enter is ok
95 (append 88 ;; Sun Function keys
96 ;; Sun Function keys 89 (loop for (x-name from-key to-key) in
97 (cond ((x-keysym-on-keyboard-p "F21") 90 `(("F21" f21 pause)
98 '((f21 . pause) 91 ("F22" f22 print)
99 (f22 . print) 92 ("F23" f23 scroll_lock)
100 (f23 . scroll_lock)))) 93
101 94 ;; X11 R6 mappings
102 (cond ((x-keysym-on-keyboard-p "SunCut") ; X11 R6 mappings 95 ("SunProps" SunProps props)
103 '((SunProps . props) (Undo . undo) 96 ("SunFront" SunFront front)
104 (SunFront . front) (SunCopy . copy) 97 ("SunOpen" SunOpen open)
105 (SunOpen . open) (SunPaste . paste) 98 ("SunFind" SunFind find)
106 (SunFind . find) (SunCut . cut) 99 ("Cancel" cancel stop)
107 (cancel . stop))) 100 ("Undo" Undo undo)
108 101 ("SunCopy" SunCopy copy)
109 ((x-keysym-on-keyboard-p "F20") 102 ("SunPaste" SunPaste paste)
110 '((f13 . props) (f14 . undo) 103 ("SunCut" SunCut cut)
111 (f15 . front) (f16 . copy) 104
112 (f17 . open) (f18 . paste) 105 ("F13" f13 props)
113 (f19 . find) (f20 . cut)))) 106 ("F14" f14 undo)
114 107 ("F15" f15 front)
115 (if (x-keysym-on-keyboard-p "F25") ; Sun Sparc keyboards 108 ("F16" f16 copy)
116 (append 109 ("F17" f17 open)
117 '((f21 . pause) 110 ("F18" f18 paste)
118 (f22 . prsc) 111 ("F19" f19 find)
119 (f23 . scroll) 112 ("F20" f20 cut)
120 (f25 . kp-divide) 113
121 (f26 . kp-multiply) 114 ("F25" f25 kp-divide)
122 (f31 . kp-5)) 115 ("F26" f26 kp-multiply)
123 116 ("F31" f31 kp-5)
124 ;; Map f33 and r13 to end or kp-end 117
125 (cond 118 ;; Map f33 and r13 to end or kp-end
126 ((not (x-keysym-on-keyboard-p "End")) 119 ,@(cond
127 '((f33 . end) (r13 . end))) 120 ((not (x-keysym-on-keyboard-sans-modifiers-p "End"))
128 ((not (x-keysym-on-keyboard-p "KP_End")) 121 '(("F33" f33 end)
129 '((f33 . kp-end) (r13 . kp-end)))) 122 ("R13" r13 end)))
130 123 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_End"))
131 (if (x-keysym-on-keyboard-p "F36") 124 '(("F33" f33 kp-end)
132 '((f36 . stop) (f37 . again)) ; MIT Type 5 name 125 ("R13" r13 kp-end))))
133 '((f11 . stop) (f12 . again))) ; Sun name or MIT Type 4 name 126
134 127 ,@(if (x-keysym-on-keyboard-sans-modifiers-p "F36")
135 ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `=' 128 '(("F36" f36 stop)
136 ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-' 129 ("F37" f37 again)))
137 (if (x-keysym-on-keyboard-p "F24") 130
138 (if (x-keysym-on-keyboard-p "KP_Subtract") 131 ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `='
139 '((f24 . kp-equal)) 132 ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-'
140 '((f24 . kp-subtract)))) 133 ,@(when (x-keysym-on-keyboard-sans-modifiers-p "F24")
141 134 `(("F24" f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p "KP_Subtract")
142 ;; Map f27 to home or kp-home, as appropriate 135 'kp-equal
143 (cond ((not (x-keysym-on-keyboard-p "Home")) '((f27 . home))) 136 'kp-subtract))))
144 ((not (x-keysym-on-keyboard-p "KP_Home")) '((f27 . kp-home)))) 137
145 138 ;; Map f27 to home or kp-home, as appropriate
146 ;; Map f29 to prior or kp-prior, as appropriate 139 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p "Home"))
147 (cond ((not (x-keysym-on-keyboard-p "Prior")) '((f29 . prior))) 140 '(("F27" f27 home)))
148 ((not (x-keysym-on-keyboard-p "KP_Prior")) '((f29 . kp-prior)))) 141 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_Home"))
149 142 '(("F27" f27 kp-home))))
150 ;; Map f35 to next or kp-next, as appropriate 143
151 (cond ((not (x-keysym-on-keyboard-p "Next")) '((f35 . next))) 144 ;; Map f29 to prior or kp-prior, as appropriate
152 ((not (x-keysym-on-keyboard-p "KP_Next")) '((f35 . kp-next)))) 145 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p "Prior"))
153 )) 146 '(("F29" f29 prior)))
154 147 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_Prior"))
155 (cond ((x-keysym-on-keyboard-p "apRead") ; SunOS 4.1.1 148 '(("F29" f29 kp-prior))))
156 '((apRead . f11) (apEdit . f12))) 149
157 ((x-keysym-on-keyboard-p "SunF36") ; SunOS 5 150 ;; Map f35 to next or kp-next, as appropriate
158 '((SunF36 . f11) (SunF37 . f12)))) 151 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p "Next"))
159 152 '(("F35" f35 next)))
160 ;; !@#$ SunOS 4 with SunOS5 X server 153 ((not (x-keysym-on-keyboard-sans-modifiers-p "KP_Next"))
161 (if (string-match "sunos4.1" system-configuration) 154 '(("F35" f35 kp-next))))
162 '((unknown_keysym_0xFF9A . kp-prior) 155
163 (unknown_keysym_0xFF9B . kp-next) 156 ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p "apRead") ; SunOS 4.1.1
164 (unknown_keysym_0xFF95 . kp-home) 157 '(("apRead" apRead f11) ("apEdit" apEdit f12)))
165 (unknown_keysym_0xFF9C . kp-end) 158 ((x-keysym-on-keyboard-sans-modifiers-p "SunF36") ; SunOS 5
166 (unknown_keysym_0xFF96 . kp-left) 159 '(("SunF36" SunF36 f11) ("SunF37" SunF37 f12))))
167 (unknown_keysym_0xFF97 . kp-up) 160 )
168 (unknown_keysym_0xFF98 . kp-right) 161 do (when (x-keysym-on-keyboard-sans-modifiers-p x-name)
169 (unknown_keysym_0xFF99 . kp-down) 162 (x-remap-keysyms-using-function-key-map from-key to-key)))
170 (unknown_keysym_0xFF9E . kp-insert))) 163
171 )) 164 (unintern 'x-remap-keysyms-using-function-key-map)
172
173 (fmakunbound 'x11-remap-keysyms-using-function-key-map)
174
175 165
176 ;; for each element in the left column of the above table, alias it 166 ;; for each element in the left column of the above table, alias it
177 ;; to the thing in the right column. Then do the same for mamy, but 167 ;; to the thing in the right column. Then do the same for many, but
178 ;; not all, modifier combinations. 168 ;; not all, modifier combinations.
179 ;; 169 ;;
180 ;; (Well, we omit hyper and super. #### Handle this some other way!) 170 ;; (Well, we omit hyper and super. #### Handle this some other way!)
181 ; (while mapping 171 ; (while mapping
182 ; (let ((mods '(() (shift) (control) (meta) (alt)))) 172 ; (let ((mods '(() (shift) (control) (meta) (alt))))
191 ;;; [FSF Emacs has something called `system-key-alist' that is 181 ;;; [FSF Emacs has something called `system-key-alist' that is
192 ;;; supposed to accomplish approximately the same thing. Unfortunately, 182 ;;; supposed to accomplish approximately the same thing. Unfortunately,
193 ;;; it's brain-dead in the typically FSF way, and associates *numbers* 183 ;;; it's brain-dead in the typically FSF way, and associates *numbers*
194 ;;; (who knows where the hell they come from?) with symbols.] --ben 184 ;;; (who knows where the hell they come from?) with symbols.] --ben
195 185
196 ;;; And I've made it into a function which is not called by default --mrb 186 ;;; And I've made it into a function which is NOT called by default --mrb
197 187
198 (defun sun-x11-keyboard-translate () 188 (defun sun-x11-keyboard-translate ()
199 "Remap Sun's X11 keyboard. 189 "Remap Sun's X11 keyboard.
200 Keys with names like `f35' are remapped, at a low level, 190 Keys with names like `f35' are remapped, at a low level,
201 to more mnemonic ones,like `kp-3'." 191 to more mnemonic ones,like `kp-3'."
202 (interactive) 192 (interactive)
203 193
204 (keyboard-translate 194 (keyboard-translate
205 'f11 'stop ; the type4 keyboard Sun/MIT name 195 'f11 'stop ; the type4 keyboard Sun/MIT name
206 'f36 'stop ; the type5 keyboard Sun name 196 'f36 'stop ; the type5 keyboard Sun name
207 'cancel 'stop ; R6 binding 197 'cancel 'stop ; R6 binding
208 'f12 'again ; the type4 keyboard Sun/MIT name 198 'f12 'again ; the type4 keyboard Sun/MIT name
249 )) 239 ))
250 240
251 241
252 ;;; OpenWindows-like "find" processing. 242 ;;; OpenWindows-like "find" processing.
253 ;;; As far as I know, the `find' key is a Sunism, so we do that binding 243 ;;; As far as I know, the `find' key is a Sunism, so we do that binding
254 ;;; here. This is the only Sun-specific keybinding. (The functions 244 ;;; here. This is the only Sun-specific keybinding. (The functions
255 ;;; themselves are in x-win.el in case someone wants to use them when 245 ;;; themselves are in x-win.el in case someone wants to use them when
256 ;;; not running on a Sun display.) 246 ;;; not running on a Sun display.)
257 247
258 (define-key global-map 'find 'ow-find) 248 (define-key global-map 'find 'ow-find)
259 (define-key global-map '(shift find) 'ow-find-backward) 249 (define-key global-map '(shift find) 'ow-find-backward)