lisp/x-init.el

   1 ;;; x-init.el --- initialization code for X windows
   2
   3 ;; Copyright (C) 1990, 1993, 1994, 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Board of Trustees, University of Illinois.
   5 ;; Copyright (C) 1995, 1996 Ben Wing.
   6
   7 ;; Maintainer: XEmacs Development Team
   8 ;; Keywords: terminals, dumped
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Synched up with: Not synched.
  28
  29 ;;; Commentary:
  30
  31 ;; This file is dumped with XEmacs (when X support is compiled in).
  32
  33 ;;; Code:
  34
  35 ;; If you want to change this variable, this is the place you must do it.
  36 ;; Do not set it to a string containing periods.  X doesn't like that.
  37 ;(setq x-emacs-application-class "Emacs")
  38
  39 (defgroup x nil
  40   "The X Window system."
  41   :group 'environment)
  42
  43 ;; selections and active regions
  44
  45 ;; If and only if zmacs-regions is true:
  46
  47 ;; When a mark is pushed and the region goes into the "active" state, we
  48 ;; assert it as the Primary selection.  This causes it to be hilighted.
  49 ;; When the region goes into the "inactive" state, we disown the Primary
  50 ;; selection, causing the region to be dehilighted.
  51
  52 ;; Note that it is possible for the region to be in the "active" state
  53 ;; and not be hilighted, if it is in the active state and then some other
  54 ;; application asserts the selection.  This is probably not a big deal.
  55
  56 (defun x-activate-region-as-selection ()
  57   (if (marker-buffer (mark-marker t))
  58       (own-selection (cons (point-marker t) (mark-marker t)))))
  59
  60 ;; OpenWindows-like "find" processing.  These functions are really Sunisms,
  61 ;; but we put them here instead of in x-win-sun.el in case someone wants
  62 ;; to use them when not running on a Sun console (presumably after binding
  63 ;; them to different keys, or putting them on menus.)
  64
  65 (defvar ow-find-last-string nil)
  66 (defvar ow-find-last-clipboard nil)
  67
  68 (defun ow-find (&optional backward-p)
  69   "Search forward the next occurrence of the text of the selection."
  70   (interactive)
  71   (let ((sel  (ignore-errors (get-selection)))
  72         (clip (ignore-errors (get-clipboard)))
  73         text)
  74     (setq text (cond
  75                 (sel)
  76                 ((not (equal clip ow-find-last-clipboard))
  77                  (setq ow-find-last-clipboard clip))
  78                 (ow-find-last-string)
  79                 (t (error "No selection available"))))
  80     (setq ow-find-last-string text)
  81     (cond (backward-p
  82            (search-backward text)
  83            (set-mark (+ (point) (length text))))
  84           (t
  85            (search-forward text)
  86            (set-mark (- (point) (length text)))))
  87     (zmacs-activate-region)))
  88
  89 (defun ow-find-backward ()
  90   "Search backward for the previous occurrence of the text of the selection."
  91   (interactive)
  92   (ow-find t))
  93
  94 ;; Load X-server specific code.
  95 ;; Specifically, load some code to repair the grievous damage that MIT and
  96 ;; Sun have done to the default keymap for the Sun keyboards.
  97
  98 (eval-when-compile
  99   (defmacro x-define-dead-key (key map)
 100     `(when (x-keysym-on-keyboard-p ',key)
 101        (define-key function-key-map [,key] ',map))))
 102
 103 (defun x-initialize-compose ()
 104   "Enable compose key and dead key processing."
 105   (autoload 'compose-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)
 108   (autoload 'compose-cedilla-map    "x-compose" nil t 'keymap)
 109   (autoload 'compose-diaeresis-map  "x-compose" nil t 'keymap)
 110   (autoload 'compose-circumflex-map "x-compose" nil t 'keymap)
 111   (autoload 'compose-tilde-map      "x-compose" nil t 'keymap)
 112
 113   (when (x-keysym-on-keyboard-p 'multi-key)
 114     (define-key function-key-map [multi-key] 'compose-map))
 115
 116   ;; The dead keys might really be called just about anything, depending
 117   ;; on the vendor.  MIT thinks that the prefixes are "SunFA_", "D", and
 118   ;; "hpmute_" for Sun, DEC, and HP respectively.  However, OpenWindows 3
 119   ;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_".
 120   ;; And HP (who don't mention Sun and DEC at all) use "XK_mute_".
 121   ;; Go figure.
 122
 123   ;; Presumably if someone is running OpenWindows, they won't be using
 124   ;; the DEC or HP keysyms, but if they are defined then that is possible,
 125   ;; so in that case we accept them all.
 126
 127   ;; If things seem not to be working, you might want to check your
 128   ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
 129   ;; mixed up view of what these keys should be called.
 130
 131   ;; Canonical names:
 132   (x-define-dead-key acute                      compose-acute-map)
 133   (x-define-dead-key grave                      compose-grave-map)
 134   (x-define-dead-key cedilla                    compose-cedilla-map)
 135   (x-define-dead-key diaeresis                  compose-diaeresis-map)
 136   (x-define-dead-key circumflex                 compose-circumflex-map)
 137   (x-define-dead-key tilde                      compose-tilde-map)
 138   (x-define-dead-key degree                     compose-ring-map)
 139
 140   ;; Sun according to MIT:
 141   (x-define-dead-key SunFA_Acute                compose-acute-map)
 142   (x-define-dead-key SunFA_Grave                compose-grave-map)
 143   (x-define-dead-key SunFA_Cedilla              compose-cedilla-map)
 144   (x-define-dead-key SunFA_Diaeresis            compose-diaeresis-map)
 145   (x-define-dead-key SunFA_Circum               compose-circumflex-map)
 146   (x-define-dead-key SunFA_Tilde                compose-tilde-map)
 147
 148   ;; Sun according to OpenWindows 2:
 149   (x-define-dead-key Dead_Grave                 compose-grave-map)
 150   (x-define-dead-key Dead_Circum                compose-circumflex-map)
 151   (x-define-dead-key Dead_Tilde                 compose-tilde-map)
 152
 153   ;; Sun according to OpenWindows 3:
 154   (x-define-dead-key SunXK_FA_Acute             compose-acute-map)
 155   (x-define-dead-key SunXK_FA_Grave             compose-grave-map)
 156   (x-define-dead-key SunXK_FA_Cedilla           compose-cedilla-map)
 157   (x-define-dead-key SunXK_FA_Diaeresis         compose-diaeresis-map)
 158   (x-define-dead-key SunXK_FA_Circum            compose-circumflex-map)
 159   (x-define-dead-key SunXK_FA_Tilde             compose-tilde-map)
 160
 161   ;; DEC according to MIT:
 162   (x-define-dead-key Dacute_accent              compose-acute-map)
 163   (x-define-dead-key Dgrave_accent              compose-grave-map)
 164   (x-define-dead-key Dcedilla_accent            compose-cedilla-map)
 165   (x-define-dead-key Dcircumflex_accent         compose-circumflex-map)
 166   (x-define-dead-key Dtilde                     compose-tilde-map)
 167   (x-define-dead-key Dring_accent               compose-ring-map)
 168
 169   ;; DEC according to OpenWindows 3:
 170   (x-define-dead-key DXK_acute_accent           compose-acute-map)
 171   (x-define-dead-key DXK_grave_accent           compose-grave-map)
 172   (x-define-dead-key DXK_cedilla_accent         compose-cedilla-map)
 173   (x-define-dead-key DXK_circumflex_accent      compose-circumflex-map)
 174   (x-define-dead-key DXK_tilde                  compose-tilde-map)
 175   (x-define-dead-key DXK_ring_accent            compose-ring-map)
 176
 177   ;; HP according to MIT:
 178   (x-define-dead-key hpmute_acute               compose-acute-map)
 179   (x-define-dead-key hpmute_grave               compose-grave-map)
 180   (x-define-dead-key hpmute_diaeresis           compose-diaeresis-map)
 181   (x-define-dead-key hpmute_asciicircum         compose-circumflex-map)
 182   (x-define-dead-key hpmute_asciitilde          compose-tilde-map)
 183
 184   ;; Empirically discovered on Linux XFree86 MetroX:
 185   (x-define-dead-key usldead_acute              compose-acute-map)
 186   (x-define-dead-key usldead_grave              compose-grave-map)
 187   (x-define-dead-key usldead_diaeresis          compose-diaeresis-map)
 188   (x-define-dead-key usldead_asciicircum        compose-circumflex-map)
 189   (x-define-dead-key usldead_asciitilde         compose-tilde-map)
 190
 191   ;; HP according to OpenWindows 3:
 192   (x-define-dead-key hpXK_mute_acute            compose-acute-map)
 193   (x-define-dead-key hpXK_mute_grave            compose-grave-map)
 194   (x-define-dead-key hpXK_mute_diaeresis        compose-diaeresis-map)
 195   (x-define-dead-key hpXK_mute_asciicircum      compose-circumflex-map)
 196   (x-define-dead-key hpXK_mute_asciitilde       compose-tilde-map)
 197
 198   ;; HP according to HP-UX 8.0:
 199   (x-define-dead-key XK_mute_acute              compose-acute-map)
 200   (x-define-dead-key XK_mute_grave              compose-grave-map)
 201   (x-define-dead-key XK_mute_diaeresis          compose-diaeresis-map)
 202   (x-define-dead-key XK_mute_asciicircum        compose-circumflex-map)
 203   (x-define-dead-key XK_mute_asciitilde         compose-tilde-map)
 204
 205   ;; Xfree86 seems to use lower case and a hyphen
 206   (x-define-dead-key dead-acute                 compose-acute-map)
 207   (x-define-dead-key dead-grave                 compose-grave-map)
 208   (x-define-dead-key dead-cedilla               compose-cedilla-map)
 209   (x-define-dead-key dead-diaeresis             compose-diaeresis-map)
 210   (x-define-dead-key dead-circum                compose-circumflex-map)
 211   (x-define-dead-key dead-circumflex            compose-circumflex-map)
 212   (x-define-dead-key dead-tilde                 compose-tilde-map)
 213   )
 214
 215 (eval-when-compile
 216   (load "x-win-sun"     nil t)
 217   (load "x-win-xfree86" nil t))
 218
 219 (defun x-initialize-keyboard ()
 220   "Perform X-Server-specific initializations.  Don't call this."
 221   ;; This is some heuristic junk that tries to guess whether this is
 222   ;; a Sun keyboard.
 223   ;;
 224   ;; One way of implementing this (which would require C support) would
 225   ;; be to examine the X keymap itself and see if the layout looks even
 226   ;; remotely like a Sun - check for the Find key on a particular
 227   ;; keycode, for example.  It'd be nice to have a table of this to
 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'.
 233   (let ((vendor (x-server-vendor)))
 234     (cond ((or (string-match "Sun Microsystems" vendor)
 235                ;; MIT losingly fails to tell us what hardware the X server
 236                ;; is managing, so assume all MIT displays are Suns...  HA HA!
 237                (string-equal "MIT X Consortium" vendor)
 238                (string-equal "X Consortium" vendor))
 239            ;; Ok, we think this could be a Sun keyboard.  Run the Sun code.
 240            (x-win-init-sun))
 241           ((string-match "XFree86" vendor)
 242            ;; Those XFree86 people do some weird keysym stuff, too.
 243            (x-win-init-xfree86)))))
 244
 245 \f
 246 ;; Moved from x-toolbar.el, since InfoDock doesn't dump a x-toolbar.el.
 247 (defun x-init-toolbar-from-resources (locale)
 248   (loop for (specifier . resname) in
 249     `((   ,top-toolbar-height       .    "topToolBarHeight")
 250       (,bottom-toolbar-height       . "bottomToolBarHeight")
 251       (  ,left-toolbar-width        .   "leftToolBarWidth")
 252       ( ,right-toolbar-width        .  "rightToolBarWidth")
 253
 254       (   ,top-toolbar-border-width .    "topToolBarBorderWidth")
 255       (,bottom-toolbar-border-width . "bottomToolBarBorderWidth")
 256       (  ,left-toolbar-border-width .   "leftToolBarBorderWidth")
 257       ( ,right-toolbar-border-width .  "rightToolBarBorderWidth"))
 258     do
 259     (x-init-specifier-from-resources
 260      specifier 'natnum locale (cons resname (upcase-initials resname)))))
 261
 262 (defvar pre-x-win-initted nil)
 263
 264 (defun init-pre-x-win ()
 265   "Initialize X Windows at startup (pre).  Don't call this."
 266   (when (not pre-x-win-initted)
 267     (require 'x-iso8859-1)
 268     (setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el
 269
 270     (setq initial-frame-plist (if initial-frame-unmapped-p
 271                                   '(initially-unmapped t)
 272                                 nil))
 273     (setq pre-x-win-initted t)))
 274
 275 (defvar x-win-initted nil)
 276
 277 (defun init-x-win ()
 278   "Initialize X Windows at startup.  Don't call this."
 279   (when (not x-win-initted)
 280     (defvar x-app-defaults-directory)
 281     (init-pre-x-win)
 282
 283     ;; Open the X display when this file is loaded
 284     ;; (Note that the first frame is created later.)
 285     (setq x-initial-argv-list (cons (car command-line-args)
 286                                     command-line-args-left))
 287     ;; Locate the app-defaults directory
 288     (when (and (boundp 'x-app-defaults-directory)
 289                (null x-app-defaults-directory))
 290       (setq x-app-defaults-directory
 291             (locate-data-directory "app-defaults")))
 292     (make-x-device nil)
 293     (setq command-line-args-left (cdr x-initial-argv-list))
 294     (setq x-win-initted t)))
 295
 296 (defvar post-x-win-initted nil)
 297
 298 (defun init-post-x-win ()
 299   "Initialize X Windows at startup (post).  Don't call this."
 300   (when (not post-x-win-initted)
 301     ;; We can't load this until after the initial X device is created
 302     ;; because the icon initialization needs to access the display to get
 303     ;; any toolbar-related color resources.
 304     (if (and (not (featurep 'infodock)) (featurep 'toolbar))
 305         (init-x-toolbar))
 306     (if (and (featurep 'infodock) (featurep 'toolbar))
 307         (require 'id-x-toolbar))
 308     (if (featurep 'gutter) (init-gutter))
 309     (if (featurep 'mule) (init-mule-x-win))
 310     ;; these are only ever called if zmacs-regions is true.
 311     (add-hook 'zmacs-deactivate-region-hook
 312               (lambda ()
 313                 (when (console-on-window-system-p)
 314                   (disown-selection))))
 315     (add-hook 'zmacs-activate-region-hook
 316               (lambda ()
 317                 (when (console-on-window-system-p)
 318                   (x-activate-region-as-selection))))
 319     (add-hook 'zmacs-update-region-hook
 320               (lambda ()
 321                 (when (console-on-window-system-p)
 322                   (x-activate-region-as-selection))))
 323     ;; Motif-ish bindings
 324     ;; The following two were generally unliked.
 325     ;;(define-key global-map '(shift delete)   'kill-primary-selection)
 326     ;;(define-key global-map '(control delete) 'delete-primary-selection)
 327     (define-key global-map '(shift insert)   'yank-clipboard-selection)
 328     (define-key global-map '(control insert) 'copy-primary-selection)
 329     ;; These are Sun-isms.
 330     (define-key global-map 'copy        'copy-primary-selection)
 331     (define-key global-map 'paste       'yank-clipboard-selection)
 332     (define-key global-map 'cut         'kill-primary-selection)
 333
 334     (define-key global-map 'menu        'popup-mode-menu)
 335     ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI
 336
 337     (setq post-x-win-initted t)))
 338
 339 ;;; Keyboard initialization needs to be done differently for each X
 340 ;;; console, so use create-console-hook.
 341 (when (featurep 'x)
 342   (add-hook
 343    'create-console-hook
 344    (lambda (console)
 345      (letf (((selected-console) console))
 346        (when (eq 'x (console-type console))
 347          (x-initialize-keyboard)
 348          (x-initialize-compose))))))
 349
 350 (defun make-frame-on-display (display &optional props)
 351   "Create a frame on the X display named DISPLAY.
 352 DISPLAY should be a standard display string such as \"unix:0\",
 353 or nil for the display specified on the command line or in the
 354 DISPLAY environment variable.
 355
 356 PROPS should be a plist of properties, as in the call to `make-frame'.
 357
 358 This function opens a connection to the display or reuses an existing
 359 connection.
 360
 361 This function is a trivial wrapper around `make-frame-on-device'."
 362   (interactive "sMake frame on display: ")
 363   (if (equal display "") (setq display nil))
 364   (make-frame-on-device 'x display props))
 365
 366 ;; Character 160 (octal 0240) displays incorrectly under X apparently
 367 ;; due to a universally crocked font width specification.  Display it
 368 ;; as a space since that's what seems to be expected.
 369 ;;
 370 ;; (make-vector 256 nil) instead of (make-display-table) because
 371 ;; make-display-table doesn't exist when this file is loaded.
 372
 373 (let ((tab (make-vector 256 nil)))
 374   (aset tab 160 " ")
 375   (set-specifier current-display-table tab 'global 'x))
 376
 377 ;;; x-init.el ends here