diff lisp/gtk-init.el @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents e34711681f30
children 308d34e9f07d
line wrap: on
line diff
--- a/lisp/gtk-init.el	Sat Dec 26 00:20:27 2009 -0600
+++ b/lisp/gtk-init.el	Sat Dec 26 21:18:49 2009 -0600
@@ -24,15 +24,19 @@
 ;; Boston, MA 02111-1307, USA.
 
 (globally-declare-boundp
- '(gtk-initial-argv-list
-   gtk-initial-geometry))
+ '(gtk-initial-argv-list gtk-initial-geometry))
 
 (globally-declare-fboundp
  '(gtk-keysym-on-keyboard-p))
 
-(defvar gtk-win-initted nil)
-(defvar gtk-pre-win-initted nil)
-(defvar gtk-post-win-initted nil)
+(defvar gtk-early-lisp-options-file "~/.xemacs/gtk-options.el"
+  "Path where GTK-specific early options should be stored.
+
+This allows the user to set initial geometry without using GNOME and session
+management, and, since it is read before GTK is initialized, it avoids
+window flicker on resizing.
+
+It is normally not useful to change without recompiling XEmacs.")
 
 (defvar gtk-command-switch-alist
   '(
@@ -66,27 +70,51 @@
     ("--sm-disable"       . t)
     )
 
-  "An assoc list of command line arguments that should in gtk-initial-argv-list.
-This is necessary because GTK and GNOME consider it a fatal error if they receive
-unknown command line arguments (perfectly reasonable).  But this means that if
-the user specifies a file name on the command line they will be unable to start.
-So we filter the command line and allow only items in this list in.
+  "An assoc list of command line args that should be in gtk-initial-argv-list.
+This is necessary because GTK and GNOME consider it a fatal error if they
+receive unknown command line arguments (perfectly reasonable).  But this
+means that if the user specifies a file name on the command line they will
+be unable to start.  So we filter the command line and allow only items in
+this list in.
+
+The CDR of the assoc list is whether it accepts an argument.  For the
+moment, all options are in GNU long form.")
+
+(defvar make-device-early-gtk-entry-point-called-p nil
+  "Whether `make-device-early-gtk-entry-point' has been called, at least once.
+
+Much of the GTK-specific Lisp init code should only be called the first time
+a GTK device is created; this variable allows for that.")
 
-The CDR of the assoc list is whether it accepts an argument.  All options are in
-GNU long form though.")
+(defvar make-device-late-gtk-entry-point-called-p nil
+  "Whether `make-device-late-gtk-entry-point' has been called, at least once.
+
+Much of the GTK-specific Lisp init code should only be called the first time
+a GTK device is created; this variable allows for that.")
 
-(defun init-pre-gtk-win ()
-  "Initialize Gtk GUI at startup (pre).  Don't call this."
-  (when (not gtk-pre-win-initted)
-    (setq initial-frame-plist (if initial-frame-unmapped-p
-				  '(initially-unmapped t)
-				nil)
-	  gtk-pre-win-initted t)))
+(defun make-device-early-gtk-entry-point ()
+  "Entry point to set up the Lisp environment before GTK device creation."
+  (unless make-device-early-gtk-entry-point-called-p
+    (setq initial-frame-plist
+          (and initial-frame-unmapped-p '(initially-unmapped t))
+          gtk-initial-argv-list
+          (cons (car command-line-args) (gtk-filter-arguments))
+	  gtk-initial-geometry
+          (nth 1 (member "-geometry" command-line-args-left))
+	  make-device-early-gtk-entry-point-called-p t)
+    (unless vanilla-inhibiting
+      (load gtk-early-lisp-options-file t t t))))
 
 (defun gtk-init-handle-geometry (arg)
   "Set up initial geometry info for GTK devices."
   (setq gtk-initial-geometry (pop command-line-args-left)))
 
+(defun make-device-late-gtk-entry-point (device)
+  "Entry-Point to do any Lisp-level GTK device-specific initialization."
+  (gtk-initialize-compose device)
+  (unless make-device-late-gtk-entry-point-called-p
+    (setq make-device-late-gtk-entry-point-called-p t)))
+
 (defun gtk-filter-arguments ()
   (let ((accepted nil)
 	(rejected nil)
@@ -121,85 +149,15 @@
     (setq command-line-args-left (nreverse rejected))
     (nreverse accepted)))
 
-(defun init-gtk-win ()
-  "Initialize Gtk GUI at startup.  Don't call this."
-  (unless gtk-win-initted
-    (init-pre-gtk-win)
-    (setq gtk-initial-argv-list (cons (car command-line-args) (gtk-filter-arguments))
-	  gtk-initial-geometry (nth 1 (member "-geometry" command-line-args-left)))
-    (make-gtk-device)
-    (init-post-gtk-win)
-    (setq gtk-win-initted t)))
-
-(defun init-post-gtk-win ()
-  (unless gtk-post-win-initted
-    (when (featurep 'mule)
-      (define-specifier-tag 'mule-fonts
-	(lambda (device) (eq 'gtk (device-type device))))
-      (set-face-font
-       'default
-       '("-*-fixed-medium-r-*--16-*-iso8859-1"
-	 "-*-fixed-medium-r-*--*-iso8859-1"
-	 "-*-fixed-medium-r-*--*-iso8859-2"
-	 "-*-fixed-medium-r-*--*-iso8859-3"
-	 "-*-fixed-medium-r-*--*-iso8859-4"
-	 "-*-fixed-medium-r-*--*-iso8859-7"
-	 "-*-fixed-medium-r-*--*-iso8859-8"
-	 "-*-fixed-medium-r-*--*-iso8859-5"
-	 "-*-fixed-medium-r-*--*-iso8859-9"
-
-	 ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun
-	 "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0"
-	 "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0"
-	 "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0"
-	 ;; Other Japanese fonts
-	 "-*-fixed-medium-r-*--*-jisx0201.1976-*"
-	 "-*-fixed-medium-r-*--*-jisx0208.1983-*"
-	 "-*-fixed-medium-r-*--*-jisx0212*-*"
-
-	 ;; Chinese fonts
-	 "-*-*-medium-r-*--*-gb2312.1980-*"
-       
-	 ;; Use One font specification for CNS chinese
-	 ;; Too many variations in font naming
-	 "-*-fixed-medium-r-*--*-cns11643*-*"
-	 ;; "-*-fixed-medium-r-*--*-cns11643*2"
-	 ;; "-*-fixed-medium-r-*--*-cns11643*3"
-	 ;; "-*-fixed-medium-r-*--*-cns11643*4"
-	 ;; "-*-fixed-medium-r-*--*-cns11643.5-0"
-	 ;; "-*-fixed-medium-r-*--*-cns11643.6-0"
-	 ;; "-*-fixed-medium-r-*--*-cns11643.7-0"
-       
-	 "-*-fixed-medium-r-*--*-big5*-*"
-	 "-*-fixed-medium-r-*--*-sisheng_cwnn-0"
-
-	 ;; Other fonts
-       
-	 ;; "-*-fixed-medium-r-*--*-viscii1.1-1"
-       
-	 ;; "-*-fixed-medium-r-*--*-mulearabic-0"
-	 ;; "-*-fixed-medium-r-*--*-mulearabic-1"
-	 ;; "-*-fixed-medium-r-*--*-mulearabic-2"
-
-	 ;; "-*-fixed-medium-r-*--*-muleipa-1"
-	 ;; "-*-fixed-medium-r-*--*-ethio-*"
-
-	 "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean
-	 "-*-fixed-medium-r-*--*-tis620.2529-1" ; Thai
-	 )
-       'global '(mule-fonts) 'append))
-    
-    (setq gtk-post-win-initted t)))
-    
 (push '("-geometry" . gtk-init-handle-geometry) command-switch-alist)
 
 ;;; Stuff to get compose keys working on GTK
 (eval-when-compile
-  (defmacro gtk-define-dead-key (key map)
-    `(when (gtk-keysym-on-keyboard-p ',key)
+  (defmacro gtk-define-dead-key (key map device)
+    `(when (gtk-keysym-on-keyboard-p ',key device)
        (define-key function-key-map [,key] ',map))))
 
-(defun gtk-initialize-compose ()
+(defun gtk-initialize-compose (device)
   "Enable compose processing"
   (autoload 'compose-map	    "gtk-compose" nil t 'keymap)
   (autoload 'compose-acute-map	    "gtk-compose" nil t 'keymap)
@@ -209,7 +167,7 @@
   (autoload 'compose-circumflex-map "gtk-compose" nil t 'keymap)
   (autoload 'compose-tilde-map	    "gtk-compose" nil t 'keymap)
 
-  (when (gtk-keysym-on-keyboard-p 'multi-key)
+  (when (gtk-keysym-on-keyboard-p 'multi-key device)
     (define-key function-key-map [multi-key] 'compose-map))
 
   ;; The dead keys might really be called just about anything, depending
@@ -228,93 +186,85 @@
   ;; mixed up view of what these keys should be called.
 
   ;; Canonical names:
-  (gtk-define-dead-key acute			compose-acute-map)
-  (gtk-define-dead-key grave			compose-grave-map)
-  (gtk-define-dead-key cedilla			compose-cedilla-map)
-  (gtk-define-dead-key diaeresis		compose-diaeresis-map)
-  (gtk-define-dead-key circumflex		compose-circumflex-map)
-  (gtk-define-dead-key tilde			compose-tilde-map)
-  (gtk-define-dead-key degree			compose-ring-map)
+  (gtk-define-dead-key acute			compose-acute-map device)
+  (gtk-define-dead-key grave			compose-grave-map device)
+  (gtk-define-dead-key cedilla			compose-cedilla-map device)
+  (gtk-define-dead-key diaeresis		compose-diaeresis-map device)
+  (gtk-define-dead-key circumflex		compose-circumflex-map device)
+  (gtk-define-dead-key tilde			compose-tilde-map device)
+  (gtk-define-dead-key degree			compose-ring-map device)
 
   ;; Sun according to MIT:
-  (gtk-define-dead-key SunFA_Acute		compose-acute-map)
-  (gtk-define-dead-key SunFA_Grave		compose-grave-map)
-  (gtk-define-dead-key SunFA_Cedilla		compose-cedilla-map)
-  (gtk-define-dead-key SunFA_Diaeresis		compose-diaeresis-map)
-  (gtk-define-dead-key SunFA_Circum		compose-circumflex-map)
-  (gtk-define-dead-key SunFA_Tilde		compose-tilde-map)
+  (gtk-define-dead-key SunFA_Acute		compose-acute-map device)
+  (gtk-define-dead-key SunFA_Grave		compose-grave-map device)
+  (gtk-define-dead-key SunFA_Cedilla		compose-cedilla-map device)
+  (gtk-define-dead-key SunFA_Diaeresis		compose-diaeresis-map device)
+  (gtk-define-dead-key SunFA_Circum		compose-circumflex-map device)
+  (gtk-define-dead-key SunFA_Tilde		compose-tilde-map device)
 
   ;; Sun according to OpenWindows 2:
-  (gtk-define-dead-key Dead_Grave		compose-grave-map)
-  (gtk-define-dead-key Dead_Circum		compose-circumflex-map)
-  (gtk-define-dead-key Dead_Tilde		compose-tilde-map)
+  (gtk-define-dead-key Dead_Grave		compose-grave-map device)
+  (gtk-define-dead-key Dead_Circum		compose-circumflex-map device)
+  (gtk-define-dead-key Dead_Tilde		compose-tilde-map device)
 
   ;; Sun according to OpenWindows 3:
-  (gtk-define-dead-key SunXK_FA_Acute		compose-acute-map)
-  (gtk-define-dead-key SunXK_FA_Grave		compose-grave-map)
-  (gtk-define-dead-key SunXK_FA_Cedilla		compose-cedilla-map)
-  (gtk-define-dead-key SunXK_FA_Diaeresis	compose-diaeresis-map)
-  (gtk-define-dead-key SunXK_FA_Circum		compose-circumflex-map)
-  (gtk-define-dead-key SunXK_FA_Tilde		compose-tilde-map)
+  (gtk-define-dead-key SunXK_FA_Acute		compose-acute-map device)
+  (gtk-define-dead-key SunXK_FA_Grave		compose-grave-map device)
+  (gtk-define-dead-key SunXK_FA_Cedilla		compose-cedilla-map device)
+  (gtk-define-dead-key SunXK_FA_Diaeresis	compose-diaeresis-map device)
+  (gtk-define-dead-key SunXK_FA_Circum		compose-circumflex-map device)
+  (gtk-define-dead-key SunXK_FA_Tilde		compose-tilde-map device)
 
   ;; DEC according to MIT:
-  (gtk-define-dead-key Dacute_accent		compose-acute-map)
-  (gtk-define-dead-key Dgrave_accent		compose-grave-map)
-  (gtk-define-dead-key Dcedilla_accent		compose-cedilla-map)
-  (gtk-define-dead-key Dcircumflex_accent	compose-circumflex-map)
-  (gtk-define-dead-key Dtilde			compose-tilde-map)
-  (gtk-define-dead-key Dring_accent		compose-ring-map)
+  (gtk-define-dead-key Dacute_accent		compose-acute-map device)
+  (gtk-define-dead-key Dgrave_accent		compose-grave-map device)
+  (gtk-define-dead-key Dcedilla_accent		compose-cedilla-map device)
+  (gtk-define-dead-key Dcircumflex_accent	compose-circumflex-map device)
+  (gtk-define-dead-key Dtilde			compose-tilde-map device)
+  (gtk-define-dead-key Dring_accent		compose-ring-map device)
 
   ;; DEC according to OpenWindows 3:
-  (gtk-define-dead-key DXK_acute_accent		compose-acute-map)
-  (gtk-define-dead-key DXK_grave_accent		compose-grave-map)
-  (gtk-define-dead-key DXK_cedilla_accent	compose-cedilla-map)
-  (gtk-define-dead-key DXK_circumflex_accent	compose-circumflex-map)
-  (gtk-define-dead-key DXK_tilde		compose-tilde-map)
-  (gtk-define-dead-key DXK_ring_accent		compose-ring-map)
+  (gtk-define-dead-key DXK_acute_accent		compose-acute-map device)
+  (gtk-define-dead-key DXK_grave_accent		compose-grave-map device)
+  (gtk-define-dead-key DXK_cedilla_accent	compose-cedilla-map device)
+  (gtk-define-dead-key DXK_circumflex_accent	compose-circumflex-map device)
+  (gtk-define-dead-key DXK_tilde		compose-tilde-map device)
+  (gtk-define-dead-key DXK_ring_accent		compose-ring-map device)
 
   ;; HP according to MIT:
-  (gtk-define-dead-key hpmute_acute		compose-acute-map)
-  (gtk-define-dead-key hpmute_grave		compose-grave-map)
-  (gtk-define-dead-key hpmute_diaeresis		compose-diaeresis-map)
-  (gtk-define-dead-key hpmute_asciicircum	compose-circumflex-map)
-  (gtk-define-dead-key hpmute_asciitilde	compose-tilde-map)
+  (gtk-define-dead-key hpmute_acute		compose-acute-map device)
+  (gtk-define-dead-key hpmute_grave		compose-grave-map device)
+  (gtk-define-dead-key hpmute_diaeresis		compose-diaeresis-map device)
+  (gtk-define-dead-key hpmute_asciicircum	compose-circumflex-map device)
+  (gtk-define-dead-key hpmute_asciitilde	compose-tilde-map device)
 
   ;; Empirically discovered on Linux XFree86 MetroX:
-  (gtk-define-dead-key usldead_acute		compose-acute-map)
-  (gtk-define-dead-key usldead_grave		compose-grave-map)
-  (gtk-define-dead-key usldead_diaeresis	compose-diaeresis-map)
-  (gtk-define-dead-key usldead_asciicircum	compose-circumflex-map)
-  (gtk-define-dead-key usldead_asciitilde	compose-tilde-map)
+  (gtk-define-dead-key usldead_acute		compose-acute-map device)
+  (gtk-define-dead-key usldead_grave		compose-grave-map device)
+  (gtk-define-dead-key usldead_diaeresis	compose-diaeresis-map device)
+  (gtk-define-dead-key usldead_asciicircum	compose-circumflex-map device)
+  (gtk-define-dead-key usldead_asciitilde	compose-tilde-map device)
 
   ;; HP according to OpenWindows 3:
-  (gtk-define-dead-key hpXK_mute_acute		compose-acute-map)
-  (gtk-define-dead-key hpXK_mute_grave		compose-grave-map)
-  (gtk-define-dead-key hpXK_mute_diaeresis	compose-diaeresis-map)
-  (gtk-define-dead-key hpXK_mute_asciicircum	compose-circumflex-map)
-  (gtk-define-dead-key hpXK_mute_asciitilde	compose-tilde-map)
+  (gtk-define-dead-key hpXK_mute_acute		compose-acute-map device)
+  (gtk-define-dead-key hpXK_mute_grave		compose-grave-map device)
+  (gtk-define-dead-key hpXK_mute_diaeresis	compose-diaeresis-map device)
+  (gtk-define-dead-key hpXK_mute_asciicircum	compose-circumflex-map device)
+  (gtk-define-dead-key hpXK_mute_asciitilde	compose-tilde-map device)
 
   ;; HP according to HP-UX 8.0:
-  (gtk-define-dead-key XK_mute_acute		compose-acute-map)
-  (gtk-define-dead-key XK_mute_grave		compose-grave-map)
-  (gtk-define-dead-key XK_mute_diaeresis	compose-diaeresis-map)
-  (gtk-define-dead-key XK_mute_asciicircum	compose-circumflex-map)
-  (gtk-define-dead-key XK_mute_asciitilde	compose-tilde-map)
+  (gtk-define-dead-key XK_mute_acute		compose-acute-map device)
+  (gtk-define-dead-key XK_mute_grave		compose-grave-map device)
+  (gtk-define-dead-key XK_mute_diaeresis	compose-diaeresis-map device)
+  (gtk-define-dead-key XK_mute_asciicircum	compose-circumflex-map device)
+  (gtk-define-dead-key XK_mute_asciitilde	compose-tilde-map device)
 
   ;; Xfree86 seems to use lower case and a hyphen
-  (gtk-define-dead-key dead-acute		compose-acute-map)
-  (gtk-define-dead-key dead-grave		compose-grave-map)
-  (gtk-define-dead-key dead-cedilla		compose-cedilla-map)
-  (gtk-define-dead-key dead-diaeresis		compose-diaeresis-map)
-  (gtk-define-dead-key dead-circum		compose-circumflex-map)
-  (gtk-define-dead-key dead-circumflex		compose-circumflex-map)
-  (gtk-define-dead-key dead-tilde		compose-tilde-map)
-  )
+  (gtk-define-dead-key dead-acute		compose-acute-map device)
+  (gtk-define-dead-key dead-grave		compose-grave-map device)
+  (gtk-define-dead-key dead-cedilla		compose-cedilla-map device)
+  (gtk-define-dead-key dead-diaeresis		compose-diaeresis-map device)
+  (gtk-define-dead-key dead-circum		compose-circumflex-map device)
+  (gtk-define-dead-key dead-circumflex		compose-circumflex-map device)
+  (gtk-define-dead-key dead-tilde		compose-tilde-map device))
 
-(when (featurep 'gtk)
-  (add-hook
-   'create-console-hook
-   (lambda (console)
-     (letf (((selected-console) console))
-       (when (eq 'gtk (console-type console))
-	 (gtk-initialize-compose))))))