comparison lisp/x-init.el @ 380:8626e4521993 r21-2-5

Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents 6240c7796c7a
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
99 (defmacro x-define-dead-key (key map) 99 (defmacro x-define-dead-key (key map)
100 `(when (x-keysym-on-keyboard-p ',key) 100 `(when (x-keysym-on-keyboard-p ',key)
101 (define-key function-key-map [,key] ',map)))) 101 (define-key function-key-map [,key] ',map))))
102 102
103 (defun x-initialize-compose () 103 (defun x-initialize-compose ()
104 "Enable compose processing" 104 "Enable compose key and dead key processing."
105 (autoload 'compose-map "x-compose" nil t 'keymap) 105 (autoload 'compose-map "x-compose" nil t 'keymap)
106 (autoload 'compose-acute-map "x-compose" nil t 'keymap) 106 (autoload 'compose-acute-map "x-compose" nil t 'keymap)
107 (autoload 'compose-grave-map "x-compose" nil t 'keymap) 107 (autoload 'compose-grave-map "x-compose" nil t 'keymap)
108 (autoload 'compose-cedilla-map "x-compose" nil t 'keymap) 108 (autoload 'compose-cedilla-map "x-compose" nil t 'keymap)
109 (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap) 109 (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap)
209 (x-define-dead-key dead-diaeresis compose-diaeresis-map) 209 (x-define-dead-key dead-diaeresis compose-diaeresis-map)
210 (x-define-dead-key dead-circum compose-circumflex-map) 210 (x-define-dead-key dead-circum compose-circumflex-map)
211 (x-define-dead-key dead-circumflex compose-circumflex-map) 211 (x-define-dead-key dead-circumflex compose-circumflex-map)
212 (x-define-dead-key dead-tilde compose-tilde-map) 212 (x-define-dead-key dead-tilde compose-tilde-map)
213 ) 213 )
214
215 (eval-when-compile
216 (load "x-win-sun" nil t)
217 (load "x-win-xfree86" nil t))
214 218
215 (defun x-initialize-keyboard () 219 (defun x-initialize-keyboard ()
216 "Perform X-Server-specific initializations. Don't call this." 220 "Perform X-Server-specific initializations. Don't call this."
217 ;; This is some heuristic junk that tries to guess whether this is 221 ;; This is some heuristic junk that tries to guess whether this is
218 ;; a Sun keyboard. 222 ;; a Sun keyboard.
220 ;; One way of implementing this (which would require C support) would 224 ;; One way of implementing this (which would require C support) would
221 ;; be to examine the X keymap itself and see if the layout looks even 225 ;; be to examine the X keymap itself and see if the layout looks even
222 ;; remotely like a Sun - check for the Find key on a particular 226 ;; remotely like a Sun - check for the Find key on a particular
223 ;; keycode, for example. It'd be nice to have a table of this to 227 ;; keycode, for example. It'd be nice to have a table of this to
224 ;; recognize various keyboards; see also xkeycaps. 228 ;; recognize various keyboards; see also xkeycaps.
229 ;;
230 ;; Note that we cannot use most vendor-provided proprietary keyboard
231 ;; APIs to identify the keyboard - those only work on the console.
232 ;; xkeycaps has the same problem when running `remotely'.
225 (let ((vendor (x-server-vendor))) 233 (let ((vendor (x-server-vendor)))
226 (cond ((or (string-match "Sun Microsystems" vendor) 234 (cond ((or (string-match "Sun Microsystems" vendor)
227 ;; MIT losingly fails to tell us what hardware the X server 235 ;; MIT losingly fails to tell us what hardware the X server
228 ;; is managing, so assume all MIT displays are Suns... HA HA! 236 ;; is managing, so assume all MIT displays are Suns... HA HA!
229 (string-equal "MIT X Consortium" vendor) 237 (string-equal "MIT X Consortium" vendor)
230 (string-equal "X Consortium" vendor)) 238 (string-equal "X Consortium" vendor))
231 ;; Ok, we think this could be a Sun keyboard. Load the Sun code. 239 ;; Ok, we think this could be a Sun keyboard. Run the Sun code.
232 ;; (load "x-win-sun"))
233 (x-win-init-sun)) 240 (x-win-init-sun))
234 ((string-match "XFree86" vendor) 241 ((string-match "XFree86" vendor)
235 ;; Those XFree86 people do some weird keysym stuff, too. 242 ;; Those XFree86 people do some weird keysym stuff, too.
236 ;; (load "x-win-xfree86")))))
237 (x-win-init-xfree86))))) 243 (x-win-init-xfree86)))))
238 244
239 245
240 ;; Moved from x-toolbar.el, since InfoDock doesn't dump a x-toolbar.el. 246 ;; Moved from x-toolbar.el, since InfoDock doesn't dump a x-toolbar.el.
241 (defun x-init-toolbar-from-resources (locale) 247 (defun x-init-toolbar-from-resources (locale)
242 (x-init-specifier-from-resources 248 (loop for (specifier . resname) in
243 top-toolbar-height 'natnum locale 249 `(( ,top-toolbar-height . "topToolBarHeight")
244 '("topToolBarHeight" . "TopToolBarHeight")) 250 (,bottom-toolbar-height . "bottomToolBarHeight")
245 (x-init-specifier-from-resources 251 ( ,left-toolbar-width . "leftToolBarWidth")
246 bottom-toolbar-height 'natnum locale 252 ( ,right-toolbar-width . "rightToolBarWidth")
247 '("bottomToolBarHeight" . "BottomToolBarHeight")) 253
248 (x-init-specifier-from-resources 254 ( ,top-toolbar-border-width . "topToolBarBorderWidth")
249 left-toolbar-width 'natnum locale 255 (,bottom-toolbar-border-width . "bottomToolBarBorderWidth")
250 '("leftToolBarWidth" . "LeftToolBarWidth")) 256 ( ,left-toolbar-border-width . "leftToolBarBorderWidth")
251 (x-init-specifier-from-resources 257 ( ,right-toolbar-border-width . "rightToolBarBorderWidth"))
252 right-toolbar-width 'natnum locale 258 do
253 '("rightToolBarWidth" . "RightToolBarWidth")) 259 (x-init-specifier-from-resources
254 (x-init-specifier-from-resources 260 specifier 'natnum locale (cons resname (upcase-initials resname)))))
255 top-toolbar-border-width 'natnum locale
256 '("topToolBarBorderWidth" . "TopToolBarBorderWidth"))
257 (x-init-specifier-from-resources
258 bottom-toolbar-border-width 'natnum locale
259 '("bottomToolBarBorderWidth" . "BottomToolBarBorderWidth"))
260 (x-init-specifier-from-resources
261 left-toolbar-border-width 'natnum locale
262 '("leftToolBarBorderWidth" . "LeftToolBarBorderWidth"))
263 (x-init-specifier-from-resources
264 right-toolbar-border-width 'natnum locale
265 '("rightToolBarBorderWidth" . "RightToolBarBorderWidth")))
266 261
267 (defvar pre-x-win-initted nil) 262 (defvar pre-x-win-initted nil)
268 263
269 (defun init-pre-x-win () 264 (defun init-pre-x-win ()
270 "Initialize X Windows at startup (pre). Don't call this." 265 "Initialize X Windows at startup (pre). Don't call this."
280 (defvar x-win-initted nil) 275 (defvar x-win-initted nil)
281 276
282 (defun init-x-win () 277 (defun init-x-win ()
283 "Initialize X Windows at startup. Don't call this." 278 "Initialize X Windows at startup. Don't call this."
284 (when (not x-win-initted) 279 (when (not x-win-initted)
280 (defvar x-app-defaults-directory)
285 (init-pre-x-win) 281 (init-pre-x-win)
286 282
287 ;; Open the X display when this file is loaded 283 ;; Open the X display when this file is loaded
288 ;; (Note that the first frame is created later.) 284 ;; (Note that the first frame is created later.)
289 (setq x-initial-argv-list (cons (car command-line-args) 285 (setq x-initial-argv-list (cons (car command-line-args)
312 (if (featurep 'mule) 308 (if (featurep 'mule)
313 (init-mule-x-win)) 309 (init-mule-x-win))
314 ;; these are only ever called if zmacs-regions is true. 310 ;; these are only ever called if zmacs-regions is true.
315 (add-hook 'zmacs-deactivate-region-hook 311 (add-hook 'zmacs-deactivate-region-hook
316 (lambda () 312 (lambda ()
317 (if (console-on-window-system-p) 313 (when (console-on-window-system-p)
318 (x-disown-selection)))) 314 (x-disown-selection))))
319 (add-hook 'zmacs-activate-region-hook 315 (add-hook 'zmacs-activate-region-hook
320 (lambda () 316 (lambda ()
321 (if (console-on-window-system-p) 317 (when (console-on-window-system-p)
322 (x-activate-region-as-selection)))) 318 (x-activate-region-as-selection))))
323 (add-hook 'zmacs-update-region-hook 319 (add-hook 'zmacs-update-region-hook
324 (lambda () 320 (lambda ()
325 (if (console-on-window-system-p) 321 (when (console-on-window-system-p)
326 (x-activate-region-as-selection)))) 322 (x-activate-region-as-selection))))
327 ;; Motif-ish bindings 323 ;; Motif-ish bindings
328 ;; The following two were generally unliked. 324 ;; The following two were generally unliked.
329 ;;(define-key global-map '(shift delete) 'kill-primary-selection) 325 ;;(define-key global-map '(shift delete) 'kill-primary-selection)
330 ;;(define-key global-map '(control delete) 'delete-primary-selection) 326 ;;(define-key global-map '(control delete) 'delete-primary-selection)
331 (define-key global-map '(shift insert) 'yank-clipboard-selection) 327 (define-key global-map '(shift insert) 'yank-clipboard-selection)