Mercurial > hg > xemacs-beta

comparison lisp/x-init.el @ 4478:ec442dc06fe1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 10 Jul 2008 23:37:52 +0200
parents e34711681f30
children e3ef34f57070
comparison
equal deleted inserted replaced
4476:dbf79a1732ba 4478:ec442dc06fe1
35 (globally-declare-fboundp 35 (globally-declare-fboundp
36 '(x-keysym-on-keyboard-p 36 '(x-keysym-on-keyboard-p
37 x-server-vendor x-init-specifier-from-resources init-mule-x-win)) 37 x-server-vendor x-init-specifier-from-resources init-mule-x-win))
38 38
39 (globally-declare-boundp 39 (globally-declare-boundp
40 '(x-initial-argv-list)) 40 '(x-initial-argv-list x-app-defaults-directory))
41 41
42 ;; If you want to change this variable, this is the place you must do it. 42 ;; If you want to change this variable, this is the place you must do it.
43 ;; Do not set it to a string containing periods. X doesn't like that. 43 ;; Do not set it to a string containing periods. X doesn't like that.
44 ;(setq x-emacs-application-class "Emacs") 44 ;(setq x-emacs-application-class "Emacs")
45 45
84 ;; Load X-server specific code. 84 ;; Load X-server specific code.
85 ;; Specifically, load some code to repair the grievous damage that MIT and 85 ;; Specifically, load some code to repair the grievous damage that MIT and
86 ;; Sun have done to the default keymap for the Sun keyboards. 86 ;; Sun have done to the default keymap for the Sun keyboards.
87 87
88 (eval-when-compile 88 (eval-when-compile
89 (defmacro x-define-dead-key (key map) 89 (defmacro x-define-dead-key (key map device)
90 `(when (x-keysym-on-keyboard-p ',key) 90 `(when (x-keysym-on-keyboard-p ',key device)
91 (define-key function-key-map [,key] ',map)))) 91 (define-key function-key-map [,key] ',map))))
92 92
93 (defun x-initialize-compose () 93 (defun x-initialize-compose (device)
94 "Enable compose key and dead key processing." 94 "Enable compose key and dead key processing on DEVICE."
95 (autoload 'compose-map "x-compose" nil t 'keymap) 95 (autoload 'compose-map "x-compose" nil t 'keymap)
96 (autoload 'compose-acute-map "x-compose" nil t 'keymap) 96 (autoload 'compose-acute-map "x-compose" nil t 'keymap)
97 (autoload 'compose-grave-map "x-compose" nil t 'keymap) 97 (autoload 'compose-grave-map "x-compose" nil t 'keymap)
98 (autoload 'compose-cedilla-map "x-compose" nil t 'keymap) 98 (autoload 'compose-cedilla-map "x-compose" nil t 'keymap)
99 (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap) 99 (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap)
100 (autoload 'compose-circumflex-map "x-compose" nil t 'keymap) 100 (autoload 'compose-circumflex-map "x-compose" nil t 'keymap)
101 (autoload 'compose-tilde-map "x-compose" nil t 'keymap) 101 (autoload 'compose-tilde-map "x-compose" nil t 'keymap)
102 102
103 (when (x-keysym-on-keyboard-p 'multi-key) 103 (when (x-keysym-on-keyboard-p 'multi-key device)
104 (define-key function-key-map [multi-key] 'compose-map)) 104 (define-key function-key-map [multi-key] 'compose-map))
105 105
106 ;; The dead keys might really be called just about anything, depending 106 ;; The dead keys might really be called just about anything, depending
107 ;; on the vendor. MIT thinks that the prefixes are "SunFA_", "D", and 107 ;; on the vendor. MIT thinks that the prefixes are "SunFA_", "D", and
108 ;; "hpmute_" for Sun, DEC, and HP respectively. However, OpenWindows 3 108 ;; "hpmute_" for Sun, DEC, and HP respectively. However, OpenWindows 3
117 ;; If things seem not to be working, you might want to check your 117 ;; If things seem not to be working, you might want to check your
118 ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally 118 ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
119 ;; mixed up view of what these keys should be called. 119 ;; mixed up view of what these keys should be called.
120 120
121 ;; Canonical names: 121 ;; Canonical names:
122 (x-define-dead-key acute compose-acute-map) 122 (x-define-dead-key acute compose-acute-map device)
123 (x-define-dead-key grave compose-grave-map) 123 (x-define-dead-key grave compose-grave-map device)
124 (x-define-dead-key cedilla compose-cedilla-map) 124 (x-define-dead-key cedilla compose-cedilla-map device)
125 (x-define-dead-key diaeresis compose-diaeresis-map) 125 (x-define-dead-key diaeresis compose-diaeresis-map device)
126 (x-define-dead-key circumflex compose-circumflex-map) 126 (x-define-dead-key circumflex compose-circumflex-map device)
127 (x-define-dead-key tilde compose-tilde-map) 127 (x-define-dead-key tilde compose-tilde-map device)
128 (x-define-dead-key degree compose-ring-map) 128 (x-define-dead-key degree compose-ring-map device)
129 129
130 ;; Sun according to MIT: 130 ;; Sun according to MIT:
131 (x-define-dead-key SunFA_Acute compose-acute-map) 131 (x-define-dead-key SunFA_Acute compose-acute-map device)
132 (x-define-dead-key SunFA_Grave compose-grave-map) 132 (x-define-dead-key SunFA_Grave compose-grave-map device)
133 (x-define-dead-key SunFA_Cedilla compose-cedilla-map) 133 (x-define-dead-key SunFA_Cedilla compose-cedilla-map device)
134 (x-define-dead-key SunFA_Diaeresis compose-diaeresis-map) 134 (x-define-dead-key SunFA_Diaeresis compose-diaeresis-map device)
135 (x-define-dead-key SunFA_Circum compose-circumflex-map) 135 (x-define-dead-key SunFA_Circum compose-circumflex-map device)
136 (x-define-dead-key SunFA_Tilde compose-tilde-map) 136 (x-define-dead-key SunFA_Tilde compose-tilde-map device)
137 137
138 ;; Sun according to OpenWindows 2: 138 ;; Sun according to OpenWindows 2:
139 (x-define-dead-key Dead_Grave compose-grave-map) 139 (x-define-dead-key Dead_Grave compose-grave-map device)
140 (x-define-dead-key Dead_Circum compose-circumflex-map) 140 (x-define-dead-key Dead_Circum compose-circumflex-map device)
141 (x-define-dead-key Dead_Tilde compose-tilde-map) 141 (x-define-dead-key Dead_Tilde compose-tilde-map device)
142 142
143 ;; Sun according to OpenWindows 3: 143 ;; Sun according to OpenWindows 3:
144 (x-define-dead-key SunXK_FA_Acute compose-acute-map) 144 (x-define-dead-key SunXK_FA_Acute compose-acute-map device)
145 (x-define-dead-key SunXK_FA_Grave compose-grave-map) 145 (x-define-dead-key SunXK_FA_Grave compose-grave-map device)
146 (x-define-dead-key SunXK_FA_Cedilla compose-cedilla-map) 146 (x-define-dead-key SunXK_FA_Cedilla compose-cedilla-map device)
147 (x-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map) 147 (x-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map device)
148 (x-define-dead-key SunXK_FA_Circum compose-circumflex-map) 148 (x-define-dead-key SunXK_FA_Circum compose-circumflex-map device)
149 (x-define-dead-key SunXK_FA_Tilde compose-tilde-map) 149 (x-define-dead-key SunXK_FA_Tilde compose-tilde-map device)
150 150
151 ;; DEC according to MIT: 151 ;; DEC according to MIT:
152 (x-define-dead-key Dacute_accent compose-acute-map) 152 (x-define-dead-key Dacute_accent compose-acute-map device)
153 (x-define-dead-key Dgrave_accent compose-grave-map) 153 (x-define-dead-key Dgrave_accent compose-grave-map device)
154 (x-define-dead-key Dcedilla_accent compose-cedilla-map) 154 (x-define-dead-key Dcedilla_accent compose-cedilla-map device)
155 (x-define-dead-key Dcircumflex_accent compose-circumflex-map) 155 (x-define-dead-key Dcircumflex_accent compose-circumflex-map device)
156 (x-define-dead-key Dtilde compose-tilde-map) 156 (x-define-dead-key Dtilde compose-tilde-map device)
157 (x-define-dead-key Dring_accent compose-ring-map) 157 (x-define-dead-key Dring_accent compose-ring-map device)
158 158
159 ;; DEC according to OpenWindows 3: 159 ;; DEC according to OpenWindows 3:
160 (x-define-dead-key DXK_acute_accent compose-acute-map) 160 (x-define-dead-key DXK_acute_accent compose-acute-map device)
161 (x-define-dead-key DXK_grave_accent compose-grave-map) 161 (x-define-dead-key DXK_grave_accent compose-grave-map device)
162 (x-define-dead-key DXK_cedilla_accent compose-cedilla-map) 162 (x-define-dead-key DXK_cedilla_accent compose-cedilla-map device)
163 (x-define-dead-key DXK_circumflex_accent compose-circumflex-map) 163 (x-define-dead-key DXK_circumflex_accent compose-circumflex-map device)
164 (x-define-dead-key DXK_tilde compose-tilde-map) 164 (x-define-dead-key DXK_tilde compose-tilde-map device)
165 (x-define-dead-key DXK_ring_accent compose-ring-map) 165 (x-define-dead-key DXK_ring_accent compose-ring-map device)
166 166
167 ;; HP according to MIT: 167 ;; HP according to MIT:
168 (x-define-dead-key hpmute_acute compose-acute-map) 168 (x-define-dead-key hpmute_acute compose-acute-map device)
169 (x-define-dead-key hpmute_grave compose-grave-map) 169 (x-define-dead-key hpmute_grave compose-grave-map device)
170 (x-define-dead-key hpmute_diaeresis compose-diaeresis-map) 170 (x-define-dead-key hpmute_diaeresis compose-diaeresis-map device)
171 (x-define-dead-key hpmute_asciicircum compose-circumflex-map) 171 (x-define-dead-key hpmute_asciicircum compose-circumflex-map device)
172 (x-define-dead-key hpmute_asciitilde compose-tilde-map) 172 (x-define-dead-key hpmute_asciitilde compose-tilde-map device)
173 173
174 ;; Empirically discovered on Linux XFree86 MetroX: 174 ;; Empirically discovered on Linux XFree86 MetroX:
175 (x-define-dead-key usldead_acute compose-acute-map) 175 (x-define-dead-key usldead_acute compose-acute-map device)
176 (x-define-dead-key usldead_grave compose-grave-map) 176 (x-define-dead-key usldead_grave compose-grave-map device)
177 (x-define-dead-key usldead_diaeresis compose-diaeresis-map) 177 (x-define-dead-key usldead_diaeresis compose-diaeresis-map device)
178 (x-define-dead-key usldead_asciicircum compose-circumflex-map) 178 (x-define-dead-key usldead_asciicircum compose-circumflex-map device)
179 (x-define-dead-key usldead_asciitilde compose-tilde-map) 179 (x-define-dead-key usldead_asciitilde compose-tilde-map device)
180 180
181 ;; HP according to OpenWindows 3: 181 ;; HP according to OpenWindows 3:
182 (x-define-dead-key hpXK_mute_acute compose-acute-map) 182 (x-define-dead-key hpXK_mute_acute compose-acute-map device)
183 (x-define-dead-key hpXK_mute_grave compose-grave-map) 183 (x-define-dead-key hpXK_mute_grave compose-grave-map device)
184 (x-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map) 184 (x-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map device)
185 (x-define-dead-key hpXK_mute_asciicircum compose-circumflex-map) 185 (x-define-dead-key hpXK_mute_asciicircum compose-circumflex-map device)
186 (x-define-dead-key hpXK_mute_asciitilde compose-tilde-map) 186 (x-define-dead-key hpXK_mute_asciitilde compose-tilde-map device)
187 187
188 ;; HP according to HP-UX 8.0: 188 ;; HP according to HP-UX 8.0:
189 (x-define-dead-key XK_mute_acute compose-acute-map) 189 (x-define-dead-key XK_mute_acute compose-acute-map device)
190 (x-define-dead-key XK_mute_grave compose-grave-map) 190 (x-define-dead-key XK_mute_grave compose-grave-map device)
191 (x-define-dead-key XK_mute_diaeresis compose-diaeresis-map) 191 (x-define-dead-key XK_mute_diaeresis compose-diaeresis-map device)
192 (x-define-dead-key XK_mute_asciicircum compose-circumflex-map) 192 (x-define-dead-key XK_mute_asciicircum compose-circumflex-map device)
193 (x-define-dead-key XK_mute_asciitilde compose-tilde-map) 193 (x-define-dead-key XK_mute_asciitilde compose-tilde-map device)
194 194
195 ;; [[ XFree86 seems to use lower case and a hyphen ]] Not true; they use 195 ;; [[ XFree86 seems to use lower case and a hyphen ]] Not true; they use
196 ;; lower case and an underscore. XEmacs converts the underscore to a 196 ;; lower case and an underscore. XEmacs converts the underscore to a
197 ;; hyphen in x_keysym_to_emacs_keysym because the keysym is in the 197 ;; hyphen in x_keysym_to_emacs_keysym because the keysym is in the
198 ;; "Keyboard" character set, which is just totally fucking random, 198 ;; "Keyboard" character set, which is just totally fucking random,
199 ;; considering it doesn't happen for any other character sets. 199 ;; considering it doesn't happen for any other character sets.
200 (x-define-dead-key dead-acute compose-acute-map) 200 (x-define-dead-key dead-acute compose-acute-map device)
201 (x-define-dead-key dead-grave compose-grave-map) 201 (x-define-dead-key dead-grave compose-grave-map device)
202 (x-define-dead-key dead-cedilla compose-cedilla-map) 202 (x-define-dead-key dead-cedilla compose-cedilla-map device)
203 (x-define-dead-key dead-diaeresis compose-diaeresis-map) 203 (x-define-dead-key dead-diaeresis compose-diaeresis-map device)
204 (x-define-dead-key dead-circum compose-circumflex-map) 204 (x-define-dead-key dead-circum compose-circumflex-map device)
205 (x-define-dead-key dead-circumflex compose-circumflex-map) 205 (x-define-dead-key dead-circumflex compose-circumflex-map device)
206 (x-define-dead-key dead-tilde compose-tilde-map) 206 (x-define-dead-key dead-tilde compose-tilde-map device)
207 ) 207 )
208 208
209 (eval-when-compile 209 (eval-when-compile
210 (load "x-win-sun" nil t) 210 (load "x-win-sun" nil t)
211 (load "x-win-xfree86" nil t)) 211 (load "x-win-xfree86" nil t))
212 212
213 (defun x-initialize-keyboard () 213 (defun x-initialize-keyboard (device)
214 "Perform X-Server-specific initializations. Don't call this." 214 "Perform X-Server-specific initializations. Don't call this."
215 ;; This is some heuristic junk that tries to guess whether this is 215 ;; This is some heuristic junk that tries to guess whether this is
216 ;; a Sun keyboard. 216 ;; a Sun keyboard.
217 ;; 217 ;;
218 ;; One way of implementing this (which would require C support) would 218 ;; One way of implementing this (which would require C support) would
222 ;; recognize various keyboards; see also xkeycaps. 222 ;; recognize various keyboards; see also xkeycaps.
223 ;; 223 ;;
224 ;; Note that we cannot use most vendor-provided proprietary keyboard 224 ;; Note that we cannot use most vendor-provided proprietary keyboard
225 ;; APIs to identify the keyboard - those only work on the console. 225 ;; APIs to identify the keyboard - those only work on the console.
226 ;; xkeycaps has the same problem when running `remotely'. 226 ;; xkeycaps has the same problem when running `remotely'.
227 (let ((vendor (x-server-vendor))) 227 (let ((vendor (x-server-vendor device)))
228 (cond ((or (string-match "Sun Microsystems" vendor) 228 (cond ((or (string-match "Sun Microsystems" vendor)
229 ;; MIT losingly fails to tell us what hardware the X server 229 ;; MIT losingly fails to tell us what hardware the X server
230 ;; is managing, so assume all MIT displays are Suns... HA HA! 230 ;; is managing, so assume all MIT displays are Suns... HA HA!
231 (string-equal "MIT X Consortium" vendor) 231 (string-equal "MIT X Consortium" vendor)
232 (string-equal "X Consortium" vendor)) 232 (string-equal "X Consortium" vendor))
233 ;; Ok, we think this could be a Sun keyboard. Run the Sun code. 233 ;; Ok, we think this could be a Sun keyboard. Run the Sun code.
234 (x-win-init-sun)) 234 (x-win-init-sun device))
235 ((string-match #r"XFree86\|Cygwin/X\|The X\.Org Foundation" vendor) 235 ((string-match #r"XFree86\|Cygwin/X\|The X\.Org Foundation" vendor)
236 ;; Those XFree86 people do some weird keysym stuff, too. 236 ;; Those XFree86 people do some weird keysym stuff, too.
237 (x-win-init-xfree86))))) 237 (x-win-init-xfree86 device)))))
238 238
239 ;; Moved from x-toolbar.el, since InfoDock doesn't dump x-toolbar.el. 239 ;; Moved from x-toolbar.el, since InfoDock doesn't dump x-toolbar.el.
240 (defun x-init-toolbar-from-resources (locale) 240 (defun x-init-toolbar-from-resources (locale)
241 (loop for (specifier . resname) in 241 (loop for (specifier . resname) in
242 `(( ,top-toolbar-height . "topToolBarHeight") 242 `(( ,top-toolbar-height . "topToolBarHeight")
250 ( ,right-toolbar-border-width . "rightToolBarBorderWidth")) 250 ( ,right-toolbar-border-width . "rightToolBarBorderWidth"))
251 do 251 do
252 (x-init-specifier-from-resources 252 (x-init-specifier-from-resources
253 specifier 'natnum locale (cons resname (upcase-initials resname))))) 253 specifier 'natnum locale (cons resname (upcase-initials resname)))))
254 254
255 (defvar pre-x-win-initted nil) 255 (defvar make-device-early-x-entry-point-called-p nil
256 256 "Whether `make-device-early-x-entry-point' has been called, at least once.
257 (defun init-pre-x-win () 257
258 "Initialize X Windows at startup (pre). Don't call this." 258 Much of the X11-specific Lisp init code should only be called the first time
259 (when (not pre-x-win-initted) 259 an X11 device is created; this variable allows for that.")
260 (setq initial-frame-plist (if initial-frame-unmapped-p 260
261 '(initially-unmapped t) 261 (defvar make-device-late-x-entry-point-called-p nil
262 nil)) 262 "Whether `make-device-late-x-entry-point' has been called, at least once.
263 (setq pre-x-win-initted t))) 263
264 264 Much of the X11-specific Lisp init code should only be called the first time
265 (defvar x-win-initted nil) 265 an X11 device is created; this variable allows for that.")
266 266
267 (defun init-x-win () 267 (defun make-device-early-x-entry-point ()
268 "Initialize X Windows at startup. Don't call this." 268 "Entry point to set up the Lisp environment for X device creation."
269 (when (not x-win-initted) 269 (unless make-device-early-x-entry-point-called-p
270 (defvar x-app-defaults-directory) 270 (setq initial-frame-plist
271 (init-pre-x-win) 271 (and initial-frame-unmapped-p '(initially-unmapped t))
272 (if (featurep 'mule) (init-mule-x-win)) 272 ;; Save the argv value.
273 273 x-initial-argv-list
274 ;; Open the X display when this file is loaded 274 (cons (car command-line-args) command-line-args-left)
275 ;; (Note that the first frame is created later.) 275 ;; Locate the app-defaults directory
276 (setq x-initial-argv-list (cons (car command-line-args) 276 x-app-defaults-directory
277 command-line-args-left)) 277 (or x-app-defaults-directory (locate-data-directory "app-defaults"))
278 ;; Locate the app-defaults directory 278 make-device-early-x-entry-point-called-p t)))
279 (when (and (boundp 'x-app-defaults-directory) 279
280 (null x-app-defaults-directory)) 280 (defun make-device-late-x-entry-point (device)
281 (setq x-app-defaults-directory 281 "Entry point to do any Lisp-level X device-specific initialization."
282 (locate-data-directory "app-defaults"))) 282 ;; General code, called on every X device created:
283 (make-x-device nil) 283 (x-initialize-keyboard device)
284 (x-initialize-compose device)
285 ;; And the following code is to be called once, the first time an X11
286 ;; device is created:
287 (unless make-device-late-x-entry-point-called-p
284 (setq command-line-args-left (cdr x-initial-argv-list)) 288 (setq command-line-args-left (cdr x-initial-argv-list))
285 (setq x-win-initted t)))
286
287 (defvar post-x-win-initted nil)
288
289 (defun init-post-x-win ()
290 "Initialize X Windows at startup (post). Don't call this."
291 (when (not post-x-win-initted)
292 ;(if (featurep 'mule) (init-mule-x-win))
293 ;; Motif-ish bindings 289 ;; Motif-ish bindings
294 ;; The following two were generally unliked.
295 ;;(define-key global-map '(shift delete) 'kill-primary-selection)
296 ;;(define-key global-map '(control delete) 'delete-primary-selection)
297 (define-key global-map '(shift insert) 'yank-clipboard-selection) 290 (define-key global-map '(shift insert) 'yank-clipboard-selection)
298 (define-key global-map '(control insert) 'copy-primary-selection) 291 (define-key global-map '(control insert) 'copy-primary-selection)
299 ;; These are Sun-isms. 292 ;; These are Sun-isms.
300 (define-key global-map 'copy 'copy-primary-selection) 293 (define-key global-map 'copy 'copy-primary-selection)
301 (define-key global-map 'paste 'yank-clipboard-selection) 294 (define-key global-map 'paste 'yank-clipboard-selection)
302 (define-key global-map 'cut 'kill-primary-selection) 295 (define-key global-map 'cut 'kill-primary-selection)
303 296 (setq make-device-late-x-entry-point-called-p t)))
304 ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI
305
306 (setq post-x-win-initted t)))
307
308 ;;; Keyboard initialization needs to be done differently for each X
309 ;;; console, so use create-console-hook.
310 (when (featurep 'x)
311 (add-hook
312 'create-console-hook
313 (lambda (console)
314 (letf (((selected-console) console))
315 (when (eq 'x (console-type console))
316 (x-initialize-keyboard)
317 (x-initialize-compose))))))
318 297
319 (defun make-frame-on-display (display &optional props) 298 (defun make-frame-on-display (display &optional props)
320 "Create a frame on the X display named DISPLAY. 299 "Create a frame on the X display named DISPLAY.
321 DISPLAY should be a standard display string such as \"unix:0\", 300 DISPLAY should be a standard display string such as \"unix:0\",
322 or nil for the display specified on the command line or in the 301 or nil for the display specified on the command line or in the