462
+ − 1 ;;; gtk-init.el --- initialization code for mswindows
+ − 2 ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
+ − 3 ;; Copyright (C) 1995 Board of Trustees, University of Illinois.
+ − 4 ;; Copyright (C) 1995, 1996 Ben Wing.
+ − 5
+ − 6 ;; Author: various
+ − 7 ;; Rewritten for Gtk by: William Perry
+ − 8
+ − 9 ;; This file is part of XEmacs.
+ − 10
+ − 11 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 12 ;; under the terms of the GNU General Public License as published by
+ − 13 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 14 ;; any later version.
+ − 15
+ − 16 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 19 ;; General Public License for more details.
+ − 20
+ − 21 ;; You should have received a copy of the GNU General Public License
+ − 22 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
+ − 24 ;; Boston, MA 02111-1307, USA.
+ − 25
502
+ − 26 (globally-declare-boundp
+ − 27 '(gtk-initial-argv-list
506
+ − 28 gtk-initial-geometry))
+ − 29
+ − 30 (globally-declare-fboundp
+ − 31 '(gtk-keysym-on-keyboard-p))
502
+ − 32
462
+ − 33 (defvar gtk-win-initted nil)
+ − 34 (defvar gtk-pre-win-initted nil)
+ − 35 (defvar gtk-post-win-initted nil)
+ − 36
+ − 37 (defvar gtk-command-switch-alist
+ − 38 '(
+ − 39 ;; GNOME Options
+ − 40 ("--disable-sound" . nil)
+ − 41 ("--enable-sound" . nil)
+ − 42 ("--espeaker" . t)
+ − 43
+ − 44 ;; GTK Options
+ − 45 ("--gdk-debug" . t)
+ − 46 ("--gdk-no-debug" . t)
+ − 47 ("--display" . t)
+ − 48 ("--sync" . nil)
+ − 49 ("--no-xshm" . nil)
+ − 50 ("--name" . t)
+ − 51 ("--class" . t)
+ − 52 ("--gxid_host" . t)
+ − 53 ("--gxid_port" . t)
+ − 54 ("--xim-preedit" . t)
+ − 55 ("--xim-status" . t)
+ − 56 ("--gtk-debug" . t)
+ − 57 ("--gtk-no-debug" . t)
+ − 58 ("--gtk-module" . t)
+ − 59
+ − 60 ;; Glib options
+ − 61 ("--g-fatal-warnings" . nil)
+ − 62
+ − 63 ;; Session management options
+ − 64 ("--sm-client-id" . t)
+ − 65 ("--sm-config-prefix" . t)
+ − 66 ("--sm-disable" . t)
+ − 67 )
+ − 68
+ − 69 "An assoc list of command line arguments that should in gtk-initial-argv-list.
+ − 70 This is necessary because GTK and GNOME consider it a fatal error if they receive
+ − 71 unknown command line arguments (perfectly reasonable). But this means that if
+ − 72 the user specifies a file name on the command line they will be unable to start.
+ − 73 So we filter the command line and allow only items in this list in.
+ − 74
+ − 75 The CDR of the assoc list is whether it accepts an argument. All options are in
+ − 76 GNU long form though.")
+ − 77
+ − 78 (defun init-pre-gtk-win ()
+ − 79 "Initialize Gtk GUI at startup (pre). Don't call this."
+ − 80 (when (not gtk-pre-win-initted)
+ − 81 (setq initial-frame-plist (if initial-frame-unmapped-p
+ − 82 '(initially-unmapped t)
+ − 83 nil)
+ − 84 gtk-pre-win-initted t)))
+ − 85
+ − 86 (defun gtk-init-handle-geometry (arg)
+ − 87 "Set up initial geometry info for GTK devices."
+ − 88 (setq gtk-initial-geometry (pop command-line-args-left)))
+ − 89
+ − 90 (defun gtk-filter-arguments ()
+ − 91 (let ((accepted nil)
+ − 92 (rejected nil)
+ − 93 (todo nil))
+ − 94 (setq todo (mapcar (lambda (argdesc)
+ − 95 (if (cdr argdesc)
+ − 96 ;; Need to look for --foo=bar
+ − 97 (concat "^" (car argdesc) "=")
+ − 98 ;; Just a simple arg
+ − 99 (concat "^" (regexp-quote (car argdesc)) "$")))
+ − 100 gtk-command-switch-alist))
+ − 101
+ − 102 (while command-line-args-left
+ − 103 (if (catch 'found
+ − 104 (mapc (lambda (r)
+ − 105 (if (string-match r (car command-line-args-left))
+ − 106 (throw 'found t))) todo)
+ − 107 (mapc (lambda (argdesc)
+ − 108 (if (cdr argdesc)
+ − 109 ;; This time we only care about argument items
+ − 110 ;; that take an argument. We'll check to see if
+ − 111 ;; someone used --foo bar instead of --foo=bar
+ − 112 (if (string-match (concat "^" (car argdesc) "$") (car command-line-args-left))
+ − 113 ;; Yup! Need to push
+ − 114 (progn
+ − 115 (push (pop command-line-args-left) accepted)
+ − 116 (throw 'found t)))))
+ − 117 gtk-command-switch-alist)
+ − 118 nil)
+ − 119 (push (pop command-line-args-left) accepted)
+ − 120 (push (pop command-line-args-left) rejected)))
+ − 121 (setq command-line-args-left (nreverse rejected))
+ − 122 (nreverse accepted)))
+ − 123
+ − 124 (defun init-gtk-win ()
+ − 125 "Initialize Gtk GUI at startup. Don't call this."
+ − 126 (unless gtk-win-initted
+ − 127 (init-pre-gtk-win)
+ − 128 (setq gtk-initial-argv-list (cons (car command-line-args) (gtk-filter-arguments))
+ − 129 gtk-initial-geometry (nth 1 (member "-geometry" command-line-args-left)))
+ − 130 (make-gtk-device)
+ − 131 (init-post-gtk-win)
+ − 132 (setq gtk-win-initted t)))
+ − 133
+ − 134 (defun init-post-gtk-win ()
+ − 135 (unless gtk-post-win-initted
+ − 136 (when (featurep 'mule)
+ − 137 (define-specifier-tag 'mule-fonts
+ − 138 (lambda (device) (eq 'gtk (device-type device))))
+ − 139 (set-face-font
+ − 140 'default
+ − 141 '("-*-fixed-medium-r-*--16-*-iso8859-1"
+ − 142 "-*-fixed-medium-r-*--*-iso8859-1"
+ − 143 "-*-fixed-medium-r-*--*-iso8859-2"
+ − 144 "-*-fixed-medium-r-*--*-iso8859-3"
+ − 145 "-*-fixed-medium-r-*--*-iso8859-4"
+ − 146 "-*-fixed-medium-r-*--*-iso8859-7"
+ − 147 "-*-fixed-medium-r-*--*-iso8859-8"
+ − 148 "-*-fixed-medium-r-*--*-iso8859-5"
+ − 149 "-*-fixed-medium-r-*--*-iso8859-9"
+ − 150
+ − 151 ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun
+ − 152 "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0"
+ − 153 "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0"
+ − 154 "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0"
+ − 155 ;; Other Japanese fonts
+ − 156 "-*-fixed-medium-r-*--*-jisx0201.1976-*"
+ − 157 "-*-fixed-medium-r-*--*-jisx0208.1983-*"
+ − 158 "-*-fixed-medium-r-*--*-jisx0212*-*"
+ − 159
+ − 160 ;; Chinese fonts
+ − 161 "-*-*-medium-r-*--*-gb2312.1980-*"
+ − 162
+ − 163 ;; Use One font specification for CNS chinese
+ − 164 ;; Too many variations in font naming
+ − 165 "-*-fixed-medium-r-*--*-cns11643*-*"
+ − 166 ;; "-*-fixed-medium-r-*--*-cns11643*2"
+ − 167 ;; "-*-fixed-medium-r-*--*-cns11643*3"
+ − 168 ;; "-*-fixed-medium-r-*--*-cns11643*4"
+ − 169 ;; "-*-fixed-medium-r-*--*-cns11643.5-0"
+ − 170 ;; "-*-fixed-medium-r-*--*-cns11643.6-0"
+ − 171 ;; "-*-fixed-medium-r-*--*-cns11643.7-0"
+ − 172
+ − 173 "-*-fixed-medium-r-*--*-big5*-*"
+ − 174 "-*-fixed-medium-r-*--*-sisheng_cwnn-0"
+ − 175
+ − 176 ;; Other fonts
+ − 177
+ − 178 ;; "-*-fixed-medium-r-*--*-viscii1.1-1"
+ − 179
+ − 180 ;; "-*-fixed-medium-r-*--*-mulearabic-0"
+ − 181 ;; "-*-fixed-medium-r-*--*-mulearabic-1"
+ − 182 ;; "-*-fixed-medium-r-*--*-mulearabic-2"
+ − 183
+ − 184 ;; "-*-fixed-medium-r-*--*-muleipa-1"
+ − 185 ;; "-*-fixed-medium-r-*--*-ethio-*"
+ − 186
+ − 187 "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean
+ − 188 "-*-fixed-medium-r-*--*-tis620.2529-1" ; Thai
+ − 189 )
+ − 190 'global '(mule-fonts) 'append))
+ − 191
+ − 192 (setq gtk-post-win-initted t)))
+ − 193
+ − 194 (push '("-geometry" . gtk-init-handle-geometry) command-switch-alist)
+ − 195
+ − 196 ;;; Stuff to get compose keys working on GTK
+ − 197 (eval-when-compile
+ − 198 (defmacro gtk-define-dead-key (key map)
+ − 199 `(when (gtk-keysym-on-keyboard-p ',key)
+ − 200 (define-key function-key-map [,key] ',map))))
+ − 201
+ − 202 (defun gtk-initialize-compose ()
+ − 203 "Enable compose processing"
+ − 204 (autoload 'compose-map "gtk-compose" nil t 'keymap)
+ − 205 (autoload 'compose-acute-map "gtk-compose" nil t 'keymap)
+ − 206 (autoload 'compose-grave-map "gtk-compose" nil t 'keymap)
+ − 207 (autoload 'compose-cedilla-map "gtk-compose" nil t 'keymap)
+ − 208 (autoload 'compose-diaeresis-map "gtk-compose" nil t 'keymap)
+ − 209 (autoload 'compose-circumflex-map "gtk-compose" nil t 'keymap)
+ − 210 (autoload 'compose-tilde-map "gtk-compose" nil t 'keymap)
+ − 211
+ − 212 (when (gtk-keysym-on-keyboard-p 'multi-key)
+ − 213 (define-key function-key-map [multi-key] 'compose-map))
+ − 214
+ − 215 ;; The dead keys might really be called just about anything, depending
+ − 216 ;; on the vendor. MIT thinks that the prefixes are "SunFA_", "D", and
+ − 217 ;; "hpmute_" for Sun, DEC, and HP respectively. However, OpenWindows 3
+ − 218 ;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_".
+ − 219 ;; And HP (who don't mention Sun and DEC at all) use "XK_mute_".
+ − 220 ;; Go figure.
+ − 221
+ − 222 ;; Presumably if someone is running OpenWindows, they won't be using
+ − 223 ;; the DEC or HP keysyms, but if they are defined then that is possible,
+ − 224 ;; so in that case we accept them all.
+ − 225
+ − 226 ;; If things seem not to be working, you might want to check your
+ − 227 ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
+ − 228 ;; mixed up view of what these keys should be called.
+ − 229
+ − 230 ;; Canonical names:
+ − 231 (gtk-define-dead-key acute compose-acute-map)
+ − 232 (gtk-define-dead-key grave compose-grave-map)
+ − 233 (gtk-define-dead-key cedilla compose-cedilla-map)
+ − 234 (gtk-define-dead-key diaeresis compose-diaeresis-map)
+ − 235 (gtk-define-dead-key circumflex compose-circumflex-map)
+ − 236 (gtk-define-dead-key tilde compose-tilde-map)
+ − 237 (gtk-define-dead-key degree compose-ring-map)
+ − 238
+ − 239 ;; Sun according to MIT:
+ − 240 (gtk-define-dead-key SunFA_Acute compose-acute-map)
+ − 241 (gtk-define-dead-key SunFA_Grave compose-grave-map)
+ − 242 (gtk-define-dead-key SunFA_Cedilla compose-cedilla-map)
+ − 243 (gtk-define-dead-key SunFA_Diaeresis compose-diaeresis-map)
+ − 244 (gtk-define-dead-key SunFA_Circum compose-circumflex-map)
+ − 245 (gtk-define-dead-key SunFA_Tilde compose-tilde-map)
+ − 246
+ − 247 ;; Sun according to OpenWindows 2:
+ − 248 (gtk-define-dead-key Dead_Grave compose-grave-map)
+ − 249 (gtk-define-dead-key Dead_Circum compose-circumflex-map)
+ − 250 (gtk-define-dead-key Dead_Tilde compose-tilde-map)
+ − 251
+ − 252 ;; Sun according to OpenWindows 3:
+ − 253 (gtk-define-dead-key SunXK_FA_Acute compose-acute-map)
+ − 254 (gtk-define-dead-key SunXK_FA_Grave compose-grave-map)
+ − 255 (gtk-define-dead-key SunXK_FA_Cedilla compose-cedilla-map)
+ − 256 (gtk-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map)
+ − 257 (gtk-define-dead-key SunXK_FA_Circum compose-circumflex-map)
+ − 258 (gtk-define-dead-key SunXK_FA_Tilde compose-tilde-map)
+ − 259
+ − 260 ;; DEC according to MIT:
+ − 261 (gtk-define-dead-key Dacute_accent compose-acute-map)
+ − 262 (gtk-define-dead-key Dgrave_accent compose-grave-map)
+ − 263 (gtk-define-dead-key Dcedilla_accent compose-cedilla-map)
+ − 264 (gtk-define-dead-key Dcircumflex_accent compose-circumflex-map)
+ − 265 (gtk-define-dead-key Dtilde compose-tilde-map)
+ − 266 (gtk-define-dead-key Dring_accent compose-ring-map)
+ − 267
+ − 268 ;; DEC according to OpenWindows 3:
+ − 269 (gtk-define-dead-key DXK_acute_accent compose-acute-map)
+ − 270 (gtk-define-dead-key DXK_grave_accent compose-grave-map)
+ − 271 (gtk-define-dead-key DXK_cedilla_accent compose-cedilla-map)
+ − 272 (gtk-define-dead-key DXK_circumflex_accent compose-circumflex-map)
+ − 273 (gtk-define-dead-key DXK_tilde compose-tilde-map)
+ − 274 (gtk-define-dead-key DXK_ring_accent compose-ring-map)
+ − 275
+ − 276 ;; HP according to MIT:
+ − 277 (gtk-define-dead-key hpmute_acute compose-acute-map)
+ − 278 (gtk-define-dead-key hpmute_grave compose-grave-map)
+ − 279 (gtk-define-dead-key hpmute_diaeresis compose-diaeresis-map)
+ − 280 (gtk-define-dead-key hpmute_asciicircum compose-circumflex-map)
+ − 281 (gtk-define-dead-key hpmute_asciitilde compose-tilde-map)
+ − 282
+ − 283 ;; Empirically discovered on Linux XFree86 MetroX:
+ − 284 (gtk-define-dead-key usldead_acute compose-acute-map)
+ − 285 (gtk-define-dead-key usldead_grave compose-grave-map)
+ − 286 (gtk-define-dead-key usldead_diaeresis compose-diaeresis-map)
+ − 287 (gtk-define-dead-key usldead_asciicircum compose-circumflex-map)
+ − 288 (gtk-define-dead-key usldead_asciitilde compose-tilde-map)
+ − 289
+ − 290 ;; HP according to OpenWindows 3:
+ − 291 (gtk-define-dead-key hpXK_mute_acute compose-acute-map)
+ − 292 (gtk-define-dead-key hpXK_mute_grave compose-grave-map)
+ − 293 (gtk-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map)
+ − 294 (gtk-define-dead-key hpXK_mute_asciicircum compose-circumflex-map)
+ − 295 (gtk-define-dead-key hpXK_mute_asciitilde compose-tilde-map)
+ − 296
+ − 297 ;; HP according to HP-UX 8.0:
+ − 298 (gtk-define-dead-key XK_mute_acute compose-acute-map)
+ − 299 (gtk-define-dead-key XK_mute_grave compose-grave-map)
+ − 300 (gtk-define-dead-key XK_mute_diaeresis compose-diaeresis-map)
+ − 301 (gtk-define-dead-key XK_mute_asciicircum compose-circumflex-map)
+ − 302 (gtk-define-dead-key XK_mute_asciitilde compose-tilde-map)
+ − 303
+ − 304 ;; Xfree86 seems to use lower case and a hyphen
+ − 305 (gtk-define-dead-key dead-acute compose-acute-map)
+ − 306 (gtk-define-dead-key dead-grave compose-grave-map)
+ − 307 (gtk-define-dead-key dead-cedilla compose-cedilla-map)
+ − 308 (gtk-define-dead-key dead-diaeresis compose-diaeresis-map)
+ − 309 (gtk-define-dead-key dead-circum compose-circumflex-map)
+ − 310 (gtk-define-dead-key dead-circumflex compose-circumflex-map)
+ − 311 (gtk-define-dead-key dead-tilde compose-tilde-map)
+ − 312 )
+ − 313
+ − 314 (when (featurep 'gtk)
+ − 315 (add-hook
+ − 316 'create-console-hook
+ − 317 (lambda (console)
+ − 318 (letf (((selected-console) console))
+ − 319 (when (eq 'gtk (console-type console))
+ − 320 (gtk-initialize-compose))))))
