[PATCH] Decide to run general device-type code in device-specific code

On my machine, where locale(1) gives the following: LANG="de_DE.UTF-8" LC_COLLATE="de_DE.UTF-8" LC_CTYPE="de_DE.UTF-8" LC_MESSAGES="de_DE.UTF-8" LC_MONETARY="de_DE.UTF-8" LC_NUMERIC="de_DE.UTF-8" LC_TIME="de_DE.UTF-8" LC_ALL="de_DE.UTF-8" I can start an X11 XEmacs and I get a German menubar. This is well and good, despite occasional bemusement here from German-speakers at the translations. However, when I do this: $ unset DISPLAY $ screen -d -m xemacs -vanilla -f gnuserv-start $ DISPLAY=:0 export DISPLAY $ gnuclient I get a frame with an English menubar. Basically, it turns out that at startup, lots of stuff is done that would be better done the first time a device of a particular type is created. This patch avoids that. Please test; I’ve tested with GTK, X11, Win32 and the TTY (though without testing all the terminal-specific code, something impossible for me; happily, the amount of terminal-specific voodoo (beyond defining key bindings) is limited). I wonder a little if I should call the pre-device-type-creation code from the superclass (in OO terms), instead of the device-type-specific init code. If anyone has a suggestion for or against, I’d love to hear it. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1215464023 -7200 # Node ID b3b6cf59fe580c5f11867a4a6ba9362cc92d846f # Parent 78738a40e31e5bb7d8ee5a1d0f8e27d025bcebb9 Don't determine whether to call general device-type code at startup, rather decide in the device-specific code itself. 2008-07-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; Patch to make it up to the device-specific code whether various Lisp functions should be called during device creation, not relying on the startup code to decide this. Also, rename initial-window-system to initial-device-type (which makes more sense in this scheme), always set it. * startup.el (command-line): Use initial-device-type, not initial-window-system; just call #'make-device, leave the special behaviour to be done the first time a console type is initialised to be decided on by the respective console code. * x-init.el (x-app-defaults-directory): Declare that it should be bound. (x-define-dead-key): Have the macro take a DEVICE argument. (x-initialize-compose): Have the function take a DEVICE argument, and use it when checking if various keysyms are available on the keyboard. (x-initialize-keyboard): Have the function take a DEVICE argument, allowing device-specific keyboard initialisation. (make-device-early-x-entry-point-called-p): New. (make-device-late-x-entry-point-called-p): New. Rename pre-x-win-initted, x-win-initted. (make-device-early-x-entry-point): Rename init-pre-x-win, take the call to make-x-device out (it should be called from the device-creation code, not vice-versa). (make-device-late-x-entry-point): Rename init-post-x-win, have it take a DEVICE argument, use that DEVICE argument when working out what device-specific things need doing. Don't use create-console-hook in core code. * x-win-xfree86.el (x-win-init-xfree86): Take a DEVICE argument; use it. * x-win-sun.el (x-win-init-sun): Take a DEVICE argument; use it. * mule/mule-x-init.el: Remove #'init-mule-x-win, an empty function. * tty-init.el (make-device-early-tty-entry-point-called-p): New. Rename pre-tty-win-initted. (make-device-early-tty-entry-point): New. Rename init-pre-tty-win. (make-frame-after-init-entry-point): New. Rename init-post-tty-win to better reflect when it's called. * gtk-init.el (gtk-early-lisp-options-file): New. Move this path to a documented variable. (gtk-command-switch-alist): Wrap the docstring to fewer than 79 columns. (make-device-early-gtk-entry-point-called-p): New. (make-device-late-gtk-entry-point-called-p): New. Renamed gtk-pre-win-initted, gtk-post-win-initted to these. (make-device-early-gtk-entry-point): New. (make-device-late-gtk-entry-point): New. Renamed init-pre-gtk-win, init-post-gtk-win to these. Have make-device-late-gtk-entry-point take a device argument, and use it; have make-device-early-gtk-entry-point load the GTK-specific startup code, instead of doing that in C. (init-gtk-win): Deleted, functionality moved to the GTK device creation code. (gtk-define-dead-key): Have it take a DEVICE argument; use this argument. (gtk-initialize-compose): Ditto. * coding.el (set-terminal-coding-system): Correct the docstring; the function isn't broken. diff -r 78738a40e31e -r b3b6cf59fe58 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/ChangeLog Mon Jul 07 22:53:43 2008 +0200 ＠＠ -1,3 +1,70 ＠＠ +2008-07-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Patch to make it up to the device-specific code whether + various Lisp functions should be called during device creation, + not relying on the startup code to decide this. Also, rename + initial-window-system to initial-device-type (which makes more + sense in this scheme), always set it. + + * startup.el (command-line): + Use initial-device-type, not initial-window-system; just call + #'make-device, leave the special behaviour to be done the first + time a console type is initialised to be decided on by the + respective console code. + + * x-init.el (x-app-defaults-directory): Declare that it should be + bound. + (x-define-dead-key): Have the macro take a DEVICE argument. + (x-initialize-compose): Have the function take a DEVICE argument, + and use it when checking if various keysyms are available on the + keyboard. + (x-initialize-keyboard): Have the function take a DEVICE argument, + allowing device-specific keyboard initialisation. + (make-device-early-x-entry-point-called-p): New. + (make-device-late-x-entry-point-called-p): New. Rename + pre-x-win-initted, x-win-initted. + (make-device-early-x-entry-point): Rename init-pre-x-win, take the + call to make-x-device out (it should be called from the + device-creation code, not vice-versa). + (make-device-late-x-entry-point): Rename init-post-x-win, have it + take a DEVICE argument, use that DEVICE argument when working out + what device-specific things need doing. Don't use + create-console-hook in core code. + * x-win-xfree86.el (x-win-init-xfree86): Take a DEVICE argument; + use it. + * x-win-sun.el (x-win-init-sun): Take a DEVICE argument; use it. + * mule/mule-x-init.el: Remove #'init-mule-x-win, an empty + function. + + * tty-init.el (make-device-early-tty-entry-point-called-p): New. + Rename pre-tty-win-initted. + (make-device-early-tty-entry-point): New. + Rename init-pre-tty-win. + (make-frame-after-init-entry-point): New. + Rename init-post-tty-win to better reflect when it's called. + + * gtk-init.el (gtk-early-lisp-options-file): New. + Move this path to a documented variable. + (gtk-command-switch-alist): Wrap the docstring to fewer than 79 + columns. + (make-device-early-gtk-entry-point-called-p): New. + (make-device-late-gtk-entry-point-called-p): New. + Renamed gtk-pre-win-initted, gtk-post-win-initted to these. + (make-device-early-gtk-entry-point): New. + (make-device-late-gtk-entry-point): New. + Renamed init-pre-gtk-win, init-post-gtk-win to these. + Have make-device-late-gtk-entry-point take a device argument, and use + it; have make-device-early-gtk-entry-point load the GTK-specific + startup code, instead of doing that in C. + (init-gtk-win): Deleted, functionality moved to the GTK device + creation code. + (gtk-define-dead-key): Have it take a DEVICE argument; use this + argument. + (gtk-initialize-compose): Ditto. + + * coding.el (set-terminal-coding-system): + Correct the docstring; the function isn't broken. + 2008-06-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * descr-text.el (describe-char-unicode-data): diff -r 78738a40e31e -r b3b6cf59fe58 lisp/coding.el --- a/lisp/coding.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/coding.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -108,7 +108,7 ＠＠ terminal-coding-system) (defun set-terminal-coding-system (coding-system) - "Set the coding system used for TTY display output. Currently broken." + "Set the coding system used for TTY display output." (interactive "zterminal-coding-system: ") (get-coding-system coding-system) ; correctness check (setq terminal-coding-system coding-system) diff -r 78738a40e31e -r b3b6cf59fe58 lisp/gtk-init.el --- a/lisp/gtk-init.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/gtk-init.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -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,26 +70,50 ＠＠ ("--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. All options are in -GNU long form though.") +The CDR of the assoc list is whether it accepts an argument. For the +moment, all options are in GNU long form.") -(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))) +(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.") + +(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 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) ＠＠ -121,29 +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 - (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) ＠＠ -153,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 ＠＠ -172,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)))))) diff -r 78738a40e31e -r b3b6cf59fe58 lisp/msw-init.el --- a/lisp/msw-init.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/msw-init.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -23,26 +23,15 ＠＠ ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -(defvar mswindows-win-initted nil) -(defvar mswindows-pre-win-initted nil) -(defvar mswindows-post-win-initted nil) +(defvar make-device-early-mswindows-entry-point-called-p nil + "Whether `make-device-early-mswindows-entry-point' has been called") -(defun init-pre-mswindows-win () - "Initialize mswindows GUI at startup (pre). Don't call this." - (unless mswindows-pre-win-initted - (setq mswindows-pre-win-initted t))) +(defvar make-device-late-mswindows-entry-point-called-p nil + "Whether `make-device-late-mswindows-entry-point' has been called") -(defun init-mswindows-win () - "Initialize mswindows GUI at startup. Don't call this." - (unless mswindows-win-initted - (init-pre-mswindows-win) - (make-mswindows-device) - (init-post-mswindows-win (selected-console)) - (setq mswindows-win-initted t))) - -(defun init-post-mswindows-win (console) - "Initialize mswindows GUI at startup (post). Don't call this." - (unless mswindows-post-win-initted +(defun make-device-early-mswindows-entry-point () + "Lisp code called before an `mswindows' device is created." + (unless make-device-early-mswindows-entry-point-called-p ;; Old-style mswindows bindings. The new-style mswindows bindings ;; (namely Ctrl-X, Ctrl-C and Ctrl-V) are already spoken for by XEmacs. (global-set-key '(shift delete) 'kill-primary-selection) ＠＠ -50,6 +39,10 ＠＠ (global-set-key '(control insert) 'copy-primary-selection) (global-set-key '(meta f4) 'save-buffers-kill-emacs) + (setq make-device-early-mswindows-entry-point-called-p t))) - (setq mswindows-post-win-initted t))) +(defun make-device-late-mswindows-entry-point (device) + "Lisp code called after an `mswindows' device is created." + (unless make-device-late-mswindows-entry-point-called-p + (setq make-device-late-mswindows-entry-point-called-p t))) diff -r 78738a40e31e -r b3b6cf59fe58 lisp/mule/mule-x-init.el --- a/lisp/mule/mule-x-init.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/mule/mule-x-init.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -28,6 +28,7 ＠＠ ;;; Work around what is arguably a Sun CDE bug. +;; #### This is unused, apparently. (defun x-use-halfwidth-roman-font (fullwidth-charset roman-registry) "Maybe set charset registry of the 'ascii charset to ROMAN-REGISTRY. ＠＠ -60,9 +61,3 ＠＠ (error (set-charset-registries 'ascii original-registries))))))) ;;;; - -(defvar mule-x-win-initted nil) - -(defun init-mule-x-win () - "Initialize X Windows for MULE at startup. Don't call this." - ) diff -r 78738a40e31e -r b3b6cf59fe58 lisp/startup.el --- a/lisp/startup.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/startup.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -726,13 +726,9 ＠＠ (require 'id-x-toolbar) (init-toolbar))) - ;; Run the window system's init function. tty is considered to be - ;; a type of window system for this purpose. This creates the - ;; initial (non stdio) device. - (when (and initial-window-system (not noninteractive)) - (funcall (intern (concat "init-" - (symbol-name initial-window-system) - "-win")))) + ;; Create the initial device (which may be the already-created stdio + ;; device, if we're noninteractive). + (make-device initial-device-type nil nil) ;; When not in batch mode, this creates the first visible frame, ;; and deletes the stdio device. ＠＠ -1457,7 +1453,7 ＠＠ If SET-GLOBAL-PACKAGE-PATHS is non-nil, initialize the global package path variables referring to the particular types of packages -(`early-package-hierarchies', `early-package-load-path', +\(`early-package-hierarchies', `early-package-load-path', `late-package-hierarchies', `late-package-load-path', `last-package-hierarchies', `last-package-load-path')." (let (earlyp latep lastp earlyp-lp latep-lp lastp-lp) diff -r 78738a40e31e -r b3b6cf59fe58 lisp/tty-init.el --- a/lisp/tty-init.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/tty-init.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -31,13 +31,13 ＠＠ ;;; Code: -(defvar pre-tty-win-initted nil) +(defvar make-device-early-tty-entry-point-called-p nil + "Whether `make-device-early-tty-entry-point' has been called, at least once.") -;; called both from init-tty-win and from the C code. -(defun init-pre-tty-win () - "Initialize TTY at startup (pre). Don't call this." +(defun make-device-early-tty-entry-point () + "Entry point to set up the Lisp environment for TTY device creation." (with-fboundp 'register-tty-color - (unless pre-tty-win-initted + (unless make-device-early-tty-entry-point-called-p (register-tty-color "black" "\e[30m" "\e[40m") (register-tty-color "red" "\e[31m" "\e[41m") (register-tty-color "green" "\e[32m" "\e[42m") ＠＠ -59,16 +59,17 ＠＠ (setq pre-tty-win-initted t)))) -;; called both from init-tty-win and from the C code. -;; we have to do this for every created TTY console. -(defun init-post-tty-win (console) - "Initialize TTY at console creation time (post). Don't call this." +;; We have to do this for every created TTY console, after the first frame +;; has been created. +(defun make-frame-after-init-entry-point (console) + "Entry point for Lisp called after first frame creation on a TTY device." ;; load the appropriate term-type-specific Lisp file. ;; we don't do this at startup here so that the user can ;; override term-file-prefix. (startup.el does it after ;; loading the init file.) - (if (featurep 'mule) - (declare-fboundp (init-mule-tty-win))) + (when (and (find-coding-system 'euc-jp) + (string-match "^kterm" (getenv "TERM"))) + (set-console-tty-coding-system console 'euc-jp)) (when init-file-loaded ;; temporarily select the console so that the changes ;; to function-key-map are made for the right console. ＠＠ -78,16 +79,6 ＠＠ (select-console console) (load-terminal-library)) (select-console foobar))))) - -(defvar tty-win-initted nil) - -(defun init-tty-win () - "Initialize TTY at startup. Don't call this." - (unless tty-win-initted - (init-pre-tty-win) - (make-tty-device nil nil) - (init-post-tty-win (selected-console)) - (setq tty-win-initted t))) (defun make-frame-on-tty (tty &optional props) "Create a frame on the TTY connection named TTY. diff -r 78738a40e31e -r b3b6cf59fe58 lisp/x-compose.el --- a/lisp/x-compose.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/x-compose.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -102,7 +102,8 ＠＠ ;; Giacomo Boffi's problem of ;; 20050324103919.8D22E4901(a)boffi95.stru.polimi.it is caused by Xlib doing -;; the compose processing. To turn that off, I'm not certain what's +;; the compose processing. To turn that off, I'm not certain what's +;; possible, beyond making C the current locale. ;;; Code: diff -r 78738a40e31e -r b3b6cf59fe58 lisp/x-init.el --- a/lisp/x-init.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/x-init.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -37,7 +37,7 ＠＠ x-server-vendor x-init-specifier-from-resources init-mule-x-win)) (globally-declare-boundp - '(x-initial-argv-list)) + '(x-initial-argv-list x-app-defaults-directory)) ;; If you want to change this variable, this is the place you must do it. ;; Do not set it to a string containing periods. X doesn't like that. ＠＠ -86,12 +86,12 ＠＠ ;; Sun have done to the default keymap for the Sun keyboards. (eval-when-compile - (defmacro x-define-dead-key (key map) - `(when (x-keysym-on-keyboard-p ',key) + (defmacro x-define-dead-key (key map device) + `(when (x-keysym-on-keyboard-p ',key device) (define-key function-key-map [,key] ',map)))) -(defun x-initialize-compose () - "Enable compose key and dead key processing." +(defun x-initialize-compose (device) + "Enable compose key and dead key processing on DEVICE." (autoload 'compose-map "x-compose" nil t 'keymap) (autoload 'compose-acute-map "x-compose" nil t 'keymap) (autoload 'compose-grave-map "x-compose" nil t 'keymap) ＠＠ -100,7 +100,7 ＠＠ (autoload 'compose-circumflex-map "x-compose" nil t 'keymap) (autoload 'compose-tilde-map "x-compose" nil t 'keymap) - (when (x-keysym-on-keyboard-p 'multi-key) + (when (x-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 ＠＠ -119,98 +119,98 ＠＠ ;; mixed up view of what these keys should be called. ;; Canonical names: - (x-define-dead-key acute compose-acute-map) - (x-define-dead-key grave compose-grave-map) - (x-define-dead-key cedilla compose-cedilla-map) - (x-define-dead-key diaeresis compose-diaeresis-map) - (x-define-dead-key circumflex compose-circumflex-map) - (x-define-dead-key tilde compose-tilde-map) - (x-define-dead-key degree compose-ring-map) + (x-define-dead-key acute compose-acute-map device) + (x-define-dead-key grave compose-grave-map device) + (x-define-dead-key cedilla compose-cedilla-map device) + (x-define-dead-key diaeresis compose-diaeresis-map device) + (x-define-dead-key circumflex compose-circumflex-map device) + (x-define-dead-key tilde compose-tilde-map device) + (x-define-dead-key degree compose-ring-map device) ;; Sun according to MIT: - (x-define-dead-key SunFA_Acute compose-acute-map) - (x-define-dead-key SunFA_Grave compose-grave-map) - (x-define-dead-key SunFA_Cedilla compose-cedilla-map) - (x-define-dead-key SunFA_Diaeresis compose-diaeresis-map) - (x-define-dead-key SunFA_Circum compose-circumflex-map) - (x-define-dead-key SunFA_Tilde compose-tilde-map) + (x-define-dead-key SunFA_Acute compose-acute-map device) + (x-define-dead-key SunFA_Grave compose-grave-map device) + (x-define-dead-key SunFA_Cedilla compose-cedilla-map device) + (x-define-dead-key SunFA_Diaeresis compose-diaeresis-map device) + (x-define-dead-key SunFA_Circum compose-circumflex-map device) + (x-define-dead-key SunFA_Tilde compose-tilde-map device) ;; Sun according to OpenWindows 2: - (x-define-dead-key Dead_Grave compose-grave-map) - (x-define-dead-key Dead_Circum compose-circumflex-map) - (x-define-dead-key Dead_Tilde compose-tilde-map) + (x-define-dead-key Dead_Grave compose-grave-map device) + (x-define-dead-key Dead_Circum compose-circumflex-map device) + (x-define-dead-key Dead_Tilde compose-tilde-map device) ;; Sun according to OpenWindows 3: - (x-define-dead-key SunXK_FA_Acute compose-acute-map) - (x-define-dead-key SunXK_FA_Grave compose-grave-map) - (x-define-dead-key SunXK_FA_Cedilla compose-cedilla-map) - (x-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map) - (x-define-dead-key SunXK_FA_Circum compose-circumflex-map) - (x-define-dead-key SunXK_FA_Tilde compose-tilde-map) + (x-define-dead-key SunXK_FA_Acute compose-acute-map device) + (x-define-dead-key SunXK_FA_Grave compose-grave-map device) + (x-define-dead-key SunXK_FA_Cedilla compose-cedilla-map device) + (x-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map device) + (x-define-dead-key SunXK_FA_Circum compose-circumflex-map device) + (x-define-dead-key SunXK_FA_Tilde compose-tilde-map device) ;; DEC according to MIT: - (x-define-dead-key Dacute_accent compose-acute-map) - (x-define-dead-key Dgrave_accent compose-grave-map) - (x-define-dead-key Dcedilla_accent compose-cedilla-map) - (x-define-dead-key Dcircumflex_accent compose-circumflex-map) - (x-define-dead-key Dtilde compose-tilde-map) - (x-define-dead-key Dring_accent compose-ring-map) + (x-define-dead-key Dacute_accent compose-acute-map device) + (x-define-dead-key Dgrave_accent compose-grave-map device) + (x-define-dead-key Dcedilla_accent compose-cedilla-map device) + (x-define-dead-key Dcircumflex_accent compose-circumflex-map device) + (x-define-dead-key Dtilde compose-tilde-map device) + (x-define-dead-key Dring_accent compose-ring-map device) ;; DEC according to OpenWindows 3: - (x-define-dead-key DXK_acute_accent compose-acute-map) - (x-define-dead-key DXK_grave_accent compose-grave-map) - (x-define-dead-key DXK_cedilla_accent compose-cedilla-map) - (x-define-dead-key DXK_circumflex_accent compose-circumflex-map) - (x-define-dead-key DXK_tilde compose-tilde-map) - (x-define-dead-key DXK_ring_accent compose-ring-map) + (x-define-dead-key DXK_acute_accent compose-acute-map device) + (x-define-dead-key DXK_grave_accent compose-grave-map device) + (x-define-dead-key DXK_cedilla_accent compose-cedilla-map device) + (x-define-dead-key DXK_circumflex_accent compose-circumflex-map device) + (x-define-dead-key DXK_tilde compose-tilde-map device) + (x-define-dead-key DXK_ring_accent compose-ring-map device) ;; HP according to MIT: - (x-define-dead-key hpmute_acute compose-acute-map) - (x-define-dead-key hpmute_grave compose-grave-map) - (x-define-dead-key hpmute_diaeresis compose-diaeresis-map) - (x-define-dead-key hpmute_asciicircum compose-circumflex-map) - (x-define-dead-key hpmute_asciitilde compose-tilde-map) + (x-define-dead-key hpmute_acute compose-acute-map device) + (x-define-dead-key hpmute_grave compose-grave-map device) + (x-define-dead-key hpmute_diaeresis compose-diaeresis-map device) + (x-define-dead-key hpmute_asciicircum compose-circumflex-map device) + (x-define-dead-key hpmute_asciitilde compose-tilde-map device) ;; Empirically discovered on Linux XFree86 MetroX: - (x-define-dead-key usldead_acute compose-acute-map) - (x-define-dead-key usldead_grave compose-grave-map) - (x-define-dead-key usldead_diaeresis compose-diaeresis-map) - (x-define-dead-key usldead_asciicircum compose-circumflex-map) - (x-define-dead-key usldead_asciitilde compose-tilde-map) + (x-define-dead-key usldead_acute compose-acute-map device) + (x-define-dead-key usldead_grave compose-grave-map device) + (x-define-dead-key usldead_diaeresis compose-diaeresis-map device) + (x-define-dead-key usldead_asciicircum compose-circumflex-map device) + (x-define-dead-key usldead_asciitilde compose-tilde-map device) ;; HP according to OpenWindows 3: - (x-define-dead-key hpXK_mute_acute compose-acute-map) - (x-define-dead-key hpXK_mute_grave compose-grave-map) - (x-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map) - (x-define-dead-key hpXK_mute_asciicircum compose-circumflex-map) - (x-define-dead-key hpXK_mute_asciitilde compose-tilde-map) + (x-define-dead-key hpXK_mute_acute compose-acute-map device) + (x-define-dead-key hpXK_mute_grave compose-grave-map device) + (x-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map device) + (x-define-dead-key hpXK_mute_asciicircum compose-circumflex-map device) + (x-define-dead-key hpXK_mute_asciitilde compose-tilde-map device) ;; HP according to HP-UX 8.0: - (x-define-dead-key XK_mute_acute compose-acute-map) - (x-define-dead-key XK_mute_grave compose-grave-map) - (x-define-dead-key XK_mute_diaeresis compose-diaeresis-map) - (x-define-dead-key XK_mute_asciicircum compose-circumflex-map) - (x-define-dead-key XK_mute_asciitilde compose-tilde-map) + (x-define-dead-key XK_mute_acute compose-acute-map device) + (x-define-dead-key XK_mute_grave compose-grave-map device) + (x-define-dead-key XK_mute_diaeresis compose-diaeresis-map device) + (x-define-dead-key XK_mute_asciicircum compose-circumflex-map device) + (x-define-dead-key XK_mute_asciitilde compose-tilde-map device) ;; [[ XFree86 seems to use lower case and a hyphen ]] Not true; they use ;; lower case and an underscore. XEmacs converts the underscore to a ;; hyphen in x_keysym_to_emacs_keysym because the keysym is in the ;; "Keyboard" character set, which is just totally fucking random, ;; considering it doesn't happen for any other character sets. - (x-define-dead-key dead-acute compose-acute-map) - (x-define-dead-key dead-grave compose-grave-map) - (x-define-dead-key dead-cedilla compose-cedilla-map) - (x-define-dead-key dead-diaeresis compose-diaeresis-map) - (x-define-dead-key dead-circum compose-circumflex-map) - (x-define-dead-key dead-circumflex compose-circumflex-map) - (x-define-dead-key dead-tilde compose-tilde-map) + (x-define-dead-key dead-acute compose-acute-map device) + (x-define-dead-key dead-grave compose-grave-map device) + (x-define-dead-key dead-cedilla compose-cedilla-map device) + (x-define-dead-key dead-diaeresis compose-diaeresis-map device) + (x-define-dead-key dead-circum compose-circumflex-map device) + (x-define-dead-key dead-circumflex compose-circumflex-map device) + (x-define-dead-key dead-tilde compose-tilde-map device) ) (eval-when-compile (load "x-win-sun" nil t) (load "x-win-xfree86" nil t)) -(defun x-initialize-keyboard () +(defun x-initialize-keyboard (device) "Perform X-Server-specific initializations. Don't call this." ;; This is some heuristic junk that tries to guess whether this is ;; a Sun keyboard. ＠＠ -224,17 +224,17 ＠＠ ;; Note that we cannot use most vendor-provided proprietary keyboard ;; APIs to identify the keyboard - those only work on the console. ;; xkeycaps has the same problem when running `remotely'. - (let ((vendor (x-server-vendor))) + (let ((vendor (x-server-vendor device))) (cond ((or (string-match "Sun Microsystems" vendor) ;; MIT losingly fails to tell us what hardware the X server ;; is managing, so assume all MIT displays are Suns... HA HA! (string-equal "MIT X Consortium" vendor) (string-equal "X Consortium" vendor)) ;; Ok, we think this could be a Sun keyboard. Run the Sun code. - (x-win-init-sun)) + (x-win-init-sun device)) ((string-match #r"XFree86\|Cygwin/X\|The X\.Org Foundation" vendor) ;; Those XFree86 people do some weird keysym stuff, too. - (x-win-init-xfree86))))) + (x-win-init-xfree86 device)))))  ;; Moved from x-toolbar.el, since InfoDock doesn't dump x-toolbar.el. (defun x-init-toolbar-from-resources (locale) ＠＠ -252,69 +252,48 ＠＠ (x-init-specifier-from-resources specifier 'natnum locale (cons resname (upcase-initials resname))))) -(defvar pre-x-win-initted nil) +(defvar make-device-early-x-entry-point-called-p nil + "Whether `make-device-early-x-entry-point' has been called, at least once. -(defun init-pre-x-win () - "Initialize X Windows at startup (pre). Don't call this." - (when (not pre-x-win-initted) - (setq initial-frame-plist (if initial-frame-unmapped-p - '(initially-unmapped t) - nil)) - (setq pre-x-win-initted t))) +Much of the X11-specific Lisp init code should only be called the first time +an X11 device is created; this variable allows for that.") -(defvar x-win-initted nil) +(defvar make-device-late-x-entry-point-called-p nil + "Whether `make-device-late-x-entry-point' has been called, at least once. -(defun init-x-win () - "Initialize X Windows at startup. Don't call this." - (when (not x-win-initted) - (defvar x-app-defaults-directory) - (init-pre-x-win) - (if (featurep 'mule) (init-mule-x-win)) +Much of the X11-specific Lisp init code should only be called the first time +an X11 device is created; this variable allows for that.") - ;; Open the X display when this file is loaded - ;; (Note that the first frame is created later.) - (setq x-initial-argv-list (cons (car command-line-args) - command-line-args-left)) - ;; Locate the app-defaults directory - (when (and (boundp 'x-app-defaults-directory) - (null x-app-defaults-directory)) - (setq x-app-defaults-directory - (locate-data-directory "app-defaults"))) - (make-x-device nil) +(defun make-device-early-x-entry-point () + "Entry point to set up the Lisp environment for X device creation." + (unless make-device-early-x-entry-point-called-p + (setq initial-frame-plist + (and initial-frame-unmapped-p '(initially-unmapped t)) + ;; Save the argv value. + x-initial-argv-list + (cons (car command-line-args) command-line-args-left) + ;; Locate the app-defaults directory + x-app-defaults-directory + (or x-app-defaults-directory (locate-data-directory "app-defaults")) + make-device-early-x-entry-point-called-p t))) + +(defun make-device-late-x-entry-point (device) + "Entry point to do any Lisp-level X device-specific initialization." + ;; General code, called on every X device created: + (x-initialize-keyboard device) + (x-initialize-compose device) + ;; And the following code is to be called once, the first time an X11 + ;; device is created: + (unless make-device-late-x-entry-point-called-p (setq command-line-args-left (cdr x-initial-argv-list)) - (setq x-win-initted t))) - -(defvar post-x-win-initted nil) - -(defun init-post-x-win () - "Initialize X Windows at startup (post). Don't call this." - (when (not post-x-win-initted) - ;(if (featurep 'mule) (init-mule-x-win)) ;; Motif-ish bindings - ;; The following two were generally unliked. - ;;(define-key global-map '(shift delete) 'kill-primary-selection) - ;;(define-key global-map '(control delete) 'delete-primary-selection) (define-key global-map '(shift insert) 'yank-clipboard-selection) (define-key global-map '(control insert) 'copy-primary-selection) ;; These are Sun-isms. (define-key global-map 'copy 'copy-primary-selection) (define-key global-map 'paste 'yank-clipboard-selection) (define-key global-map 'cut 'kill-primary-selection) - - ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI - - (setq post-x-win-initted t))) - -;;; Keyboard initialization needs to be done differently for each X -;;; console, so use create-console-hook. -(when (featurep 'x) - (add-hook - 'create-console-hook - (lambda (console) - (letf (((selected-console) console)) - (when (eq 'x (console-type console)) - (x-initialize-keyboard) - (x-initialize-compose)))))) + (setq make-device-late-x-entry-point-called-p t))) (defun make-frame-on-display (display &optional props) "Create a frame on the X display named DISPLAY. diff -r 78738a40e31e -r b3b6cf59fe58 lisp/x-win-sun.el --- a/lisp/x-win-sun.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/x-win-sun.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -68,7 +68,7 ＠＠ '(x-keysym-on-keyboard-sans-modifiers-p)) ;;;###autoload -(defun x-win-init-sun () +(defun x-win-init-sun (device) ;; help is ok ;; num_lock is ok ＠＠ -112,51 +112,51 ＠＠ ;; Map f33 and r13 to end or kp-end ,＠(cond - ((not (x-keysym-on-keyboard-sans-modifiers-p 'end)) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'end device)) '((f33 end) (r13 end))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-end)) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-end device)) '((f33 kp-end) (r13 kp-end)))) - ,＠(when (x-keysym-on-keyboard-sans-modifiers-p 'f36) + ,＠(when (x-keysym-on-keyboard-sans-modifiers-p 'f36 device) '((f36 stop) (f37 again))) ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `=' ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-' - ,＠(when (x-keysym-on-keyboard-sans-modifiers-p 'f24) - `((f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p 'kp-subtract) + ,＠(when (x-keysym-on-keyboard-sans-modifiers-p 'f24 device) + `((f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p 'kp-subtract device) 'kp-equal 'kp-subtract)))) ;; Map f27 to home or kp-home, as appropriate - ,＠(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'home)) + ,＠(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'home device)) '((f27 home))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-home)) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-home device)) '((f27 kp-home)))) ;; Map f29 to prior or kp-prior, as appropriate - ,＠(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'prior)) + ,＠(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'prior device)) '((f29 prior))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-prior)) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-prior device)) '((f29 kp-prior)))) ;; Map f35 to next or kp-next, as appropriate - ,＠(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'next)) + ,＠(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'next device)) '((f35 next))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-next)) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-next device)) '((f35 kp-next)))) - ,＠(cond ((x-keysym-on-keyboard-sans-modifiers-p 'apRead) ; SunOS 4.1.1 + ,＠(cond ((x-keysym-on-keyboard-sans-modifiers-p 'apRead device) ; SunOS 4.1.1 '((apRead f11) (apEdit f12))) - ((x-keysym-on-keyboard-sans-modifiers-p 'SunF36) ; SunOS 5 + ((x-keysym-on-keyboard-sans-modifiers-p 'SunF36 device) ; SunOS 5 '((SunF36 f11) (SunF37 f12) (f11 stop) (f12 again)))) ) - do (when (x-keysym-on-keyboard-sans-modifiers-p from-key) + do (when (x-keysym-on-keyboard-sans-modifiers-p from-key device) (dolist (prefix '(() (shift) (control) (meta) (alt) (shift control) (shift alt) (shift meta) (control alt) (control meta) (alt meta) diff -r 78738a40e31e -r b3b6cf59fe58 lisp/x-win-xfree86.el --- a/lisp/x-win-xfree86.el Sun Jun 29 11:06:16 2008 +0200 +++ b/lisp/x-win-xfree86.el Mon Jul 07 22:53:43 2008 +0200 ＠＠ -45,7 +45,7 ＠＠ '(x-keysym-on-keyboard-p x-keysym-on-keyboard-sans-modifiers-p)) ;;;###autoload -(defun x-win-init-xfree86 () +(defun x-win-init-xfree86 (device) ;; We know this keyboard is an XFree86 keyboard. As such, we can predict ;; what key scan codes will correspond to the keys on US keyboard layout, ＠＠ -91,8 +91,8 ＠＠ (f23 f11) (f24 f12)) do - (when (and (x-keysym-on-keyboard-p key) - (not (x-keysym-on-keyboard-sans-modifiers-p key))) + (when (and (x-keysym-on-keyboard-p key device) + (not (x-keysym-on-keyboard-sans-modifiers-p key device))) ;; define also the control, meta, and meta-control versions. (loop for mods in '(() (control) (meta) (meta control)) do (define-key function-key-map `[(,＠mods ,key)] `[(shift ,＠mods ,sane-key)]) diff -r 78738a40e31e -r b3b6cf59fe58 src/ChangeLog --- a/src/ChangeLog Sun Jun 29 11:06:16 2008 +0200 +++ b/src/ChangeLog Mon Jul 07 22:53:43 2008 +0200 ＠＠ -1,3 +1,56 ＠＠ +2008-07-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + Patch to make it up to the device-specific code whether + various Lisp functions should be called during device creation, + not relying on the startup code to decide this. Also, rename + initial-window-system to initial-device-type (which makes more + sense in this scheme), always set it. + + * redisplay.c (Vinitial_device_type): New. + (Vinitial_window_system): Removed. + Rename initial-window-system to initial-device type, making it + a stream if we're noninteractive. Update its docstring. + + * device-x.c (Qmake_device_early_x_entry_point, + Qmake_device_late_x_entry_point): New. + Rename Qinit_pre_x_win, Qinit_post_x_win. + (x_init_device): Call #'make-device-early-x-entry-point earlier, + now we rely on it to find the application class and the + app-defaults directory. + (x_finish_init_device): Call #'make-device-late-x-entry-point with + the created device. + (Vx_app_defaults_directory): Always make this available, to + simplify code in x-init.el. + + * device-tty.c (Qmake_device_early_tty_entry_point): New. + Rename Qinit_pre_tty_win, rename Qinit_post_tty_win and move to + frame-tty.c as Qmake_frame_after_init_entry_point. + (tty_init_device): Call #'make-device-early-tty-entry-point before + doing anything. + * frame-tty.c (Qmake_frame_after_init_entry_point): New. + * frame-tty.c (tty_after_init_frame): Have it call the + better-named #'make-frame-after-init-entry-point function + instead of #'init-post-tty-win (since it's called after frame, not + device, creation). + + * device-msw.c (Qmake_device_early_mswindows_entry_point, + Qmake_device_late_mswindows_entry_point): New. + Rename Qinit_pre_mswindows_win, Qinit_post_mswindows_win. + (mswindows_init_device): Call + #'make-device-early-mswindows-entry-point here, instead of having + its predecessor call us. + (mswindows_finish_init_device): Call + #'make-device-early-mswindows-entry-point, for symmetry with the + other device types (though it's an empty function). + + * device-gtk.c (Qmake_device_early_gtk_entry_point, + Qmake_device_late_gtk_entry_point): New. + Rename Qinit_pre_gtk_win, Qinit_post_gtk_win. + (gtk_init_device): Call #'make-device-early-gtk-entry-point; don't + load ~/.xemacs/gtk-options.el ourselves, leave that to lisp. + (gtk_finish_init_device): Call #'make-device-late-gtk-entry-point + with the created device as an argument. + 2008-05-27 Aidan Kehoe <kehoea(a)parhasard.net&gt; * editfns.c (Ftranslate_region): diff -r 78738a40e31e -r b3b6cf59fe58 src/device-gtk.c --- a/src/device-gtk.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/device-gtk.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -56,8 +56,8 ＠＠ #include <bonobo.h> #endif -/* Qdisplay in general.c */ -Lisp_Object Qinit_pre_gtk_win, Qinit_post_gtk_win; +Lisp_Object Qmake_device_early_gtk_entry_point, + Qmake_device_late_gtk_entry_point; /* The application class of Emacs. */ Lisp_Object Vgtk_emacs_application_class; ＠＠ -220,6 +220,9 ＠＠ GdkVisual *visual = NULL; GdkColormap *cmap = NULL; + /* Run the early elisp side of the GTK device initialization. */ + call0 (Qmake_device_early_gtk_entry_point); + /* gtk_init() and even gtk_check_init() are so brain dead that getting an empty argv array causes them to abort. */ if (NILP (Vgtk_initial_argv_list)) ＠＠ -266,13 +269,6 ＠＠ #ifdef __FreeBSD__ gdk_set_use_xshm (FALSE); #endif - - /* We attempt to load this file so that the user can set - ** gtk-initial-geometry and not need GNOME & session management to - ** set their default frame size. It also avoids the flicker - ** associated with setting the frame size in your .emacs file. - */ - call4 (Qload, build_string ("~/.xemacs/gtk-options.el"), Qt, Qt, Qt); #ifdef HAVE_GDK_IMLIB_INIT /* Some themes in Gtk are so lame (most notably the Pixmap theme) ＠＠ -336,15 +332,12 ＠＠ DEVICE_GTK_GRAY_PIXMAP (d) = NULL; gtk_init_device_class (d); - - /* Run the elisp side of the X device initialization. */ - call0 (Qinit_pre_gtk_win); } static void -gtk_finish_init_device (struct device *UNUSED (d), Lisp_Object UNUSED (props)) +gtk_finish_init_device (struct device *d, Lisp_Object UNUSED (props)) { - call0 (Qinit_post_gtk_win); + call1 (Qmake_device_late_gtk_entry_point, wrap_device(d)); } static void ＠＠ -709,8 +702,8 ＠＠ DEFSUBR (Fgtk_ungrab_keyboard); DEFSUBR (Fgtk_init); - DEFSYMBOL (Qinit_pre_gtk_win); - DEFSYMBOL (Qinit_post_gtk_win); + DEFSYMBOL (Qmake_device_early_gtk_entry_point); + DEFSYMBOL (Qmake_device_late_gtk_entry_point); } void diff -r 78738a40e31e -r b3b6cf59fe58 src/device-msw.c --- a/src/device-msw.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/device-msw.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -60,7 +60,8 ＠＠ HSZ mswindows_dde_item_open; #endif -Lisp_Object Qinit_pre_mswindows_win, Qinit_post_mswindows_win; +Lisp_Object Qmake_device_early_mswindows_entry_point, + Qmake_device_late_mswindows_entry_point; Lisp_Object Qdevmodep; static Lisp_Object Q_allow_selection; ＠＠ -156,6 +157,8 ＠＠ { HDC hdc; WNDCLASSEXW wc; + + call0 (Qmake_device_early_mswindows_entry_point); DEVICE_CLASS (d) = Qcolor; DEVICE_INFD (d) = DEVICE_OUTFD (d) = -1; ＠＠ -273,13 +276,14 ＠＠ } static void -mswindows_finish_init_device (struct device *UNUSED (d), +mswindows_finish_init_device (struct device *d, Lisp_Object UNUSED (props)) { #ifdef HAVE_DRAGNDROP /* Tell pending clients we are ready. */ mswindows_dde_enable = 1; #endif + call1 (Qmake_device_late_mswindows_entry_point, wrap_device(d)); } static void ＠＠ -1393,8 +1397,8 ＠＠ DEFKEYWORD (Q_selected_page_button); DEFSYMBOL (Qselected_page_button); - DEFSYMBOL (Qinit_pre_mswindows_win); - DEFSYMBOL (Qinit_post_mswindows_win); + DEFSYMBOL (Qmake_device_early_mswindows_entry_point); + DEFSYMBOL ( Qmake_device_late_mswindows_entry_point); } void diff -r 78738a40e31e -r b3b6cf59fe58 src/device-tty.c --- a/src/device-tty.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/device-tty.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -41,7 +41,7 ＠＠ #include "sysfile.h" #include "syssignal.h" /* for SIGWINCH */ -Lisp_Object Qinit_pre_tty_win, Qinit_post_tty_win; +Lisp_Object Qmake_device_early_tty_entry_point;  #ifdef NEW_GC ＠＠ -71,6 +71,10 ＠＠ { struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); Lisp_Object terminal_type = CONSOLE_TTY_DATA (con)->terminal_type; + + /* Run part of the elisp side of the TTY device initialization. + The post-init is run in the tty_finish_init_device() method. */ + call0 (Qmake_device_early_tty_entry_point); DEVICE_INFD (d) = CONSOLE_TTY_DATA (con)->infd; DEVICE_OUTFD (d) = CONSOLE_TTY_DATA (con)->outfd; ＠＠ -107,10 +111,6 ＠＠ } init_one_device (d); - - /* Run part of the elisp side of the TTY device initialization. - The post-init is run in the tty_after_init_frame() method. */ - call0 (Qinit_pre_tty_win); } #ifndef NEW_GC ＠＠ -211,8 +211,7 ＠＠ INIT_LRECORD_IMPLEMENTATION (tty_device); #endif /* NEW_GC */ - DEFSYMBOL (Qinit_pre_tty_win); - DEFSYMBOL (Qinit_post_tty_win); + DEFSYMBOL (Qmake_device_early_tty_entry_point); } void diff -r 78738a40e31e -r b3b6cf59fe58 src/device-x.c --- a/src/device-x.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/device-x.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -65,14 +65,14 ＠＠ #include "offix.h" #endif +Lisp_Object Vx_app_defaults_directory; #ifdef MULE -Lisp_Object Vx_app_defaults_directory; Lisp_Object Qget_coding_system_from_locale; #endif /* Qdisplay in general.c */ Lisp_Object Qx_error; -Lisp_Object Qinit_pre_x_win, Qinit_post_x_win; +Lisp_Object Qmake_device_early_x_entry_point, Qmake_device_late_x_entry_point; /* The application class of Emacs. */ Lisp_Object Vx_emacs_application_class; ＠＠ -542,6 +542,10 ＠＠ /* */ int best_visual_found = 0; + /* Run the elisp side of the X device initialization, allowing it to set + x-emacs-application-class and x-app-defaults-directory. */ + call0 (Qmake_device_early_x_entry_point); + #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) /* * In order to avoid the lossage with flat Athena widgets dynamically ＠＠ -921,15 +925,12 ＠＠ Xatoms_of_select_x (d); Xatoms_of_objects_x (d); x_init_device_class (d); - - /* Run the elisp side of the X device initialization. */ - call0 (Qinit_pre_x_win); } static void -x_finish_init_device (struct device *UNUSED (d), Lisp_Object UNUSED (props)) +x_finish_init_device (struct device *d, Lisp_Object UNUSED (props)) { - call0 (Qinit_post_x_win); + call1 (Qmake_device_late_x_entry_point, wrap_device (d)); } static void ＠＠ -2133,8 +2134,8 ＠＠ DEFSUBR (Fx_set_font_path); DEFSYMBOL (Qx_error); - DEFSYMBOL (Qinit_pre_x_win); - DEFSYMBOL (Qinit_post_x_win); + DEFSYMBOL (Qmake_device_early_x_entry_point); + DEFSYMBOL (Qmake_device_late_x_entry_point); #ifdef MULE DEFSYMBOL (Qget_coding_system_from_locale); ＠＠ -2207,13 +2208,11 ＠＠ */ ); Vx_initial_argv_list = Qnil; -#ifdef MULE DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /* Used by the Lisp code to communicate to the low level X initialization where the localized init files are. */ ); Vx_app_defaults_directory = Qnil; -#endif Fprovide (Qx); } diff -r 78738a40e31e -r b3b6cf59fe58 src/emacs.c --- a/src/emacs.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/emacs.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -3008,13 +3008,14 ＠＠ Do not call this. It will reinitialize your XEmacs. You'll be sorry. */ /* If this function is called from startup.el, it will be possible to run - temacs as an editor using `temacs -batch -l loadup.el run-temacs', instead - of having to dump an emacs and then run that (when debugging emacs itself, - this can be much faster)). [Actually, the speed difference isn't that - much as long as your filesystem is local, and you don't end up with - a dumped version in case you want to rerun it. This function is most - useful when used as part of the `make all-elc' command. --ben] - This will "restart" emacs with the specified command-line arguments. + temacs as an editor using `temacs -batch -l ../lisp/loadup.el + run-temacs', instead of having to dump an emacs and then run that (when + debugging emacs itself, this can be much faster)). [Actually, the speed + difference isn't that much as long as your filesystem is local, and you + don't end up with a dumped version in case you want to rerun it. This + function is most useful when used as part of the `make all-elc' + command. --ben] This will "restart" emacs with the specified command-line + arguments. Martin thinks this function is most useful when using debugging tools like Purify or tcov that get confused by XEmacs' dumping. */ diff -r 78738a40e31e -r b3b6cf59fe58 src/frame-tty.c --- a/src/frame-tty.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/frame-tty.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -37,7 +37,7 ＠＠ /* Default properties to use when creating frames. */ Lisp_Object Vdefault_tty_frame_plist; -Lisp_Object Qframe_number; +Lisp_Object Qframe_number, Qmake_frame_after_init_entry_point; static void tty_raise_frame (struct frame *); ＠＠ -83,7 +83,7 ＠＠ int first_on_console) { if (first_on_console) - call1 (Qinit_post_tty_win, FRAME_CONSOLE (f)); + call1 (Qmake_frame_after_init_entry_point, FRAME_CONSOLE (f)); } /* Change from withdrawn state to mapped state. */ ＠＠ -235,6 +235,7 ＠＠ syms_of_frame_tty (void) { DEFSYMBOL (Qframe_number); + DEFSYMBOL (Qmake_frame_after_init_entry_point); } void diff -r 78738a40e31e -r b3b6cf59fe58 src/redisplay.c --- a/src/redisplay.c Sun Jun 29 11:06:16 2008 +0200 +++ b/src/redisplay.c Mon Jul 07 22:53:43 2008 +0200 ＠＠ -476,7 +476,7 ＠＠ (`x', `gtk', `mswindows', and `tty' are supported -- yes, TTYs are window systems for this purpose. */ -Lisp_Object Vinitial_window_system; +Lisp_Object Vinitial_device_type; Lisp_Object Vglobal_mode_string; ＠＠ -9748,9 +9748,15 ＠＠ internal_cache = Dynarr_new (line_start_cache); } - /* window system is nil when in -batch mode */ - if (!initialized || noninteractive) + if (!initialized) return; + + if (noninteractive) + { + Vwindow_system = Qstream; + Vinitial_device_type = Qstream; + return; + } /* If the user wants to use a window system, we shouldn't bother initializing the terminal. This is especially important when the ＠＠ -9765,7 +9771,7 ＠＠ { /* Some stuff checks this way early. */ Vwindow_system = Qx; - Vinitial_window_system = Qx; + Vinitial_device_type = Qx; return; } #endif /* HAVE_X_WINDOWS */ ＠＠ -9774,7 +9780,7 ＠＠ if (!strcmp (display_use, "gtk")) { Vwindow_system = Qgtk; - Vinitial_window_system = Qgtk; + Vinitial_device_type = Qgtk; return; } #endif ＠＠ -9784,7 +9790,7 ＠＠ { /* Some stuff checks this way early. */ Vwindow_system = Qmswindows; - Vinitial_window_system = Qmswindows; + Vinitial_device_type = Qmswindows; return; } #endif /* HAVE_MS_WINDOWS */ ＠＠ -9804,7 +9810,7 ＠＠ exit (1); } - Vinitial_window_system = Qtty; + Vinitial_device_type = Qtty; return; #else /* not HAVE_TTY */ /* No DISPLAY specified, and no TTY support. */ ＠＠ -9948,11 +9954,13 ＠＠ */ ); Vwindow_system = Qnil; - /* #### Temporary shit until window-system is eliminated. */ - DEFVAR_CONST_LISP ("initial-window-system", &Vinitial_window_system /* -DON'T TOUCH -*/ ); - Vinitial_window_system = Qnil; + DEFVAR_CONST_LISP ("initial-device-type", &Vinitial_device_type /* +The type of the first XEmacs device to be created. + +This is constant; it's used by the command line handling code to communicate +to Lisp what type the initial device to be created should be. +*/ ); + Vinitial_device_type = Qnil; DEFVAR_BOOL ("cursor-in-echo-area", &cursor_in_echo_area /* Non-nil means put cursor in minibuffer, at end of any message there. -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches