Don't determine whether to call general device-type code at startup, rather decide in the device-specific code itself. lisp/ChangeLog addition: 2008-07-07 Aidan Kehoe <kehoea@parhasard.net> 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. src/ChangeLog addition: 2008-07-07 Aidan Kehoe <kehoea@parhasard.net> 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.

;;; widgets-gtk.el --- Embedded widget support for XEmacs w/GTK primitives

;; Copyright (C) 2001 Free Software Foundation, Inc.

;; Maintainer: William M. Perry <wmperry@gnu.org>
;; Keywords: extensions, internal, dumped

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the 
;; Free Software Foundation, 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Synched up with: Not in FSF.

;;; Commentary:

;; This file is dumped with XEmacs (when embedded widgets are compiled in).

(globally-declare-fboundp
 '(gtk-button-new-with-label
   gtk-signal-connect
   gtk-radio-button-new-with-label gtk-radio-button-group
   gtk-toggle-button-set-active gtk-check-button-new-with-label
   gtk-widget-show-all gtk-notebook-new gtk-notebook-append-page
   gtk-vbox-new gtk-label-new gtk-adjustment-new
   gtk-progress-bar-new-with-adjustment gtk-adjustment-set-value
   gtk-entry-new gtk-entry-set-text gtk-widget-set-style
   gtk-widget-get-style))

(defun gtk-widget-get-callback (widget plist instance)
  (let ((cb (plist-get plist :callback))
	(ex (plist-get plist :callback-ex))
	(real-cb nil))
    (cond
     (ex
      (gtk-signal-connect widget 'button-release-event
			  (lambda (widget event data)
			    (put widget 'last-event event)))
      `(lambda (widget &rest ignored)
	 (funcall ,ex ,instance (get widget 'last-event))))
     (cb
      `(lambda (widget &rest ignored)
	 (if (functionp ,real-cb)
	     (funcall ,real-cb)
	   (eval ,real-cb))))
     (t
      nil))))

(defun gtk-widget-instantiate-button-internal (plist instance)
  (let* ((type (or (plist-get plist :style) 'button))
	 (label (or (plist-get plist :descriptor) (symbol-name type)))
	 (widget nil))
    (case type
      (button
       (setq widget (gtk-button-new-with-label label))
       (gtk-signal-connect widget 'clicked
			   (gtk-widget-get-callback widget plist instance)))
      (radio
       (let ((aux nil)
	     (selected-p (plist-get plist :selected)))
	 (setq widget (gtk-radio-button-new-with-label nil label)
	       aux (gtk-radio-button-new-with-label
		    (gtk-radio-button-group widget)
		    "bogus sibling"))
	 (gtk-toggle-button-set-active widget (eval selected-p))
	 (gtk-signal-connect widget 'toggled
			     (gtk-widget-get-callback widget plist instance) aux)))
      (otherwise
       ;; Check boxes
       (setq widget (gtk-check-button-new-with-label label))
       (gtk-toggle-button-set-active widget
				     (eval (plist-get plist :selected)))
       (gtk-signal-connect widget 'toggled
			   (gtk-widget-get-callback widget plist instance))))
    (gtk-widget-show-all widget)
    widget))

(defun gtk-widget-instantiate-notebook-internal (plist instance)
  (let ((widget (gtk-notebook-new))
	;(items (plist-get plist :items))
	)
;    (while items
;      (gtk-notebook-append-page widget
;				(gtk-vbox-new nil 3)
;				(gtk-label-new (aref (car items) 0)))
;      (setq items (cdr items)))
    widget))

(defun gtk-widget-instantiate-progress-internal (plist instance)
  (let* ((adj (gtk-adjustment-new 0.0 0.0 100.0 1.0 5.0 5.0))
	 (widget (gtk-progress-bar-new-with-adjustment adj)))
    (gtk-adjustment-set-value adj (or (plist-get plist :value) 0.0))
    widget))

(defun gtk-widget-instantiate-entry-internal (plist instance)
  (let* ((widget (gtk-entry-new))
	 (default (plist-get plist :descriptor)))
    (cond
     ((stringp default)
      nil)
     ((sequencep default)
      (setq default (mapconcat 'identity default "")))
     (t
      (error "Invalid default value: %S" default)))
    (gtk-entry-set-text widget default)
    widget))

(put 'button         'instantiator 'gtk-widget-instantiate-button-internal)
(put 'tab-control    'instantiator 'gtk-widget-instantiate-notebook-internal)
(put 'progress-gauge 'instantiator 'gtk-widget-instantiate-progress-internal)
(put 'tree-view      'instantiator 'ignore)
(put 'edit-field     'instantiator 'gtk-widget-instantiate-entry-internal)
(put 'combo-box      'instantiator 'ignore)
(put 'label          'instantiator 'ignore)
(put 'layout         'instantiator 'ignore)

(defun gtk-widget-instantiate-internal (instance
					instantiator
					pointer-fg
					pointer-bg
					domain)
  "The lisp side of widget/glyph instantiation code."
  (let* ((type (aref instantiator 0))
	 (plist (cdr (map 'list 'identity instantiator)))
	 (widget (funcall (or (get type 'instantiator) 'ignore)
			  plist instance)))
;    (add-timeout 0.1 (lambda (obj)
;		       (gtk-widget-set-style obj
;					     (gtk-widget-get-style
;					      (frame-property nil 'text-widget))))
;		 widget)
    widget))

(defun gtk-widget-property-internal ()
  nil)

(defun gtk-widget-redisplay-internal ()
  nil)

(provide 'widgets-gtk)